[Dart-dev] [4471] DART/trunk/models/NCOMMAS/model_mod.f90: nc_write_model_atts() fleshed out.
nancy at ucar.edu
nancy at ucar.edu
Mon Aug 9 13:57:05 MDT 2010
Revision: 4471
Author: thoar
Date: 2010-08-09 13:57:05 -0600 (Mon, 09 Aug 2010)
Log Message:
-----------
nc_write_model_atts() fleshed out.
I think there is a problem with the lats/lons coming out of get_grid().
set 'debug' to 2 and:
xc range 500.000000000000 39500.0000000000
xe range 0.000000000000000E+000 40000.0000000000
yc range 500.000000000000 39500.0000000000
ye range 0.000000000000000E+000 40000.0000000000
zc range 100.000000000000 17650.0000000000
ze range 0.000000000000000E+000 18000.0000000000
ref_lat/LAT 35.4799995422363
ref_lon/LON -95.5400009155273
xg_pos/XG_POS 0.000000000000000E+000
yg_pos/YG_POS 0.000000000000000E+000
hgt_offset/HGT 0.000000000000000E+000
ulon longitude range -5114.03882713574 -5088.65602072690
ulat latitude range 90.0000000000000 90.0000000000000
vlon longitude range -5113.72224508341 -5088.97259965123
vlat latitude range 90.0000000000000 90.0000000000000
wlon longitude range -5113.72223622281 -5088.97330580702
wlat latitude range 90.0000000000000 90.0000000000000
Modified Paths:
--------------
DART/trunk/models/NCOMMAS/model_mod.f90
-------------- next part --------------
Modified: DART/trunk/models/NCOMMAS/model_mod.f90
===================================================================
--- DART/trunk/models/NCOMMAS/model_mod.f90 2010-08-06 22:10:32 UTC (rev 4470)
+++ DART/trunk/models/NCOMMAS/model_mod.f90 2010-08-09 19:57:05 UTC (rev 4471)
@@ -302,7 +302,7 @@
!
! Variables needed to be stored in the MODEL_MODULE data structure
!
-! PROGVARS => Module's data structure
+! PROGVAR => Module's data structure
!
!############################################################################
@@ -735,7 +735,7 @@
integer :: ZEVarID, ZCVarID
! for the prognostic variables
-integer :: VarID
+integer :: ivar, VarID
!----------------------------------------------------------------------
! variables for the namelist output
@@ -758,8 +758,10 @@
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
+character(len=NF90_MAX_NAME) :: varname
+integer, dimension(NF90_MAX_VAR_DIMS) :: mydimids
+integer :: i, myndims
-integer :: i
character(len=128) :: filename
if ( .not. module_initialized ) call static_init_model
@@ -1037,77 +1039,43 @@
! 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))
+ do ivar=1, nfields
+ varname = trim(progvar(ivar)%varname)
+ string1 = trim(filename)//' '//trim(varname)
+
+ ! match shape of the variable to the dimension IDs
+
+ call define_var_dims(progvar(ivar), myndims, mydimids, MemberDimID, unlimitedDimID, &
+ NxcDimID, NycDimID, NzcDimID, NxeDimID, NyeDimID, NzeDimID, &
+ nxc , nyc , nzc , nxe , nye , nze )
+
+ ! define the variable and set the attributes
+
+ call nc_check(nf90_def_var(ncid=ncFileID, name=trim(varname), xtype=nf90_real, &
+ dimids = mydimids(1:myndims), varid=VarID),&
+ 'nc_write_model_atts', trim(string1)//' def_var' )
+
+ call nc_check(nf90_put_att(ncFileID, VarID, 'type', trim(progvar(ivar)%storder)), &
+ 'nc_write_model_atts', trim(string1)//' put_att storage type' )
+
+ call nc_check(nf90_put_att(ncFileID, VarID, 'long_name', trim(progvar(ivar)%long_name)), &
+ 'nc_write_model_atts', trim(string1)//' put_att long_name' )
+
+ call nc_check(nf90_put_att(ncFileID, VarID, 'units', trim(progvar(ivar)%units)), &
+ 'nc_write_model_atts', trim(string1)//' put_att units' )
+
+ call nc_check(nf90_put_att(ncFileID, VarID, 'missing_value', NF90_FILL_REAL), &
+ 'nc_write_model_atts', trim(string1)//' put_att missing_value' )
+
+ call nc_check(nf90_put_att(ncFileID, VarID, '_FillValue', NF90_FILL_REAL), &
+ 'nc_write_model_atts', trim(string1)//' put_att _FillValue' )
+
+ enddo
+
+ !----------------------------------------------------------------------------
! Finished with dimension/variable definitions, must end 'define' mode to fill.
+ !----------------------------------------------------------------------------
call nc_check(nf90_enddef(ncfileID), 'prognostic enddef '//trim(filename))
@@ -2437,6 +2405,24 @@
call nc_check(nf90_close(ncid), 'get_grid','close '//trim(ncommas_restart_filename) )
+! A little sanity check
+
+if ( debug > 1 ) then
+
+ write(*,*)'xc range ',minval(xc),maxval(xc)
+ write(*,*)'xe range ',minval(xe),maxval(xe)
+ write(*,*)'yc range ',minval(yc),maxval(yc)
+ write(*,*)'ye range ',minval(ye),maxval(ye)
+ write(*,*)'zc range ',minval(zc),maxval(zc)
+ write(*,*)'ze range ',minval(ze),maxval(ze)
+ write(*,*)'ref_lat/LAT ',ref_lat
+ write(*,*)'ref_lon/LON ',ref_lon
+ write(*,*)'xg_pos/XG_POS ',xg_pos
+ write(*,*)'yg_pos/YG_POS ',yg_pos
+ write(*,*)'hgt_offset/HGT ',hgt_offset
+
+endif
+
! Here convert model vertical height to height above sea level
zc(:) = zc(:) + hgt_offset
@@ -2480,7 +2466,6 @@
ENDDO
ENDIF
-
! IF WE DO THIS, THEN CAN ASSUME THAT LON > 0 IN LL_TO_XY
where (ULON < 0.0_r8) ULON = ULON + 360.0_r8
where (ULON > 360.0_r8) ULON = ULON - 360.0_r8
@@ -2496,6 +2481,18 @@
where (WLAT < -90.0_r8) WLAT = -90.0_r8
where (WLAT > 90.0_r8) WLAT = 90.0_r8
+! Print a little summary.
+if ( debug > 1 ) then
+ write(*,*)'ulon longitude range ',minval(ulon),maxval(ulon)
+ write(*,*)'ulat latitude range ',minval(ulat),maxval(ulat)
+
+ write(*,*)'vlon longitude range ',minval(vlon),maxval(vlon)
+ write(*,*)'vlat latitude range ',minval(vlat),maxval(vlat)
+
+ write(*,*)'wlon longitude range ',minval(wlon),maxval(wlon)
+ write(*,*)'wlat latitude range ',minval(wlat),maxval(wlat)
+endif
+
return
end subroutine get_grid
@@ -3107,6 +3104,69 @@
return
end subroutine xy_to_ll
+
+
+
+subroutine define_var_dims(myprogvar, ndims, dimids, memberdimid, unlimiteddimid, &
+ nxcdimid, nycdimid, nzcdimid, nxedimid, nyedimid, nzedimid, &
+ nxc , nyc , nzc , nxe , nye , nze )
+
+type(progvartype), intent(in) :: myprogvar
+integer, intent(out) :: ndims
+integer, dimension(:), intent(out) :: dimids
+integer, intent(in) :: memberdimid, unlimiteddimid
+integer, intent(in) :: nxcdimid, nycdimid, nzcdimid, nxedimid, nyedimid, nzedimid
+integer, intent(in) :: nxc , nyc , nzc , nxe , nye , nze
+
+select case( myprogvar%storder )
+case('xyz3d')
+
+ ndims = 5
+
+ dimids(1) = nxcdimid
+ dimids(2) = nycdimid
+ dimids(3) = nzcdimid
+ dimids(4) = memberdimid
+ dimids(5) = unlimitedDimid
+
+ if (myprogvar%dimlens(1) == nxe) dimids(1) = nxedimid
+ if (myprogvar%dimlens(2) == nye) dimids(2) = nyedimid
+ if (myprogvar%dimlens(3) == nze) dimids(3) = nzedimid
+
+case('xy2d')
+
+ ndims = 4
+
+ dimids(1) = nxcdimid
+ dimids(2) = nycdimid
+ dimids(3) = memberdimid
+ dimids(4) = unlimitedDimid
+
+ if (myprogvar%dimlens(1) == nxe) dimids(1) = nxedimid
+ if (myprogvar%dimlens(2) == nye) dimids(2) = nyedimid
+
+case('x1d','y1d','z1d')
+
+ ndims = 3
+
+ dimids(1) = nxcdimid
+ dimids(2) = memberdimid
+ dimids(3) = unlimitedDimid
+
+ if (myprogvar%dimlens(1) == nxe) dimids(1) = nxedimid
+
+case default
+
+ write(string1,*)'unknown storage order '//trim(myprogvar%storder)//&
+ ' for variable '//trim(myprogvar%varname)
+ call error_handler(E_ERR,'define_var_dims',string1,source,revision,revdate)
+
+end select
+
+return
+end subroutine define_var_dims
+
+
!===================================================================
! End of model_mod
!===================================================================
More information about the Dart-dev
mailing list