wrfv2_fire/phys/module_sf_sstskin.F

   1 !WRF:MODEL_LAYER:PHYSICS
   2 !
   3 MODULE module_sf_sstskin
   4
   5 CONTAINS
   6
   7    SUBROUTINE sst_skin_update(xland,glw,gsw,hfx,qfx,tsk,ust,emiss,  &
   8                 dtw1,sstsk,dt,stbolt,                                &
   9                 ids, ide, jds, jde, kds, kde,                       &
  10                 ims, ime, jms, jme, kms, kme,                       &
  11                 its, ite, jts, jte, kts, kte                       )
  12
  13
  14    USE module_wrf_error
  15    IMPLICIT NONE
  16
  17
  18 !---------------------------------------------------------------------
  19    INTEGER , INTENT(IN)           :: ids, ide, jds, jde, kds, kde,   &
  20                                      ims, ime, jms, jme, kms, kme,   &
  21                                      its, ite, jts, jte, kts, kte
  22
  23
  24    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: xland, glw, gsw
  25    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: hfx, qfx, tsk
  26    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(IN   ) :: ust, emiss
  27    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT  ) :: dtw1         ! warm temp difference (C)
  28    REAL,     DIMENSION( ims:ime , jms:jme ) , INTENT(INOUT  ) :: sstsk        ! skin sst (K)
  29    REAL,                                      INTENT(IN )   ::   DT           ! model time step
  30    REAL,                                      INTENT(IN )   ::   STBOLT       ! Stefan-Boltzmann constant (W/m^2/K^4)
  31 !---------------------------------------------------------------------
  32 ! Local
  33    REAL :: lw, sw, q, qn, zeta, dep, dtw3, skinmax, skinmin
  34    REAL :: fs, con1, con2, con3, con4, con5, zlan, q2, ts, phi, qn1
  35    REAL :: usw, qo, swo, us, tb, dtc, dtw, alw, dtwo, delt, f1
  36    INTEGER :: i, j, k
  37 !---------------------------------------------------------------------
  38    INTEGER , PARAMETER :: n=1152
  39    REAL , PARAMETER :: z1=3.,an=.3,zk=.4,rho=1.2,rhow=1025.,cw=4190.
  40    REAL , PARAMETER :: g=9.8,znuw=1.e-6,zkw=1.4e-7,sdate=1201.6667
  41 !     parameter(g=9.8,delt=900.,znuw=1.e-6,zkw=1.4e-7)
  42 !
  43 !     Input arguments
  44 !     (all fluxes are positive downwards)
  45 !     real qo      ! LH + SH + LW (W/m^2), + down
  46 !     real swo      ! Net shortwave flux (W/m^2), + down
  47 !     real u       ! Wind speed (m/s)
  48 !     real us      ! Atmospheric friction velocity (m/s)
  49 !     real tb      ! Bulk temperature (deg C)
  50 !     real dtwo    ! Warm layer temp. diff. from previous time (deg C)
  51 !     Local variables
  52 !     real lw
  53 !     real sw
  54 !     real q       ! LH + SH + LW
  55 !     real qn      ! Q + R_s - R(-d)
  56 !     real zeta    ! -z / L
  57 !     real dep     ! Skin layer depth (m)
  58 !     real dtw3
  59 !     Output variables
  60 !     real dtw     ! Warm layer temp. diff. (deg C)
  61 !     real dtc     ! Cool skin temp. diff. (deg C)
  62 !     real ts      ! Skin temperature (deg C)
  63 !      q=lh+sh+lwo
  64 !
  65       skinmax=-9999.
  66       skinmin=9999.
  67       do i=its,ite
  68       do j=jts,jte
  69 !
  70       if(xland(i,j).ge.1.5) then
  71       qo=glw(i,j)-emiss(i,j)*stbolt*(sstsk(i,j)**4)-qfx(i,j)-hfx(i,j)
  72       swo=gsw(i,j)
  73       us=MAX(ust(i,j), 0.01)
  74       tb=tsk(i,j)-273.15
  75       dtwo=dtw1(i,j)
  76       delt=dt
  77 !
  78       q=qo/(rhow*cw)
  79       sw=swo/(rhow*cw)
  80 ! TEMPORARY KLUDGE
  81 !     f1=1.-0.28*exp(-71.5*z1)-0.27*exp(-2.8*z1)-0.45*exp(-0.07*z1)
  82       f1=1.                   -0.27*exp(-2.8*z1)-0.45*exp(-0.07*z1)
  83 ! cool skin
  84       dtc=0.0
  85 ! tb in C
  86       alw=1.e-5*max(tb,1.)
  87       con4=16.*g*alw*znuw**3/zkw**2
  88       usw=sqrt(rho/rhow)*us
  89       con5=con4/usw**4
  90 ! otherwise, iterations would be needed for the computation of fs
  91 ! iteration impact is less than 0.03C
  92       q2=max(1./(rhow*cw),-q)
  93       zlan=6./(1.+(con5*q2)**0.75)**0.333
  94       dep=zlan*znuw/usw                    ! skin layer depth (m)
  95       fs=0.065+11.*dep-(6.6e-5/dep)*(1.-exp(-dep/8.e-4))
  96       fs=max(fs,0.01)          ! fract. of solar rad. absorbed in sublayer
  97       dtc=dep*(q+sw*fs)/zkw            ! cool skin temp. diff (deg C)
  98       dtc=min(dtc,0.)
  99 ! warm layer (X. Zeng)
 100       dtw=0.0
 101 ! tb in C
 102       alw=1.e-5*max(tb,1.)
 103       con1=sqrt(5.*z1*g*alw/an)
 104       con2=zk*g*alw
 105       qn=q+sw*f1
 106       usw=sqrt(rho/rhow)*us
 107 !  does not change when qn is positive
 108       if(dtwo.gt.0..and.qn.lt.0.) then
 109          qn1=sqrt(dtwo)*usw**2/con1
 110          qn=max(qn,qn1)
 111       endif
 112       zeta=z1*con2*qn/usw**3
 113       if(zeta.gt.0.) then
 114          phi=1.+5.*zeta
 115       else
 116          phi=1./sqrt(1.-16.*zeta)
 117       endif
 118       con3=zk*usw/(z1*phi)
 119 ! use all SW flux
 120       dtw=(dtwo+(an+1.)/an*(q+sw*f1)*                             &
 121                           delt/z1)/(1.+(an+1.)*con3*delt)
 122       dtw=max(0.,dtw)
 123       dtwo=dtw
 124       ts = tb + dtw + dtc
 125 !
 126       skinmax=amax1(skinmax,ts-tb)
 127       skinmin=amin1(skinmin,ts-tb)
 128       sstsk(i,j)=ts+273.15      ! convert ts (in C) to sstsk (in K)
 129       dtw1(i,j)=dtw              ! dtw always in C
 130 if(i.eq.5.and.j.eq.5)print *,'sstsk tsk',i,j,sstsk(i,j),tsk(i,j)
 131       endif
 132 !
 133       end do
 134       end do
 135 !     print *, 'check skin sst skinmax = ', skinmax, '  skinmin = ', skinmin
 136 !
 137       return
 138
 139    END SUBROUTINE sst_skin_update
 140
 141
 142 END MODULE module_sf_sstskin