phys/module_progtm.F

   1       module module_progtm
   2       USE MODULE_GFS_MACHINE , ONLY : kind_phys
   3       implicit none
   4       SAVE
   5 !
   6       integer,parameter:: NTYPE=9
   7       integer,parameter:: NGRID=22
   8       real(kind=kind_phys) B(NTYPE), SATPSI(NTYPE), SATKT(NTYPE),       &
   9      &                     TSAT(NTYPE),                                 &
  10      &                     DFK(NGRID,NTYPE),                            &
  11      &                     KTK(NGRID,NTYPE),                            &
  12      &                     DFKT(NGRID,NTYPE)
  13 !
  14 !  the nine soil types are:
  15 !    1  ... loamy sand (coarse)
  16 !    2  ... silty clay loam (medium)
  17 !    3  ... light clay (fine)
  18 !    4  ... sandy loam (coarse-medium)
  19 !    5  ... sandy clay (coarse-fine)
  20 !    6  ... clay loam  (medium-fine)
  21 !    7  ... sandy clay loam (coarse-med-fine)
  22 !    8  ... loam  (organic)
  23 !    9  ... ice (use loamy sand property)
  24 !
  25 !     DATA B/4.05,4.38,4.9,5.3,5.39,7.12,7.75,8.52,
  26 !    &       10.4,10.4,11.4/
  27 !     DATA SATPSI/.121,.09,.218,.786,.478,.299,.356,.63,
  28 !    &            .153,.49,.405/
  29 !     DATA SATKT/1.76E-4,1.5633E-4,3.467E-5,7.2E-6,6.95E-6,
  30 !    &           6.3E-6,1.7E-6,2.45E-6,2.167E-6,1.033E-6,
  31 !    &           1.283E-6/
  32 !     DATA TSAT/.395,.41,.435,.485,.451,.42,.477,.476,
  33 !    &          .426,.492,.482/
  34       data b/4.26,8.72,11.55,4.74,10.73,8.17,6.77,5.25,4.26/
  35       data satpsi/.04,.62,.47,.14,.10,.26,.14,.36,.04/
  36       data satkt/1.41e-5,.20e-5,.10e-5,.52e-5,.72e-5,                   &
  37      &           .25e-5,.45e-5,.34e-5,1.41e-5/
  38       data tsat/.421,.464,.468,.434,.406,.465,.404,.439,.421/
  39 !
  40       contains
  41       subroutine GRDDF
  42       USE MODULE_GFS_MACHINE , ONLY : kind_phys
  43       implicit none
  44       integer              i,    k
  45       real(kind=kind_phys) dynw, f1, f2, theta
  46 !
  47 !  GRDDF SETS UP MOISTURE DIFFUSIVITY AND HYDROLIC CONDUCTIVITY
  48 !  FOR ALL SOIL TYPES
  49 !  GRDDFS SETS UP THERMAL DIFFUSIVITY FOR ALL SOIL TYPES
  50 !
  51       DO K = 1, NTYPE
  52         DYNW = TSAT(K) * .05
  53         F1 = B(K) * SATKT(K) * SATPSI(K) / TSAT(K) ** (B(K) + 3.)
  54         F2 = SATKT(K) / TSAT(K) ** (B(K) * 2. + 3.)
  55 !
  56 !  CONVERT FROM M/S TO KG M-2 S-1 UNIT
  57 !
  58         F1 = F1 * 1000.
  59         F2 = F2 * 1000.
  60         DO I = 1, NGRID
  61           THETA = FLOAT(I-1) * DYNW
  62           THETA = MIN(TSAT(K),THETA)
  63           DFK(I,K) = F1 * THETA ** (B(K) + 2.)
  64           KTK(I,K) = F2 * THETA ** (B(K) * 2. + 3.)
  65         ENDDO
  66       ENDDO
  67       END SUBROUTINE
  68       subroutine GRDKT
  69       USE MODULE_GFS_MACHINE , ONLY : kind_phys
  70       implicit none
  71       integer              i,    k
  72       real(kind=kind_phys) dynw, f1, theta, pf
  73       DO K = 1, NTYPE
  74         DYNW = TSAT(K) * .05
  75         F1 = LOG10(SATPSI(K)) + B(K) * LOG10(TSAT(K)) + 2.
  76         DO I = 1, NGRID
  77           THETA = FLOAT(I-1) * DYNW
  78           THETA = MIN(TSAT(K),THETA)
  79           IF(THETA.GT.0.) THEN
  80             PF = F1 - B(K) * LOG10(THETA)
  81           ELSE
  82             PF = 5.2
  83           ENDIF
  84           IF(PF.LE.5.1) THEN
  85             DFKT(I,K) = EXP(-(2.7+PF)) * 420.
  86           ELSE
  87             DFKT(I,K) = .1744
  88           ENDIF
  89         ENDDO
  90       ENDDO
  91       END SUBROUTINE
  92 !
  93       end module module_progtm