[Dart-dev] [4450] DART/trunk/models/NCOMMAS: Reordered the routines so that the required interfaces come first,
nancy at ucar.edu
nancy at ucar.edu
Tue Aug 3 09:53:48 MDT 2010
Revision: 4450
Author: thoar
Date: 2010-08-03 09:53:48 -0600 (Tue, 03 Aug 2010)
Log Message:
-----------
Reordered the routines so that the required interfaces come first,
the other public interfaces are next, followed by the module routines.
Modified Paths:
--------------
DART/trunk/models/NCOMMAS/dart_to_ncommas.f90
DART/trunk/models/NCOMMAS/model_mod.f90
DART/trunk/models/NCOMMAS/ncommas_to_dart.f90
Added Paths:
-----------
DART/trunk/models/NCOMMAS/work/input.nml
-------------- next part --------------
Modified: DART/trunk/models/NCOMMAS/dart_to_ncommas.f90
===================================================================
--- DART/trunk/models/NCOMMAS/dart_to_ncommas.f90 2010-08-03 05:03:13 UTC (rev 4449)
+++ DART/trunk/models/NCOMMAS/dart_to_ncommas.f90 2010-08-03 15:53:48 UTC (rev 4450)
@@ -33,8 +33,8 @@
use assim_model_mod, only : open_restart_read, aread_state_restart, close_restart
use time_manager_mod, only : time_type, print_time, print_date, operator(-)
use model_mod, only : static_init_model, sv_to_restart_file, &
- get_model_size, get_ncommas_restart_filename
-use dart_ncommas_mod, only : write_ncommas_namelist
+ get_model_size
+use dart_ncommas_mod, only : write_ncommas_namelist, get_ncommas_restart_filename
implicit none
Modified: DART/trunk/models/NCOMMAS/model_mod.f90
===================================================================
--- DART/trunk/models/NCOMMAS/model_mod.f90 2010-08-03 05:03:13 UTC (rev 4449)
+++ DART/trunk/models/NCOMMAS/model_mod.f90 2010-08-03 15:53:48 UTC (rev 4450)
@@ -86,8 +86,7 @@
! generally useful routines for various support purposes.
! the interfaces here can be changed as appropriate.
-public :: get_gridsize, restart_file_to_sv, sv_to_restart_file, &
- get_ncommas_restart_filename
+public :: get_gridsize, restart_file_to_sv, sv_to_restart_file
! version controlled file description for error handling, do not edit
character(len=128), parameter :: &
@@ -142,6 +141,7 @@
!
! FIXME: make this completely namelist driven,
! both contents and order of vars.
+! Example: WRF input.nml sets kind_string, etc.
!------------------------------------------------------------------
integer, parameter :: n3dfields = 13
@@ -149,6 +149,7 @@
integer, parameter :: nfields = n3dfields + n2dfields
! Everything needed to describe a variable
+
type progvartype
private
character(len=NF90_MAX_NAME) :: varname
@@ -255,9 +256,113 @@
contains
!==================================================================
+! All the REQUIRED interfaces come first - just by convention.
+!==================================================================
+function get_model_size()
+!------------------------------------------------------------------
+!
+! Returns the size of the model as an integer. Required for all
+! applications.
+integer :: get_model_size
+if ( .not. module_initialized ) call static_init_model
+
+get_model_size = model_size
+
+end function get_model_size
+
+
+
+subroutine adv_1step(x, time)
+!------------------------------------------------------------------
+!
+! Does a single timestep advance of the model. The input value of
+! the vector x is the starting condition and x is updated to reflect
+! the changed state after a timestep. The time argument is intent
+! in and is used for models that need to know the date/time to
+! compute a timestep, for instance for radiation computations.
+! This interface is only called IF the namelist parameter
+! async is set to 0 in perfect_model_obs or filter -OR- if the
+! program integrate_model is to be used to advance the model
+! state as a separate executable. If none of these options
+! are used (the model will only be advanced as a separate
+! model-specific executable), this can be a NULL INTERFACE.
+
+real(r8), intent(inout) :: x(:)
+type(time_type), intent(in) :: time
+
+if ( .not. module_initialized ) call static_init_model
+
+if (do_output()) then
+ call print_time(time,'NULL interface adv_1step (no advance) DART time is')
+ call print_time(time,'NULL interface adv_1step (no advance) DART time is',logfileunit)
+endif
+
+end subroutine adv_1step
+
+
+
+subroutine get_state_meta_data(index_in, location, var_type)
+!------------------------------------------------------------------
+!
+! Given an integer index into the state vector structure, returns the
+! associated location. A second intent(out) optional argument kind
+! can be returned if the model has more than one type of field (for
+! instance temperature and zonal wind component). This interface is
+! required for all filter applications as it is required for computing
+! the distance between observations and state variables.
+
+integer, intent(in) :: index_in
+type(location_type), intent(out) :: location
+integer, intent(out), optional :: var_type
+
+real(r8) :: lat, lon, height
+integer :: lon_index, lat_index, height_index, local_var
+
+call get_state_indices(index_in, lat_index, lon_index, height_index, local_var)
+
+if (is_on_ugrid(local_var)) then
+ lon = ULON(lon_index, lat_index)
+ lat = ULAT(lon_index, lat_index)
+elseif (is_on_vgrid(local_var)) then
+ lon = VLON(lon_index, lat_index)
+ lat = VLAT(lon_index, lat_index)
+else
+ lon = WLON(lon_index, lat_index)
+ lat = WLAT(lon_index, lat_index)
+endif
+
+if (debug > 5) print *, 'lon, lat, height = ', lon, lat, height
+
+location = set_location(lon, lat, height, VERTISHEIGHT)
+
+if (present(var_type)) then
+ var_type = local_var
+endif
+
+end subroutine get_state_meta_data
+
+
+
+function get_model_time_step()
+!------------------------------------------------------------------
+!
+! Returns the the time step of the model; the smallest increment
+! in time that the model is capable of advancing the state in a given
+! implementation. This interface is required for all applications.
+
+type(time_type) :: get_model_time_step
+
+if ( .not. module_initialized ) call static_init_model
+
+get_model_time_step = model_timestep
+
+end function get_model_time_step
+
+
+
subroutine static_init_model()
!------------------------------------------------------------------
!
@@ -269,7 +374,7 @@
integer, dimension(NF90_MAX_VAR_DIMS) :: dimIDs
character(len=NF90_MAX_NAME) :: varname
integer :: ncid, VarID, numdims, dimlen, varsize
-integer :: iunit, io, ivar, i
+integer :: iunit, io, ivar, i, index1, indexN
integer :: ss, dd
if ( module_initialized ) return ! only need to do this once.
@@ -311,19 +416,13 @@
! 2) allocate space for the grids
! 3) read them, convert them from X-Y-Z to lat-lon-z
-! call get_grid_dims(nxc, nyc, nzc, )
call get_grid_dims(nxc, nxe, nyc, nye, nzc, nze )
-! Allocate space for grid variables.
allocate(ULAT(nxe,nyc), ULON(nxe,nyc))
allocate(VLAT(nxc,nye), VLON(nxc,nye))
allocate(WLAT(nxc,nyc), WLON(nxc,nyc))
allocate( ZC( nzc ), ZE( nze ))
-! Fill them in.
-! horiz grid initializes ULAT/LON, slat/LON as well.
-! kmt initializes HT/HU if present in input file.
-
call get_grid(nxc, nxe, nyc, nye, nzc, nze, &
ULAT, ULON, VLAT, VLON, WLAT, WLON, ZC, ZE)
@@ -331,7 +430,10 @@
! compute the offsets into the state vector for the start of each
! different variable type. Requires reading shapes from the NCOMMAS
! restart file.
-
+!
+! FIXME - this should go in dart_ncommas_mod.f90
+! as well as the progvartype declaration, should be query routines.
+!
! Record where in the state vector the data type changes
! from one type to another, by computing the starting
! index for each block of data.
@@ -339,7 +441,8 @@
call nc_check( nf90_open(trim(ncommas_filename), NF90_NOWRITE, ncid), &
'static_init_model', 'open '//trim(ncommas_filename))
-model_size = 0;
+index1 = 1;
+indexN = 0;
do ivar = 1, nfields
varname = adjustl(progvarnames(ivar))
@@ -365,13 +468,16 @@
varsize = 1
do i = 1,numdims
write(string1,'(''inquire dimension'',i2,A)') i,trim(string2)
- call nc_check(nf90_inquire_dimension(ncid, dimIDs(i), len=dimlen), 'static_init_model', string1)
+ call nc_check(nf90_inquire_dimension(ncid, dimIDs(i), len=dimlen), &
+ 'static_init_model', string1)
progvar(ivar)%dimlens(i) = dimlen
varsize = varsize * dimlen
enddo
progvar(ivar)%varsize = varsize
- progvar(ivar)%indexN = model_size + varsize
+ progvar(ivar)%index1 = index1
+ progvar(ivar)%indexN = index1 + varsize - 1
+ index1 = index1 + varsize - 1 ! sets up for next variable
if (do_output()) then
write(logfileunit,*) ivar,trim(progvar(ivar)%varname)
@@ -380,6 +486,7 @@
write(logfileunit,*) ' numdims ',progvar(ivar)%numdims
write(logfileunit,*) ' dimlens ',progvar(ivar)%dimlens(1:progvar(ivar)%numdims)
write(logfileunit,*) ' varsize ',progvar(ivar)%varsize
+ write(logfileunit,*) ' index1 ',progvar(ivar)%index1
write(logfileunit,*) ' indexN ',progvar(ivar)%indexN
write( * ,*) ivar,trim(progvar(ivar)%varname)
@@ -388,11 +495,14 @@
write( * ,*) ' numdims ',progvar(ivar)%numdims
write( * ,*) ' dimlens ',progvar(ivar)%dimlens(1:progvar(ivar)%numdims)
write( * ,*) ' varsize ',progvar(ivar)%varsize
+ write( * ,*) ' index1 ',progvar(ivar)%index1
write( * ,*) ' indexN ',progvar(ivar)%indexN
endif
enddo
+model_size = progvar(nfields)%indexN
+
if (do_output()) then
write(logfileunit, *)'grid: nx[ce], ny[ce], nz[ce] = ', nxc, nxe, nyc, nye, nzc, nze
write( * , *)'grid: nx[ce], ny[ce], nz[ce] = ', nxc, nxe, nyc, nye, nzc, nze
@@ -400,18 +510,6 @@
write( * , *)'model_size = ', model_size
endif
-! fixme start_index(S_index) = 1
-! fixme start_index(T_index) = start_index(S_index) + (nxc * nyc * nzc)
-! fixme start_index(U_index) = start_index(T_index) + (nxc * nyc * nzc)
-! fixme start_index(V_index) = start_index(U_index) + (nxc * nyc * nzc)
-! fixme start_index(PSURF_index) = start_index(V_index) + (nxc * nyc * nzc)
-
-! in spite of the staggering, all grids are the same size
-! and offset by half a grid cell. 4 are 3D and 1 is 2D.
-! e.g. S,T,U,V = 256 x 225 x 70
-! e.g. PSURF = 256 x 225
-
-
allocate( ens_mean(model_size) )
! Initialize the interpolation routines
@@ -421,8 +519,1160 @@
-!------------------------------------------------------------
+subroutine end_model()
+!------------------------------------------------------------------
+!
+! Does any shutdown and clean-up needed for model. Can be a NULL
+! INTERFACE if the model has no need to clean up storage, etc.
+! if ( .not. module_initialized ) call static_init_model
+
+deallocate(ULAT, ULON, VLAT, VLON, WLAT, WLON)
+deallocate(ZC, ZE)
+
+end subroutine end_model
+
+
+
+subroutine init_time(time)
+!------------------------------------------------------------------
+!
+! Companion interface to init_conditions. Returns a time that is somehow
+! appropriate for starting up a long integration of the model.
+! At present, this is only used if the namelist parameter
+! start_from_restart is set to .false. in the program perfect_model_obs.
+! If this option is not to be used in perfect_model_obs, or if no
+! synthetic data experiments using perfect_model_obs are planned,
+! this can be a NULL INTERFACE.
+
+type(time_type), intent(out) :: time
+
+if ( .not. module_initialized ) call static_init_model
+
+! for now, just set to 0
+time = set_time(0,0)
+
+end subroutine init_time
+
+
+
+subroutine init_conditions(x)
+!------------------------------------------------------------------
+!
+! Returns a model state vector, x, that is some sort of appropriate
+! initial condition for starting up a long integration of the model.
+! At present, this is only used if the namelist parameter
+! start_from_restart is set to .false. in the program perfect_model_obs.
+! If this option is not to be used in perfect_model_obs, or if no
+! synthetic data experiments using perfect_model_obs are planned,
+! this can be a NULL INTERFACE.
+
+real(r8), intent(out) :: x(:)
+
+if ( .not. module_initialized ) call static_init_model
+
+x = 0.0_r8
+
+end subroutine init_conditions
+
+
+
+function nc_write_model_atts( ncFileID ) result (ierr)
+!------------------------------------------------------------------
+! TJH -- Writes the model-specific attributes to a netCDF file.
+! This includes coordinate variables and some metadata, but NOT
+! the model state vector.
+!
+! assim_model_mod:init_diag_output uses information from the location_mod
+! to define the location dimension and variable ID. All we need to do
+! is query, verify, and fill ...
+!
+! Typical sequence for adding new dimensions,variables,attributes:
+! NF90_OPEN ! open existing netCDF dataset
+! NF90_redef ! put into define mode
+! NF90_def_dim ! define additional dimensions (if any)
+! NF90_def_var ! define variables: from name, type, and dims
+! NF90_put_att ! assign attribute values
+! NF90_ENDDEF ! end definitions: leave define mode
+! NF90_put_var ! provide values for variable
+! NF90_CLOSE ! close: save updated netCDF dataset
+
+integer, intent(in) :: ncFileID ! netCDF file identifier
+integer :: ierr ! return value of function
+
+integer :: nDimensions, nVariables, nAttributes, unlimitedDimID
+
+!----------------------------------------------------------------------
+! variables if we just blast out one long state vector
+!----------------------------------------------------------------------
+
+integer :: StateVarDimID ! netCDF pointer to state variable dimension (model size)
+integer :: MemberDimID ! netCDF pointer to dimension of ensemble (ens_size)
+integer :: TimeDimID ! netCDF pointer to time dimension (unlimited)
+
+integer :: StateVarVarID ! netCDF pointer to state variable coordinate array
+integer :: StateVarID ! netCDF pointer to 3D [state,copy,time] array
+
+!----------------------------------------------------------------------
+! variables if we parse the state vector into prognostic variables.
+!----------------------------------------------------------------------
+
+! for the dimensions and coordinate variables
+integer :: NxcDimID, NycDimID, NzcDimID
+integer :: NxeDimID, NyeDimID, NzeDimID
+
+integer :: ulonVarID, ulatVarID
+integer :: vlonVarID, vlatVarID
+integer :: wlonVarID, wlatVarID
+integer :: ZEVarID, ZCVarID
+
+! for the prognostic variables
+integer :: SVarID, TVarID, UVarID, VVarID, PSURFVarID
+
+!----------------------------------------------------------------------
+! variables for the namelist output
+!----------------------------------------------------------------------
+
+character(len=129), allocatable, dimension(:) :: textblock
+integer :: LineLenDimID, nlinesDimID, nmlVarID
+integer :: nlines, linelen
+logical :: has_ncommas_namelist
+
+!----------------------------------------------------------------------
+! local variables
+!----------------------------------------------------------------------
+
+! we are going to need these to record the creation date in the netCDF file.
+! This is entirely optional, but nice.
+
+character(len=8) :: crdate ! needed by F90 DATE_AND_TIME intrinsic
+character(len=10) :: crtime ! needed by F90 DATE_AND_TIME intrinsic
+character(len=5) :: crzone ! needed by F90 DATE_AND_TIME intrinsic
+integer, dimension(8) :: values ! needed by F90 DATE_AND_TIME intrinsic
+character(len=NF90_MAX_NAME) :: str1
+
+integer :: i
+character(len=128) :: filename
+
+if ( .not. module_initialized ) call static_init_model
+
+ierr = -1 ! assume things go poorly
+
+!--------------------------------------------------------------------
+! we only have a netcdf handle here so we do not know the filename
+! or the fortran unit number. but construct a string with at least
+! the netcdf handle, so in case of error we can trace back to see
+! which netcdf file is involved.
+!--------------------------------------------------------------------
+
+write(filename, '(a, i3)') 'ncFileID', ncFileID
+
+!-------------------------------------------------------------------------------
+! make sure ncFileID refers to an open netCDF file,
+! and then put into define mode.
+!-------------------------------------------------------------------------------
+
+call nc_check(nf90_Inquire(ncFileID,nDimensions,nVariables,nAttributes,unlimitedDimID),&
+ 'nc_write_model_atts', 'inquire '//trim(filename))
+call nc_check(nf90_Redef(ncFileID),'nc_write_model_atts', 'redef '//trim(filename))
+
+!-------------------------------------------------------------------------------
+! We need the dimension ID for the number of copies/ensemble members, and
+! we might as well check to make sure that Time is the Unlimited dimension.
+! Our job is create the 'model size' dimension.
+!-------------------------------------------------------------------------------
+
+call nc_check(nf90_inq_dimid(ncid=ncFileID, name='NMLlinelen', dimid=LineLenDimID), &
+ 'nc_write_model_atts','inq_dimid NMLlinelen')
+call nc_check(nf90_inq_dimid(ncid=ncFileID, name='copy', dimid=MemberDimID), &
+ 'nc_write_model_atts', 'copy dimid '//trim(filename))
+call nc_check(nf90_inq_dimid(ncid=ncFileID, name='time', dimid= TimeDimID), &
+ 'nc_write_model_atts', 'time dimid '//trim(filename))
+
+if ( TimeDimID /= unlimitedDimId ) then
+ write(string1,*)'Time Dimension ID ',TimeDimID, &
+ ' should equal Unlimited Dimension ID',unlimitedDimID
+ call error_handler(E_ERR,'nc_write_model_atts', string1, source, revision, revdate)
+endif
+
+!-------------------------------------------------------------------------------
+! Define the model size / state variable dimension / whatever ...
+!-------------------------------------------------------------------------------
+call nc_check(nf90_def_dim(ncid=ncFileID, name='StateVariable', len=model_size, &
+ dimid = StateVarDimID),'nc_write_model_atts', 'state def_dim '//trim(filename))
+
+!-------------------------------------------------------------------------------
+! Write Global Attributes
+!-------------------------------------------------------------------------------
+
+call DATE_AND_TIME(crdate,crtime,crzone,values)
+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 nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, 'creation_date' ,str1 ), &
+ 'nc_write_model_atts', 'creation put '//trim(filename))
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, 'model_source' ,source ), &
+ 'nc_write_model_atts', 'source put '//trim(filename))
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, 'model_revision',revision), &
+ 'nc_write_model_atts', 'revision put '//trim(filename))
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, 'model_revdate' ,revdate ), &
+ 'nc_write_model_atts', 'revdate put '//trim(filename))
+call nc_check(nf90_put_att(ncFileID, NF90_GLOBAL, 'model', 'ncommas' ), &
+ 'nc_write_model_atts', 'model put '//trim(filename))
+
+!-------------------------------------------------------------------------------
+! Determine shape of most important namelist
+!-------------------------------------------------------------------------------
+
+call find_textfile_dims('ncommas_in', nlines, linelen)
+if (nlines > 0) then
+ has_ncommas_namelist = .true.
+else
+ has_ncommas_namelist = .false.
+endif
+
+if (debug > 0) print *, 'ncommas namelist: nlines, linelen = ', nlines, linelen
+
+if (has_ncommas_namelist) then
+ allocate(textblock(nlines))
+ textblock = ''
+
+ call nc_check(nf90_def_dim(ncid=ncFileID, name='nlines', &
+ len = nlines, dimid = nlinesDimID), &
+ 'nc_write_model_atts', 'def_dim nlines ')
+
+ call nc_check(nf90_def_var(ncFileID,name='ncommas_in', xtype=nf90_char, &
+ dimids = (/ linelenDimID, nlinesDimID /), varid=nmlVarID), &
+ 'nc_write_model_atts', 'def_var ncommas_in')
+ call nc_check(nf90_put_att(ncFileID, nmlVarID, 'long_name', &
+ 'contents of ncommas_in namelist'), 'nc_write_model_atts', 'put_att ncommas_in')
+
+endif
+
+!-------------------------------------------------------------------------------
+! Here is the extensible part. The simplest scenario is to output the state vector,
+! parsing the state vector into model-specific parts is complicated, and you need
+! to know the geometry, the output variables (PS,U,V,T,Q,...) etc. We're skipping
+! complicated part.
+!-------------------------------------------------------------------------------
+
+if ( output_state_vector ) then
+
+ !----------------------------------------------------------------------------
+ ! Create a variable for the state vector
+ !----------------------------------------------------------------------------
+
+ ! Define the state vector coordinate variable and some attributes.
+ call nc_check(nf90_def_var(ncid=ncFileID,name='StateVariable', xtype=nf90_int, &
+ dimids=StateVarDimID, varid=StateVarVarID), 'nc_write_model_atts', &
+ 'statevariable def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID,StateVarVarID,'long_name','State Variable ID'),&
+ 'nc_write_model_atts','statevariable long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, StateVarVarID, 'units','indexical'), &
+ 'nc_write_model_atts', 'statevariable units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID,StateVarVarID,'valid_range',(/ 1,model_size /)),&
+ 'nc_write_model_atts', 'statevariable valid_range '//trim(filename))
+
+ ! Define the actual (3D) state vector, which gets filled as time goes on ...
+ call nc_check(nf90_def_var(ncid=ncFileID, name='state', xtype=nf90_real, &
+ dimids=(/StateVarDimID,MemberDimID,unlimitedDimID/),varid=StateVarID),&
+ 'nc_write_model_atts','state def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID,StateVarID,'long_name','model state or fcopy'),&
+ 'nc_write_model_atts', 'state long_name '//trim(filename))
+
+ ! Leave define mode so we can fill the coordinate variable.
+ call nc_check(nf90_enddef(ncfileID),'nc_write_model_atts','state enddef '//trim(filename))
+
+ ! Fill the state variable coordinate variable
+ call nc_check(nf90_put_var(ncFileID, StateVarVarID, (/ (i,i=1,model_size) /) ), &
+ 'nc_write_model_atts', 'state put_var '//trim(filename))
+
+else
+
+ !----------------------------------------------------------------------------
+ ! We need to output the prognostic variables.
+ !----------------------------------------------------------------------------
+ ! Define the new dimensions IDs
+ !----------------------------------------------------------------------------
+
+ call nc_check(nf90_def_dim(ncid=ncFileID, name='XC', &
+ len = nxc, dimid = NxcDimID),'nc_write_model_atts', 'xc def_dim '//trim(filename))
+ call nc_check(nf90_def_dim(ncid=ncFileID, name='XE', &
+ len = nxe, dimid = NxeDimID),'nc_write_model_atts', 'xe def_dim '//trim(filename))
+
+ call nc_check(nf90_def_dim(ncid=ncFileID, name='YC', &
+ len = nyc, dimid = NycDimID),'nc_write_model_atts', 'yc def_dim '//trim(filename))
+ call nc_check(nf90_def_dim(ncid=ncFileID, name='YE', &
+ len = nye, dimid = NyeDimID),'nc_write_model_atts', 'ye def_dim '//trim(filename))
+
+ call nc_check(nf90_def_dim(ncid=ncFileID, name='ZC', &
+ len = nzc, dimid = NzcDimID),'nc_write_model_atts', 'zc def_dim '//trim(filename))
+ call nc_check(nf90_def_dim(ncid=ncFileID, name='ZE', &
+ len = nze, dimid = NzeDimID),'nc_write_model_atts', 'ze def_dim '//trim(filename))
+
+ !----------------------------------------------------------------------------
+ ! Create the (empty) Coordinate Variables and the Attributes
+ !----------------------------------------------------------------------------
+
+
+ ! U Grid Longitudes
+ call nc_check(nf90_def_var(ncFileID,name='ULON', xtype=nf90_real, &
+ dimids=(/ NxeDimID, NycDimID /), varid=ulonVarID),&
+ 'nc_write_model_atts', 'ULON def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulonVarID, 'long_name', 'longitudes of U grid'), &
+ 'nc_write_model_atts', 'ULON long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulonVarID, 'cartesian_axis', 'X'), &
+ 'nc_write_model_atts', 'ULON cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulonVarID, 'units', 'degrees_east'), &
+ 'nc_write_model_atts', 'ULON units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulonVarID, 'valid_range', (/ 0.0_r8, 360.0_r8 /)), &
+ 'nc_write_model_atts', 'ULON valid_range '//trim(filename))
+
+ ! U Grid Latitudes
+ call nc_check(nf90_def_var(ncFileID,name='ULAT', xtype=nf90_real, &
+ dimids=(/ NxeDimID, NycDimID /), varid=ulatVarID),&
+ 'nc_write_model_atts', 'ULAT def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulatVarID, 'long_name', 'latitudes of U grid'), &
+ 'nc_write_model_atts', 'ULAT long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulatVarID, 'cartesian_axis', 'Y'), &
+ 'nc_write_model_atts', 'ULAT cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulatVarID, 'units', 'degrees_north'), &
+ 'nc_write_model_atts', 'ULAT units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ulatVarID,'valid_range',(/ -90.0_r8, 90.0_r8 /)), &
+ 'nc_write_model_atts', 'ULAT valid_range '//trim(filename))
+
+ ! V Grid Longitudes
+ call nc_check(nf90_def_var(ncFileID,name='VLON', xtype=nf90_real, &
+ dimids=(/ NxcDimID, NyeDimID /), varid=vlonVarID),&
+ 'nc_write_model_atts', 'vlon def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlonVarID, 'long_name', 'longitudes of V grid'), &
+ 'nc_write_model_atts', 'vlon long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlonVarID, 'cartesian_axis', 'X'), &
+ 'nc_write_model_atts', 'vlon cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlonVarID, 'units', 'degrees_east'), &
+ 'nc_write_model_atts', 'vlon units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlonVarID, 'valid_range', (/ 0.0_r8, 360.0_r8 /)), &
+ 'nc_write_model_atts', 'vlon valid_range '//trim(filename))
+
+ ! V Grid Latitudes
+ call nc_check(nf90_def_var(ncFileID,name='VLAT', xtype=nf90_real, &
+ dimids= (/ NxcDimID, NyeDimID /), varid=vlatVarID), &
+ 'nc_write_model_atts', 'vlat def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlatVarID, 'long_name', 'latitudes of V grid'), &
+ 'nc_write_model_atts', 'vlat long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlatVarID, 'cartesian_axis', 'Y'), &
+ 'nc_write_model_atts', 'vlat cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlatVarID, 'units', 'degrees_north'), &
+ 'nc_write_model_atts', 'vlat units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, vlatVarID, 'valid_range', (/ -90.0_r8, 90.0_r8 /)), &
+ 'nc_write_model_atts', 'vlat valid_range '//trim(filename))
+
+ ! W Grid Longitudes
+ call nc_check(nf90_def_var(ncFileID,name='WLON', xtype=nf90_real, &
+ dimids=(/ NxcDimID, NycDimID /), varid=wlonVarID),&
+ 'nc_write_model_atts', 'wlon def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlonVarID, 'long_name', 'longitudes of all others... grid'), &
+ 'nc_write_model_atts', 'wlon long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlonVarID, 'cartesian_axis', 'X'), &
+ 'nc_write_model_atts', 'wlon cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlonVarID, 'units', 'degrees_east'), &
+ 'nc_write_model_atts', 'wlon units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlonVarID, 'valid_range', (/ 0.0_r8, 360.0_r8 /)), &
+ 'nc_write_model_atts', 'wlon valid_range '//trim(filename))
+
+ ! V Grid Latitudes
+ call nc_check(nf90_def_var(ncFileID,name='WLAT', xtype=nf90_real, &
+ dimids= (/ NxcDimID, NycDimID /), varid=wlatVarID), &
+ 'nc_write_model_atts', 'wlat def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlatVarID, 'long_name', 'latitudes of all others ... grid'), &
+ 'nc_write_model_atts', 'wlat long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlatVarID, 'cartesian_axis', 'Y'), &
+ 'nc_write_model_atts', 'wlat cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlatVarID, 'units', 'degrees_north'), &
+ 'nc_write_model_atts', 'wlat units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, wlatVarID, 'valid_range', (/ -90.0_r8, 90.0_r8 /)), &
+ 'nc_write_model_atts', 'wlat valid_range '//trim(filename))
+
+ ! heights
+ call nc_check(nf90_def_var(ncFileID,name='ZE', xtype=nf90_real, &
+ dimids=NzeDimID, varid= ZEVarID), &
+ 'nc_write_model_atts', 'ZE def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZEVarID, 'long_name', 'height at grid edges'), &
+ 'nc_write_model_atts', 'ZE long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZEVarID, 'cartesian_axis', 'Z'), &
+ 'nc_write_model_atts', 'ZE cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZEVarID, 'units', 'meters'), &
+ 'nc_write_model_atts', 'ZE units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZEVarID, 'positive', 'down'), &
+ 'nc_write_model_atts', 'ZE units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZEVarID, 'comment', &
+ 'more positive is closer to the center of the earth'), &
+ 'nc_write_model_atts', 'ZE comment '//trim(filename))
+
+ ! heights
+ call nc_check(nf90_def_var(ncFileID,name='ZC',xtype=nf90_real, &
+ dimids=NzcDimID,varid=ZCVarID), &
+ 'nc_write_model_atts', 'ZC def_var '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZCVarID, 'long_name', 'height at grid centroids'), &
+ 'nc_write_model_atts', 'ZC long_name '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZCVarID, 'cartesian_axis', 'Z'), &
+ 'nc_write_model_atts', 'ZC cartesian_axis '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZCVarID, 'units', 'meters'), &
+ 'nc_write_model_atts', 'ZC units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZCVarID, 'positive', 'down'), &
+ 'nc_write_model_atts', 'ZC units '//trim(filename))
+ call nc_check(nf90_put_att(ncFileID, ZCVarID, 'comment', &
+ 'more positive is closer to the center of the earth'), &
+ 'nc_write_model_atts', 'ZC comment '//trim(filename))
+
+ !----------------------------------------------------------------------------
+ ! Create the (empty) Prognostic Variables and the Attributes
+ !----------------------------------------------------------------------------
+
+! call nc_check(nf90_def_var(ncid=ncFileID, name='SALT', xtype=nf90_real, &
+! dimids = (/NlonDimID,NlatDimID,NzDimID,MemberDimID,unlimitedDimID/),varid=SVarID),&
+! 'nc_write_model_atts', 'S def_var '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, SVarID, 'long_name', 'salinity'), &
+! 'nc_write_model_atts', 'S long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, SVarID, 'units', 'kg/kg'), &
+! 'nc_write_model_atts', 'S units '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, SVarID, 'missing_value', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'S missing '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, SVarID, '_FillValue', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'S fill '//trim(filename))
+!
+!
+! call nc_check(nf90_def_var(ncid=ncFileID, name='TEMP', xtype=nf90_real, &
+! dimids=(/NlonDimID,NlatDimID,NzDimID,MemberDimID,unlimitedDimID/),varid=TVarID),&
+! 'nc_write_model_atts', 'T def_var '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, TVarID, 'long_name', 'Potential Temperature'), &
+! 'nc_write_model_atts', 'T long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, TVarID, 'units', 'deg C'), &
+! 'nc_write_model_atts', 'T units '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, TVarID, 'units_long_name', 'degrees celsius'), &
+! 'nc_write_model_atts', 'T units_long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, TVarID, 'missing_value', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'T missing '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, TVarID, '_FillValue', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'T fill '//trim(filename))
+!
+!
+! call nc_check(nf90_def_var(ncid=ncFileID, name='UVEL', xtype=nf90_real, &
+! dimids=(/NlonDimID,NlatDimID,NzDimID,MemberDimID,unlimitedDimID/),varid=UVarID),&
+! 'nc_write_model_atts', 'U def_var '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, UVarID, 'long_name', 'U velocity'), &
+! 'nc_write_model_atts', 'U long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, UVarID, 'units', 'cm/s'), &
+! 'nc_write_model_atts', 'U units '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, UVarID, 'units_long_name', 'centimeters per second'), &
+! 'nc_write_model_atts', 'U units_long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, UVarID, 'missing_value', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'U missing '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, UVarID, '_FillValue', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'U fill '//trim(filename))
+!
+!
+! call nc_check(nf90_def_var(ncid=ncFileID, name='VVEL', xtype=nf90_real, &
+! dimids=(/NlonDimID,NlatDimID,NzDimID,MemberDimID,unlimitedDimID/),varid=VVarID),&
+! 'nc_write_model_atts', 'V def_var '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, VVarID, 'long_name', 'V Velocity'), &
+! 'nc_write_model_atts', 'V long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, VVarID, 'units', 'cm/s'), &
+! 'nc_write_model_atts', 'V units '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, VVarID, 'units_long_name', 'centimeters per second'), &
+! 'nc_write_model_atts', 'V units_long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, VVarID, 'missing_value', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'V missing '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, VVarID, '_FillValue', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'V fill '//trim(filename))
+!
+!
+! call nc_check(nf90_def_var(ncid=ncFileID, name='PSURF', xtype=nf90_real, &
+! dimids=(/NlonDimID,NlatDimID,MemberDimID,unlimitedDimID/),varid=PSURFVarID), &
+! 'nc_write_model_atts', 'PSURF def_var '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, PSURFVarID, 'long_name', 'surface pressure'), &
+! 'nc_write_model_atts', 'PSURF long_name '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, PSURFVarID, 'units', 'dyne/cm2'), &
+! 'nc_write_model_atts', 'PSURF units '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, PSURFVarID, 'missing_value', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'PSURF missing '//trim(filename))
+! call nc_check(nf90_put_att(ncFileID, PSURFVarID, '_FillValue', NF90_FILL_REAL), &
+! 'nc_write_model_atts', 'PSURF fill '//trim(filename))
+
+ ! Finished with dimension/variable definitions, must end 'define' mode to fill.
+
+ call nc_check(nf90_enddef(ncfileID), 'prognostic enddef '//trim(filename))
+
+ !----------------------------------------------------------------------------
+ ! Fill the coordinate variables
+ !----------------------------------------------------------------------------
+
+ call nc_check(nf90_put_var(ncFileID, ulonVarID, ULON ), &
+ 'nc_write_model_atts', 'ULON put_var '//trim(filename))
+ call nc_check(nf90_put_var(ncFileID, ulatVarID, ULAT ), &
+ 'nc_write_model_atts', 'ULAT put_var '//trim(filename))
+
+ call nc_check(nf90_put_var(ncFileID, vlonVarID, VLON ), &
+ 'nc_write_model_atts', 'VLON put_var '//trim(filename))
+ call nc_check(nf90_put_var(ncFileID, vlatVarID, VLAT ), &
+ 'nc_write_model_atts', 'VLAT put_var '//trim(filename))
+
+ call nc_check(nf90_put_var(ncFileID, wlonVarID, WLON ), &
+ 'nc_write_model_atts', 'WLON put_var '//trim(filename))
+ call nc_check(nf90_put_var(ncFileID, wlatVarID, WLAT ), &
+ 'nc_write_model_atts', 'WLAT put_var '//trim(filename))
+
+ call nc_check(nf90_put_var(ncFileID, ZCVarID, ZC ), &
+ 'nc_write_model_atts', 'ZC put_var '//trim(filename))
+ call nc_check(nf90_put_var(ncFileID, ZEVarID, ZE ), &
+ 'nc_write_model_atts', 'ZE put_var '//trim(filename))
+
+endif
+
+!-------------------------------------------------------------------------------
+! Fill the variables we can
+!-------------------------------------------------------------------------------
+
+if (has_ncommas_namelist) then
+ call file_to_text('ncommas_in', textblock)
+ call nc_check(nf90_put_var(ncFileID, nmlVarID, textblock ), &
+ 'nc_write_model_atts', 'put_var nmlVarID')
+ deallocate(textblock)
+endif
+
+!-------------------------------------------------------------------------------
+! Flush the buffer and leave netCDF file open
+!-------------------------------------------------------------------------------
+call nc_check(nf90_sync(ncFileID), 'nc_write_model_atts', 'atts sync')
+
+ierr = 0 ! If we got here, things went well.
+
+end function nc_write_model_atts
+
+
+
+function nc_write_model_vars( ncFileID, statevec, copyindex, timeindex ) result (ierr)
+!------------------------------------------------------------------
+! TJH 24 Oct 2006 -- Writes the model variables to a netCDF file.
+!
+! TJH 29 Jul 2003 -- for the moment, all errors are fatal, so the
+! return code is always '0 == normal', since the fatal errors stop execution.
+!
+! For the lorenz_96 model, each state variable is at a separate location.
+! that's all the model-specific attributes I can think of ...
+!
+! assim_model_mod:init_diag_output uses information from the location_mod
+! to define the location dimension and variable ID. All we need to do
+! is query, verify, and fill ...
+!
+! Typical sequence for adding new dimensions,variables,attributes:
+! NF90_OPEN ! open existing netCDF dataset
+! NF90_redef ! put into define mode
+! NF90_def_dim ! define additional dimensions (if any)
+! NF90_def_var ! define variables: from name, type, and dims
+! NF90_put_att ! assign attribute values
+! NF90_ENDDEF ! end definitions: leave define mode
+! NF90_put_var ! provide values for variable
+! NF90_CLOSE ! close: save updated netCDF dataset
+
+integer, intent(in) :: ncFileID ! netCDF file identifier
+real(r8), dimension(:), intent(in) :: statevec
+integer, intent(in) :: copyindex
+integer, intent(in) :: timeindex
+integer :: ierr ! return value of function
+
+integer :: nDimensions, nVariables, nAttributes, unlimitedDimID
+integer :: VarID
+
+real(r8), dimension(nxc,nyc,nzc) :: data_3d
+real(r8), dimension(nxc,nyc) :: data_2d
+character(len=128) :: filename
+
+if ( .not. module_initialized ) call static_init_model
+
+ierr = -1 ! assume things go poorly
+
+!--------------------------------------------------------------------
+! we only have a netcdf handle here so we do not know the filename
+! or the fortran unit number. but construct a string with at least
@@ Diff output truncated at 40000 characters. @@
More information about the Dart-dev
mailing list