NGMFLD.f

Go to the documentation of this file.

!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

      SUBROUTINE ngmfld(RH4710,RH4796,RH1847,RH8498,QM8510)

!     
!     
!     INCLUDE PARAMETERS
      use vrbls3d,    only: q, uh, vh, pint, alpint, zint, t
      use masks,      only: lmh
      use params_mod, only: d00, d50, h1m12, pq0, a2, a3, a4, h1, d01, small
      use ctlblk_mod, only: jsta, jend, lm, jsta_2l, jend_2u, jsta_m2, jend_m2,&
                            spval, im, &
                            ista, iend, ista_2l, iend_2u, ista_m2, iend_m2, ista_m, iend_m
!
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
       implicit none
!
      real,PARAMETER :: sig100=1.00000, sig98=0.98230, sig96=0.96470
      real,PARAMETER :: sig89 =0.89671, sig85=0.85000, sig84=0.84368
      real,PARAMETER :: sig78 =0.78483, sig47=0.47191, sig18=0.18018
!     
!     DECLARE VARIABLES.
      LOGICAL got8510,got4710,got4796,got1847,got8498
      REAL,dimension(ista_2l:iend_2u,jsta_2l:jend_2u),intent(out) :: qm8510,rh4710,rh8498, &
                                                        rh4796,rh1847
      REAL,dimension(ista_2l:iend_2u,jsta_2l:jend_2u) :: z8510,z4710,z8498,z4796,z1847
      real,dimension(ista_2l:iend_2u,jsta_2l:jend_2u) ::  q1d, u1d, v1d, qcnvg
!
      integer i,j,l
      real p100,p85,p98,p96,p84,p47,p18,alpm,de,pm,tm,qm,     &
           qmcvg,qs,rh,dz
!********************************************************************
!     START NGMFLD HERE.
!     
!     INITIALIZE ARRAYS.
!$omp  parallel do private(i,j)
      DO j=jsta,jend
        DO i=ista,iend
           qm8510(i,j) = d00
           rh4710(i,j) = d00
           rh8498(i,j) = d00
           rh4796(i,j) = d00
           rh1847(i,j) = d00
           z8510(i,j)  = d00
           z8498(i,j)  = d00
           z4710(i,j)  = d00
           z4796(i,j)  = d00
           z1847(i,j)  = d00
        ENDDO
      ENDDO
!     
!     LOOP OVER HORIZONTAL GRID.
!     
!!$omp  parallel do                                                 &
!     & private(dz,p100,p18,p47,p84,p85,                            &
!     &         p96,p98,pm,qdiv,qk,qkhn,qkhs,qkm1,qm,qm8510,        &
!     &         qmcvg,qs,qudx,qvdy,r2dx,r2dy,rh,rh1847,rh4710,      &
!     &         rh4796,rh8498,tm,tmt0,tmt15,z1847,z4710,z4796,      &
!     &         z8498,z8510,q1d,u1d,v1d,qcnvg)

     DO l=1,lm
!          COMPUTE MOISTURE CONVERGENCE
!$omp parallel do private(i,j)
       DO j=jsta_2l,jend_2u
         DO i=ista_2l,iend_2u
           q1d(i,j) = q(i,j,l)
           u1d(i,j) = uh(i,j,l)
           v1d(i,j) = vh(i,j,l)
         ENDDO
       ENDDO
       CALL calmcvg(q1d,u1d,v1d,qcnvg)
!          COMPUTE MOISTURE CONVERGENCE
      DO j=jsta_m2,jend_m2
      DO i=ista_m,iend_m
!
!        SET TARGET PRESSURES.
         
         p100  = pint(i,j,nint(lmh(i,j)))
         p98   = sig98*p100
         p96   = sig96*p100
         p85   = sig85*p100
         p84   = sig84*p100
         p47   = sig47*p100
         p18   = sig18*p100
!     
!     
!        COMPUTE LAYER MEAN FIELDS AT THE GIVEN K.
!
!          COMPUTE P, Z, T, AND Q AT THE MIDPOINT OF THE CURRENT ETA LAYER.
           alpm = d50*(alpint(i,j,l)+alpint(i,j,l+1))
           dz   = zint(i,j,l)-zint(i,j,l+1)
           pm   = exp(alpm)
           tm   = t(i,j,l)
           qm   = q(i,j,l)
           qm   = amax1(qm,h1m12)
           qmcvg= qcnvg(i,j)
!
!     
!          COMPUTE RELATIVE HUMIDITY.
!
           qs=pq0/pm*exp(a2*(tm-a3)/(tm-a4))
!
           rh   = qm/qs
           IF (rh>h1) THEN
              rh = h1
              qm = rh*qs
           ENDIF
           IF (rh<d01) THEN
              rh = d01
              qm = rh*qs
           ENDIF
!     
!          SIGMA 0.85-1.00 MOISTURE CONVERGENCE.
           IF ((pm<=p100).AND.(pm>=p85)) THEN
              z8510(i,j)  = z8510(i,j) + dz
              qm8510(i,j) = qm8510(i,j) + qmcvg*dz
           ENDIF
!    
!          SIGMA 0.47-1.00 RELATIVE HUMIDITY.
           IF ((pm<=p100).AND.(pm>=p47)) THEN
              z4710(i,j)  = z4710(i,j) + dz
              rh4710(i,j) = rh4710(i,j) + rh*dz
           ENDIF
!
!          SIGMA 0.84-0.98 RELATIVE HUMIDITY.
           IF ((pm<=p98).AND.(pm>=p84)) THEN
              z8498(i,j)  = z8498(i,j) + dz
              rh8498(i,j) = rh8498(i,j) + rh*dz
           ENDIF
!     
!          SIGMA 0.47-0.96 RELATIVE HUMIDITY.
           IF ((pm<=p96).AND.(pm>=p47)) THEN
              z4796(i,j)  = z4796(i,j) + dz
              rh4796(i,j) = rh4796(i,j) + rh*dz
           ENDIF
!     
!          SIGMA 0.18-0.47 RELATIVE HUMIDITY.
           IF ((pm<=p47).AND.(pm>=p18)) THEN
              z1847(i,j)  = z1847(i,j) + dz
              rh1847(i,j) = rh1847(i,j) + rh*dz
           ENDIF
!
      ENDDO
      ENDDO
      ENDDO
!     
      DO j=jsta_m2,jend_m2
      DO i=ista_m,iend_m
!        NORMALIZE TO GET LAYER MEAN VALUES.
         IF (z8510(i,j)>0) THEN
            qm8510(i,j) = qm8510(i,j)/z8510(i,j)
         ELSE
            qm8510(i,j) = spval
         ENDIF
         IF (abs(qm8510(i,j)-spval)<small)qm8510(i,j)=h1m12
!
         IF (z4710(i,j)>0) THEN
            rh4710(i,j) = rh4710(i,j)/z4710(i,j)
         ELSE
            rh4710(i,j) = spval
         ENDIF
!
         IF (z8498(i,j)>0) THEN
            rh8498(i,j) = rh8498(i,j)/z8498(i,j)
         ELSE
            rh8498(i,j) = spval
         ENDIF
!
         IF (z4796(i,j)>0) THEN
            rh4796(i,j) = rh4796(i,j)/z4796(i,j)
         ELSE
            rh4796(i,j) = spval
         ENDIF
!
         IF (z1847(i,j)>0) THEN
            rh1847(i,j) = rh1847(i,j)/z1847(i,j)
         ELSE
            rh1847(i,j) = spval
         ENDIF
      ENDDO
      ENDDO
!
!     
!     END OF ROUTINE.
!     
      RETURN
      END