phys/module_diag_trad_fields.F

   1 #if (NMM_CORE == 1)
   2 MODULE module_trad_fields
   3 CONTAINS
   4    SUBROUTINE trad_fields
   5    END SUBROUTINE trad_fields
   6 END MODULE module_trad_fields
   7 #else
   8 !WRF:MEDIATION_LAYER:PHYSICS
   9 !
  10
  11 MODULE module_trad_fields
  12 CONTAINS
  13
  14    SUBROUTINE trad_fields ( u,v,w,t,qv,zp,zb,pp,pb,p,pw,            &
  15                     msfux,msfuy,msfvx,msfvy,msftx,msfty,            &
  16                     f,e,sina,cosa,                                  &
  17                     qc,rho,dz8w, ht,                                &
  18                     use_theta_m,                                    &
  19                     psfc,rainc,rainnc,snownc,graupelnc,hailnc,      &
  20                     sealevelp,                                      &
  21                     temperature,pressure,geoheight,                 &
  22                     umet,vmet,speed,dir,                            &
  23                     rain, liqrain, tpw,potential_t, rh,             &
  24                     ids,ide, jds,jde, kds,kde,                      &
  25                     ims,ime, jms,jme, kms,kme,                      &
  26                     ips,ipe, jps,jpe, kps,kpe,                      &
  27                     its,ite, jts,jte, kts,kte                       )
  28
  29       USE diag_functions
  30       USE module_model_constants
  31
  32       IMPLICIT NONE
  33
  34
  35       !  Input variables
  36
  37       INTEGER, INTENT(IN   )                                          :: ids,ide, jds,jde, kds,kde, &
  38                                                                          ims,ime, jms,jme, kms,kme, &
  39                                                                          ips,ipe, jps,jpe, kps,kpe, &
  40                                                                          its,ite, jts,jte, kts,kte
  41       REAL   , INTENT(IN   ) , DIMENSION(ims:ime , jms:jme)           :: msfux,msfuy,msfvx,msfvy,msftx,msfty, &
  42                                                                          f,e,sina,cosa,ht
  43       INTEGER, INTENT(IN   )                                          :: use_theta_m
  44       REAL   , INTENT(IN   ) , DIMENSION(ims:ime , kms:kme , jms:jme) :: u,v,w,t,qv,zp,zb,pp,pb,p,pw
  45
  46       REAL   , INTENT(IN   ) , DIMENSION(ims:ime , kms:kme , jms:jme) :: qc, rho, dz8w
  47       REAL   , INTENT(IN   ) , DIMENSION(ims:ime , jms:jme)           :: psfc, rainc, rainnc, hailnc,graupelnc, snownc
  48
  49       !  Output variables
  50
  51       REAL   , INTENT(  OUT) ,  DIMENSION(ims:ime , kms:kme , jms:jme) :: temperature , &
  52                                                                           pressure    , &
  53                                                                           geoheight   , &
  54                                                                           umet        , &
  55                                                                           vmet        , &
  56                                                                           speed       , &
  57                                                                           potential_t , &
  58                                                                           rh          , &
  59                                                                           dir
  60       REAL   , INTENT(  OUT) ,  DIMENSION(ims:ime , jms:jme)           :: sealevelp, rain, liqrain,tpw
  61
  62       !  Local variables
  63
  64       REAL :: ptot
  65
  66       REAL, PARAMETER :: eps = 0.622, t_kelvin = svpt0 , s1 = 243.5, s2 = svp2 , s3 = svp1*10., s4 = 611.0, s5 = 5418.12
  67       REAL, PARAMETER :: zshul=75., tvshul=290.66
  68
  69       INTEGER :: i, j, k
  70       REAL    :: es, qs
  71       REAL    :: gammas
  72
  73       ! Half levels
  74
  75       j_loop_h : DO j = jts , MIN(jte,jde-1)
  76          k_loop_h : DO k = kts , MIN(kte,kde-1)
  77             i_loop_h : DO i = its , MIN(ite,ide-1)
  78
  79                !  Temperature
  80
  81                temperature(i,k,j) = ( ( t(i,k,j) + t0 ) * ( (pb(i,k,j)+pp(i,k,j)) / p1000mb ) ** rcp )
  82
  83                !  Hydrostatic pressure
  84
  85                pressure(i,k,j) = p(i,k,j)
  86
  87                !  Height
  88
  89                geoheight(i,k,j) = ( zb(i,k,j)+zp(i,k,j)+zb(i,k+1,j)+zp(i,k+1,j) ) / (2.0 * g )
  90
  91                !  Earth relative winds
  92
  93                umet(i,k,j) = 0.5 * ( (u(i,k,j)+u(i+1,k,j))*cosa(i,j) - (v(i,k,j)+v(i,k,j+1))*sina(i,j) )
  94                vmet(i,k,j) = 0.5 * ( (u(i,k,j)+u(i+1,k,j))*sina(i,j) + (v(i,k,j)+v(i,k,j+1))*cosa(i,j) )
  95
  96                !  Horizontal wind speed
  97
  98                speed(i,k,j) = SQRT ( umet(i,k,j)**2 + vmet(i,k,j)**2 )
  99
 100                !  Direction
 101
 102                IF      ( ( umet(i,k,j) .EQ. 0. ) .AND. ( vmet(i,k,j) .EQ. 0. ) ) THEN
 103                   dir(i,k,j) = 0.
 104                ELSE IF ( ( umet(i,k,j) .EQ. 0. ) .AND. ( vmet(i,k,j) .GT. 0. ) ) THEN
 105                   dir(i,k,j) = 180.
 106                ELSE IF ( ( umet(i,k,j) .EQ. 0. ) .AND. ( vmet(i,k,j) .LT. 0. ) ) THEN
 107                   dir(i,k,j) = 0.
 108                ELSE
 109                   dir(i,k,j) = 270. - atan2(vmet(i,k,j),umet(i,k,j)) * 180./3.14159265358979
 110                   IF ( dir(i,k,j) .GE. 360. ) THEN
 111                      dir(i,k,j) = dir(i,k,j) - 360.
 112                   END IF
 113                   IF ( dir(i,k,j) .LE.   0. ) THEN
 114                      dir(i,k,j) = dir(i,k,j) + 360.
 115                   END IF
 116                END IF
 117
 118                !  Potential Temperature
 119
 120                potential_t(i,k,j) =   t(i,k,j) + t0
 121
 122
 123                !  Relative humidity
 124
 125                   ptot      = pb(i,k,j)+pp(i,k,j)
 126                   rh(i,k,j) = calc_rh(ptot, temperature(i,k,j), qv(i,k,j))
 127
 128             END DO i_loop_h
 129          END DO k_loop_h
 130       END DO j_loop_h
 131
 132       ! Full levels
 133
 134       j_loop_f : DO j = jts , MIN(jte,jde-1)
 135          k_loop_f : DO k = kts , kte
 136             i_loop_f : DO i = its , MIN(ite,ide-1)
 137
 138  ! so far nothing
 139
 140             END DO i_loop_f
 141          END DO k_loop_f
 142       END DO j_loop_f
 143
 144       ! 2d
 145
 146       j_loop_2 : DO j = jts , MIN(jte,jde-1)
 147          i_loop_2 : DO i = its , MIN(ite,ide-1)
 148
 149                ! Mean sea level pressure
 150
 151                sealevelp(i,j) =   MSLP ( ht(i,j), pressure(i,kms,j), geoheight(i,kms,j) , &
 152                                          qv(i,kms,j), temperature(i,kms,j) )
 153
 154                ! Total rainfall
 155
 156                rain(i,j) =   rainc(i,j) + rainnc(i,j)
 157
 158                ! Total liquid rainfall
 159
 160                liqrain(i,j) =   rainc(i,j) + rainnc(i,j) - snownc(i,j) - graupelnc(i,j) - hailnc(i,j)
 161
 162                ! Total precipitable water
 163
 164                tpw(i,j) = PWAT(kme-kms+1, qv(i,kms:kme,j), qc(i,kms:kme,j), dz8w(i,kms:kme,j), rho(i,kms:kme,j))
 165
 166          END DO i_loop_2
 167       END DO j_loop_2
 168
 169    END SUBROUTINE trad_fields
 170
 171 END MODULE module_trad_fields
 172 #endif