@@ -12,8 +12,27 @@ module IPD_driver
12
12
13
13
use physics_restart_layer, only: restart_populate
14
14
15
+ #ifdef CCPP_IPD
16
+ use fms_mod, only: error_mesg
17
+ use ccpp_types, only: ccpp_t
18
+ use ccpp, only: ccpp_init
19
+ use ccpp_fcall, only: ccpp_run
20
+ use ccpp_fields, only: ccpp_fields_add
21
+ ! Begin include auto-generated list of modules for ccpp
22
+ ! DH* #include "ccpp_modules.inc"
23
+ ! End include auto-generated list of modules for ccpp
24
+ use iso_c_binding, only: c_loc
25
+ #endif
26
+
15
27
implicit none
16
28
29
+ #ifdef CCPP_IPD
30
+ !- -----------------------------------------------------!
31
+ ! CCPP container !
32
+ !- -----------------------------------------------------!
33
+ type (ccpp_t), save , target :: cdata
34
+ #endif
35
+
17
36
!- -----------------------------------------------------!
18
37
! IPD containers !
19
38
!- -----------------------------------------------------!
@@ -32,6 +51,9 @@ module IPD_driver
32
51
public IPD_radiation_step
33
52
public IPD_physics_step1
34
53
public IPD_physics_step2
54
+ #ifdef CCPP_IPD
55
+ public IPD_step
56
+ #endif
35
57
36
58
CONTAINS
37
59
! *******************************************************************************************
@@ -138,4 +160,85 @@ subroutine IPD_physics_step2 (IPD_Control, IPD_Data, IPD_Diag, IPD_Restart)
138
160
139
161
end subroutine IPD_physics_step2
140
162
163
+
164
+ #ifdef CCPP_IPD
165
+ !- ---------------------
166
+ ! IPD step generalized
167
+ !- ---------------------
168
+ subroutine IPD_step (IPD_Control , IPD_Data , IPD_Diag , IPD_Restart , Atm_block , Init_parm , l_salp_data , l_snupx , ccpp_suite , step )
169
+
170
+ use namelist_soilveg, only: salp_data, snupx, max_vegtyp
171
+ use block_control_mod, only: block_control_type
172
+ use IPD_typedefs, only: kind_phys
173
+
174
+ implicit none
175
+
176
+ type (IPD_control_type), intent (inout ) :: IPD_Control
177
+ type (IPD_data_type), intent (inout ) :: IPD_Data(:)
178
+ type (IPD_diag_type), intent (inout ) :: IPD_Diag(:)
179
+ type (IPD_restart_type), intent (inout ) :: IPD_Restart
180
+ type (block_control_type), intent (in ) , optional :: Atm_block
181
+ type (IPD_init_type), intent (in ) , optional :: Init_parm
182
+ real (kind= kind_phys), intent (inout ), optional :: l_salp_data
183
+ real (kind= kind_phys), intent (inout ), optional :: l_snupx(max_vegtyp)
184
+ character (len= 256 ), intent (in ), optional :: ccpp_suite
185
+ integer , intent (in ) :: step
186
+ ! Local variables
187
+ integer :: ierr
188
+
189
+ if (step== 0 ) then
190
+ if (.not. present (Atm_block)) then
191
+ ! DH* TODO - NEED PROPER ERROR HANDLING HERE
192
+ print * , " IPD init step called without mandatory Atm_block argument"
193
+ stop
194
+ else if (.not. present (Init_parm)) then
195
+ ! DH* TODO - NEED PROPER ERROR HANDLING HERE
196
+ print * , " IPD init step called without mandatory Init_parm argument"
197
+ stop
198
+ else if (.not. present (l_salp_data)) then
199
+ ! DH* TODO - NEED PROPER ERROR HANDLING HERE
200
+ print * , " IPD init step called without mandatory l_salp_data argument"
201
+ stop
202
+ else if (.not. present (l_snupx)) then
203
+ ! DH* TODO - NEED PROPER ERROR HANDLING HERE
204
+ print * , " IPD init step called without mandatory l_snupx argument"
205
+ stop
206
+ else if (.not. present (ccpp_suite)) then
207
+ ! DH* TODO - NEED PROPER ERROR HANDLING HERE
208
+ print * , " IPD init step called without mandatory ccpp_suite argument"
209
+ stop
210
+ end if
211
+
212
+ !- -- Initialize CCPP
213
+ call ccpp_init(ccpp_suite, cdata, ierr)
214
+
215
+ ! Begin include auto-generated list of calls to ccpp_fields_add
216
+ ! DH* #include "ccpp_fields.inc"
217
+ ! End include auto-generated list of calls to ccpp_fields_add
218
+
219
+ !- -- Add the DDTs to the CCPP data structure
220
+ call ccpp_fields_add(cdata, ' IPD_Control' , ' ' , c_loc(IPD_Control), &
221
+ ierr= ierr)
222
+ call ccpp_fields_add(cdata, ' IPD_Data' , ' ' , c_loc(IPD_Data), &
223
+ size (IPD_Data), shape (IPD_Data), ierr)
224
+ call ccpp_fields_add(cdata, ' IPD_Diag' , ' ' , c_loc(IPD_Diag), &
225
+ size (IPD_Diag), shape (IPD_Diag), ierr)
226
+ call ccpp_fields_add(cdata, ' IPD_Restart' , ' ' , c_loc(IPD_Restart), ierr= ierr)
227
+ call ccpp_fields_add(cdata, ' Atm_block' , ' ' , c_loc(Atm_block), ierr= ierr)
228
+ call ccpp_fields_add(cdata, ' Init_parm' , ' ' , c_loc(Init_parm), ierr= ierr)
229
+ call ccpp_fields_add(cdata, ' nblks' , Atm_block% nblks, ierr, ' ' )
230
+ call ccpp_fields_add(cdata, ' salp_data' , l_salp_data, ierr)
231
+ call ccpp_fields_add(cdata, ' snupx' , l_snupx, ierr)
232
+
233
+ call ccpp_run(cdata% suite% init, cdata, ierr)
234
+ ! else if (step==X) then
235
+ ! !--- Finalize CCPP
236
+ ! call ccpp_init(ccpp_suite, cdata, ierr)
237
+ else
238
+ call ccpp_run(cdata% suite% ipds(1 )% subcycles(1 )% schemes(step), cdata, ierr)
239
+ end if
240
+ end subroutine IPD_step
241
+ #endif
242
+
243
+
141
244
end module IPD_driver
0 commit comments