-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathdelhf.F90
134 lines (105 loc) · 4.56 KB
/
delhf.F90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
!===================SUBROUTINE DELHF25=====================================
subroutine delhf(sib,sib_loc)
use kinds
use sibtype
use physical_parameters, only : &
cp => spec_heat_cp
use sib_const_module, only : &
dtt
!========================================================================
!
! Calculation of partial derivatives of canopy and ground sensible
! heat fluxes with respect to Tc, Tg, and Theta-m.
! Calculation of initial sensible heat fluxes.
!
!========================================================================
!++++++++++++++++++++++++++++++OUTPUT+++++++++++++++++++++++++++++++++++
!
! HC CANOPY SENSIBLE HEAT FLUX (J M-2)
! HG GROUND SENSIBLE HEAT FLUX (J M-2)
! HS SNOW SENSIBLE HEAT FLUX (J M-2)
! HA CAS SENSIBLE HEAT FLUX (J M-2)
! HCDTC dHC/dTC
! HCDTA dHC/dTA
! HGDTG dHG/dTG
! HGDTA dHG/dTA
! HSDTS dHS/dTS
! HSDTA dHS/dTA
! HADTA dHA/dTA
! HADTH dHA/dTH
! AAC dH/dTC
! AAG dH/dTG
! AAM dH/dTH
!
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
implicit none
!----------------------------------------------------------------------
type(sib_t), intent(inout) :: sib
type(sib_local_vars) ,intent(inout) :: sib_loc
! variables local to SiB
!----------------------------------------------------------------------
! local variables
! REALX8 D1, d1i,
real(kind=dbl_kind) :: rai ! 1/ra
real(kind=dbl_kind) :: rbi ! 1/rb
real(kind=dbl_kind) :: rdi ! 1/rd
!-----------------------------------------------------------------------
!
! FLUXES EXPRESSED IN JOULES M-2, although in SIBSLV WE THEN WANT W/m2
! WHY ????
!
! if we were to keep things simple, there is no need to separate
! HG and HS, but it helps the derivatives keep clean.
!
! HC (HC) : EQUATION (63) , SE-86
! HG (HG) : EQUATION (65) , SE-86
! HS (HS) : EQUATION (65) , SE-86
! HA (HA) : EQUATION ???
!-----------------------------------------------------------------------
rai = 1.0 / sib%diag%ra
rbi = 1.0 / sib%diag%rb
rdi = 1.0 / sib%diag%rd
! these are the current time step fluxes in J/m2
! can we change this to W/m2 ???
sib%diag%hc = cp * sib%prog%ros * (sib%prog%tc - sib%prog%ta) &
* rbi * dtt
if(sib%prog%nsl == 0 ) then !no snow case
sib%diag%hg = cp * sib%prog%ros * &
(sib%prog%td(1) - sib%prog%ta) * rdi * dtt
sib%diag%hs = 0.0
else ! snow case
sib%diag%hg = cp * sib%prog%ros * &
(sib%prog%td(1) - sib%prog%ta) * rdi * dtt
! sib%diag%hg = sib%diag%hg * (1.0 - sib%diag%areas)
sib%diag%hg = 0.0
sib%diag%hs = cp * sib%prog%ros * &
(sib%diag%tsnow - sib%prog%ta) * rdi * dtt
! sib%diag%hs = sib%diag%hs * sib%diag%areas
endif
sib%diag%fss = cp * sib%prog%ros * (sib%prog%ta - sib%prog%tm) &
* rai * dtt
! now we do the partial derivatives
! these are done assuming the fluxes in W/m2
! for canopy leaves sensible heat flux: W/(m2 * K)
!
sib_loc%hcdtc = cp * sib%prog%ros * rbi
sib_loc%hcdta = - sib_loc%hcdtc
!
! for ground and snow sensible heat fluxes: W/(m2 * K)
!
sib_loc%hgdtg = cp * sib%prog%ros * rdi
sib_loc%hsdts = sib_loc%hgdtg
sib_loc%hgdta = - sib_loc%hgdtg
sib_loc%hsdta = - sib_loc%hgdtg
!
! for the canopy air space (CAS) sensible heat flux: W/(m2 * K)
!
sib_loc%hadta = cp * sib%prog%ros * rai
sib_loc%hadth = - sib_loc%hadta/sib%prog%bps(1)
! ATTENTION !!!! DANGER !!!!! THIS WILL NOT WORK WITHOUT sibdrv = true
! for mixed layer (ref temp if not sibdrv): YET TO BE DONE
!itb...LOOK AT SATO ET AL...
! AAG(I) = rdi * d1i
! AAC(I) = rbi * d1i
! AAM(I) = rai * d1i * bps(i)
end subroutine delhf