CALLCL.f

Go to the documentation of this file.

      SUBROUTINE callcl(P1D,T1D,Q1D,PLCL,ZLCL)

!     
!     
      use vrbls3d, only: alpint, zint
      use vrbls2d, only: fis
      use masks, only: lmh
      use params_mod, only: eps, oneps, d01, h1m12, gi, d00
      use ctlblk_mod, only: jsta, jend, spval, jsta_m, jend_m, im
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!     
      real,PARAMETER :: d35=3.5, d4805=4.805,  h2840=2840.
      real,PARAMETER :: h55=55., d2845=0.2845, d28=0.28
!
!     DECLARE VARIABLES.
!     
      REAL,dimension(IM,jsta:jend), intent(in)    :: p1d,t1d,q1d
      REAL,dimension(IM,jsta:jend), intent(inout) :: plcl,zlcl
      REAL tlcl(im,jsta:jend)
      integer i,j,l,llmh
      real dlplcl,zsfc,dz,dalp,alplcl,rmx,evp,arg,rkapa
!     
!**********************************************************************
!     START CALLCL HERE.
!     
!     LOAD OUTPUT ARRAYS WITH SPECIAL VALUE.
!     
!$omp parallel do private(i,j)
      DO j=jsta,jend
        DO i=1,im
          plcl(i,j) = spval
          tlcl(i,j) = spval
          zlcl(i,j) = spval
        ENDDO
      ENDDO
!     
!     COMPUTE PRESSURE, TEMPERATURE AND AGL HEIGHT AT LCL.
!
! Bo Cui 10/30/2019, remove "GOTO" statement

      DO 30 j=jsta_m,jend_m
      DO 30 i=2,im-1
!     DO 30 I=1,IM
      IF(p1d(i,j)<spval.and.q1d(i,j)<spval)THEN
      evp       = p1d(i,j)*q1d(i,j)/(eps+oneps*q1d(i,j))
      rmx       = eps*evp/(p1d(i,j)-evp)
      rkapa     = 1.0 / (d2845*(1.0-d28*rmx))
      arg       = max(h1m12,evp*d01)
      tlcl(i,j) = h55 + h2840 / (d35*log(t1d(i,j))-log(arg)-d4805)
      plcl(i,j) = p1d(i,j)*(tlcl(i,j)/t1d(i,j))**rkapa
      alplcl    = log(plcl(i,j))
      llmh      = nint(lmh(i,j))
      zsfc      = fis(i,j)*gi
!
      DO 20 l=llmh,1,-1
      IF(alpint(i,j,l) < alplcl)THEN
        dlplcl    = alplcl        - alpint(i,j,l+1)
        dalp      = alpint(i,j,l) - alpint(i,j,l+1)
        dz        = zint(i,j,l)   - zint(i,j,l+1)
        zlcl(i,j) = max(d00, zint(i,j,l+1) + dz*dlplcl/dalp - zsfc)
        EXIT
      ENDIF
 20   CONTINUE
      ENDIF
 30   CONTINUE
!     
!     END OF ROUTINE.
!     
      RETURN
      END