wrftladj/module_bl_surface_drag.F

   1 !WRF:MODEL_LAYER:PHYSICS
   2
   3 MODULE module_bl_surface_drag
   4
   5
   6 CONTAINS
   7
   8    SUBROUTINE surface_drag (rublten, rvblten, u_phy, v_phy, xland,  &
   9                          z,    ht, kpbl2d,                           &
  10                          ids, ide, jds, jde, kds, kde,               &
  11                          ims, ime, jms, jme, kms, kme,               &
  12                          its, ite, jts, jte, kts, kte   )
  13
  14    IMPLICIT NONE
  15
  16    INTEGER ,          INTENT(IN   ) :: ids, ide, jds, jde, kds, kde, &
  17                                         ims, ime, jms, jme, kms, kme, &
  18                                         its, ite, jts, jte, kts, kte
  19
  20    INTEGER,  DIMENSION( ims:ime, jms:jme )                       , &
  21              INTENT(  OUT)   ::                          kpbl2d
  22
  23    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,               &
  24                                         INTENT(INOUT) :: rublten,  &
  25                                                          rvblten
  26    REAL , DIMENSION( ims:ime , kms:kme, jms:jme  ) ,               &
  27                                         INTENT(IN   ) :: u_phy,    &
  28                                                          v_phy,    &
  29                                                          z
  30    REAL , DIMENSION( ims:ime , jms:jme  ), INTENT(IN) :: xland, ht
  31
  32 ! Local
  33    REAL :: V0,  tao_xz, tao_yz, cd, zh, zwt
  34    INTEGER :: i, j, i_start, i_end, i_endu, j_start, j_end, j_endv, k
  35
  36 ! End declarations.
  37 !-----------------------------------------------------------------------
  38
  39    i_start = its
  40    i_end   = MIN(ite,ide-1)
  41    i_endu  = ite
  42    j_start = jts
  43    j_end   = MIN(jte,jde-1)
  44    j_endv  = jte
  45
  46     DO j = j_start, j_end
  47     DO i = i_start, i_endu
  48
  49        V0 =    sqrt((u_phy(i,kts,j)**2) +         &
  50                     (v_phy(i,kts,j)**2))
  51
  52        IF ( ABS(xland(i,j)-xland(i-1,j)) .LT. 1.0E-10 ) THEN
  53           IF ( xland(i,j) .LT. 1.5 ) THEN
  54              ! land
  55              Cd=0.01
  56           ELSE
  57              ! water
  58              Cd=0.001
  59              Cd=MAX(Cd, 1.e-4 * V0)
  60              Cd=MIN(Cd, 0.003)
  61
  62           ENDIF
  63        ELSE
  64           ! coast
  65           Cd=0.003
  66        ENDIF
  67
  68        tao_xz=Cd*V0*u_phy(i,kts,j)
  69
  70        DO k = kts, kte
  71           zh = (z(i,k,j)-ht(i,j))
  72           IF ( zh .LT. 1000. ) THEN
  73              zwt = 2. * (1000.-zh) / 1000.
  74              rublten(i,k,j)=rublten(i,k,j)            &
  75                             -zwt*0.5*tao_xz/1000.
  76              kpbl2d(i,j) = k
  77           ENDIF
  78        ENDDO
  79
  80     ENDDO
  81     ENDDO
  82
  83 !
  84     DO j = j_start, j_endv
  85     DO i = i_start, i_end
  86
  87        V0 = SQRT((u_phy(i,kts,j)**2) +         &
  88                  (v_phy(i,kts,j)**2))
  89
  90        IF ( ABS(xland(i,j)-xland(i,j-1)) .LT. 1.0E-10 ) THEN
  91           IF ( xland(i,j) .LT. 1.5 ) THEN
  92              ! land
  93              Cd=0.01
  94           ELSE
  95              ! water
  96              Cd=0.001
  97              Cd=MAX(Cd, 1.e-4 * V0)
  98              Cd=MIN(Cd, 0.003)
  99           ENDIF
 100        ELSE
 101           ! coast
 102           Cd=0.003
 103        ENDIF
 104
 105        tao_yz=Cd*V0*v_phy(i,kts,j)
 106
 107        DO k = kts, kte
 108           zh = (z(i,k,j)-ht(i,j))
 109           IF ( zh .LT. 1000. ) THEN
 110              zwt = 2. * (1000.-zh) / 1000.
 111              rvblten(i,k,j)= rvblten(i,k,j)            &
 112                              -zwt*0.5*tao_yz/1000.
 113           ENDIF
 114        ENDDO
 115
 116     ENDDO
 117     ENDDO
 118
 119    END SUBROUTINE surface_drag
 120
 121 !===================================================================
 122    SUBROUTINE surface_drag_init(RUBLTEN,RVBLTEN,RTHBLTEN,          &
 123                       RQVBLTEN,restart,                            &
 124                       ids, ide, jds, jde, kds, kde,                &
 125                       ims, ime, jms, jme, kms, kme,                &
 126                       its, ite, jts, jte, kts, kte                 )
 127 !-------------------------------------------------------------------
 128    IMPLICIT NONE
 129 !-------------------------------------------------------------------
 130    LOGICAL , INTENT(IN)          :: restart
 131    INTEGER , INTENT(IN)          ::  ids, ide, jds, jde, kds, kde, &
 132                                      ims, ime, jms, jme, kms, kme, &
 133                                      its, ite, jts, jte, kts, kte
 134
 135    REAL , DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::         &
 136                                                          RUBLTEN, &
 137                                                          RVBLTEN, &
 138                                                          RTHBLTEN, &
 139                                                          RQVBLTEN
 140    INTEGER :: i, j, k, itf, jtf, ktf
 141
 142    jtf=min0(jte,jde-1)
 143    ktf=min0(kte,kde-1)
 144    itf=min0(ite,ide-1)
 145
 146    IF(.not.restart)THEN
 147      DO j=jts,jtf
 148      DO k=kts,ktf
 149      DO i=its,itf
 150         RUBLTEN(i,k,j)=0.
 151         RVBLTEN(i,k,j)=0.
 152         RTHBLTEN(i,k,j)=0.
 153         RQVBLTEN(i,k,j)=0.
 154      ENDDO
 155      ENDDO
 156      ENDDO
 157    ENDIF
 158
 159    END SUBROUTINE surface_drag_init
 160
 161 END MODULE module_bl_surface_drag