-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathHMC_Module_Phys_StateUpdating.f90
166 lines (132 loc) · 8.87 KB
/
HMC_Module_Phys_StateUpdating.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
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
!------------------------------------------------------------------------------------------
! File: HMC_Module_Phys_StateUpdating.f90
! Author: Fabio Delogu, Valerio Basso
!
! Created on December 19, 2017, 4:02 PM
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Module Header
module HMC_Module_Phys_StateUpdating
!------------------------------------------------------------------------------------------
! External module(s) for all subroutine in this module
use HMC_Module_Namelist, only: oHMC_Namelist
use HMC_Module_Vars_Loader, only: oHMC_Vars
use HMC_Module_Tools_Generic, only: assimNudging
use HMC_Module_Tools_Debug
! Implicit none for all subroutines in this module
implicit none
!------------------------------------------------------------------------------------------
contains
!------------------------------------------------------------------------------------------
! Subroutine to update model state(s)
subroutine HMC_Phys_StateUpdating_Cpl(iID, iRows, iCols)
!------------------------------------------------------------------------------------------
! Variable(s) declaration
integer(kind = 4) :: iID
integer(kind = 4) :: iRows, iCols
integer(kind = 4) :: iFlagSMAssim
integer(kind = 4), dimension (iRows, iCols) :: a2iVarMask, a2iVarChoice
real(kind = 4), dimension (iRows, iCols) :: a2dVarDEM, a2dVarS
real(kind = 4), dimension (iRows, iCols) :: a2dVarVTot
real(kind = 4), dimension (iRows, iCols) :: a2dVarSMStar, a2dVarSMGain
real(kind = 4), dimension (iRows, iCols) :: a2dVarVTot_Obs, a2dVarVTot_Assim, a2dVarVTot_Corr
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Initialization variable(s)
iFlagSMAssim = 0;
a2iVarMask = 0; a2dVarDEM = 0.0; a2dVarS = 0.0; a2iVarChoice = 0.0;
a2dVarVTot = -9999.0; a2dVarSMStar = -9999.0; a2dVarSMGain = -9999.0;
a2dVarVTot_Obs = -9999.0; a2dVarVTot_Assim = -9999.0; a2dVarVTot_Corr = -9999.0
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Soil Moisture Assimilation flag
iFlagSMAssim = oHMC_Namelist(iID)%iFlagSMAssim
! Data static definition
a2dVarDEM = oHMC_Vars(iID)%a2dDem
a2iVarMask = oHMC_Vars(iID)%a2iMask
a2dVarS = oHMC_Vars(iID)%a2dS
a2iVarChoice = oHMC_Vars(iID)%a2iChoice
! Data dynamic definition
a2dVarVTot = oHMC_Vars(iID)%a2dVTot
a2dVarSMStar = oHMC_Vars(iID)%a2dSMStar
a2dVarSMGain = oHMC_Vars(iID)%a2dSMGain
! Info start
call mprintf(.true., iINFO_Verbose, ' Phys :: StateUpdating ... ' )
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Debug
if (iDEBUG.gt.0) then
call mprintf(.true., iINFO_Extra, ' ========= STATEUPDATING START =========== ')
call mprintf(.true., iINFO_Extra, checkvar(a2dVarVTot, a2iVarMask, 'VTOT START ') )
call mprintf(.true., iINFO_Extra, checkvar(a2dVarSMStar, a2iVarMask, 'SMSTAR START ') )
call mprintf(.true., iINFO_Extra, checkvar(a2dVarSMGain, a2iVarMask, 'SMGAIN START ') )
call mprintf(.true., iINFO_Extra, '')
endif
!------------------------------------------------------------------------------------------
!-------------------------------------------------------------------------------------
! Call subroutine to compute SM assimilation
call mprintf(.true., iINFO_Verbose, ' Phys :: StateUpdating :: Soil Moisture ... ' )
if (iFlagSMAssim.eq.1) then
!-------------------------------------------------------------------------------------
! Check forcing(s) to use assimilation method
if ( any(a2dVarSMStar.ne.-9999.0) .and. any(a2dVarSMGain.ne.-9999.0) ) then
!------------------------------------------------------------------------------------------
! Convert SM star from HSAF product(s) into volumetric soil water content [mm]
where( (a2dVarSMStar.gt.0.0) .and. (a2dVarSMGain.ge.0.0) )
a2dVarVTot_Obs = a2dVarSMStar * a2dVarS
elsewhere
a2dVarVTot_Obs = a2dVarVTot
endwhere
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Replace volumetric soil water content [mm] from HSAF product(s) with volumetric soil water content [mm] from HMC in channel cells
where (a2iVarChoice.gt.0)
a2dVarVTot_Obs = a2dVarVTot
endwhere
!------------------------------------------------------------------------------------------
! Nudging assimilation method
call assimNudging(a2iVarMask, a2dVarVTot, a2dVarVTot_Obs, a2dVarSMGain, &
a2dVarVTot_Assim, a2dVarVTot_Corr)
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Update volumetric soil water content
a2dVarVTot = -9999.0
a2dVarVTot = a2dVarVTot_Assim
!------------------------------------------------------------------------------------------
! Info start assimilation
call mprintf(.true., iINFO_Verbose, ' Phys :: StateUpdating :: Soil Moisture ... OK' )
!------------------------------------------------------------------------------------------
else
!-------------------------------------------------------------------------------------
! Info assimilation no data available
call mprintf(.true., iINFO_Verbose, ' Phys :: StateUpdating :: Soil Moisture ... DATA NO AVAILABLE ' )
!-------------------------------------------------------------------------------------
endif
!-------------------------------------------------------------------------------------
else
!-------------------------------------------------------------------------------------
! Info assimilation no data available
call mprintf(.true., iINFO_Verbose, ' Phys :: StateUpdating :: Soil Moisture ... NOT ACTIVATED ' )
!-------------------------------------------------------------------------------------
endif
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Debug
if (iDEBUG.gt.0) then
call mprintf(.true., iINFO_Extra, '')
call mprintf(.true., iINFO_Extra, checkvar(a2dVarVTot, a2iVarMask, 'VTOT END ') )
call mprintf(.true., iINFO_Extra, checkvar(a2dVarSMStar, a2iVarMask, 'SMSTAR END ') )
call mprintf(.true., iINFO_Extra, checkvar(a2dVarSMGain, a2iVarMask, 'SMGAIN END ') )
call mprintf(.true., iINFO_Extra, ' ========= STATEUPDATING END =========== ')
endif
!------------------------------------------------------------------------------------------
!------------------------------------------------------------------------------------------
! Passing variable(s) to global declaration
oHMC_Vars(iID)%a2dVTot = a2dVarVTot
! Info end
call mprintf(.true., iINFO_Verbose, ' Phys :: StateUpdating ... OK ' )
!------------------------------------------------------------------------------------------
end subroutine HMC_Phys_StateUpdating_Cpl
!------------------------------------------------------------------------------------------
end module HMC_Module_Phys_StateUpdating
!------------------------------------------------------------------------------------------