!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE ININUDGE ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma. All rights reserved. ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE ininudge(nxndg,nyndg,nzndg, & 1,2
uincr,vincr,wincr,pincr,ptincr,qvincr, &
qcincr,qrincr,qiincr,qsincr,qhincr,istatus)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Initialize analysis increments for use in continuous
! nudging adjustment process.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! March, 1998
!
! MODIFICATION HISTORY:
!
! 07/10/2001 (K. Brewster)
! Added increment arrays to argument list and removed
! initialization to zero before reading (now done prior to call).
!
!-----------------------------------------------------------------------
!
! INPUT :
!
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nxndg,nyndg,nzndg
REAL :: uincr(nxndg,nyndg,nzndg) ! Analysis increment for u
REAL :: vincr(nxndg,nyndg,nzndg) ! Analysis increment for v
REAL :: wincr(nxndg,nyndg,nzndg) ! Analysis increment for w
REAL :: pincr(nxndg,nyndg,nzndg) ! Analysis increment for p
REAL :: ptincr(nxndg,nyndg,nzndg) ! Analysis increment for pt
REAL :: qvincr(nxndg,nyndg,nzndg) ! Analysis increment for qv
REAL :: qcincr(nxndg,nyndg,nzndg) ! Analysis increment for qc
REAL :: qrincr(nxndg,nyndg,nzndg) ! Analysis increment for qr
REAL :: qiincr(nxndg,nyndg,nzndg) ! Analysis increment for qi
REAL :: qsincr(nxndg,nyndg,nzndg) ! Analysis increment for qs
REAL :: qhincr(nxndg,nyndg,nzndg) ! Analysis increment for qh
INTEGER :: istatus
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
INTEGER :: ncorx
INTEGER :: i,j,k
! real ndtime
!
!-----------------------------------------------------------------------
!
! Include files
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'nudging.inc'
!
!-----------------------------------------------------------------------
!
! Initializations
!
!-----------------------------------------------------------------------
!
IF ( nudgopt <= 0 ) THEN
RETURN
END IF
ndtime=ndstop-ndstart
WRITE(6,'(a,f10.2,a)') &
' Application of nudging adjustment lasts ',ndtime,' secs'
!
!-----------------------------------------------------------------------
!
! Read analysis increment file
!
!-----------------------------------------------------------------------
!
CALL incrread
(nxndg,nyndg,nzndg,incrfnam, &
uincr,vincr,wincr,pincr,ptincr,qvincr, &
qcincr,qrincr,qiincr,qsincr,qhincr, &
istatus)
!
!-----------------------------------------------------------------------
!
! Compute the fixed time scale factor.
!
!-----------------------------------------------------------------------
!
IF(ndintvl > 0.) THEN
ncorx=nint(ndtime/ndintvl)
WRITE(6,'(a,i5,a,/a,f10.2)') &
' Nudging applied in ',ncorx,' steps', &
' ndintvl adjusted for dtbig =',ndintvl
ELSE
WRITE(6,'(a,/a,f10.2)') &
' Try again using new ndintvl', &
' ndintvl adjusted for dtbig =',ndintvl
WRITE(6,'(a)') ' STOPPING in ININUDGE'
CALL arpsstop('arpsstop called from ININUDGE improper nudging &
& interval selected.',1)
END IF
RETURN
END SUBROUTINE ininudge
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE INCRREAD ######
!###### ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma. ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE incrread(nxndg,nyndg,nzndg,incrfnam, & 1,52
uincr,vincr,wincr,pincr,ptincr,qvincr, &
qcincr,qrincr,qiincr,qsincr,qhincr, &
istatus)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Read analysis increments from a file for use in continuous
! adjustment process.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! March 1998
!
! MODIFICATION HISTORY:
!
! 07/10/2001 (K. Brewster)
! Added increment arrays to argument list rather than obtaining
! them through common in nudging.inc
!
!-----------------------------------------------------------------------
!
! INPUT :
!
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nxndg,nyndg,nzndg
CHARACTER (LEN=132) :: incrfnam
REAL :: uincr(nxndg,nyndg,nzndg) ! Analysis increment for u
REAL :: vincr(nxndg,nyndg,nzndg) ! Analysis increment for v
REAL :: wincr(nxndg,nyndg,nzndg) ! Analysis increment for w
REAL :: pincr(nxndg,nyndg,nzndg) ! Analysis increment for p
REAL :: ptincr(nxndg,nyndg,nzndg) ! Analysis increment for pt
REAL :: qvincr(nxndg,nyndg,nzndg) ! Analysis increment for qv
REAL :: qcincr(nxndg,nyndg,nzndg) ! Analysis increment for qc
REAL :: qrincr(nxndg,nyndg,nzndg) ! Analysis increment for qr
REAL :: qiincr(nxndg,nyndg,nzndg) ! Analysis increment for qi
REAL :: qsincr(nxndg,nyndg,nzndg) ! Analysis increment for qs
REAL :: qhincr(nxndg,nyndg,nzndg) ! Analysis increment for qh
INTEGER :: istatus
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=80) :: runnamin
CHARACTER (LEN=8) :: varin
INTEGER :: iyr,imon,idy,ihr,imin,isec
INTEGER :: nxin,nyin,nzin,i4timein
INTEGER :: maprojin
REAL :: trlat1in,trlat2in,trlonin
REAL :: sclfctin,ctrlatin,ctrlonin
INTEGER :: ustor,vstor,wstor,pstor,ptstor,qvstor, &
qcstor,qrstor,qistor,qsstor,qhstor
INTEGER :: nchinc,ierr
INTEGER :: ireturn
INTEGER :: strhoptin
REAL :: dxin,dyin,dzin,dzminin,zrefsfcin,dlayer1in, &
dlayer2in,zflatin,strhtunein
INTEGER(2), allocatable :: itmp(:,:,:) ! Temporary array
REAL, allocatable :: hmax(:), hmin(:) ! Temporary array
INTEGER :: istat, sd_id
!wdt kwthomas update
CHARACTER (LEN=132) :: savename
!
!-----------------------------------------------------------------------
!
! Include files
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc' ! Grid & map parameters.
!wdt kwthomas update
INCLUDE 'mp.inc'
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
IF (incrfmt /= 0) THEN
ALLOCATE (itmp(nxndg,nyndg,nzndg),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "INCRREAD: ERROR allocating itmp, returning"
ierr = 1
RETURN
END IF
ALLOCATE (hmax(nzndg),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "INCRREAD: ERROR allocating hmax, returning"
ierr = 1
RETURN
END IF
ALLOCATE (hmin(nzndg),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "INCRREAD: ERROR allocating hmin, returning"
ierr = 1
RETURN
END IF
END IF
!wdt kwthomas update
IF (mp_opt > 0) THEN
savename(1:132) = incrfnam(1:132)
WRITE(incrfnam, '(a,a,2i2.2)') trim(savename),'_',loc_x,loc_y
END IF
!
!-----------------------------------------------------------------------
!
! Get unit number and open file
!
!-----------------------------------------------------------------------
!
IF (incrfmt == 0) THEN
!-----------------------------------------------------------------------
!
! Fortran unformatted dump.
!
!-----------------------------------------------------------------------
CALL getunit(nchinc)
CALL asnctl ('NEWLOCAL', 1, ierr)
CALL asnfile(incrfnam,'-F f77 -N ieee', ierr)
OPEN(nchinc,FILE=trim(incrfnam),ERR=950, &
FORM='unformatted',STATUS='old')
!
READ(nchinc,ERR=950) runnamin,nxin,nyin,nzin,i4timein, &
iyr,imon,idy,ihr,imin,isec
!
READ(nchinc,ERR=950) maprojin,trlat1in,trlat2in,trlonin, &
sclfctin,ctrlatin,ctrlonin
!
READ(nchinc,ERR=950) ustor,vstor,wstor,pstor,ptstor,qvstor, &
qcstor,qrstor,qistor,qsstor,qhstor
!
IF(ustor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into u-increment field'
READ(nchinc,ERR=950) uincr
END IF
IF(vstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into v-increment field'
READ(nchinc,ERR=950) vincr
END IF
IF(wstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into w-increment field'
READ(nchinc,ERR=950) wincr
END IF
IF(pstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into p-increment field'
READ(nchinc,ERR=950) pincr
END IF
IF(ptstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into pt-increment field'
READ(nchinc,ERR=950) ptincr
END IF
IF(qvstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into qv-increment field'
READ(nchinc,ERR=950) qvincr
END IF
IF(qcstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into qc-increment field'
READ(nchinc,ERR=950) qcincr
END IF
IF(qrstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into qr-increment field'
READ(nchinc,ERR=950) qrincr
END IF
IF(qistor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into qi-increment field'
READ(nchinc,ERR=950) qiincr
END IF
IF(qsstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into qs-increment field'
READ(nchinc,ERR=950) qsincr
END IF
IF(qhstor > 0) THEN
READ(nchinc,ERR=950) varin
WRITE(6,'(a,a,a)') 'Reading ',varin,' into qh-increment field'
READ(nchinc,ERR=950) qhincr
END IF
!
WRITE(6,'(/a,a/)') &
' Successfully read analysis incr file: ',incrfnam
istatus=0
!wdt kwthomas update
IF (mp_opt > 0) incrfnam(1:132) = savename(1:132)
RETURN
ELSE
!-----------------------------------------------------------------------
!
! HDF4 format.
!
!-----------------------------------------------------------------------
CALL hdfopen(trim(incrfnam), 1, sd_id)
IF (sd_id < 0) THEN
WRITE (6,*) "INCRREAD: ERROR opening ", &
trim(incrfnam)," for reading."
istatus = 1
GO TO 900
END IF
CALL hdfrdi(sd_id,"i4time",i4timein,istat)
CALL hdfrdi(sd_id,"month",imon,istat)
CALL hdfrdi(sd_id,"day",idy,istat)
CALL hdfrdi(sd_id,"year",iyr,istat)
CALL hdfrdi(sd_id,"hour",ihr,istat)
CALL hdfrdi(sd_id,"minute",imin,istat)
CALL hdfrdi(sd_id,"second",isec,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",trlat1in,istat)
CALL hdfrdr(sd_id,"trulat2",trlat2in,istat)
CALL hdfrdr(sd_id,"trulon",trlonin,istat)
CALL hdfrdr(sd_id,"sclfct",sclfctin,istat)
CALL hdfrdr(sd_id,"ctrlat",ctrlatin,istat)
CALL hdfrdr(sd_id,"ctrlon",ctrlonin,istat)
CALL checkgrid3d(nxndg,nyndg,nzndg,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,trlat1in,trlat2in,trlonin,sclfctin,ireturn)
IF (ireturn /= 0) THEN
WRITE (6,*) "INCRREAD: ERROR, grid parameter mismatch"
istatus = 1
GO TO 900
END IF
CALL hdfrdi(sd_id,"i4time",i4timein,istat)
CALL hdfrdi(sd_id,"iyr",iyr,istat)
CALL hdfrdi(sd_id,"imon",imon,istat)
CALL hdfrdi(sd_id,"idy",idy,istat)
CALL hdfrdi(sd_id,"ihr",ihr,istat)
CALL hdfrdi(sd_id,"imin",imin,istat)
CALL hdfrdi(sd_id,"isec",isec,istat)
CALL hdfrd3d(sd_id,"uincr",nxndg,nyndg,nzndg,uincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"vincr",nxndg,nyndg,nzndg,vincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"wincr",nxndg,nyndg,nzndg,wincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"pincr",nxndg,nyndg,nzndg,pincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"ptincr",nxndg,nyndg,nzndg,ptincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"qvincr",nxndg,nyndg,nzndg,qvincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"qcincr",nxndg,nyndg,nzndg,qcincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"qrincr",nxndg,nyndg,nzndg,qrincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"qiincr",nxndg,nyndg,nzndg,qiincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"qsincr",nxndg,nyndg,nzndg,qsincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
CALL hdfrd3d(sd_id,"qhincr",nxndg,nyndg,nzndg,qhincr, &
istat,itmp,hmax,hmin)
IF (istat > 1) GO TO 950
istatus = 0
END IF
GO TO 900
950 CONTINUE
WRITE(6,'(/a,a/)') &
'INCRREAD: Error reading analysis incr output file: ', &
trim(incrfnam)
istatus = 1
!wdt kwthomas update
WRITE(6,*) "INCCREAD: calling arpsstop"
CALL arpsstop('arpsstop called from INCREAD error reading incr &
& output file.',1)
900 CONTINUE
!wdt update
IF (mp_opt > 0) incrfnam(1:132) = savename(1:132)
IF (incrfmt == 0) THEN
CLOSE(nchinc)
ELSE
CALL hdfclose(sd_id,istat)
DEALLOCATE (itmp,stat=istat)
DEALLOCATE (hmax,stat=istat)
DEALLOCATE (hmin,stat=istat)
END IF
!wdt kwthomas update
RETURN
END SUBROUTINE incrread
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE NUDGEALL ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE nudgeall(nx,ny,nz,nxndg,nyndg,nzndg, & 2,22
u,v,w,pprt,ptprt,qv,qc,qr,qi,qs,qh, &
uincr,vincr,wincr,pincr,ptincr,qvincr, &
qcincr,qrincr,qiincr,qsincr,qhincr)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! March, 1998
!
! MODIFICATION HISTORY:
!
! 07/10/2001 (K. Brewster)
! Added increment arrays to argument list rather than obtaining
! them through common in nudging.inc
!
!
!-----------------------------------------------------------------------
!
! 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
! nxndg Number x grid points for IAU
! nyndg Number y grid points for IAU
! nzndg Number z grid points for IAU
!
! u x component of velocity at times tpast and tpresent (m/s)
! v y component of velocity at times tpast and tpresent (m/s)
! w Vertical component of Cartesian velocity at times
! tpast and tpresent (m/s)
! ptprt Perturbation potential temperature at times tpast and
! tpresent (K)
! pprt Perturbation pressure at times tpast and tpresent (Pascal)
! qv Water vapor specific humidity at times tpast and tpresent (kg/kg)
! qc Cloud water mixing ratio at times tpast and tpresent (kg/kg)
! qr Rainwater mixing ratio at times tpast and tpresent (kg/kg)
! qi Cloud ice mixing ratio at times tpast and tpresent (kg/kg)
! qs Snow mixing ratio at times tpast and tpresent (kg/kg)
! qh Hail mixing ratio at times tpast and tpresent (kg/kg)
!
!-----------------------------------------------------------------------
!
! Variable Declarations:
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE ! Force explicit declarations
INTEGER :: nx, ny, nz ! Number of grid points in 3 directions
INTEGER :: nxndg,nyndg,nzndg ! Number of grid points in 3 directions
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
! from that of base state atmosphere (K)
REAL :: pprt (nx,ny,nz) ! Perturbation pressure from that
! of base state atmosphere (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 :: uincr(nxndg,nyndg,nzndg) ! Analysis increment for u
REAL :: vincr(nxndg,nyndg,nzndg) ! Analysis increment for v
REAL :: wincr(nxndg,nyndg,nzndg) ! Analysis increment for w
REAL :: pincr(nxndg,nyndg,nzndg) ! Analysis increment for p
REAL :: ptincr(nxndg,nyndg,nzndg) ! Analysis increment for pt
REAL :: qvincr(nxndg,nyndg,nzndg) ! Analysis increment for qv
REAL :: qcincr(nxndg,nyndg,nzndg) ! Analysis increment for qc
REAL :: qrincr(nxndg,nyndg,nzndg) ! Analysis increment for qr
REAL :: qiincr(nxndg,nyndg,nzndg) ! Analysis increment for qi
REAL :: qsincr(nxndg,nyndg,nzndg) ! Analysis increment for qs
REAL :: qhincr(nxndg,nyndg,nzndg) ! Analysis increment for qh
!
!-----------------------------------------------------------------------
!
! Include files:
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'nudging.inc'
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
REAL :: timscl,dmid
REAL :: timsum = 0.
INTEGER :: icall = 0
SAVE timsum,icall
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!-----------------------------------------------------------------------
!
! Compute scale factor for this application.
! nudgopt=1 Constant time function
! nudgopt=2 Triangular time function, max at mid, zero at ends.
!
!-----------------------------------------------------------------------
!
icall = icall + 1
IF(nudgopt == 1) THEN
timscl=ndscale
ELSE IF(nudgopt == 2) THEN
dmid=ABS(curtim-0.5*(ndstop-ndstart))
timscl=ndscale*AMAX1(0.,(2.-(4.*dmid/(ndstop-ndstart))))
ELSE
timscl=0.
END IF
timsum=timsum+0.5*timscl
WRITE(6,'(a,f9.4,a,f9.4,a,f9.4)') &
' Timeweight:',timscl,' Accum wgt:',timsum, &
' Accum Target:',ndgain
!
IF (nudgu == 1 .OR. nudgu == 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx,1,ny-1,2,nz-1,u,uincr,timscl)
ELSE IF (nudgu == 3 .AND. icall <= 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx,1,ny-1,2,nz-1,u,uincr,1.0)
END IF
IF (nudgv == 1 .OR. nudgv == 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny,2,nz-1,v,vincr,timscl)
ELSE IF (nudgv == 3 .AND. icall <= 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny,2,nz-1,v,vincr,1.0)
END IF
IF (nudgw == 1 .OR. nudgw == 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,w,wincr,timscl)
ELSE IF (nudgw == 3 .AND. icall <= 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,w,wincr,1.0)
END IF
IF (nudgp == 1 .OR. nudgp == 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,pprt,pincr,timscl)
ELSE IF (nudgp == 3 .AND. icall <= 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,pprt,pincr,1.0)
END IF
IF (nudgpt == 1 .OR. nudgpt == 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,ptprt,ptincr,timscl)
ELSE IF (nudgpt == 3 .AND. icall <= 2 ) THEN
CALL nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,ptprt,ptincr,1.0)
END IF
IF (nudgqv == 1 .OR. nudgqv == 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qv,qvincr,timscl)
ELSE IF (nudgqv == 3 .AND. icall <= 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qv,qvincr,1.0)
END IF
IF (nudgqc == 1 .OR. nudgqc == 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qc,qcincr,timscl)
ELSE IF (nudgqc == 3 .AND. icall <= 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qc,qcincr,1.0)
END IF
IF (nudgqr == 1 .OR. nudgqr == 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qr,qrincr,timscl)
ELSE IF (nudgqr == 3 .AND. icall <= 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qr,qrincr,1.0)
END IF
IF (nudgqi == 1 .OR. nudgqi == 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qi,qiincr,timscl)
ELSE IF (nudgqi == 3 .AND. icall <= 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qi,qiincr,1.0)
END IF
IF (nudgqs == 1 .OR. nudgqs == 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qs,qsincr,timscl)
ELSE IF (nudgqs == 3 .AND. icall <= 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qs,qsincr,1.0)
END IF
IF (nudgqh == 1 .OR. nudgqh == 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qh,qhincr,timscl)
ELSE IF (nudgqh == 3 .AND. icall <= 2 ) THEN
CALL nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, &
1,nx-1,1,ny-1,2,nz-1,qh,qhincr,1.0)
END IF
RETURN
END SUBROUTINE nudgeall
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE NUDGEVAR ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE nudgevar(nx,ny,nz,nxndg,nyndg,nzndg, & 10
ibeg,iend,jbeg,jend,kbeg,kend, &
var,varincr,timscl)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! March, 1998
!
! MODIFICATION HISTORY:
!
! 07/10/2001 (K. Brewster)
! Added increment array dimensions to argument list for consistency
! in array dimension statements.
!
!-----------------------------------------------------------------------
!
! 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
! nxndg Number x grid points for IAU
! nyndg Number y grid points for IAU
! nzndg Number z grid points for IAU
!
! var Variable to be nudged
! varincr Increment to apply to variable over time
! timscl Scale factor to determine increment to apply
! at this time
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz
INTEGER :: nxndg,nyndg,nzndg
INTEGER :: ibeg,iend,jbeg,jend,kbeg,kend
REAL :: var(nx,ny,nz)
REAL :: varincr(nxndg,nyndg,nzndg)
REAL :: timscl
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
INTEGER :: i,j,k
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
DO k=kbeg,kend
DO j=jbeg,jend
DO i=ibeg,iend
var(i,j,k)=var(i,j,k)+timscl*varincr(i,j,k)
END DO
END DO
END DO
RETURN
END SUBROUTINE nudgevar
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE NUDGEPOS ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE nudgepos(nx,ny,nz,nxndg,nyndg,nzndg, & 12
ibeg,iend,jbeg,jend,kbeg,kend, &
var,varincr,timscl)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! March, 1998
!
! MODIFICATION HISTORY:
! 07/10/2001 (K. Brewster)
! Added increment array dimensions to argument list for consistency
! in array dimension statements.
!
!-----------------------------------------------------------------------
!
! 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
! nxndg Number x grid points for IAU
! nyndg Number y grid points for IAU
! nzndg Number z grid points for IAU
!
! var Variable to be nudged
! varincr Increment to apply to variable over time
! timscl Scale factor to determine increment to apply
! at this time
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
INTEGER :: nx,ny,nz
INTEGER :: nxndg,nyndg,nzndg
REAL :: var(nx,ny,nz)
REAL :: varincr(nxndg,nyndg,nzndg)
REAL :: timscl
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
INTEGER :: i,j,k
INTEGER :: ibeg,iend,jbeg,jend,kbeg,kend
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
DO k=kbeg,kend
DO j=jbeg,jend
DO i=ibeg,iend
var(i,j,k)=MAX(0.,(var(i,j,k)+timscl*varincr(i,j,k)))
END DO
END DO
END DO
RETURN
END SUBROUTINE nudgepos