[Dart-dev] [5803] DART/branches/development/obs_def/obs_def_tower_mod.f90: Replacing the three nearly identical subroutines with one

nancy at ucar.edu nancy at ucar.edu
Fri Jul 20 15:22:32 MDT 2012


Revision: 5803
Author:   thoar
Date:     2012-07-20 15:22:32 -0600 (Fri, 20 Jul 2012)
Log Message:
-----------
Replacing the three nearly identical subroutines with one
routine that has the CLM history file variable name as a string argument.
Otherwise - all three routines were identical.
Removed a couple unused variables as identified by the Intel compiler.
The routine name to get a scalar from a CLM history file 3D variable is
get_scalar_from_3Dhistory().

Modified Paths:
--------------
    DART/branches/development/obs_def/obs_def_tower_mod.f90

-------------- next part --------------
Modified: DART/branches/development/obs_def/obs_def_tower_mod.f90
===================================================================
--- DART/branches/development/obs_def/obs_def_tower_mod.f90	2012-07-18 21:19:01 UTC (rev 5802)
+++ DART/branches/development/obs_def/obs_def_tower_mod.f90	2012-07-20 21:22:32 UTC (rev 5803)
@@ -25,20 +25,18 @@
 
 !-----------------------------------------------------------------------------
 ! BEGIN DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
-!  use obs_def_tower_mod, only : get_expected_latent_heat_flux
-!  use obs_def_tower_mod, only : get_expected_sensible_heat_flux
-!  use obs_def_tower_mod, only : get_expected_net_C_production
+!  use obs_def_tower_mod, only : get_scalar_from_3Dhistory
 ! END DART PREPROCESS USE OF SPECIAL OBS_DEF MODULE
 !-----------------------------------------------------------------------------
 
 !-----------------------------------------------------------------------------
 ! BEGIN DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
 !  case(TOWER_LATENT_HEAT_FLUX)
-!     call get_expected_latent_heat_flux(state, state_time, ens_index, location, obs_time, obs_key, obs_val, istatus)
+!     call get_scalar_from_3Dhistory('EFLX_LH_TOT_R', state_time, ens_index, location, obs_time, obs_val, istatus)
 !  case(TOWER_SENSIBLE_HEAT_FLUX)
-!     call get_expected_sensible_heat_flux(state, state_time, ens_index, location, obs_time, obs_key, obs_val, istatus)
+!     call get_scalar_from_3Dhistory('FSH', state_time, ens_index, location, obs_time, obs_val, istatus)
 !  case(TOWER_NETC_ECO_EXCHANGE)
-!     call get_expected_net_C_production(state, state_time, ens_index, location, obs_time, obs_key, obs_val, istatus)
+!     call get_scalar_from_3Dhistory('NEP', state_time, ens_index, location, obs_time, obs_val, istatus)
 ! END DART PREPROCESS GET_EXPECTED_OBS_FROM_DEF
 !-----------------------------------------------------------------------------
 
@@ -88,9 +86,7 @@
 implicit none
 private
 
-public :: get_expected_latent_heat_flux,   &
-          get_expected_sensible_heat_flux, &
-          get_expected_net_C_production
+public :: get_scalar_from_3Dhistory
 
 ! version controlled file description for error handling, do not edit
 character(len=128), parameter :: &
@@ -129,7 +125,7 @@
 ! Called once to set values and allocate space, open all the CLM files
 ! that have the observations, etc.
 
-integer :: iunit, io, rc, i
+integer :: iunit, io, i
 integer :: dimid, varid
 integer :: year, month, day, hour, minute, second, leftover
 integer, allocatable, dimension(:) :: yyyymmdd,sssss
@@ -303,342 +299,14 @@
 end subroutine initialize_module
 
 
-subroutine get_expected_latent_heat_flux(state, state_time, ens_index, location, obs_time, obs_key, obs_val, istatus)
-! the routine must return values for:
-! obs_val -- the computed forward operator value
-! istatus -- return code: 0=ok, > 0 is error, < 0 reserved for system use
 
