Merge branch 'master' into jm2/detect2
[wrffire.git] / wrfv2_fire / phys / module_progtm.F
blob86ac47eb7d6fb41eab1a65a5be1cfd7b39b392a2
1       module module_progtm
2       USE MODULE_GFS_MACHINE , ONLY : kind_phys
3       implicit none
4       SAVE
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)
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)
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/
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
47 !  GRDDF SETS UP MOISTURE DIFFUSIVITY AND HYDROLIC CONDUCTIVITY
48 !  FOR ALL SOIL TYPES
49 !  GRDDFS SETS UP THERMAL DIFFUSIVITY FOR ALL SOIL TYPES
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.)
56 !  CONVERT FROM M/S TO KG M-2 S-1 UNIT
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
93       end module module_progtm