LFMFLD.f

Go to the documentation of this file.

!--------------------------------------------------------------------------------------
      SUBROUTINE lfmfld(RH3310,RH6610,RH3366,PW3310)

!     
!
      use vrbls3d, only: pint, alpint, zint, t, q, cwm
      use masks, only: lmh
      use params_mod, only: d00, d50, pq0, a2, a3, a4, h1, d01, gi
      use ctlblk_mod, only: jsta, jend, modelname, spval, im, ista, iend
      use physcons_post, only: con_rd, con_rv, con_eps, con_epsm1
      use upp_physics, only: fpvsnew

      implicit none

!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!
      real,PARAMETER :: rhowat=1.e3
!     
!     DECLARE VARIABLES.
!     
      REAL alpm, dz, es, pm, pwsum, qm, qs, tm, dp, rh
      REAL,dimension(ista:iend,jsta:jend),intent(inout) :: rh3310, rh6610, rh3366
      REAL,dimension(ista:iend,jsta:jend),intent(inout) :: pw3310
      real z3310,z6610,z3366,p10,p33,p66
      integer i,j,l,llmh
!
!***********************************************************************
!     START LFMFLD HERE
!     
!
!     LOOP OVER HORIZONTAL GRID.
!     
      DO 30 j=jsta,jend
      DO 30 i=ista,iend
!     
!        ZERO VARIABLES.
         rh3310(i,j) = d00
         pw3310(i,j) = d00
         rh6610(i,j) = d00
         rh3366(i,j) = d00
         z3310     = d00
         z6610     = d00
         z3366     = d00
!     
!        SET BOUNDS FOR PRESSURES AND SURFACE L.
         p10  = pint(i,j,nint(lmh(i,j)))
         p66  = 0.75*p10
         p33  = 0.50*p10
         llmh = nint(lmh(i,j))
!     
!        ACCULMULATE RELATIVE HUMIDITIES AND PRECIPITABLE WATER.
!
         DO 10 l = llmh,1,-1
!     
!           GET P, Z, T, AND Q AT MIDPOINT OF ETA LAYER.
            alpm = d50*(alpint(i,j,l)+alpint(i,j,l+1))
            dz   = zint(i,j,l)-zint(i,j,l+1)
            dp   = pint(i,j,l+1)-pint(i,j,l)
            pm   = exp(alpm)
            tm   = t(i,j,l)
            qm   = q(i,j,l)
            qm   = amax1(qm,d00)
!
!            QS=PQ0/PM*EXP(A2*(TM-A3)/(TM-A4))
        IF(modelname == 'GFS')THEN
          es = min(fpvsnew(tm),pm)
          qs = con_eps*es/(pm+con_epsm1*es)
        ELSE      
              qs=pq0/pm*exp(a2*(tm-a3)/(tm-a4))
        END IF
            rh   = qm/qs
            IF (rh>h1) THEN
               rh = h1
               qm = rh*qs
            ENDIF
            IF (rh<d01) THEN
               rh = d01
               qm = rh*qs
            ENDIF
!
!           JUMP OUT OF THIS LOOP IF WE ARE ABOVE THE HIGHEST TARGET PRESSURE.
            IF (pm<=p33) exit     
!     
!           0.66-1.00 RELATIVE HUMIDITY.
            IF ((pm<=p10).AND.(pm>=p66)) THEN
               z6610     = z6610 + dz
               rh6610(i,j) = rh6610(i,j) + rh*dz
            ENDIF
!     
!           0.33-1.00 RELATIVE HUMIDITY AND PRECIPITABLE WATER.
            IF ((pm<=p10).AND.(pm>=p33)) THEN
               z3310      = z3310 + dz
               rh3310(i,j)= rh3310(i,j)+rh*dz
               pw3310(i,j)= pw3310(i,j)+(q(i,j,l)+cwm(i,j,l))*dp*gi
            ENDIF
!     
!           0.33-0.66 RELATIVE HUMIDITY.
            IF ((pm<=p66).AND.(pm>=p33)) THEN
               z3366     = z3366 + dz
               rh3366(i,j) = rh3366(i,j) + rh*dz
            ENDIF
!
 10      CONTINUE
!     
!        NORMALIZE TO GET MEAN RELATIVE HUMIDITIES.  AT
!        ONE TIME WE DIVIDED PRECIPITABLE WATER BY DENSITY
!        TO GET THE EQUIVALENT WATER DEPTH IN METERS.  NO MORE.
         IF (z6610>d00) THEN
            rh6610(i,j) = rh6610(i,j)/z6610
         ELSE
            rh6610(i,j) = spval
         ENDIF
!     
         IF (z3310>d00) THEN
            rh3310(i,j) = rh3310(i,j)/z3310
         ELSE
            rh3310(i,j) = spval
         ENDIF
!     
         IF (z3366>d00) THEN
            rh3366(i,j) = rh3366(i,j)/z3366
         ELSE
            rh3366(i,j) = spval
         ENDIF
 30   CONTINUE
!     
!     
!     END OF ROUTINE.
!     
      RETURN
      END