CALDWP.f

Go to the documentation of this file.

!
      SUBROUTINE caldwp(P1D,Q1D,TDWP,T1D)

!
!
!     SET PARAMETERS.
     use params_mod, only: eps, oneps, d001, h1m12
     use ctlblk_mod, only: jsta, jend, im, spval
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
      implicit none
!     
!     DECLARE VARIABLES.
!     
     REAL,dimension(IM,jsta:jend),intent(in)    ::  p1d,q1d,t1d
     REAL,dimension(IM,jsta:jend),intent(inout) ::  tdwp

     REAL evp(im,jsta:jend)
     integer i,j
!     
!****************************************************************************
!     START CALDWP HERE.
!     
!     COMPUTE VAPOR PRESSURE.  CONVERT TO CENITBARS.
!     
!$omp parallel do private(i,j)
      DO j=jsta,jend
        DO i=1,im
          IF(p1d(i,j)<spval .and. q1d(i,j)<spval) THEN
          evp(i,j) = p1d(i,j)*q1d(i,j)/(eps+oneps*q1d(i,j))
          evp(i,j) = max(h1m12,evp(i,j)*d001)
          ELSE
          evp(i,j) = spval
          ENDIF
        ENDDO
      ENDDO
!     
!     COMPUTE DEWPOINT TEMPERATURE.
!     
      CALL dewpoint(evp,tdwp)
!     
!     ENSURE DEWPOINT TEMPERATURE DOES NOT EXCEED AMBIENT TEMPERATURE.
!     
!$omp parallel do private(i,j)
      DO j=jsta,jend
        DO i=1,im
          tdwp(i,j) = min(tdwp(i,j),t1d(i,j))
        ENDDO
      ENDDO
!
!     END OF ROUTINE.
!     
      RETURN
      END