LFMFLD_GFS.f

Go to the documentation of this file.

      SUBROUTINE lfmfld_gfs(RH4410,RH7294,RH4472,RH3310)

!     
!
      use vrbls3d, only: pint, q, t, pmid
      use masks, only: lmh
      use params_mod, only: d00
      use ctlblk_mod, only: jsta, jend, spval, im
      use upp_physics, only: fpvsnew
!     
    implicit none
!
      real,PARAMETER :: rhowat=1.e3
      real,parameter:: con_rd      =2.8705e+2 ! gas constant air    (J/kg/K)
      real,parameter:: con_rv      =4.6150e+2 ! gas constant H2O
      real,parameter:: con_eps     =con_rd/con_rv
      real,parameter:: con_epsm1   =con_rd/con_rv-1
      real,parameter:: strh1=0.44,strh2=0.72,strh3=0.44,strh4=0.33 &
                      ,sbrh1=1.00,sbrh2=0.94,sbrh3=0.72,sbrh4=1.00
!     
!     DECLARE VARIABLES.
!     
      REAL alpm, dz, es, pm, pwsum, qm, qs
      REAL,dimension(IM,jsta:jend),intent(out) :: rh4410, rh7294, rh4472    &
                                                 ,rh3310    
!
      integer i,j,l,llmh
      real p4410, p7294,p4472,p3310,q4410,q7294,q4472,q3310,qs4410, &
         qs7294,qs4472,qs3310,ps,p33,dp1,dp2,dp3,dp4

!***********************************************************************
!     START LFMFLD HERE
!     
!
!     LOOP OVER HORIZONTAL GRID.
!     
      DO 30 j=jsta,jend
      DO 30 i=1,im
!     
!        ZERO VARIABLES.
         rh4410(i,j) = d00
         rh4472(i,j) = d00
         rh7294(i,j) = d00
         rh3310(i,j) = d00
         p4410       = d00
         p7294       = d00
         p4472       = d00
         p3310       = d00
         q4410       = d00
         q7294       = d00
         q4472       = d00
         q3310       = d00
         qs4410      = d00
         qs7294      = d00
         qs4472      = d00
         qs3310      = d00
!     
!        SET BOUNDS FOR PRESSURES AND SURFACE L.
 
         llmh = nint(lmh(i,j))
     ps=pint(i,j,llmh+1)
     p33  = 0.33*ps
!     
!        ACCULMULATE RELATIVE HUMIDITIES AND PRECIPITABLE WATER.
!
         DO 10 l = llmh,1,-1
!     
!           GET P, Z, T, AND Q AT MIDPOINT OF ETA LAYER.
            
            dp1 = max(min(pint(i,j,l+1),sbrh1*ps)      &
                     -max(pint(i,j,l),strh1*ps),0.)            
            dp2 = max(min(pint(i,j,l+1),sbrh2*ps)      &
                     -max(pint(i,j,l),strh2*ps),0.)
            dp3 = max(min(pint(i,j,l+1),sbrh3*ps)      &
                     -max(pint(i,j,l),strh3*ps),0.)
            dp4 = max(min(pint(i,j,l+1),sbrh4*ps)      &
                     -max(pint(i,j,l),strh4*ps),0.)
     
            pm   = pint(i,j,l)
            qm   = q(i,j,l)
            qm   = max(qm,d00)
            es   = min(fpvsnew(t(i,j,l)),pmid(i,j,l))
            qs=con_eps*es/(pmid(i,j,l)+con_epsm1*es)
!
!
!           JUMP OUT OF THIS LOOP IF WE ARE ABOVE THE HIGHEST TARGET PRESSURE.
            IF (pm<=p33) exit
!     
!           0.44-1.00 RELATIVE HUMIDITY.
!            IF ((PM<=P10).AND.(PM>=P44)) THEN
               p4410     = p4410 + dp1
               q4410     = q4410 + qm*dp1
               qs4410    = qs4410+ qs*dp1
!            ENDIF
!     
!           0.33-1.00 RELATIVE HUMIDITY 
!            IF ((PM<=P10).AND.(PM>=P33)) THEN
               p3310      = p3310 + dp4
               q3310     = q3310 + qm*dp4
               qs3310    = qs3310+ qs*dp4
!            ENDIF
!     
!           0.44-0.72 RELATIVE HUMIDITY.
!            IF ((PM<=P66).AND.(PM>=P33)) THEN
               p4472     = p4472 + dp3
               q4472     = q4472 + qm*dp3
               qs4472    = qs4472+ qs*dp3
!            ENDIF
!           0.72-0.94 RELATIVE HUMIDITY.
!            IF ((PM<=P66).AND.(PM>=P33)) THEN
               p7294     = p7294 + dp2
               q7294     = q7294 + qm*dp2
               qs7294    = qs7294+ qs*dp2
!            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 (p4410>d00) THEN
            rh4410(i,j) = q4410/qs4410
         ELSE
            rh4410(i,j) = spval
         ENDIF
!     
         IF (p3310>d00) THEN
            rh3310(i,j) = q3310/qs3310
         ELSE
            rh3310(i,j) = spval
         ENDIF
!     
         IF (p4472>d00) THEN
            rh4472(i,j) = q4472/qs4472
         ELSE
            rh4472(i,j) = spval
         ENDIF

         IF (p7294>d00) THEN
            rh7294(i,j) = q7294/qs7294
         ELSE
            rh7294(i,j) = spval
         ENDIF
 30   CONTINUE
!     
!     END OF ROUTINE.
!     
      RETURN
      END