CALMCVG.f

Go to the documentation of this file.

      SUBROUTINE calmcvg(Q1D,U1D,V1D,QCNVG)

!
!     
!     
      use masks,        only: dx, dy, hbm2
      use params_mod,   only: d00, d25
      use ctlblk_mod,   only: jsta_2l, jend_2u, spval, jsta_m, jend_m,       &
                              jsta_m2, jend_m2, im, jm
      use gridspec_mod, only: gridtype
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!     
!     DECLARE VARIABLES.
!     
      REAL,dimension(IM,jsta_2l:jend_2u),intent(in)    ::  q1d, u1d, v1d
      REAL,dimension(IM,jsta_2l:jend_2u),intent(inout) ::  qcnvg

      REAL r2dy, r2dx
      REAL, dimension(im,jsta_2l:jend_2u) ::  uwnd, vwnd, qv
      INTEGER ihe(jm),ihw(jm),ive(jm),ivw(jm)
      integer i,j,ista,iend
      real qvdy,qudx
!     
!***************************************************************************
!     START CALMCVG HERE.
!
!     
!     INITIALIZE MOISTURE CONVERGENCE ARRAY.  LOAD TEMPORARY WIND ARRAYS.
!     
!$omp  parallel do private(i,j)
      DO j=jsta_2l,jend_2u
        DO i=1,im
          IF(u1d(i,j)<spval)THEN
          qcnvg(i,j) = 0.
          ELSE
          qcnvg(i,j) = spval
          ENDIF
          uwnd(i,j)  = u1d(i,j)
          vwnd(i,j)  = v1d(i,j)
          IF (uwnd(i,j) == spval) uwnd(i,j) = d00
          IF (vwnd(i,j) == spval) vwnd(i,j) = d00
        ENDDO
      ENDDO
      
      CALL exch_f(q1d)
      CALL exch_f(vwnd)
!
      IF(gridtype == 'A')THEN
!$omp  parallel do private(i,j,qudx,qvdy,r2dx,r2dy)
       DO j=jsta_m,jend_m
         DO i=2,im-1
           IF(q1d(i,j+1)<spval.AND.q1d(i,j-1)<spval.AND.          &
              q1d(i+1,j)<spval.AND.q1d(i-1,j)<spval.AND. &
              q1d(i,j)<spval) THEN
             r2dx   = 1./(2.*dx(i,j))   !MEB DX?
             r2dy   = 1./(2.*dy(i,j))   !MEB DY?  
             qudx   = (q1d(i+1,j)*uwnd(i+1,j)-q1d(i-1,j)*uwnd(i-1,j))*r2dx
             qvdy   = (q1d(i,j+1)*vwnd(i,j+1)-q1d(i,j-1)*vwnd(i,j-1))*r2dy
             qcnvg(i,j) = -(qudx + qvdy)
           ELSE
             qcnvg(i,j) = spval
           ENDIF
         ENDDO
       ENDDO
      ELSE IF(gridtype == 'E')THEN

       DO j=jsta_m,jend_m
         ihe(j) = mod(j+1,2)
         ihw(j) = ihe(j)-1
         ive(j) = mod(j,2)
         ivw(j) = ive(j)-1 
       END DO
     
!$omp  parallel do private(i,j,ista,iend)
       DO j=jsta_m,jend_m
         ista = 1+mod(j+1,2)
         iend = im-mod(j,2)
         DO i=ista,iend
          IF(q1d(i,j-1)<spval.AND.q1d(i+ivw(j),j)<spval.AND.&
             q1d(i+ive(j),j)<spval.AND.q1d(i,j+1)<spval) THEN
           qv(i,j) = d25*(q1d(i,j-1)+q1d(i+ivw(j),j)                   &
                         +q1d(i+ive(j),j)+q1d(i,j+1))
          ELSE
           qv(i,j) = spval
          ENDIF
         END DO
       END DO

       CALL exch_f(qv)
!      CALL EXCH_F(VWND)

!
!$omp  parallel do private(i,j,iend,qudx,qvdy,r2dx,r2dy)
       DO j=jsta_m2,jend_m2
         iend = im-1-mod(j,2)
         DO i=2,iend
          IF(qv(i+ihe(j),j)<spval.AND.uwnd(i+ihe(j),j)<spval.AND.&
             qv(i+ihw(j),j)<spval.AND.uwnd(i+ihw(j),j)<spval.AND.&
             qv(i,j)<spval.AND.qv(i,j-1)<spval.AND.qv(i,j+1)<spval) THEN
           r2dx   = 1./(2.*dx(i,j))
           r2dy   = 1./(2.*dy(i,j))
           qudx   = (qv(i+ihe(j),j)*uwnd(i+ihe(j),j)                   &
                    -qv(i+ihw(j),j)*uwnd(i+ihw(j),j))*r2dx
           qvdy   = (qv(i,j+1)*vwnd(i,j+1)-qv(i,j-1)*vwnd(i,j-1))*r2dy

           qcnvg(i,j) = -(qudx + qvdy) * hbm2(i,j)
          ELSE
           qcnvg(i,j) = spval
          ENDIF
         ENDDO
       ENDDO
      ELSE IF(gridtype=='B')THEN
     
       CALL exch_f(uwnd)
!
!$omp  parallel do private(i,j,qudx,qvdy,r2dx,r2dy)
       DO j=jsta_m,jend_m
        DO i=2,im-1
         IF(uwnd(i,j)<spval.AND.uwnd(i,j-1)<spval.AND.&
            uwnd(i-1,j)<spval.AND.uwnd(i-1,j-1)<spval.AND.&
            q1d(i,j)<spval.AND.q1d(i+1,j)<spval.AND.q1d(i-1,j)<spval.AND.&
            vwnd(i,j)<spval.AND.vwnd(i-1,j)<spval.AND.&
            vwnd(i,j-1)<spval.AND.vwnd(i-1,j-1)<spval.AND.&
            q1d(i,j+1)<spval.AND.q1d(i,j-1)<spval) THEN
          r2dx   = 1./dx(i,j)
          r2dy   = 1./dy(i,j)
          qudx=(0.5*(uwnd(i,j)+uwnd(i,j-1))*0.5*(q1d(i,j)+q1d(i+1,j))        &
               -0.5*(uwnd(i-1,j)+uwnd(i-1,j-1))*0.5*(q1d(i,j)+q1d(i-1,j)))*r2dx
          qvdy=(0.5*(vwnd(i,j)+vwnd(i-1,j))*0.5*(q1d(i,j)+q1d(i,j+1))        &
               -0.5*(vwnd(i,j-1)+vwnd(i-1,j-1))*0.5*(q1d(i,j)+q1d(i,j-1)))*r2dy
  
          qcnvg(i,j) = -(qudx + qvdy)
         ELSE
          qcnvg(i,j) = spval
         ENDIF
!     print*,'mcvg=',i,j,r2dx,r2dy,QCNVG(I,J)
        ENDDO
       ENDDO
      ENDIF
!meb not sure about the indexing for the c-grid
!
!     END OF ROUTINE.
!     
      RETURN
      END