-real(r8),            intent(in)  :: state(:)
-type(time_type),     intent(in)  :: state_time
-integer,             intent(in)  :: ens_index
-type(location_type), intent(in)  :: location
-type(time_type),     intent(in)  :: obs_time
-integer,             intent(in)  :: obs_key
-real(r8),            intent(out) :: obs_val
-integer,             intent(out) :: istatus
-
-integer,  dimension(NF90_MAX_VAR_DIMS) :: dimids
-real(r8), dimension(3) :: loc
-integer,  dimension(3) :: ncstart, nccount
-integer,  dimension(1) :: loninds, latinds, timeinds
-integer                :: gridloni, gridlatj, timei
-integer                :: varid, xtype, ndims, natts, dimlen
-integer                :: io1, io2, second, day
-real(r8)               :: loc_lon, loc_lat
-real(r4), dimension(1) :: hyperslab
-real(r4)               :: spvalR4
-real(r8)               :: scale_factor, add_offset
-real(digits12)         :: otime
-character(len=20)      :: strshort
-
-if ( .not. module_initialized ) call initialize_module(state_time)
-
-obs_val = MISSING_R8
-istatus = 1
-
-write(strshort,'(''ens_index '',i4)')ens_index
-
-if (ens_index > ens_size) then
-   write(string1,*)'believed to have ',ens_size,'ensemble members for observation operator.'
-   write(string2,*)'asking to use operator for ensemble member ',ens_index
-   call error_handler(E_ERR, 'get_expected_latent_heat_flux', &
-              string1, source, revision, revdate, text2=string2)
-endif
-
-! bombproofing ... make sure the netcdf file is open.
-
-write(*,*)'ncid(',ens_index,') is ',ncid(ens_index)
-call nc_check(nf90_inquire(ncid(ens_index)), &
-              'get_expected_latent_heat_flux', 'inquire '//trim(strshort))
-
-! bombproofing ... make sure the variable is the shape and size we expect
-
-call nc_check(nf90_inq_varid(ncid(ens_index), 'EFLX_LH_TOT_R', varid), &
-        'get_expected_latent_heat_flux', 'inq_varid EFLX_LH_TOT_R '//trim(strshort))
-call nc_check(nf90_inquire_variable(ncid(ens_index), varid, xtype=xtype, ndims=ndims, &
-        dimids=dimids, natts=natts),'get_expected_latent_heat_flux','inquire variable EFLX_LH_TOT_R '//trim(strshort))
-
-if (ndims /= 3) then
-   write(string1,*)'EFLX_LH_TOT_R is supposed to have 3 dimensions, it has',ndims
-   call error_handler(E_ERR, 'get_expected_latent_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! If the variable is not a NF90_FLOAT, then the assumptions for processing
-! the missing_value, _FillValue, etc., may not be correct.
-if (xtype /= NF90_FLOAT) then
-   write(string1,*)'EFLX_LH_TOT_R supposed to be a 32 bit real. xtype = ',NF90_FLOAT,' it is ',xtype 
-   call error_handler(E_ERR, 'get_expected_latent_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Dimension 1 is longitude
-call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(1), len=dimlen), &
-              'get_expected_latent_heat_flux', 'inquire_dimension EFLX_LH_TOT_R 1'//trim(strshort))
-if (dimlen /= nlon) then
-   write(string1,*)'LON has length',nlon,'EFLX_LH_TOT_R has ',dimlen,'longitudes.'
-   call error_handler(E_ERR, 'get_expected_latent_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Dimension 2 is latitude
-call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(2), len=dimlen), &
-              'get_expected_latent_heat_flux', 'inquire_dimension EFLX_LH_TOT_R 2'//trim(strshort))
-if (dimlen /= nlat) then
-   write(string1,*)'LAT has length',nlat,'EFLX_LH_TOT_R has ',dimlen,'latitudes.'
-   call error_handler(E_ERR, 'get_expected_latent_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Dimension 3 is time
-call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(3), len=dimlen), &
-              'get_expected_latent_heat_flux', 'inquire_dimension EFLX_LH_TOT_R 3'//trim(strshort))
-if (dimlen /= ntime) then
-   write(string1,*)'TIME has length',ntime,'EFLX_LH_TOT_R has ',dimlen,'times.'
-   call error_handler(E_ERR, 'get_expected_latent_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Find the grid cell and timestep of interest 
-! Get the individual locations values
-
-call get_time(obs_time, second, day)
-otime    = real(day,digits12) + real(second,digits12)/86400.0_digits12
-loc      = get_location(location)       ! loc is in DEGREES
-loc_lon  = loc(1)
-loc_lat  = loc(2)
-
-latinds  = minloc(abs(lat - loc_lat))   ! these return 'arrays' ...
-loninds  = minloc(abs(lon - loc_lon))   ! these return 'arrays' ...
-timeinds = minloc(abs(rtime - otime))   ! these return 'arrays' ...
-
-gridlatj = latinds(1)
-gridloni = loninds(1)
-timei    = timeinds(1)
-
-if (debug .and. do_output()) then
-   write(*,*)'get_expected_latent_heat_flux:targetlon, lon, lon index is ', &
-                                           loc_lon,lon(gridloni),gridloni
-   write(*,*)'get_expected_latent_heat_flux:targetlat, lat, lat index is ', &
-                                           loc_lat,lat(gridlatj),gridlatj
-   write(*,*)'get_expected_latent_heat_flux:  targetT,   T,   T index is ', &
-                                           otime,rtime(timei),timei
-endif
-
-if ( abs(otime - rtime(timei)) > 30*60 ) then
-   if (debug .and. do_output()) then
-      write(*,*)'get_expected_latent_heat_flux: no close time ... skipping observation'
-      call print_time(obs_time,'get_expected_latent_heat_flux:observation time')
-      call print_date(obs_time,'get_expected_latent_heat_flux:observation date')
-   endif
-   istatus = 2
-   return
-endif
-
-! Grab exactly the scalar we want.
-
-ncstart = (/ gridloni, gridlatj, timei /)
-nccount = (/        1,        1,     1 /)
-
-call nc_check(nf90_get_var(ncid(ens_index), varid, hyperslab, start=ncstart, count=nccount), &
-     'get_expected_latent_heat_flux', 'get_var')
-
-obs_val = hyperslab(1)
-
-! Apply any netCDF attributes ...
-
-io1 = nf90_get_att(ncid(ens_index), varid, '_FillValue' , spvalR4)
-if ((io1 == NF90_NOERR) .and. (hyperslab(1) == spvalR4)) obs_val = MISSING_R8
-
-io2 = nf90_get_att(ncid(ens_index), varid, 'missing_value' , spvalR4)
-if ((io2 == NF90_NOERR) .and. (hyperslab(1) == spvalR4)) obs_val = MISSING_R8
-
-io1 = nf90_get_att(ncid(ens_index), varid, 'scale_factor', scale_factor)
-io2 = nf90_get_att(ncid(ens_index), varid, 'add_offset'  , add_offset)
-
-if ( (io1 == NF90_NOERR) .and. (io2 == NF90_NOERR) ) then
-   if (obs_val /= MISSING_R8) obs_val = obs_val * scale_factor + add_offset
-elseif (io1 == NF90_NOERR) then
-   if (obs_val /= MISSING_R8) obs_val = obs_val * scale_factor
-elseif (io2 == NF90_NOERR) then
-   if (obs_val /= MISSING_R8) obs_val = obs_val + add_offset
-endif
-
-if (obs_val /= MISSING_R8) istatus = 0
-end subroutine get_expected_latent_heat_flux
-
-
-
-subroutine get_expected_sensible_heat_flux(state, state_time, ens_index, location, obs_time, obs_key, obs_val, istatus)
+subroutine get_scalar_from_3Dhistory(varstring, state_time, ens_index, location, obs_time, obs_val, istatus )
 ! the routine must return values for:
 ! obs_val -- the computed forward operator value
 ! istatus -- return code: 0=ok, > 0 is error, < 0 reserved for system use
-real(r8),            intent(in)  :: state(:)
-type(time_type),     intent(in)  :: state_time
-integer,             intent(in)  :: ens_index
-type(location_type), intent(in)  :: location
-type(time_type),     intent(in)  :: obs_time
-integer,             intent(in)  :: obs_key
-real(r8),            intent(out) :: obs_val
-integer,             intent(out) :: istatus
-
-integer,  dimension(NF90_MAX_VAR_DIMS) :: dimids
-real(r8), dimension(3) :: loc
-integer,  dimension(3) :: ncstart, nccount
-integer,  dimension(1) :: loninds, latinds, timeinds
-integer                :: gridloni, gridlatj, timei
-integer                :: varid, xtype, ndims, natts, dimlen
-integer                :: io1, io2, second, day
-real(r8)               :: loc_lon, loc_lat
-real(r4), dimension(1) :: hyperslab
-real(r4)               :: spvalR4
-real(r8)               :: scale_factor, add_offset
-real(digits12)         :: otime
-character(len=20)      :: strshort
-
-if ( .not. module_initialized ) call initialize_module(state_time)
-
-obs_val = MISSING_R8
-istatus = 1
-
-write(strshort,'(''ens_index '',i4)')ens_index
-
-if (ens_index > ens_size) then
-   write(string1,*)'believed to have ',ens_size,'ensemble members for observation operator.'
-   write(string2,*)'asking to use operator for ensemble member ',ens_index
-   call error_handler(E_ERR, 'get_expected_sensible_heat_flux', &
-              string1, source, revision, revdate, text2=string2)
-endif
-
-! bombproofing ... make sure the netcdf file is open.
-
-write(*,*)'ncid(',ens_index,') is ',ncid(ens_index)
-call nc_check(nf90_inquire(ncid(ens_index)), &
-              'get_expected_sensible_heat_flux', 'inquire '//trim(strshort))
-
-! bombproofing ... make sure the variable is the shape and size we expect
-
-call nc_check(nf90_inq_varid(ncid(ens_index), 'FSH', varid), &
-        'get_expected_sensible_heat_flux', 'inq_varid FSH '//trim(strshort))
-call nc_check(nf90_inquire_variable(ncid(ens_index), varid, xtype=xtype, ndims=ndims, &
-        dimids=dimids, natts=natts),'get_expected_sensible_heat_flux','inquire variable FSH '//trim(strshort))
-
-if (ndims /= 3) then
-   write(string1,*)'FSH is supposed to have 3 dimensions, it has',ndims
-   call error_handler(E_ERR, 'get_expected_sensible_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! If the variable is not a NF90_FLOAT, then the assumptions for processing
-! the missing_value, _FillValue, etc., may not be correct.
-if (xtype /= NF90_FLOAT) then
-   write(string1,*)'FSH supposed to be a 32 bit real. xtype = ',NF90_FLOAT,' it is ',xtype 
-   call error_handler(E_ERR, 'get_expected_sensible_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Dimension 1 is longitude
-call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(1), len=dimlen), &
-              'get_expected_sensible_heat_flux', 'inquire_dimension FSH 1'//trim(strshort))
-if (dimlen /= nlon) then
-   write(string1,*)'LON has length',nlon,'FSH has ',dimlen,'longitudes.'
-   call error_handler(E_ERR, 'get_expected_sensible_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Dimension 2 is latitude
-call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(2), len=dimlen), &
-              'get_expected_sensible_heat_flux', 'inquire_dimension FSH 2'//trim(strshort))
-if (dimlen /= nlat) then
-   write(string1,*)'LAT has length',nlat,'FSH has ',dimlen,'latitudes.'
-   call error_handler(E_ERR, 'get_expected_sensible_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Dimension 3 is time
-call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(3), len=dimlen), &
-              'get_expected_sensible_heat_flux', 'inquire_dimension FSH 3'//trim(strshort))
-if (dimlen /= ntime) then
-   write(string1,*)'TIME has length',ntime,'FSH has ',dimlen,'times.'
-   call error_handler(E_ERR, 'get_expected_sensible_heat_flux', &
-              string1, source, revision, revdate)
-endif
-
-! Find the grid cell and timestep of interest 
-! Get the individual locations values
-
-call get_time(obs_time, second, day)
-otime    = real(day,digits12) + real(second,digits12)/86400.0_digits12
-loc      = get_location(location)       ! loc is in DEGREES
-loc_lon  = loc(1)
-loc_lat  = loc(2)
-
-latinds  = minloc(abs(lat - loc_lat))   ! these return 'arrays' ...
-loninds  = minloc(abs(lon - loc_lon))   ! these return 'arrays' ...
-timeinds = minloc(abs(rtime - otime))   ! these return 'arrays' ...
-
-gridlatj = latinds(1)
-gridloni = loninds(1)
-timei    = timeinds(1)
-
-if (debug .and. do_output()) then
-   write(*,*)'get_expected_sensible_heat_flux:targetlon, lon, lon index is ', &
-                                           loc_lon,lon(gridloni),gridloni
-   write(*,*)'get_expected_sensible_heat_flux:targetlat, lat, lat index is ', &
-                                           loc_lat,lat(gridlatj),gridlatj
-   write(*,*)'get_expected_sensible_heat_flux:  targetT,   T,   T index is ', &
-                                           otime,rtime(timei),timei
-endif
-
-if ( abs(otime - rtime(timei)) > 30*60 ) then
-   if (debug .and. do_output()) then
-      write(*,*)'get_expected_sensible_heat_flux: no close time ... skipping observation'
-      call print_time(obs_time,'get_expected_sensible_heat_flux:observation time')
-      call print_date(obs_time,'get_expected_sensible_heat_flux:observation date')
-   endif
-   istatus = 2
-   return
-endif
-
-! Grab exactly the scalar we want.
-
-ncstart = (/ gridloni, gridlatj, timei /)
-nccount = (/        1,        1,     1 /)
-
-call nc_check(nf90_get_var(ncid(ens_index), varid, hyperslab, start=ncstart, count=nccount), &
-     'get_expected_sensible_heat_flux', 'get_var')
-
-obs_val = hyperslab(1)
-
-! Apply any netCDF attributes ...
-
-io1 = nf90_get_att(ncid(ens_index), varid, '_FillValue' , spvalR4)
-if ((io1 == NF90_NOERR) .and. (hyperslab(1) == spvalR4)) obs_val = MISSING_R8
-
-io2 = nf90_get_att(ncid(ens_index), varid, 'missing_value' , spvalR4)
-if ((io2 == NF90_NOERR) .and. (hyperslab(1) == spvalR4)) obs_val = MISSING_R8
-
-io1 = nf90_get_att(ncid(ens_index), varid, 'scale_factor', scale_factor)
-io2 = nf90_get_att(ncid(ens_index), varid, 'add_offset'  , add_offset)
-
-if ( (io1 == NF90_NOERR) .and. (io2 == NF90_NOERR) ) then
-   if (obs_val /= MISSING_R8) obs_val = obs_val * scale_factor + add_offset
-elseif (io1 == NF90_NOERR) then
-   if (obs_val /= MISSING_R8) obs_val = obs_val * scale_factor
-elseif (io2 == NF90_NOERR) then
-   if (obs_val /= MISSING_R8) obs_val = obs_val + add_offset
-endif
-
-if (obs_val /= MISSING_R8) istatus = 0
-
-end subroutine get_expected_sensible_heat_flux
-
-
-subroutine get_expected_net_C_production(state, state_time, ens_index, location, obs_time, obs_key, obs_val, istatus)
-! the routine must return values for:
-! obs_val -- the computed forward operator value
-! istatus -- return code: 0=ok, > 0 is error, < 0 reserved for system use
 !
+! The requirement is that the history file variable is a 3D variable shaped similarly:
+!
 ! float NEP(time, lat, lon) ;
 !          NEP:long_name = "net ecosystem production, blah, blah, blah" ;
 !          NEP:units = "gC/m^2/s" ;
@@ -646,12 +314,11 @@
 !          NEP:_FillValue = 1.e+36f ;
 !          NEP:missing_value = 1.e+36f ;
 
-real(r8),            intent(in)  :: state(:)
+character(len=*),    intent(in)  :: varstring
 type(time_type),     intent(in)  :: state_time
 integer,             intent(in)  :: ens_index
 type(location_type), intent(in)  :: location
 type(time_type),     intent(in)  :: obs_time
-integer,             intent(in)  :: obs_key
 real(r8),            intent(out) :: obs_val
 integer,             intent(out) :: istatus
 
@@ -674,12 +341,12 @@
 obs_val = MISSING_R8
 istatus = 1
 
-write(strshort,'(''ens_index '',i4)')ens_index
+write(strshort,'(''ens_index '',i4,1x,A)')ens_index,trim(varstring)
 
 if (ens_index > ens_size) then
    write(string1,*)'believed to have ',ens_size,'ensemble members for observation operator.'
    write(string2,*)'asking to use operator for ensemble member ',ens_index
-   call error_handler(E_ERR, 'get_expected_net_C_production', &
+   call error_handler(E_ERR, 'get_scalar_from_3Dhistory', &
               string1, source, revision, revdate, text2=string2)
 endif
 
@@ -687,53 +354,53 @@
 
 write(*,*)'ncid(',ens_index,') is ',ncid(ens_index)
 call nc_check(nf90_inquire(ncid(ens_index)), &
-              'get_expected_net_C_production', 'inquire '//trim(strshort))
+              'get_scalar_from_3Dhistory', 'inquire '//trim(strshort))
 
 ! bombproofing ... make sure the variable is the shape and size we expect
 
-call nc_check(nf90_inq_varid(ncid(ens_index), 'NEP', varid), &
-        'get_expected_net_C_production', 'inq_varid NEP '//trim(strshort))
+call nc_check(nf90_inq_varid(ncid(ens_index), trim(varstring), varid), &
+        'get_scalar_from_3Dhistory', 'inq_varid '//trim(strshort))
 call nc_check(nf90_inquire_variable(ncid(ens_index), varid, xtype=xtype, ndims=ndims, &
-        dimids=dimids, natts=natts),'get_expected_net_C_production','inquire variable NEP '//trim(strshort))
+        dimids=dimids, natts=natts),'get_scalar_from_3Dhistory','inquire variable '//trim(strshort))
 
 if (ndims /= 3) then
-   write(string1,*)'NEP is supposed to have 3 dimensions, it has',ndims
-   call error_handler(E_ERR, 'get_expected_net_C_production', &
+   write(string1,*)trim(varstring),' is supposed to have 3 dimensions, it has',ndims
+   call error_handler(E_ERR, 'get_scalar_from_3Dhistory', &
               string1, source, revision, revdate)
 endif
 
 ! If the variable is not a NF90_FLOAT, then the assumptions for processing
 ! the missing_value, _FillValue, etc., may not be correct.
 if (xtype /= NF90_FLOAT) then
-   write(string1,*)'NEP supposed to be a 32 bit real. xtype = ',NF90_FLOAT,' it is ',xtype 
-   call error_handler(E_ERR, 'get_expected_net_C_production', &
+   write(string1,*)trim(varstring),' is supposed to be a 32 bit real. xtype = ',NF90_FLOAT,' it is ',xtype 
+   call error_handler(E_ERR, 'get_scalar_from_3Dhistory', &
               string1, source, revision, revdate)
 endif
 
 ! Dimension 1 is longitude
 call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(1), len=dimlen), &
-              'get_expected_net_C_production', 'inquire_dimension NEP 1'//trim(strshort))
+              'get_scalar_from_3Dhistory', 'inquire_dimension 1 '//trim(strshort))
 if (dimlen /= nlon) then
-   write(string1,*)'LON has length',nlon,'NEP has ',dimlen,'longitudes.'
-   call error_handler(E_ERR, 'get_expected_net_C_production', &
+   write(string1,*)'LON has length',nlon,trim(varstring),' has ',dimlen,'longitudes.'
+   call error_handler(E_ERR, 'get_scalar_from_3Dhistory', &
               string1, source, revision, revdate)
 endif
 
 ! Dimension 2 is latitude
 call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(2), len=dimlen), &
-              'get_expected_net_C_production', 'inquire_dimension NEP 2'//trim(strshort))
+              'get_scalar_from_3Dhistory', 'inquire_dimension 2 '//trim(strshort))
 if (dimlen /= nlat) then
-   write(string1,*)'LAT has length',nlat,'NEP has ',dimlen,'latitudes.'
-   call error_handler(E_ERR, 'get_expected_net_C_production', &
+   write(string1,*)'LAT has length',nlat,trim(varstring),' has ',dimlen,'latitudes.'
+   call error_handler(E_ERR, 'get_scalar_from_3Dhistory', &
               string1, source, revision, revdate)
 endif
 
 ! Dimension 3 is time
 call nc_check(nf90_inquire_dimension(ncid(ens_index), dimids(3), len=dimlen), &
-              'get_expected_net_C_production', 'inquire_dimension NEP 3'//trim(strshort))
+              'get_scalar_from_3Dhistory', 'inquire_dimension 3'//trim(strshort))
 if (dimlen /= ntime) then
-   write(string1,*)'TIME has length',ntime,'NEP has ',dimlen,'times.'
-   call error_handler(E_ERR, 'get_expected_net_C_production', &
+   write(string1,*)'TIME has length',ntime,trim(varstring),' has ',dimlen,'times.'
+   call error_handler(E_ERR, 'get_scalar_from_3Dhistory', &
               string1, source, revision, revdate)
 endif
 
@@ -755,19 +422,19 @@
 timei    = timeinds(1)
 
 if (debug .and. do_output()) then
-   write(*,*)'get_expected_net_C_production:targetlon, lon, lon index is ', &
+   write(*,*)'get_scalar_from_3Dhistory:targetlon, lon, lon index is ', &
                                            loc_lon,lon(gridloni),gridloni
-   write(*,*)'get_expected_net_C_production:targetlat, lat, lat index is ', &
+   write(*,*)'get_scalar_from_3Dhistory:targetlat, lat, lat index is ', &
                                            loc_lat,lat(gridlatj),gridlatj
-   write(*,*)'get_expected_net_C_production:  targetT,   T,   T index is ', &
+   write(*,*)'get_scalar_from_3Dhistory:  targetT,   T,   T index is ', &
                                            otime,rtime(timei),timei
 endif
 
 if ( abs(otime - rtime(timei)) > 30*60 ) then
    if (debug .and. do_output()) then
-      write(*,*)'get_expected_net_C_production: no close time ... skipping observation'
-      call print_time(obs_time,'get_expected_net_C_production:observation time')
-      call print_date(obs_time,'get_expected_net_C_production:observation date')
+      write(*,*)'get_scalar_from_3Dhistory: no close time ... skipping observation'
+      call print_time(obs_time,'get_scalar_from_3Dhistory:observation time')
+      call print_date(obs_time,'get_scalar_from_3Dhistory:observation date')
    endif
    istatus = 2
    return
@@ -779,7 +446,7 @@
 nccount = (/        1,        1,     1 /)
 
 call nc_check(nf90_get_var(ncid(ens_index), varid, hyperslab, start=ncstart, count=nccount), &
-     'get_expected_net_C_production', 'get_var')
+     'get_scalar_from_3Dhistory', 'get_var')
 
 obs_val = hyperslab(1)
 
@@ -804,10 +471,9 @@
 
 if (obs_val /= MISSING_R8) istatus = 0
 
-end subroutine get_expected_net_C_production
+end subroutine get_scalar_from_3Dhistory
 
 
-
 end module obs_def_tower_mod
 
 ! END DART PREPROCESS MODULE CODE


More information about the Dart-dev mailing list