Layout of routine rd_prog
SUBROUTINE RD_PROG(NCID)
#ifdef DOC
!**** *RD_PROG * - Reading netCDF file containing surface prognostic fields
! Purpose.
! --------
! initialization surface prognostics
!** Interface.
! ----------
! *CALL* *RD_PROG(NCID)
! Explicit arguments :
! --------------------
! NCID INT NetCDF file ID
! Implicit arguments :
! --------------------
! Method.
! -------
! Opens a file called 'soilinit' to read relevant fields
! In the file, fields are assumed to be stored as
! FIELD(LAT,LON)
! or as
! FIELD(NLEVS,LAT,LON)
!
! Externals.
! ----------
! NETCDF-utilities
! screen output routine MINMAX
! Reference.
! ----------
! Author.
! -------
! Bart vd Hurk, KNMI
! Modifications.
! --------------
! Original : 2000-07-13
! ------------------------------------------------------------------
#endif
.....
#include "netcdf.inc"
INTEGER ISTART2(2),ICOUNT2(2)
INTEGER ISTART3(3),ICOUNT3(3)
INTEGER NDIMS(100)
REAL*4,ALLOCATABLE :: ZREAL(:),ZREAL3(:,:)
REAL*8,ALLOCATABLE :: ZREALD(:),ZREAL3D(:,:)
CHARACTER*100 CNAME
CHARACTER*8 CDUM
DATA ISTART2/1,1/
DATA ISTART3/1,1,1/
!* check the dimensions
NIDLAT = NCDID(NCID, 'y', IERR)
NIDLON = NCDID(NCID, 'x', IERR)
NIDLEVS = NCDID(NCID, 'nlevs', IERR)
CALL NCDINQ(NCID,NIDLAT,CNAME,NILAT,IERR)
CALL NCDINQ(NCID,NIDLON,CNAME,NILON,IERR)
CALL NCDINQ(NCID,NIDLEVS,CNAME,NILEVS,IERR)
IF(NILON.NE.NLON .OR. NILAT.NE.NLAT) THEN
.....
ENDIF
!
!* Note the reversal of the order of array storage
!
ICOUNT2(1)=NILON
ICOUNT2(2)=NILAT
ICOUNT3(1)=NILON
ICOUNT3(2)=NILAT
ICOUNT3(3)=NILEVS
ALLOCATE (ZREAL3(NLALO,NCSS))
ALLOCATE (ZREAL3D(NLALO,NCSS))
!* Read surface prognostic values
!* -- temperature
NVARID = NCVID(NCID, 'SoilTemp', IERR)
CALL NCVINQ (NCID, NVARID, CNAME, NVARTYP,
+ NVDIMS, NDIMS,NVATTS, IERR)
IF(NVARTYP.EQ.NCFLOAT)THEN
CALL NCVGT(NCID, NVARID, ISTART3, ICOUNT3, ZREAL3, IERR)
ZREAL3D(:,1:NCSS)=ZREAL3(:,1:NCSS)
ELSE
CALL NCVGT(NCID, NVARID, ISTART3, ICOUNT3, ZREAL3D, IERR)
ENDIF
DO ILEVS=1,NCSS
WRITE(CDUM,'(A6,I2.2)')'TEMP. ',ILEVS
CALL MINMAX(CDUM,ZREAL3D(1,ILEVS),NLON,NLAT,LMASK,NULOUT)
TSLNU0(:,ILEVS)=PACK(ZREAL3D(:,ILEVS),LMASK)
ENDDO
!* -- ice temperature
NVARID = NCVID(NCID, 'icetemp', IERR)
......(etc)
!* -- soil water
NVARID = NCVID(NCID, 'SoilMoist', IERR)
......(etc)
ALLOCATE (ZREAL(NLALO))
ALLOCATE (ZREALD(NLALO))
!* -- Snow depth
NVARID = NCVID(NCID, 'SWE', IERR)
CALL NCVINQ (NCID, NVARID, CNAME, NVARTYP,
+ NVDIMS, NDIMS,NVATTS, IERR)
IF(NVARTYP.EQ.NCFLOAT)THEN
CALL NCVGT(NCID, NVARID, ISTART2, ICOUNT2, ZREAL, IERR)
ZREALD(:)=ZREAL(:)
ELSE
CALL NCVGT(NCID, NVARID, ISTART2, ICOUNT2, ZREALD, IERR)
ENDIF
ZREALD(:)=ZREALD(:)/RHOH2O
CALL MINMAX('SNOWDEPT',ZREALD,NLON,NLAT,LMASK,NULOUT)
FSNNU0=PACK(ZREALD,LMASK)
!* -- Snow density
NVARID = NCVID(NCID, 'snowdens', IERR)
.....(etc)
!* -- Snow albedo
NVARID = NCVID(NCID, 'SAlbedo', IERR)
.....(etc)
!* -- Snow temperature
NVARID = NCVID(NCID, 'SnowT', IERR)
.....(etc)
!* -- Interception depth
NVARID = NCVID(NCID, 'CanopInt', IERR)
.....(etc)
!* -- skin temp
NVARID = NCVID(NCID, 'AvgSurfT', IERR)
.....(etc)
!* Check final values
.......
END SUBROUTINE RD_PROG