phys/module_sf_sfcdiags.F

   1 !WRF:MODEL_LAYER:PHYSICS
   2 !
   3 MODULE module_sf_sfcdiags
   4
   5 CONTAINS
   6
   7    SUBROUTINE SFCDIAGS(HFX,QFX,TSK,QSFC,CHS2,CQS2,T2,TH2,Q2,       &
   8                      PSFC,CP,R_d,ROVCP,CHS,T3D,QV3D,UA_PHYS,       &
   9                      ids,ide, jds,jde, kds,kde,                    &
  10                      ims,ime, jms,jme, kms,kme,                    &
  11                      its,ite, jts,jte, kts,kte                     )
  12 !-------------------------------------------------------------------
  13       IMPLICIT NONE
  14 !-------------------------------------------------------------------
  15       INTEGER,  INTENT(IN )   ::        ids,ide, jds,jde, kds,kde, &
  16                                         ims,ime, jms,jme, kms,kme, &
  17                                         its,ite, jts,jte, kts,kte
  18       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  19                 INTENT(IN)                  ::                HFX, &
  20                                                               QFX, &
  21                                                               TSK, &
  22                                                              QSFC
  23       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  24                 INTENT(INOUT)               ::                Q2, &
  25                                                              TH2, &
  26                                                               T2
  27       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  28                 INTENT(IN)                  ::               PSFC, &
  29                                                              CHS2, &
  30                                                              CQS2
  31       REAL,     INTENT(IN   )               ::       CP,R_d,ROVCP
  32
  33 ! UA changes
  34       LOGICAL, INTENT(IN) :: UA_PHYS   ! UA: flag for UA option
  35       REAL,    DIMENSION( ims:ime, kms:kme, jms:jme )            , &
  36             INTENT(IN   )    ::                           QV3D,T3D
  37       REAL,     DIMENSION( ims:ime, jms:jme )                    , &
  38                 INTENT(IN)                  ::               CHS
  39
  40 ! LOCAL VARS
  41       INTEGER ::  I,J
  42       REAL    ::  RHO
  43
  44       DO J=jts,jte
  45         DO I=its,ite
  46           RHO = PSFC(I,J)/(R_d * TSK(I,J))
  47           if(CQS2(I,J).lt.1.E-5) then
  48              Q2(I,J)=QSFC(I,J)
  49           else
  50               IF ( UA_PHYS ) THEN
  51                   Q2(I,J) = QSFC(I,J) - CHS(I,J)/CQS2(I,J)*(QSFC(I,J) - QV3D(i,1,j))
  52               ELSE
  53 #if (HWRF==1)
  54                   Q2(I,J) = QSFC(I,J) - amax1(amin1(CHS(I,J)/CQS2(I,J),0.0),2.0)*(QSFC(I,J) - QV3D(i,1,j))
  55 #else
  56                   Q2(I,J) = QSFC(I,J) - QFX(I,J)/(RHO*CQS2(I,J))
  57 #endif
  58               ENDIF
  59           endif
  60           if(CHS2(I,J).lt.1.E-5) then
  61              T2(I,J) = TSK(I,J)
  62           else
  63               IF ( UA_PHYS ) THEN
  64                   T2(I,J) = TSK(I,J) - CHS(I,J)/CHS2(I,J)*(TSK(I,J) - T3D(i,1,j))
  65               ELSE
  66 #if (HWRF==1)
  67                   T2(I,J) = TSK(I,J) - amax1(amin1(CHS(I,J)/CHS2(I,J),0.0),2.0)*(TSK(I,J) - T3D(i,1,j))
  68 #else
  69                   T2(I,J) = TSK(I,J) - HFX(I,J)/(RHO*CP*CHS2(I,J))
  70 #endif
  71               ENDIF
  72           endif
  73           TH2(I,J) = T2(I,J)*(1.E5/PSFC(I,J))**ROVCP
  74         ENDDO
  75       ENDDO
  76
  77   END SUBROUTINE SFCDIAGS
  78
  79 END MODULE module_sf_sfcdiags