module_progtm.F
References to this file elsewhere.
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