forked from wrf-model/WRF
-
Notifications
You must be signed in to change notification settings - Fork 0
/
mediation_wrfmain.F
266 lines (216 loc) · 8.32 KB
/
mediation_wrfmain.F
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
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
!WRF:MEDIATION_LAYER:
!
SUBROUTINE med_initialdata_input_ptr ( grid , config_flags )
USE module_domain
USE module_configure
IMPLICIT NONE
TYPE (domain) , POINTER :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
INTERFACE
SUBROUTINE med_initialdata_input ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
END SUBROUTINE med_initialdata_input
END INTERFACE
CALL med_initialdata_input ( grid , config_flags )
END SUBROUTINE med_initialdata_input_ptr
SUBROUTINE med_initialdata_input ( grid , config_flags )
! Driver layer
USE module_domain
USE module_io_domain
USE module_timing
use module_io
! Model layer
USE module_configure
USE module_bc_time_utilities
USE module_utility
IMPLICIT NONE
! Interface
INTERFACE
SUBROUTINE start_domain ( grid , allowed_to_read ) ! comes from module_start in appropriate dyn_ directory
USE module_domain
TYPE (domain) grid
LOGICAL, INTENT(IN) :: allowed_to_read
END SUBROUTINE start_domain
END INTERFACE
! Arguments
TYPE(domain) :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
! Local
INTEGER :: fid , ierr , myproc
CHARACTER (LEN=256) :: inpname , rstname, timestr
CHARACTER (LEN=80) :: message
LOGICAL :: restart
LOGICAL, EXTERNAL :: wrf_dm_on_monitor
#if (WRFPLUS == 1)
INTEGER :: save_dyn_opt
#endif
CALL nl_get_restart( 1, restart )
IF ( .NOT. restart ) THEN
! Initialize the mother domain.
grid%input_from_file = .true.
IF ( grid%input_from_file ) THEN
CALL wrf_debug ( 1 , 'wrf main: calling open_r_dataset for wrfinput' )
IF ( wrf_dm_on_monitor() ) CALL start_timing
! typically <date> will not be part of input_inname but allow for it
CALL domain_clock_get( grid, current_timestr=timestr )
CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
IF ( ierr .NE. 0 ) THEN
WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
CALL WRF_ERROR_FATAL ( wrf_err_message )
ENDIF
! registry-generated code that reads the variable set defined on a given stream
#include "fine_stream_input.inc"
CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
IF ( wrf_dm_on_monitor() ) THEN
WRITE ( message , FMT = '("processing wrfinput file (stream 0) for domain ",I8)' ) grid%id
CALL end_timing ( TRIM(message) )
ENDIF
!gmm add input for noamp hydro model here
IF ( config_flags%opt_run.eq.5 ) THEN
CALL construct_filename2a ( inpname , config_flags%auxinput7_inname &
,grid%id , 2 , timestr)
if( grid%auxinput7_oid .NE. 0 ) then
CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
endif
CALL open_r_dataset ( grid%auxinput7_oid, TRIM(inpname) , grid , config_flags , "DATASET=AUXINPUT7", ierr )
! call set_first_operation(grid%auxinput6_oid)
IF ( ierr .NE. 0 ) THEN
WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
CALL WRF_ERROR_FATAL ( wrf_err_message )
ENDIF
CALL wrf_debug ( 0 , 'med_initialdata_input: calling input_aux_model_input7' )
CALL input_auxinput7 ( grid%auxinput7_oid , grid , config_flags , ierr )
CALL wrf_debug ( 100 , 'med_initialdata_input: back from input_aux_model_input7' )
CALL close_dataset ( grid%auxinput7_oid , config_flags , "DATASET=AUXINPUT7" )
ENDIF
!gmm
#ifdef MOVE_NESTS
#if ( EM_CORE == 1 )
grid%nest_pos = grid%ht
where ( grid%nest_pos .gt. 0 ) grid%nest_pos = grid%nest_pos + 500. ! make a cliff
#endif
#endif
ENDIF
grid%imask_nostag = 1
grid%imask_xstag = 1
grid%imask_ystag = 1
grid%imask_xystag = 1
#if (EM_CORE == 1)
grid%press_adj = .FALSE.
#endif
#if (WRFPLUS == 1)
! if calling start_domain here, we always want it be called as NLM
save_dyn_opt = model_config_rec%dyn_opt
model_config_rec%dyn_opt = dyn_em
IF ( model_config_rec%dyn_opt .NE. dyn_em_check ) &
#endif
CALL start_domain ( grid , .TRUE. )
#if (WRFPLUS == 1)
model_config_rec%dyn_opt = save_dyn_opt
#endif
ELSE
IF ( wrf_dm_on_monitor() ) CALL start_timing
CALL domain_clock_get( grid, current_timestr=timestr )
CALL construct_filename2a ( rstname , config_flags%rst_inname , grid%id , 2 , timestr )
WRITE(message,*)'RESTART run: opening ',TRIM(rstname),' for reading'
CALL wrf_message ( message )
CALL open_r_dataset ( fid , TRIM(rstname) , grid , config_flags , "DATASET=RESTART", ierr )
IF ( ierr .NE. 0 ) THEN
WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
CALL WRF_ERROR_FATAL ( message )
ENDIF
CALL input_restart ( fid, grid , config_flags , ierr )
CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
IF ( wrf_dm_on_monitor() ) THEN
WRITE ( message , FMT = '("processing restart file for domain ",I8)' ) grid%id
CALL end_timing ( TRIM(message) )
ENDIF
grid%imask_nostag = 1
grid%imask_xstag = 1
grid%imask_ystag = 1
grid%imask_xystag = 1
#if (EM_CORE == 1)
grid%press_adj = .FALSE.
#endif
CALL start_domain ( grid , .TRUE. )
ENDIF
RETURN
END SUBROUTINE med_initialdata_input
SUBROUTINE med_shutdown_io ( grid , config_flags )
! Driver layer
USE module_domain
USE module_io_domain
! Model layer
USE module_configure
USE module_dm, ONLY : domain_active_this_task
IMPLICIT NONE
INTERFACE
RECURSIVE SUBROUTINE med_shutdown_io_recurse ( grid , config_flags )
USE module_domain
USE module_configure
TYPE (domain) , POINTER :: grid
TYPE (grid_config_rec_type), INTENT(IN) :: config_flags
END SUBROUTINE med_shutdown_io_recurse
END INTERFACE
! Arguments
TYPE(domain), TARGET :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
! Local
TYPE(domain),POINTER :: grid_ptr
CHARACTER (LEN=80) :: message
INTEGER :: id, ierr
IF ( grid%lbc_fid > 0 ) CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
grid_ptr => grid
CALL med_shutdown_io_recurse ( grid_ptr , config_flags )
CALL wrf_ioexit( ierr ) ! shut down the quilt I/O
RETURN
END SUBROUTINE med_shutdown_io
RECURSIVE SUBROUTINE med_shutdown_io_recurse ( grid , config_flags )
! Driver layer
USE module_domain
USE module_io_domain
! Model layer
USE module_configure
IMPLICIT NONE
! Arguments
TYPE(domain), POINTER :: grid
TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
! Local
TYPE(domain), POINTER :: grid_ptr
CHARACTER (LEN=80) :: message
INTEGER :: kid
INTEGER :: ierr
IF ( ASSOCIATED( grid ) ) THEN
CALL push_communicators_for_domain(grid%id)
IF ( grid%oid > 0 ) CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" )
! registry generated closes for auxhist streams
# include "shutdown_closes.inc"
grid_ptr => grid
DO WHILE ( ASSOCIATED( grid_ptr ) )
DO kid = 1, max_nests
IF ( ASSOCIATED( grid_ptr%nests(kid)%ptr ) ) THEN
CALL med_shutdown_io_recurse ( grid_ptr%nests(kid)%ptr, config_flags )
ENDIF
ENDDO
grid_ptr => grid_ptr%sibling
ENDDO
CALL pop_communicators_for_domain
ENDIF
RETURN
END SUBROUTINE med_shutdown_io_recurse
SUBROUTINE med_add_config_info_to_grid ( grid )
USE module_domain
USE module_configure
IMPLICIT NONE
! Input data.
TYPE(domain) , TARGET :: grid
#define SOURCE_RECORD model_config_rec %
#define SOURCE_REC_DEX (grid%id)
#define DEST_RECORD grid %
#include "config_assigns.inc"
RETURN
END SUBROUTINE med_add_config_info_to_grid