[Dart-dev] [3669] DART/trunk/models/template/model_mod.f90: using
utilities: nc_check to set a good example
nancy at ucar.edu
nancy at ucar.edu
Mon Nov 24 17:02:34 MST 2008
An HTML attachment was scrubbed...
URL: http://mailman.ucar.edu/pipermail/dart-dev/attachments/20081124/ea8b5ccc/attachment.html
-------------- next part --------------
Modified: DART/trunk/models/template/model_mod.f90
===================================================================
--- DART/trunk/models/template/model_mod.f90 2008-11-21 00:13:40 UTC (rev 3668)
+++ DART/trunk/models/template/model_mod.f90 2008-11-25 00:02:34 UTC (rev 3669)
@@ -18,14 +18,15 @@
! interface and look for NULL INTERFACE).
! Modules that are absolutely required for use are listed
-use types_mod, only : r8
+use types_mod, only : r8, MISSING_R8
use time_manager_mod, only : time_type, set_time
use location_mod, only : location_type, get_close_maxdist_init, &
get_close_obs_init, get_close_obs, set_location
-use utilities_mod, only : register_module, error_handler, E_ERR, E_MSG
- ! nmlfileunit, do_output, find_namelist_in_file, check_namelist_read
+use utilities_mod, only : register_module, error_handler, nc_check, &
+ E_ERR, E_MSG
+ ! nmlfileunit, do_output, &
+ ! find_namelist_in_file, check_namelist_read
-
implicit none
private
@@ -131,6 +132,7 @@
real(r8), intent(out) :: x(:)
+x = MISSING_R8
end subroutine init_conditions
@@ -343,9 +345,9 @@
ierr = -1 ! assume things go poorly
-call check(nf90_Inquire(ncFileID, nDimensions, nVariables, &
- nAttributes, unlimitedDimID), "inquire")
-call check(nf90_Redef(ncFileID),"redef")
+call nc_check(nf90_inquire(ncFileID,nDimensions,nVariables,nAttributes,unlimitedDimID), &
+ "nc_write_model_atts", "inquire")
+call nc_check(nf90_redef(ncFileID), "nc_write_model_atts", "redef")
!-------------------------------------------------------------------------------
! We need the dimension ID for the number of copies/ensemble members, and
@@ -353,8 +355,10 @@
! Our job is create the 'model size' dimension.
!-------------------------------------------------------------------------------
-call check(nf90_inq_dimid(ncid=ncFileID, name="copy", dimid=MemberDimID),"copy dimid")
-call check(nf90_inq_dimid(ncid=ncFileID, name="time", dimid= TimeDimID),"time dimid")
+call nc_check(nf90_inq_dimid(ncid=ncFileID, name="copy", dimid=MemberDimID), &
+ "nc_write_model_atts", "inq_dimid copy")
+call nc_check(nf90_inq_dimid(ncid=ncFileID, name="time", dimid= TimeDimID), &
+ "nc_write_model_atts", "inq_dimid time")
if ( TimeDimID /= unlimitedDimId ) then
write(errstring,*)"Time Dimension ID ",TimeDimID, &
@@ -365,8 +369,9 @@
!-------------------------------------------------------------------------------
! Define the model size / state variable dimension / whatever ...
!-------------------------------------------------------------------------------
-call check(nf90_def_dim(ncid=ncFileID, name="StateVariable", &
- len=model_size, dimid = StateVarDimID),"state def_dim")
+call nc_check(nf90_def_dim(ncid=ncFileID, name="StateVariable", &
+ len=model_size, dimid=StateVarDimID), &
+ "nc_write_model_atts", "def_dim state")
!-------------------------------------------------------------------------------
! Write Global Attributes
@@ -376,11 +381,16 @@
write(str1,'(''YYYY MM DD HH MM SS = '',i4,5(1x,i2.2))') &
values(1), values(2), values(3), values(5), values(6), values(7)
-call check(nf90_put_att(ncFileID, NF90_GLOBAL, "creation_date" ,str1 ),"creation put")
-call check(nf90_put_att(ncFileID, NF90_GLOBAL, "model_source" ,source ),"source put")
-call check(nf90_put_att(ncFileID, NF90_GLOBAL, "model_revision",revision),"revision put")
-call check(nf90_put_att(ncFileID, NF90_GLOBAL, "model_revdate" ,revdate ),"revdate put")
-call check(nf90_put_att(ncFileID, NF90_GLOBAL, "model","template" ),"model put")
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, "creation_date" ,str1), &
+ "nc_write_model_atts", "put_att creation_date")
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, "model_source" ,source), &
+ "nc_write_model_atts", "put_att model_source")
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, "model_revision",revision), &
+ "nc_write_model_atts", "put_att model_revision")
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, "model_revdate" ,revdate), &
+ "nc_write_model_atts", "put_att model_revdate")
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, "model","template"), &
+ "nc_write_model_atts", "put_att model")
!-------------------------------------------------------------------------------
! Here is the extensible part. The simplest scenario is to output the state vector,
@@ -396,28 +406,29 @@
!----------------------------------------------------------------------------
! Define the state vector coordinate variable and some attributes.
- call check(nf90_def_var(ncid=ncFileID,name="StateVariable", xtype=nf90_int, &
- dimids=StateVarDimID, varid=StateVarVarID), "statevariable def_var")
- call check(nf90_put_att(ncFileID, StateVarVarID, "long_name", "State Variable ID"), &
- "statevariable long_name")
- call check(nf90_put_att(ncFileID, StateVarVarID, "units", "indexical"), &
- "statevariable units")
- call check(nf90_put_att(ncFileID, StateVarVarID, "valid_range", (/ 1, model_size /)), &
- "statevariable valid_range")
+ call nc_check(nf90_def_var(ncid=ncFileID,name="StateVariable", xtype=NF90_INT, &
+ dimids=StateVarDimID, varid=StateVarVarID), &
+ "nc_write_model_atts", "def_var StateVariable")
+ call nc_check(nf90_put_att(ncFileID, StateVarVarID,"long_name","State Variable ID"), &
+ "nc_write_model_atts", "put_att StateVariable long_name")
+ call nc_check(nf90_put_att(ncFileID, StateVarVarID, "units", "indexical"), &
+ "nc_write_model_atts", "put_att StateVariable units")
+ call nc_check(nf90_put_att(ncFileID, StateVarVarID, "valid_range", (/ 1, model_size /)), &
+ "nc_write_model_atts", "put_att StateVariable valid_range")
! Define the actual (3D) state vector, which gets filled as time goes on ...
- call check(nf90_def_var(ncid=ncFileID, name="state", xtype=nf90_real, &
- dimids = (/ StateVarDimID, MemberDimID, unlimitedDimID /), &
- varid=StateVarID), "state def_var")
- call check(nf90_put_att(ncFileID, StateVarID, "long_name", "model state or fcopy"), &
- "state long_name")
+ call nc_check(nf90_def_var(ncid=ncFileID, name="state", xtype=NF90_REAL, &
+ dimids = (/ StateVarDimID, MemberDimID, unlimitedDimID /), &
+ varid=StateVarID), "nc_write_model_atts", "def_var state")
+ call nc_check(nf90_put_att(ncFileID, StateVarID, "long_name", "model state or fcopy"), &
+ "nc_write_model_atts", "put_att state long_name")
! Leave define mode so we can fill the coordinate variable.
- call check(nf90_enddef(ncfileID),"state enddef")
+ call nc_check(nf90_enddef(ncfileID),"nc_write_model_atts", "state_vector enddef")
! Fill the state variable coordinate variable
- call check(nf90_put_var(ncFileID, StateVarVarID, (/ (i,i=1,model_size) /) ), &
- "state put_var")
+ call nc_check(nf90_put_var(ncFileID, StateVarVarID, (/ (i,i=1,model_size) /)), &
+ "nc_write_model_atts", "put_var state")
else
@@ -429,53 +440,17 @@
! Usually, the control for the execution of this block is a namelist variable.
! Take a peek at the bgrid model_mod.f90 for a (rather complicated) example.
- call check(nf90_enddef(ncfileID), "prognostic enddef")
+ call nc_check(nf90_enddef(ncfileID), "nc_write_model_atts", "prognostic enddef")
endif
!-------------------------------------------------------------------------------
! Flush the buffer and leave netCDF file open
!-------------------------------------------------------------------------------
-call check(nf90_sync(ncFileID),"atts sync")
+call nc_check(nf90_sync(ncFileID),"nc_write_model_atts", "sync")
ierr = 0 ! If we got here, things went well.
-contains
-
- ! Internal subroutine - checks error status after each netcdf, prints
- ! text message each time an error code is returned.
- subroutine check(istatus, string1)
- !
- ! string1 was added to provide some sense of WHERE things were bombing.
- ! It helps to determine which particular 'nf90_put_att' was generating
- ! the error, for example.
-
- integer, intent ( in) :: istatus
- character(len=*), intent(in), optional :: string1
-
- character(len=20) :: myname = 'nc_write_model_atts '
- character(len=129) :: mystring
- integer :: indexN
-
- if( istatus /= nf90_noerr) then
-
- if (present(string1) ) then
- if ((len_trim(string1)+len(myname)) <= len(mystring) ) then
- mystring = myname // trim(adjustl(string1))
- else
- indexN = len(mystring) - len(myname)
- mystring = myname // string1(1:indexN)
- endif
- else
- mystring = myname
- endif
-
- call error_handler(E_ERR, mystring, trim(nf90_strerror(istatus)), &
- source, revision, revdate)
- endif
-
- end subroutine check
-
end function nc_write_model_atts
@@ -523,14 +498,16 @@
ierr = -1 ! assume things go poorly
-call check(nf90_Inquire(ncFileID, nDimensions, nVariables, &
- nAttributes, unlimitedDimID), "inquire")
+call nc_check(nf90_inquire(ncFileID,nDimensions,nVariables,nAttributes,unlimitedDimID), &
+ "nc_write_model_vars", "inquire")
if ( output_state_vector ) then
- call check(NF90_inq_varid(ncFileID, "state", StateVarID), "state inq_varid" )
- call check(NF90_put_var(ncFileID, StateVarID, statevec, &
- start=(/ 1, copyindex, timeindex /)), "state put_var")
+ call nc_check(nf90_inq_varid(ncFileID, "state", StateVarID), &
+ "nc_write_model_vars", "inq_varid state" )
+ call nc_check(nf90_put_var(ncFileID, StateVarID, statevec, &
+ start=(/ 1, copyindex, timeindex /)), &
+ "nc_write_model_vars", "put_var state")
else
@@ -554,9 +531,11 @@
! the 'start' array is crucial. In the following example, 'ps' is a 2D
! array, and the netCDF variable "ps" is a 4D array [lat,lon,copy,time]
- ! call check(NF90_inq_varid(ncFileID, "ps", psVarID), "ps inq_varid")
- ! call check(nf90_put_var( ncFileID, psVarID, global_Var%ps, &
- ! start=(/ 1, 1, copyindex, timeindex /) ), "ps put_var")
+ ! call nc_check(nf90_inq_varid(ncFileID, "ps", psVarID), &
+ ! "nc_write_model_vars", "inq_varid ps")
+ ! call nc_check(nf90_put_var( ncFileID, psVarID, global_Var%ps, &
+ ! start=(/ 1, 1, copyindex, timeindex /)), &
+ ! "nc_write_model_vars", "put_var ps")
endif
@@ -564,41 +543,10 @@
! Flush the buffer and leave netCDF file open
!-------------------------------------------------------------------------------
-call check(nf90_sync(ncFileID), "sync")
+call nc_check(nf90_sync(ncFileID), "nc_write_model_vars", "sync")
ierr = 0 ! If we got here, things went well.
-contains
-
- ! Internal subroutine - checks error status after each netcdf, prints
- ! text message each time an error code is returned.
- subroutine check(istatus, string1)
- integer, intent ( in) :: istatus
- character(len=*), intent(in), optional :: string1
-
- character(len=20) :: myname = 'nc_write_model_vars '
- character(len=129) :: mystring
- integer :: indexN
-
- if( istatus /= nf90_noerr) then
-
- if (present(string1) ) then
- if ((len_trim(string1)+len(myname)) <= len(mystring) ) then
- mystring = myname // trim(adjustl(string1))
- else
- indexN = len(mystring) - len(myname)
- mystring = myname // string1(1:indexN)
- endif
- else
- mystring = myname
- endif
-
- call error_handler(E_ERR, mystring, trim(nf90_strerror(istatus)), &
- source, revision, revdate)
- endif
-
- end subroutine check
-
end function nc_write_model_vars
@@ -620,6 +568,7 @@
real(r8), intent(out) :: pert_state(:)
logical, intent(out) :: interf_provided
+pert_state = MISSING_R8
interf_provided = .false.
end subroutine pert_model_state
More information about the Dart-dev
mailing list