phys/module_ra_hs.F

   1 !WRF:MODEL_LAYER:PHYSICS
   2 !
   3 MODULE module_ra_hs
   4
   5 CONTAINS
   6
   7 !------------------------------------------------------------------
   8    SUBROUTINE HSRAD(RTHRATEN,p8w,p_phy,pi_phy,dz8w,t_phy,          &
   9                      t8w, rho_phy, R_d,G,CP,dt,xlat,degrad,        &
  10                      ids,ide, jds,jde, kds,kde,                    &
  11                      ims,ime, jms,jme, kms,kme,                    &
  12                      its,ite, jts,jte, kts,kte                     )
  13
  14 !------------------------------------------------------------------
  15    IMPLICIT NONE
  16 !------------------------------------------------------------------
  17    INTEGER,    INTENT(IN   ) ::        ids,ide, jds,jde, kds,kde, &
  18                                        ims,ime, jms,jme, kms,kme, &
  19                                        its,ite, jts,jte, kts,kte
  20
  21    REAL, INTENT(IN    )      ::        DEGRAD
  22
  23    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
  24          INTENT(INOUT)  ::                              RTHRATEN
  25
  26    REAL, INTENT(IN   )   ::                   R_d,CP,G,dt
  27
  28    REAL, DIMENSION( ims:ime, kms:kme, jms:jme ),                  &
  29          INTENT(IN ) ::                                     dz8w, &
  30                                                              p8w, &
  31                                                            p_phy, &
  32                                                           pi_phy, &
  33                                                            t_phy, &
  34                                                              t8w, &
  35                                                          rho_phy
  36    REAL, DIMENSION( ims:ime, jms:jme ),                           &
  37          INTENT(IN ) ::                                     xlat
  38
  39    INTEGER :: i,j,K,NK
  40    real :: delty,delthez,p0,sec_p_d,sigb,kka,kks,kkf,rcp
  41    real :: ttmp,teq,sig,sigterm,kkt,t_tend
  42
  43 !------------------------------------------------------------------
  44 ! Newtonian relaxation scheme from Held and Suarez, Bull. Amer. Met.
  45 ! Soc., Vol. 75, No. 10., p1825-1830, 1994.  (box on page 1826)
  46 ! CEN and MIR  31-JUL-04
  47
  48    delty   = 60.0
  49    delthez = 10.0
  50    p0      = 100000.0
  51    sec_p_d = 86400.
  52    sigb    = 0.7
  53    kka     = 1.0/40.0   ! units of per day
  54    kks     = 0.25
  55    kkf     = 1.0
  56    rcp     = R_d/CP
  57
  58    j_loop: DO J=jts,MIN(jte,jde-1)
  59    k_loop: DO K=kts,MIN(kte,kde-1)
  60    i_loop: DO I=its,MIN(ite,ide-1)
  61
  62       ttmp = 315.0 - delty*(sin(xlat(i,j)*degrad))**2.0- &
  63                delthez*alog(p_phy(i,k,j)/p0)*(cos(xlat(i,j)*degrad))**2.0
  64
  65       teq=max(200.0,ttmp*(p_phy(i,k,j)/p0)**rcp)
  66
  67       sig=p_phy(i,k,j)/p8w(i,1,j)
  68       sigterm=max(0.0,(sig-sigb)/(1.0-sigb))
  69
  70       kkt=kka+(kks-kka)*sigterm*(cos(xlat(i,j)*degrad))**4.0
  71
  72       t_tend=-kkt*(t_phy(i,k,j)-teq)/sec_p_d  ! t_tend in kinetic K/s
  73
  74       RTHRATEN(I,K,J)=RTHRATEN(I,K,J)+t_tend/pi_phy(i,k,j)
  75
  76    ENDDO i_loop
  77    ENDDO k_loop
  78    ENDDO j_loop
  79
  80    END SUBROUTINE HSRAD
  81
  82 !====================================================================
  83    SUBROUTINE hsinit(RTHRATEN,restart,                              &
  84                      ids, ide, jds, jde, kds, kde,                  &
  85                      ims, ime, jms, jme, kms, kme,                  &
  86                      its, ite, jts, jte, kts, kte                   )
  87 !--------------------------------------------------------------------
  88    IMPLICIT NONE
  89 !--------------------------------------------------------------------
  90    LOGICAL , INTENT(IN)           :: restart
  91    INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,  &
  92                                      ims, ime, jms, jme, kms, kme,  &
  93                                      its, ite, jts, jte, kts, kte
  94
  95    REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(INOUT) ::        &
  96                                                           RTHRATEN
  97    INTEGER :: i, j, k, itf, jtf, ktf
  98
  99    jtf=min0(jte,jde-1)
 100    ktf=min0(kte,kde-1)
 101    itf=min0(ite,ide-1)
 102
 103    IF(.not.restart)THEN
 104      DO j=jts,jtf
 105      DO k=kts,ktf
 106      DO i=its,itf
 107         RTHRATEN(i,k,j)=0.
 108      ENDDO
 109      ENDDO
 110      ENDDO
 111    ENDIF
 112
 113    END SUBROUTINE hsinit
 114
 115 !====================================================================
 116
 117 END MODULE module_ra_hs