!wdt update filename(1:lfname) below
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE READEXBC ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE readexbc(nx,ny,nz, & 5,63
filename,lfname, ctime, &
u,v,w,pt,pr,qv,qc,qr,qi,qs,qh, ierr)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Read in 6 primary fields for use as external boundary
! conditions.
!
! In general these data will come from another model.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! May, 1994
!
! MODIFICATION HISTORY:
!
! 5/26/94 (Yuhe Liu)
! Merged into the part of ARPS for external boundary conditions.
!
! 8/8/95 (M. Xue)
! Added water and ice variables to the EXBC files.
! To read earlier version EXBC files, one has to set old_v=1.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nz Number of grid points in the vertical
!
! dx Expected x grid spacing
! dy Expected y grid spacing
! dz Expected z grid spacing
!
! ctrlat Expected center latitude
! ctrlon Expected center longitude
!
! filename File name of EXBC boundary data set.
! lfname Length of the filename
!
! OUTPUT:
!
! ctime Charater representation of the time of EXBC data
!
! ubcrd Flag indicating (1) if the u field is valid
! vbcrd Flag indicating (1) if the v field is valid
! wbcrd Flag indicating (1) if the w field is valid
! ptbcrd Flag indicating (1) if the pt field is valid
! prbcrd Flag indicating (1) if the pr field is valid
! qvbcrd Flag indicating (1) if the qv field is valid
! qcbcrd Flag indicating (1) if the qc field is valid
! qrbcrd Flag indicating (1) if the qr field is valid
! qibcrd Flag indicating (1) if the qi field is valid
! qsbcrd Flag indicating (1) if the qs field is valid
! qhbcrd Flag indicating (1) if the qh field is valid
!
! u x component of velocity (m/s)
! v y component of velocity (m/s)
! w Vertical component of Cartesian velocity (m/s)
! pt Potential temperature (K)
! pr Pressure (Pascal)
! qv Water vapor mixing ratio humidity (kg/kg)
! qc Cloud water mixing ratio humidity (kg/kg)
! qr Rain water mixing ratio humidity (kg/kg)
! qi Cloud ice mixing ratio humidity (kg/kg)
! qs Snow mixing ratio humidity (kg/kg)
! qh Hail water mixing ratio humidity (kg/kg)
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz ! Number of grid points in x, y, and z dir.
CHARACTER (LEN=80) :: filename
INTEGER :: lfname
CHARACTER (LEN=15) :: ctime
REAL :: u(nx,ny,nz) ! u-velocity (m/s)
REAL :: v(nx,ny,nz) ! v-velocity (m/s)
REAL :: w(nx,ny,nz) ! w-velocity (m/s)
REAL :: pt(nx,ny,nz) ! Potential temperature (K)
REAL :: pr(nx,ny,nz) ! Pressure (Pascal)
REAL :: qv(nx,ny,nz) ! Water vapor mixing ratio (kg/kg)
REAL :: qc(nx,ny,nz) ! Cloud water mixing ratio (kg/kg)
REAL :: qr(nx,ny,nz) ! Rain water mixing ratio (kg/kg)
REAL :: qi(nx,ny,nz) ! Cloud ice mixing ratio (kg/kg)
REAL :: qs(nx,ny,nz) ! Snow mixing ratio (kg/kg)
REAL :: qh(nx,ny,nz) ! Hail mixing ratio (kg/kg)
!
!-----------------------------------------------------------------------
!
! Misc internal variables
!
!-----------------------------------------------------------------------
!
INTEGER :: nch
INTEGER :: nxin,nyin,nzin
REAL :: ctrlatin,ctrlonin
INTEGER :: istat, ierr, idummy, old_v
REAL :: amax, amin
INTEGER :: ireturn
INTEGER :: strhoptin
REAL :: dxin,dyin,dzin,dzminin,zrefsfcin,dlayer1in, &
dlayer2in,zflatin,strhtunein
REAL :: trulat1in,trulat2in,trulonin,sclfctin
INTEGER :: maprojin
INTEGER(2), allocatable :: itmp(:,:,:) ! Temporary array
REAL, allocatable :: hmax(:), hmin(:) ! Temporary array
INTEGER :: clipxy, clipz
INTEGER :: sd_id
!
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'exbc.inc'
INCLUDE 'grid.inc' ! Grid & map parameters.
INCLUDE 'mp.inc' ! mpi parameters.
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. (HDF format exbc)
!wdt begin block
IF (exbcfmt /= 0) THEN
ALLOCATE (itmp(nx,ny,nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "READEXBC: ERROR allocating itmp, returning"
ierr = 1
RETURN
END IF
ALLOCATE (hmax(nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "READEXBC: ERROR allocating hmax, returning"
ierr = 1
RETURN
END IF
ALLOCATE (hmin(nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "READEXBC: ERROR allocating hmin, returning"
ierr = 1
RETURN
END IF
END IF
!wdt end block
IF (myproc == 0) &
WRITE (6,*) "READEXBC: reading in external boundary data ", &
"from file ",filename(1:lfname)
!
!-----------------------------------------------------------------------
!
! Read in header information.
!
!-----------------------------------------------------------------------
!
IF (exbcfmt == 0) THEN
!-----------------------------------------------------------------------
!
! Fortran unformatted dump.
!
!-----------------------------------------------------------------------
CALL getunit
( nch )
CALL asnctl ('NEWLOCAL', 1, ierr)
CALL asnfile(filename(1:lfname), '-F f77 -N ieee', ierr)
OPEN(nch,FILE=filename(1:lfname),STATUS='old', &
FORM='unformatted',IOSTAT=istat)
IF ( istat /= 0 ) THEN
ierr = 1
GO TO 900
END IF
READ(nch,ERR=999) nxin,nyin,nzin,dxin,dyin,dzin, &
ctrlatin,ctrlonin
!
READ(nch,ERR=999) ctime
old_v = 0 ! In case that the EXBC files are of an earlier
! version that does not contain water and ice variables,
! set old_v to 1. Otherwise, set it to 0.
IF( old_v == 1 ) THEN
READ(nch,ERR=999) ubcrd,vbcrd,wbcrd,ptbcrd,prbcrd,qvbcrd
qcbcrd=0
qrbcrd=0
qibcrd=0
qsbcrd=0
qhbcrd=0
ELSE
READ(nch,ERR=999) ubcrd,vbcrd,wbcrd,ptbcrd,prbcrd, &
qvbcrd,qcbcrd,qrbcrd,qibcrd,qsbcrd, &
qhbcrd,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
END IF
ELSE
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. (HDF format exbc)
!wdt begin block
!-----------------------------------------------------------------------
!
! HDF4 format.
!
!-----------------------------------------------------------------------
CALL hdfopen(trim(filename(1:lfname)), 1, sd_id)
IF (sd_id < 0) THEN
WRITE (6,*) "READEXBC: ERROR opening ", &
trim(filename(1:lfname))," for reading."
ierr = 1
GO TO 900
END IF
CALL hdfrdc(sd_id,15,"ctime",ctime,istat)
CALL hdfrdi(sd_id,"nx",nxin,istat)
CALL hdfrdi(sd_id,"ny",nyin,istat)
CALL hdfrdi(sd_id,"nz",nzin,istat)
CALL hdfrdr(sd_id,"dx",dxin,istat)
CALL hdfrdr(sd_id,"dy",dyin,istat)
CALL hdfrdr(sd_id,"dz",dzin,istat)
CALL hdfrdr(sd_id,"dzmin",dzminin,istat)
CALL hdfrdi(sd_id,"strhopt",strhoptin,istat)
CALL hdfrdr(sd_id,"zrefsfc",zrefsfcin,istat)
CALL hdfrdr(sd_id,"dlayer1",dlayer1in,istat)
CALL hdfrdr(sd_id,"dlayer2",dlayer2in,istat)
CALL hdfrdr(sd_id,"zflat",zflatin,istat)
CALL hdfrdr(sd_id,"strhtune",strhtunein,istat)
CALL hdfrdi(sd_id,"mapproj",maprojin,istat)
CALL hdfrdr(sd_id,"trulat1",trulat1in,istat)
CALL hdfrdr(sd_id,"trulat2",trulat2in,istat)
CALL hdfrdr(sd_id,"trulon",trulonin,istat)
CALL hdfrdr(sd_id,"sclfct",sclfctin,istat)
CALL hdfrdr(sd_id,"ctrlat",ctrlatin,istat)
CALL hdfrdr(sd_id,"ctrlon",ctrlonin,istat)
CALL hdfrdi(sd_id,"ubcflg",ubcrd,istat)
CALL hdfrdi(sd_id,"vbcflg",vbcrd,istat)
CALL hdfrdi(sd_id,"wbcflg",wbcrd,istat)
CALL hdfrdi(sd_id,"ptbcflg",ptbcrd,istat)
CALL hdfrdi(sd_id,"prbcflg",prbcrd,istat)
CALL hdfrdi(sd_id,"qvbcflg",qvbcrd,istat)
CALL hdfrdi(sd_id,"qcbcflg",qcbcrd,istat)
CALL hdfrdi(sd_id,"qrbcflg",qrbcrd,istat)
CALL hdfrdi(sd_id,"qibcflg",qibcrd,istat)
CALL hdfrdi(sd_id,"qsbcflg",qsbcrd,istat)
CALL hdfrdi(sd_id,"qhbcflg",qhbcrd,istat)
CALL hdfrdi(sd_id, 'clipxy', clipxy,istat)
IF (istat == 0 .AND. clipxy < ngbrz) THEN
WRITE (6,*) "READEXBC: ERROR, clipxy (ngbrz) in exbc file too small"
ierr = 1
GO TO 900
END IF
CALL hdfrdi(sd_id, 'clipz', clipz,istat)
IF (istat == 0 .AND. clipz > rayklow) THEN
WRITE (6,*) "READEXBC: ERROR, clipz (rayklow) in exbc file too large"
ierr = 1
GO TO 900
END IF
!wdt end block
! alternate dump format ...
END IF
!-----------------------------------------------------------------------
!
! Check the data file for consistent grid parameters.
!
!-----------------------------------------------------------------------
IF (exbcfmt == 0) THEN
IF (myproc == 0) &
WRITE (6,*) &
"READEXBC: WARNING, not checking all map projection parameters"
CALL checkgrid2d(nx,ny,nxin,nyin, &
dx,dy,ctrlat,ctrlon, &
mapproj,trulat1,trulat2,trulon,sclfct, &
dxin,dyin,ctrlatin,ctrlonin, &
mapproj,trulat1,trulat2,trulon,sclfct,ireturn)
ELSE
CALL checkgrid3d(nx,ny,nz,nxin,nyin,nzin, &
dx,dy,dz,dzmin,ctrlat,ctrlon, &
strhopt,zrefsfc,dlayer1,dlayer2,zflat,strhtune, &
mapproj,trulat1,trulat2,trulon,sclfct, &
dxin,dyin,dzin,dzminin,ctrlatin,ctrlonin, &
strhoptin,zrefsfcin,dlayer1in,dlayer2in,zflatin,strhtunein, &
maprojin,trulat1in,trulat2in,trulonin,sclfctin,ireturn)
END IF
IF (ireturn /= 0) THEN
WRITE (6,*) "READEXBC: ERROR, grid parameter mismatch"
ierr = 1
GO TO 900
END IF
!-----------------------------------------------------------------------
!
! Read in the external boundary file data
!
!-----------------------------------------------------------------------
IF (exbcfmt == 0) THEN
READ(nch,ERR=999) u
READ(nch,ERR=999) v
READ(nch,ERR=999) w
READ(nch,ERR=999) pt
READ(nch,ERR=999) pr
IF(qvbcrd == 1) READ(nch,ERR=999) qv
IF(qcbcrd == 1) READ(nch,ERR=999) qc
IF(qrbcrd == 1) READ(nch,ERR=999) qr
IF(qibcrd == 1) READ(nch,ERR=999) qi
IF(qsbcrd == 1) READ(nch,ERR=999) qs
IF(qhbcrd == 1) READ(nch,ERR=999) qh
ELSE
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. (HDF format exbc)
!wdt begin block
IF (ubcrd == 1) THEN
CALL hdfrd3d(sd_id,"u",nx,ny,nz,u,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (vbcrd == 1) THEN
CALL hdfrd3d(sd_id,"v",nx,ny,nz,v,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (wbcrd == 1) THEN
CALL hdfrd3d(sd_id,"w",nx,ny,nz,w,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (ptbcrd == 1) THEN
CALL hdfrd3d(sd_id,"pt",nx,ny,nz,pt,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (prbcrd == 1) THEN
CALL hdfrd3d(sd_id,"p",nx,ny,nz,pr,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (qvbcrd == 1) THEN
CALL hdfrd3d(sd_id,"qv",nx,ny,nz,qv,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (qcbcrd == 1) THEN
CALL hdfrd3d(sd_id,"qc",nx,ny,nz,qc,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (qrbcrd == 1) THEN
CALL hdfrd3d(sd_id,"qr",nx,ny,nz,qr,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (qibcrd == 1) THEN
CALL hdfrd3d(sd_id,"qi",nx,ny,nz,qi,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (qsbcrd == 1) THEN
CALL hdfrd3d(sd_id,"qs",nx,ny,nz,qs,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
IF (qhbcrd == 1) THEN
CALL hdfrd3d(sd_id,"qh",nx,ny,nz,qh,istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 999
END IF
!wdt end block
! alternate dump format ...
END IF
IF(myproc == 0)THEN
write(6,'(/1x,a/)') 'Max. and Min. of EXBC data variables:'
CALL a3dmax0lcl(u,1,nx,1,nx,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'umin = ', amin,', umax =',amax
CALL a3dmax0lcl(v,1,nx,1,nx-1,1,ny,1,ny,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'vmin = ', amin,', vmax =',amax
CALL a3dmax0lcl(w,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz,amax,amin)
write(6,'(1x,2(a,e13.6))') 'wmin = ', amin,', wmax =',amax
CALL a3dmax0lcl(pt,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'ptmin= ', amin,', ptmax=',amax
CALL a3dmax0lcl(pr,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'pmin = ', amin,', pmax =',amax
CALL a3dmax0lcl(qv,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'qvmin= ', amin,', qvmax=',amax
CALL a3dmax0lcl(qc,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'qcmin= ', amin,', qcmax=',amax
CALL a3dmax0lcl(qr,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'qrmin= ', amin,', qrmax=',amax
CALL a3dmax0lcl(qi,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'qimin= ', amin,', qimax=',amax
CALL a3dmax0lcl(qs,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'qsmin= ', amin,', qsmax=',amax
CALL a3dmax0lcl(qh,1,nx,1,nx-1,1,ny,1,ny-1,1,nz,1,nz-1,amax,amin)
write(6,'(1x,2(a,e13.6))') 'qhmin= ', amin,', qhmax=',amax
END IF
ierr = 0
GO TO 900
999 CONTINUE
WRITE (6,*) "READEXBC: ERROR reading data ", &
"from file ",trim(filename(1:lfname))," returning"
ierr = 2
900 CONTINUE
IF (exbcfmt == 0) THEN
CLOSE (nch)
CALL retunit( nch )
ELSE
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. (HDF format exbc)
!wdt begin block
CALL hdfclose(sd_id,istat)
DEALLOCATE (itmp,stat=istat)
DEALLOCATE (hmax,stat=istat)
DEALLOCATE (hmin,stat=istat)
!wdt end block
! alternate dump format ...
END IF
RETURN
END SUBROUTINE readexbc
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE GETBCFN ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE getbcfn( abstsec, exbcnam, tinite, tintve, & 3,3
filename, lfname, istat )
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Get the external boundary data file name.
!
!
!-----------------------------------------------------------------------
!
! AUTHOR: Yuhe Liu
! 5/26/1994
!
! MODIFICATION HISTORY:
!
! 2000/03/24 (Gene Basett)
! Added HDF4 format dumps.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! abstsec Absolute seconds from 00:00:00, Jan. 1, 1980
! exbcnam A prefix of the external boundary condition file.
!
! tinite The boundary forecast initial time in yydddhhmm, In
! general, the boundary files are named in yydddhhmm.
! tintve EXBC forecast time interval in seconds
!
! OUTPUT:
!
! filename File name of EXBC boundary data set.
! lfname Length of the filename
!
! istat Status of finding the file.
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations and COMMON blocks.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: abstsec
CHARACTER (LEN=80) :: filename
INTEGER :: lfname
CHARACTER (LEN=80) :: exbcnam
CHARACTER (LEN=19) :: tinite
INTEGER :: tintve
INTEGER :: lenstr,istat
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=15) :: ctime
CHARACTER (LEN=1) :: chr
INTEGER :: abstsec1
INTEGER :: bcfcst, bcfcstop
INTEGER :: iyr, imon, idy, ihr, imin, isec
INTEGER :: maxtry
PARAMETER ( maxtry = 10 )
LOGICAL :: iexist
INTEGER :: sd_id
!
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'exbc.inc'
INCLUDE 'globcst.inc'
INCLUDE 'mp.inc' ! Message passing parameters.
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
READ (tinite,'(i4,a,i2,a,i2,a,i2,a,i2,a,i2)') &
iyr,chr,imon,chr,idy,chr,ihr,chr,imin,chr,isec
CALL ctim2abss( iyr,imon,idy,ihr,imin,isec, abstsec1 )
bcfcstop = abststop + maxtry * tintve
bcfcst = abstsec - MOD( abstsec-abstsec1, tintve )
IF ( abstsec < abstsec1 ) bcfcst = bcfcst - tintve
100 CONTINUE
bcfcst = bcfcst + tintve
IF ( bcfcst == abstsec .OR. bcfcst < abstsec1 ) GO TO 100
CALL abss2ctim( bcfcst, iyr, imon, idy, ihr, imin, isec )
WRITE (ctime,'(i4.4,2i2.2,a,3i2.2)') &
iyr,imon,idy,'.',ihr,imin,isec
lenstr = 80
CALL strlnth( exbcnam, lenstr )
lfname = lenstr + 16
filename(1:lfname) = exbcnam(1:lenstr)//'.'//ctime
IF (mp_opt > 0) THEN
WRITE(filename,'(a,a,a,a,2i2.2)') &
exbcnam(1:lenstr),'.',ctime,'_',loc_x,loc_y
lfname = lfname + 5
END IF
INQUIRE(FILE=filename(1:lfname),EXIST=iexist)
IF ( iexist ) THEN
istat = 0
WRITE (6,'(a,a)') &
'External boundary data file has been found: ', &
filename(1:lfname)
ELSE IF ( bcfcst <= bcfcstop ) THEN
WRITE (6,'(a,a,a)') &
'External BC data file ', filename(1:lfname), &
' could not be found. Try another time.'
GO TO 100
ELSE
WRITE (6,'(a,a)') &
'No external BC data file could not be found within a time range' &
,'Job will stop.'
istat = 1
END IF
RETURN
END SUBROUTINE getbcfn
!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE WRITEXBC ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE writexbc(nx,ny,nz,filename,lfname,ctime, & 2,61
ubcdmp,vbcdmp,wbcdmp,ptbcdmp,prbcdmp, &
qvbcdmp,qcbcdmp,qrbcdmp,qibcdmp,qsbcdmp,qhbcdmp, &
u,v,w,pt,pr,qv,qc,qr,qi,qs,qh)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Output 6 primary fields for use as external boundary conditions.
! In general these data come from another model.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! May, 1994
!
! MODIFICATION HISTORY:
!
! 5/26/94 (Yuhe Liu)
! Merged into the part of ARPS for external boundary conditions.
!
! 2000/03/24 (Gene Basett)
! Added HDF4 format dumps.
!
!-----------------------------------------------------------------------
!
! INPUT:
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nz Number of grid points in the vertical
!
! filename File name of EXBC boundary data set.
! lfname Length of the filename
!
! ctime Charater representation of the time of the EXBC data
!
! dx Expected x grid spacing
! dy Expected y grid spacing
! dz Expected z grid spacing
!
! ctrlat Expected center latitude
! ctrlon Expected center longitude
!
! u x component of velocity (m/s)
! v y component of velocity (m/s)
! w Vertical component of Cartesian velocity (m/s)
! pt Potential temperature (K)
! pr Pressure (Pascal)
! qv Water vapor specific humidity (kg/kg)
! qc Cloud water mixing ratio humidity (kg/kg)
! qr Rain water mixing ratio humidity (kg/kg)
! qi Cloud ice mixing ratio humidity (kg/kg)
! qs Snow mixing ratio humidity (kg/kg)
! qh Hail water mixing ratio humidity (kg/kg)
!
! OUTPUT:
!
! none
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz
CHARACTER (LEN=80) :: filename
INTEGER :: lfname
CHARACTER (LEN=15) :: ctime
INTEGER :: ubcdmp,vbcdmp,wbcdmp,ptbcdmp,prbcdmp
INTEGER :: qvbcdmp,qcbcdmp,qrbcdmp,qibcdmp,qsbcdmp,qhbcdmp
REAL :: u(nx,ny,nz) ! u-velocity (m/s)
REAL :: v(nx,ny,nz) ! v-velocity (m/s)
REAL :: w(nx,ny,nz) ! w-velocity (m/s)
REAL :: pt(nx,ny,nz) ! Potential temperature (K)
REAL :: pr(nx,ny,nz) ! Pressure (Pascal)
REAL :: qv(nx,ny,nz) ! Specific humidity (kg/kg)
REAL :: qc(nx,ny,nz) ! Cloud water mixing ratio (kg/kg)
REAL :: qr(nx,ny,nz) ! Rain water mixing ratio (kg/kg)
REAL :: qi(nx,ny,nz) ! Cloud ice mixing ratio (kg/kg)
REAL :: qs(nx,ny,nz) ! Snow mixing ratio (kg/kg)
REAL :: qh(nx,ny,nz) ! Hail mixing ratio (kg/kg)
!
!-----------------------------------------------------------------------
!
! Misc internal variables
!
!-----------------------------------------------------------------------
!
INTEGER :: nch, ierr, idummy
INTEGER(2), allocatable :: itmp(:,:,:) ! Temporary array
REAL, allocatable :: hmax(:), hmin(:) ! Temporary array
REAL, allocatable :: ctmp(:,:,:) ! Temporary array
INTEGER :: exbccompr
INTEGER :: istat, sd_id
INTEGER :: i,j,k
!
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc' ! Grid & map parameters.
INCLUDE 'exbc.inc'
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
IF (exbcdmp == 0) RETURN
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. (HDF format exbc)
!wdt begin block
IF (exbcdmp == 3) THEN
exbccompr = hdfcompr
ELSE IF (exbcdmp == 4) THEN
exbccompr = 5
ELSE
exbccompr = 0
END IF
IF (exbccompr > 3) THEN
ALLOCATE (itmp(nx,ny,nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "WRITEXBC: ERROR allocating itmp, returning"
RETURN
END IF
ALLOCATE (hmax(nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "WRITEXBC: ERROR allocating hmax, returning"
RETURN
END IF
ALLOCATE (hmin(nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "WRITEXBC: ERROR allocating hmin, returning"
RETURN
END IF
END IF
IF (exbcdmp == 4) THEN
ALLOCATE (ctmp(nx,ny,nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "WRITEXBC: ERROR allocating ctmp, returning"
RETURN
END IF
END IF
!wdt end block
WRITE (6,*) 'WRITEXBC: Opening external boundary file ', &
trim(filename(1:lfname))
!-----------------------------------------------------------------------
!
! Write out in Fortran unformatted.
!
!-----------------------------------------------------------------------
IF (exbcdmp == 1) THEN
CALL getunit( nch )
CALL asnctl ('NEWLOCAL', 1, ierr)
CALL asnfile(filename(1:lfname), '-F f77 -N ieee', ierr)
OPEN (nch,FILE=trim(filename(1:lfname)),STATUS='unknown', &
FORM='unformatted')
!
!-----------------------------------------------------------------------
!
! Write grid and time descriptors
!
!-----------------------------------------------------------------------
!
WRITE (nch) nx,ny,nz,dx,dy,dz,ctrlat,ctrlon
!
WRITE (nch) ctime
!
!-----------------------------------------------------------------------
!
! Write integers which indicate whether each of the
! variables are valid. These must be properly set
! by the calling routine.
!
!-----------------------------------------------------------------------
!
idummy = 0
WRITE (nch) ubcdmp,vbcdmp,wbcdmp,ptbcdmp,prbcdmp, &
qvbcdmp,qcbcdmp,qrbcdmp,qibcdmp,qsbcdmp, &
qhbcdmp,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
!
!-----------------------------------------------------------------------
!
! Write each variable in a separate record
!
!-----------------------------------------------------------------------
!
IF( ubcdmp == 1) WRITE (nch) u
IF( vbcdmp == 1) WRITE (nch) v
IF( wbcdmp == 1) WRITE (nch) w
IF(ptbcdmp == 1) WRITE (nch) pt
IF(prbcdmp == 1) WRITE (nch) pr
IF(qvbcdmp == 1) WRITE (nch) qv
IF(qcbcdmp == 1) WRITE (nch) qc
IF(qrbcdmp == 1) WRITE (nch) qr
IF(qibcdmp == 1) WRITE (nch) qi
IF(qsbcdmp == 1) WRITE (nch) qs
IF(qhbcdmp == 1) WRITE (nch) qh
ELSE
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. (HDF format exbc)
!wdt begin block
!-----------------------------------------------------------------------
!
! Write out in HDF4.
!
!-----------------------------------------------------------------------
CALL hdfopen(trim(filename(1:lfname)), 2, sd_id)
IF (sd_id < 0) THEN
WRITE (6,*) "WRITEXBC: ERROR creating HDF4 file: ", &
trim(filename(1:lfname))
GO TO 900
END IF
CALL hdfwrtc(sd_id, 15, 'ctime', ctime, istat)
CALL hdfwrti(sd_id, 'nx', nx, istat)
CALL hdfwrti(sd_id, 'ny', ny, istat)
CALL hdfwrti(sd_id, 'nz', nz, istat)
CALL hdfwrtr(sd_id, 'dx', dx, istat)
CALL hdfwrtr(sd_id, 'dy', dy, istat)
CALL hdfwrtr(sd_id, 'dz', dz, istat)
CALL hdfwrtr(sd_id, 'dzmin', dzmin, istat)
CALL hdfwrti(sd_id, 'strhopt', strhopt, istat)
CALL hdfwrtr(sd_id, 'zrefsfc', zrefsfc, istat)
CALL hdfwrtr(sd_id, 'dlayer1', dlayer1, istat)
CALL hdfwrtr(sd_id, 'dlayer2', dlayer2, istat)
CALL hdfwrtr(sd_id, 'zflat', zflat, istat)
CALL hdfwrtr(sd_id, 'strhtune', strhtune, istat)
CALL hdfwrti(sd_id, 'mapproj', mapproj, istat)
CALL hdfwrtr(sd_id, 'trulat1', trulat1, istat)
CALL hdfwrtr(sd_id, 'trulat2', trulat2, istat)
CALL hdfwrtr(sd_id, 'trulon', trulon, istat)
CALL hdfwrtr(sd_id, 'sclfct', sclfct, istat)
CALL hdfwrtr(sd_id, 'ctrlat', ctrlat, istat)
CALL hdfwrtr(sd_id, 'ctrlon', ctrlon, istat)
CALL hdfwrti(sd_id,"ubcflg",ubcdmp,istat)
CALL hdfwrti(sd_id,"vbcflg",vbcdmp,istat)
CALL hdfwrti(sd_id,"wbcflg",wbcdmp,istat)
CALL hdfwrti(sd_id,"ptbcflg",ptbcdmp,istat)
CALL hdfwrti(sd_id,"prbcflg",prbcdmp,istat)
CALL hdfwrti(sd_id,"qvbcflg",qvbcdmp,istat)
CALL hdfwrti(sd_id,"qcbcflg",qcbcdmp,istat)
CALL hdfwrti(sd_id,"qrbcflg",qrbcdmp,istat)
CALL hdfwrti(sd_id,"qibcflg",qibcdmp,istat)
CALL hdfwrti(sd_id,"qsbcflg",qsbcdmp,istat)
CALL hdfwrti(sd_id,"qhbcflg",qhbcdmp,istat)
IF (exbcdmp == 4) THEN
CALL hdfwrti(sd_id, 'clipxy', ngbrz, istat)
CALL hdfwrti(sd_id, 'clipz', rayklow, istat)
END IF
IF( ubcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = u(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=2+ngbrz,nx-2-ngbrz
ctmp(i,j,k) = u(2,2,k) ! just need some value with max/min
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'u','u-velocity','m/s', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(u,nx,ny,nz,sd_id,1,exbccompr, &
'u','u-velocity','m/s', &
itmp,hmax,hmin)
END IF
END IF
IF( vbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = v(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=2+ngbrz,ny-2-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = v(2,2,k) ! just need some value with max/min
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'v','v-velocity','m/s', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(v,nx,ny,nz,sd_id,1,exbccompr, &
'v','v-velocity','m/s', &
itmp,hmax,hmin)
END IF
END IF
IF( wbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = w(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-2
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = w(2,2,k) ! just need some value with max/min
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'w','w-velocity','m/s', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(w,nx,ny,nz,sd_id,1,exbccompr, &
'w','w-velocity','m/s', &
itmp,hmax,hmin)
END IF
END IF
IF(ptbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = pt(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = pt(2,2,k) ! just need some value with max/min
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'pt','Potential temperature','K', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(pt,nx,ny,nz,sd_id,1,exbccompr, &
'pt','Potential temperature','K', &
itmp,hmax,hmin)
END IF
END IF
IF(prbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = pr(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = pr(2,2,k) ! just need some value with max/min
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'p','Pressure','Pascal', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(pr,nx,ny,nz,sd_id,1,exbccompr, &
'p','Pressure','Pascal', &
itmp,hmax,hmin)
END IF
END IF
IF(qvbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = qv(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = 0.0
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'qv','Water vapor specific humidity','kg/kg', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(qv,nx,ny,nz,sd_id,1,exbccompr, &
'qv','Water vapor specific humidity','kg/kg', &
itmp,hmax,hmin)
END IF
END IF
IF(qcbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = qc(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = 0.0
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'qc','Cloud water mixing ratio','kg/kg', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(qc,nx,ny,nz,sd_id,1,exbccompr, &
'qc','Cloud water mixing ratio','kg/kg', &
itmp,hmax,hmin)
END IF
END IF
IF(qrbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = qr(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = 0.0
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'qr','Rain water mixing ratio','kg/kg', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(qr,nx,ny,nz,sd_id,1,exbccompr, &
'qr','Rain water mixing ratio','kg/kg', &
itmp,hmax,hmin)
END IF
END IF
IF(qibcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = qi(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = 0.0
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'qi','Cloud ice mixing ratio','kg/kg', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(qi,nx,ny,nz,sd_id,1,exbccompr, &
'qi','Cloud ice mixing ratio','kg/kg', &
itmp,hmax,hmin)
END IF
END IF
IF(qsbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = qs(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = 0.0
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'qs','Snow mixing ratio','kg/kg', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(qs,nx,ny,nz,sd_id,1,exbccompr, &
'qs','Snow mixing ratio','kg/kg', &
itmp,hmax,hmin)
END IF
END IF
IF(qhbcdmp == 1) THEN
IF (exbcdmp == 4) THEN
DO k=1,nz
DO j=1,ny
DO i=1,nx
ctmp(i,j,k) = qh(i,j,k)
END DO
END DO
END DO
! reset values inside region not used by LBC forcing
DO k=1,rayklow-1
DO j=1+ngbrz,ny-1-ngbrz
DO i=1+ngbrz,nx-1-ngbrz
ctmp(i,j,k) = 0.0
END DO
END DO
END DO
CALL hdfwrt3d(ctmp,nx,ny,nz,sd_id,1,exbccompr, &
'qh','Hail mixing ratio','kg/kg', &
itmp,hmax,hmin)
ELSE
CALL hdfwrt3d(qh,nx,ny,nz,sd_id,1,exbccompr, &
'qh','Hail mixing ratio','kg/kg', &
itmp,hmax,hmin)
END IF
END IF
!wdt end block
! alternate dump format ...
END IF
900 CONTINUE
IF (exbcdmp == 1) THEN
CLOSE (nch)
CALL retunit( nch )
ELSE
!wdt Copyright (c) 2001 Weather Decision Technologies, Inc. (HDF format exbc)
!wdt begin block
CALL hdfclose(sd_id,istat)
IF (exbccompr > 3) THEN
DEALLOCATE (itmp,stat=istat)
DEALLOCATE (hmax,stat=istat)
DEALLOCATE (hmin,stat=istat)
END IF
IF (exbcdmp == 4) THEN
DEALLOCATE (ctmp,stat=istat)
END IF
!wdt end block
! alternate dump format ...
END IF
RETURN
END SUBROUTINE writexbc
!
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE EXBCDUMP ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE exbcdump( nx,ny,nz,nstyps, & 2,2
hisfmt,hisfnm,grdbas,flcmprs, &
u,v,w,ptprt,pprt,qv,qc,qr,qi,qs,qh,tke,kmh,kmv, &
ubar,vbar,wbar,ptbar,pbar,rhobar,qvbar, &
x,y,z,zp,hterain,j1,j2,j3, &
soiltyp,stypfrct,vegtyp,lai,roufns,veg, &
tsfc,tsoil,wetsfc,wetdp,wetcanp,snowdpth, &
raing,rainc,prcrate, &
radfrc,radsw,rnflx, &
usflx,vsflx,ptsflx,qvsflx, &
u0exb,v0exb,w0exb,pt0exb,pr0exb,qv0exb,qc0exb,qr0exb, &
qi0exb,qs0exb,qh0exb,udtexb,vdtexb,wdtexb, &
ptdtexb,prdtexb,qvdtexb,qcdtexb,qrdtexb,qidtexb, &
qsdtexb,qhdtexb, &
tem1,tem2,tem3 )
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Dump EXBC fields interpolated to the model time in history
! dump format.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Yuhe Liu
! 5/27/94
!
! MODIFICATION HISTORY:
!
! 12/09/1998 (Donghai Wang)
! Added the snow cover.
!
!-----------------------------------------------------------------------
!
! INPUT :
!
! nx Number of grid points in the x-direction (east/west)
! ny Number of grid points in the y-direction (north/south)
! nz Number of grid points in the vertical
!
! hisfmt
! hisfnm
! grdbas
! flcmprs
!
! u x component of velocity (m/s)
! v y component of velocity (m/s)
! w Vertical component of Cartesian velocity (m/s)
! ptprt Perturbation potential temperature (K)
! pprt Perturbation pressure (Pascal)
! qv Water vapor specific humidity (kg/kg)
! qc Cloud water mixing ratio (kg/kg)
! qr Rainwater mixing ratio (kg/kg)
! qi Cloud ice mixing ratio (kg/kg)
! qs Snow mixing ratio (kg/kg)
! qh Hail mixing ratio (kg/kg)
! tke Turbulent Kinetic Energy ((m/s)**2)
!
! kmh Horizontal turb. mixing coef. for momentum ( m**2/s )
! kmv Vertical turb. mixing coef. for momentum ( m**2/s )
!
! ubar Base state zonal velocity component (m/s)
! vbar Base state meridional velocity component (m/s)
! wbar Base state vertical velocity component (m/s)
! ptbar Base state potential temperature (K)
! pbar Base state pressure (Pascal)
! rhobar Base state density (kg/m**3)
! qvbar Base state water vapor specific humidity (kg/kg)
!
! x coordinate of grid points in physical/comp. space (m)
! y y coordinate of grid points in physical/comp. space (m)
! z z coordinate of grid points in computational space (m)
! zp Vertical coordinate of grid points in physical space (m)
! hterain Terrain height (m)
!
! j1 Coordinate transformation Jacobian -d(zp)/dx
! j2 Coordinate transformation Jacobian -d(zp)/dy
! j3 Coordinate transformation Jacobian d(zp)/dz
!
! soiltyp Soil type
! vegtyp Vegetation type
! lai Leaf Area Index
! roufns Surface roughness
! veg Vegetation fraction
!
! tsfc Temperature at ground (K) (in top 1 cm layer)
! tsoil Deep soil temperature (K) (in deep 1 m layer)
! wetsfc Surface soil moisture in the top 1 cm layer
! wetdp Deep soil moisture in the deep 1 m layer
! wetcanp Canopy water amount
!
! raing Grid supersaturation rain
! rainc Cumulus convective rain
! prcrate Precipitation rates
!
! radfrc Radiation forcing (K/s)
! radsw Solar radiation reaching the surface
! rnflx Net radiation flux absorbed by surface
!
! usflx Surface flux of u-momentum (kg/(m*s**2))
! vsflx Surface flux of v-momentum (kg/(m*s**2))
! ptsflx Surface heat flux (K*kg/(m**2 * s ))
! qvsflx Surface moisture flux of (kg/(m**2 * s))
!
! OUTPUT:
!
! None
!
! TEMPORATY WORKING ARRAY
!
! tem1
! tem2
! tem3
!
!-----------------------------------------------------------------------
!
! Variable Declarations.
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx, ny, nz
INTEGER :: hisfmt
CHARACTER (LEN=*) :: hisfnm
INTEGER :: grdbas
INTEGER :: flcmprs
!
REAL :: u (nx,ny,nz) ! Total u-velocity (m/s)
REAL :: v (nx,ny,nz) ! Total v-velocity (m/s)
REAL :: w (nx,ny,nz) ! Total w-velocity (m/s)
REAL :: ptprt (nx,ny,nz) ! Perturbation potential temperature (K)
REAL :: pprt (nx,ny,nz) ! Perturbation pressure (Pascal)
REAL :: qv (nx,ny,nz) ! Water vapor specific humidity (kg/kg)
REAL :: qc (nx,ny,nz) ! Cloud water mixing ratio (kg/kg)
REAL :: qr (nx,ny,nz) ! Rain water mixing ratio (kg/kg)
REAL :: qi (nx,ny,nz) ! Cloud ice mixing ratio (kg/kg)
REAL :: qs (nx,ny,nz) ! Snow mixing ratio (kg/kg)
REAL :: qh (nx,ny,nz) ! Hail mixing ratio (kg/kg)
REAL :: tke (nx,ny,nz) ! Turbulent Kinetic Energy ((m/s)**2)
REAL :: kmh (nx,ny,nz) ! Horizontal turb. mixing coef. for
REAL :: kmv (nx,ny,nz) ! Vertical turb. mixing coef. for
! momentum. ( m**2/s )
!
REAL :: ubar (nx,ny,nz) ! Base state u-velocity (m/s)
REAL :: vbar (nx,ny,nz) ! Base state v-velocity (m/s)
REAL :: wbar (nx,ny,nz) ! Base state w-velocity (m/s)
REAL :: ptbar (nx,ny,nz) ! Base state potential temperature (K)
REAL :: pbar (nx,ny,nz) ! Base state pressure (Pascal)
REAL :: rhobar(nx,ny,nz) ! Base state air density (kg/m**3)
REAL :: qvbar (nx,ny,nz) ! Base state water vapor specific humidity
! (kg/kg)
!
REAL :: x (nx) ! The x-coord. of the physical and
! computational grid. Defined at u-point.
REAL :: y (ny) ! The y-coord. of the physical and
! computational grid. Defined at v-point.
REAL :: z (nz) ! The z-coord. of the computational grid.
! Defined at w-point on the staggered grid.
REAL :: zp (nx,ny,nz) ! The physical height coordinate defined at
! w-point of the staggered grid.
REAL :: hterain(nx,ny) ! Terrain height.
REAL :: j1 (nx,ny,nz) ! Coordinate transformation Jacobian defined as
! - d( zp )/d( x )
REAL :: j2 (nx,ny,nz) ! Coordinate transformation Jacobian defined as
! - d( zp )/d( y )
REAL :: j3 (nx,ny,nz) ! Coordinate transformation Jacobian defined as
! d( zp )/d( z )
INTEGER :: nstyps
INTEGER :: soiltyp (nx,ny,nstyps) ! Soil type
REAL :: stypfrct(nx,ny,nstyps) ! Soil type fratction
INTEGER :: vegtyp(nx,ny) ! Vegetation type
REAL :: lai (nx,ny) ! Leaf Area Index
REAL :: roufns (nx,ny) ! Surface roughness
REAL :: veg (nx,ny) ! Vegetation fraction
REAL :: tsfc (nx,ny,0:nstyps) ! Ground sfc. temperature (K)
REAL :: tsoil (nx,ny,0:nstyps) ! Deep soil temperature (K)
REAL :: wetsfc (nx,ny,0:nstyps) ! Surface soil moisture
REAL :: wetdp (nx,ny,0:nstyps) ! Deep soil moisture
REAL :: wetcanp(nx,ny,0:nstyps) ! Canopy water amount
REAL :: snowdpth(nx,ny) ! Snow depth (m)
REAL :: raing(nx,ny) ! Grid supersaturation rain
REAL :: rainc(nx,ny) ! Cumulus convective rain
REAL :: prcrate(nx,ny,4) ! precipitation rate (kg/(m**2*s))
! prcrate(1,1,1) = total precip. rate
! prcrate(1,1,2) = grid scale precip. rate
! prcrate(1,1,3) = cumulus precip. rate
! prcrate(1,1,4) = microphysics precip. rate
REAL :: radfrc(nx,ny,nz) ! Radiation forcing (K/s)
REAL :: radsw (nx,ny) ! Solar radiation reaching the surface
REAL :: rnflx (nx,ny) ! Net radiation flux absorbed by surface
REAL :: usflx (nx,ny) ! Surface flux of u-momentum (kg/(m*s**2))
REAL :: vsflx (nx,ny) ! Surface flux of v-momentum (kg/(m*s**2))
REAL :: ptsflx(nx,ny) ! Surface heat flux (K*kg/(m*s**2))
REAL :: qvsflx(nx,ny) ! Surface moisture flux (kg/(m**2*s))
REAL :: u0exb (nx,ny,nz) ! External boundary u-velocity field
REAL :: v0exb (nx,ny,nz) ! External boundary v-velocity field
REAL :: w0exb (nx,ny,nz) ! External boundary w-velocity field
REAL :: pt0exb(nx,ny,nz) ! External boundary pt field
REAL :: pr0exb(nx,ny,nz) ! External boundary p field
REAL :: qv0exb(nx,ny,nz) ! External boundary qv field
REAL :: qc0exb(nx,ny,nz) ! External boundary qc field
REAL :: qr0exb(nx,ny,nz) ! External boundary qr field
REAL :: qi0exb(nx,ny,nz) ! External boundary qi field
REAL :: qs0exb(nx,ny,nz) ! External boundary qs field
REAL :: qh0exb(nx,ny,nz) ! External boundary qh field
REAL :: udtexb (nx,ny,nz) ! Time tendency of external boundary u
REAL :: vdtexb (nx,ny,nz) ! Time tendency of external boundary v
REAL :: wdtexb (nx,ny,nz) ! Time tendency of external boundary w
REAL :: ptdtexb(nx,ny,nz) ! Time tendency of external boundary pt
REAL :: prdtexb(nx,ny,nz) ! Time tendency of external boundary p
REAL :: qvdtexb(nx,ny,nz) ! Time tendency of external boundary qv
REAL :: qcdtexb(nx,ny,nz) ! Time tendency of external boundary qc
REAL :: qrdtexb(nx,ny,nz) ! Time tendency of external boundary qr
REAL :: qidtexb(nx,ny,nz) ! Time tendency of external boundary qi
REAL :: qsdtexb(nx,ny,nz) ! Time tendency of external boundary qs
REAL :: qhdtexb(nx,ny,nz) ! Time tendency of external boundary qh
REAL :: tem1 (nx,ny,nz)
REAL :: tem2 (nx,ny,nz)
REAL :: tem3 (nx,ny,nz)
!
!-----------------------------------------------------------------------
!
! Misc. local variables:
!
!-----------------------------------------------------------------------
!
INTEGER :: i, j, k
INTEGER :: nchexbc
REAL :: tema
SAVE nchexbc
!
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
!
!-----------------------------------------------------------------------
!
! Declare the external boundary fields
!
!-----------------------------------------------------------------------
!
INCLUDE 'exbc.inc'
INCLUDE 'mp.inc' ! Message passing parameters.
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
tema = curtim - ( abstfcst0 - abstinit )
DO k = 1, nz-1
DO j = 1, ny-1
DO i = 1, nx
u(i,j,k) = u0exb(i,j,k) + udtexb(i,j,k) * tema
END DO
END DO
END DO
DO k = 1, nz-1
DO j = 1, ny
DO i = 1, nx-1
v(i,j,k) = v0exb(i,j,k) + vdtexb(i,j,k) * tema
END DO
END DO
END DO
DO k = 1, nz
DO j = 1, ny-1
DO i = 1, nx-1
w(i,j,k) = w0exb(i,j,k) + wdtexb(i,j,k) * tema
END DO
END DO
END DO
DO k = 1, nz-1
DO j = 1, ny-1
DO i = 1, nx-1
ptprt(i,j,k) = pt0exb(i,j,k) + ptdtexb(i,j,k) * tema
pprt (i,j,k) = pr0exb(i,j,k) + prdtexb(i,j,k) * tema
qv (i,j,k) = qv0exb(i,j,k) + qvdtexb(i,j,k) * tema
!
! Since we do not have enough tem arrays to store qctem,
! qrtem, qitem, qstem and qhtem, we pass the model arrays
! into dtadump.
!
! qctem(i,j,k) = qc0exb(i,j,k) + qcdtexb(i,j,k) * tema
! qrtem(i,j,k) = qr0exb(i,j,k) + qrdtexb(i,j,k) * tema
! qitem(i,j,k) = qi0exb(i,j,k) + qidtexb(i,j,k) * tema
! qstem(i,j,k) = qs0exb(i,j,k) + qsdtexb(i,j,k) * tema
! qhtem(i,j,k) = qh0exb(i,j,k) + qhdtexb(i,j,k) * tema
END DO
END DO
END DO
! blocking inserted for ordering i/o for message passing
DO i=0,nprocs-1,max_fopen
IF(myproc >= i.AND.myproc <= i+max_fopen-1)THEN
CALL dtadump( nx,ny,nz,nstyps, &
hisfmt,nchexbc,hisfnm,grdbas,filcmprs, &
u,v,w,ptprt,pprt,qv, &
qc,qr,qi,qs,qh,tke,kmh,kmv, &
ubar,vbar,wbar,ptbar,pbar,rhobar,qvbar, &
x,y,z,zp,hterain,j1,j2,j3, &
soiltyp,stypfrct,vegtyp,lai,roufns,veg, &
tsfc,tsoil,wetsfc,wetdp,wetcanp,snowdpth, &
raing,rainc,prcrate, &
radfrc,radsw,rnflx, &
usflx,vsflx,ptsflx,qvsflx, &
tem1,tem2,tem3 )
END IF
IF (mp_opt > 0) CALL mpbarrier
END DO
RETURN
END SUBROUTINE exbcdump