ndown_em.F
References to this file elsewhere.
1 !WRF:DRIVER_LAYER:MAIN
2 !
3
4 PROGRAM ndown_em
5
6 USE module_machine
7 USE module_domain
8 USE module_initialize
9 USE module_integrate
10 USE module_driver_constants
11 USE module_configure
12 USE module_io_domain
13 USE module_utility
14
15 USE module_timing
16 USE module_wrf_error
17 #ifdef DM_PARALLEL
18 USE module_dm
19 #endif
20
21 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
22 !new for bc
23 USE module_bc
24 USE module_big_step_utilities_em
25 USE module_get_file_names
26 #ifdef WRF_CHEM
27 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
28 ! for chemistry
29 USE module_input_chem_data
30 ! USE module_input_chem_bioemiss
31 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32 #endif
33
34 IMPLICIT NONE
35 ! interface
36 INTERFACE
37 ! mediation-supplied
38 SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
39 USE module_domain
40 TYPE (domain) grid
41 TYPE (grid_config_rec_type) config_flags
42 END SUBROUTINE med_read_wrf_chem_bioemiss
43
44 SUBROUTINE init_domain_constants_em_ptr ( parent , nest )
45 USE module_domain
46 USE module_configure
47 TYPE(domain), POINTER :: parent , nest
48 END SUBROUTINE init_domain_constants_em_ptr
49
50 END INTERFACE
51
52
53
54 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
55 !new for bc
56 INTEGER :: ids , ide , jds , jde , kds , kde
57 INTEGER :: ims , ime , jms , jme , kms , kme
58 INTEGER :: ips , ipe , jps , jpe , kps , kpe
59 INTEGER :: its , ite , jts , jte , kts , kte
60 INTEGER :: spec_bdy_width
61 INTEGER :: i , j , k , nvchem
62 INTEGER :: time_loop_max , time_loop
63 INTEGER :: total_time_sec , file_counter
64 INTEGER :: julyr , julday , iswater , map_proj
65 INTEGER :: icnt
66
67 REAL :: dt , new_bdy_frq
68 REAL :: gmt , cen_lat , cen_lon , dx , dy , truelat1 , truelat2 , moad_cen_lat , stand_lon
69
70 REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp1 , vbdy3dtemp1 , tbdy3dtemp1 , pbdy3dtemp1 , qbdy3dtemp1
71 REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp1
72 REAL , DIMENSION(:,:,:) , ALLOCATABLE :: ubdy3dtemp2 , vbdy3dtemp2 , tbdy3dtemp2 , pbdy3dtemp2 , qbdy3dtemp2
73 REAL , DIMENSION(:,:,:) , ALLOCATABLE :: mbdy2dtemp2
74 REAL , DIMENSION(:,:,:) , ALLOCATABLE :: cbdy3dtemp1 , cbdy3dtemp2
75 REAL , DIMENSION(:,:,:,:) , ALLOCATABLE :: cbdy3dtemp0
76
77 CHARACTER(LEN=19) :: start_date_char , current_date_char , end_date_char
78 CHARACTER(LEN=19) :: stopTimeStr
79
80 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
81
82 INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
83
84 REAL :: time
85 INTEGER :: rc
86
87 INTEGER :: loop , levels_to_process
88 INTEGER , PARAMETER :: max_sanity_file_loop = 100
89
90 TYPE (domain) , POINTER :: keep_grid, grid_ptr, null_domain, parent_grid , nested_grid
91 TYPE (domain) :: dummy
92 TYPE (grid_config_rec_type) :: config_flags
93 INTEGER :: number_at_same_level
94 INTEGER :: time_step_begin_restart
95
96 INTEGER :: max_dom , domain_id , fid , fido, fidb , oid , idum1 , idum2 , ierr
97 INTEGER :: status_next_var
98 INTEGER :: debug_level
99 LOGICAL :: input_from_file , need_new_file
100 CHARACTER (LEN=19) :: date_string
101
102 #ifdef DM_PARALLEL
103 INTEGER :: nbytes
104 INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
105 INTEGER :: configbuf( configbuflen )
106 LOGICAL , EXTERNAL :: wrf_dm_on_monitor
107 #endif
108
109 INTEGER :: idsi
110 CHARACTER (LEN=80) :: inpname , outname , bdyname
111 CHARACTER (LEN=80) :: si_inpname
112 character *19 :: temp19
113 character *24 :: temp24 , temp24b
114 character(len=24) :: start_date_hold
115
116 CHARACTER (LEN=80) :: message
117 integer :: ii
118
119 #include "version_decl"
120
121 ! Interface block for routine that passes pointers and needs to know that they
122 ! are receiving pointers.
123
124 INTERFACE
125
126 SUBROUTINE med_interp_domain ( parent_grid , nested_grid )
127 USE module_domain
128 USE module_configure
129 TYPE(domain), POINTER :: parent_grid , nested_grid
130 END SUBROUTINE med_interp_domain
131
132 SUBROUTINE Setup_Timekeeping( parent_grid )
133 USE module_domain
134 TYPE(domain), POINTER :: parent_grid
135 END SUBROUTINE Setup_Timekeeping
136
137 END INTERFACE
138
139 ! Define the name of this program (program_name defined in module_domain)
140
141 program_name = "NDOWN_EM " // TRIM(release_version) // " PREPROCESSOR"
142
143 #ifdef DM_PARALLEL
144 CALL disable_quilting
145 #endif
146
147 ! Initialize the modules used by the WRF system. Many of the CALLs made from the
148 ! init_modules routine are NO-OPs. Typical initializations are: the size of a
149 ! REAL, setting the file handles to a pre-use value, defining moisture and
150 ! chemistry indices, etc.
151
152 CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
153 CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc )
154 CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
155
156 ! Get the NAMELIST data. This is handled in the initial_config routine. All of the
157 ! NAMELIST input variables are assigned to the model_config_rec structure. Below,
158 ! note for parallel processing, only the monitor processor handles the raw Fortran
159 ! I/O, and then broadcasts the info to each of the other nodes.
160
161 #ifdef DM_PARALLEL
162 IF ( wrf_dm_on_monitor() ) THEN
163 CALL initial_config
164 ENDIF
165 CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
166 CALL wrf_dm_bcast_bytes( configbuf, nbytes )
167 CALL set_config_as_buffer( configbuf, configbuflen )
168 CALL wrf_dm_initialize
169 #else
170 CALL initial_config
171 #endif
172
173 ! And here is an instance of using the information in the NAMELIST.
174
175 CALL nl_get_debug_level ( 1, debug_level )
176 CALL set_wrf_debug_level ( debug_level )
177
178 ! Allocated and configure the mother domain. Since we are in the nesting down
179 ! mode, we know a) we got a nest, and b) we only got 1 nest.
180
181 NULLIFY( null_domain )
182
183 CALL wrf_message ( program_name )
184 CALL wrf_debug ( 100 , 'ndown_em: calling alloc_and_configure_domain coarse ' )
185 CALL alloc_and_configure_domain ( domain_id = 1 , &
186 grid = head_grid , &
187 parent = null_domain , &
188 kid = -1 )
189
190 parent_grid => head_grid
191
192 ! Set up time initializations.
193
194 CALL Setup_Timekeeping ( parent_grid )
195
196 CALL domain_clock_set( head_grid, &
197 time_step_seconds=model_config_rec%interval_seconds )
198 CALL wrf_debug ( 100 , 'ndown_em: calling model_to_grid_config_rec ' )
199 CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
200 CALL wrf_debug ( 100 , 'ndown_em: calling set_scalar_indices_from_config ' )
201 CALL set_scalar_indices_from_config ( parent_grid%id , idum1, idum2 )
202
203 ! Initialize the I/O for WRF.
204
205 CALL wrf_debug ( 100 , 'ndown_em: calling init_wrfio' )
206 CALL init_wrfio
207
208 ! Some of the configuration values may have been modified from the initial READ
209 ! of the NAMELIST, so we re-broadcast the configuration records.
210
211 #ifdef DM_PARALLEL
212 CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
213 CALL wrf_dm_bcast_bytes( configbuf, nbytes )
214 CALL set_config_as_buffer( configbuf, configbuflen )
215 #endif
216
217 ! We need to current and starting dates for the output files. The times need to be incremented
218 ! so that the lateral BC files are not overwritten.
219
220 WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
221 model_config_rec%start_year (parent_grid%id) , &
222 model_config_rec%start_month (parent_grid%id) , &
223 model_config_rec%start_day (parent_grid%id) , &
224 model_config_rec%start_hour (parent_grid%id) , &
225 model_config_rec%start_minute(parent_grid%id) , &
226 model_config_rec%start_second(parent_grid%id)
227
228 WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
229 model_config_rec% end_year (parent_grid%id) , &
230 model_config_rec% end_month (parent_grid%id) , &
231 model_config_rec% end_day (parent_grid%id) , &
232 model_config_rec% end_hour (parent_grid%id) , &
233 model_config_rec% end_minute(parent_grid%id) , &
234 model_config_rec% end_second(parent_grid%id)
235
236 ! Override stop time with value computed above.
237 CALL domain_clock_set( parent_grid, stop_timestr=end_date_char )
238
239 CALL geth_idts ( end_date_char , start_date_char , total_time_sec )
240
241 new_bdy_frq = model_config_rec%interval_seconds
242 time_loop_max = total_time_sec / model_config_rec%interval_seconds + 1
243
244 start_date = start_date_char // '.0000'
245 current_date = start_date_char // '.0000'
246 start_date_hold = start_date_char // '.0000'
247 current_date_char = start_date_char
248
249 ! Get a list of available file names to try. This fills up the eligible_file_name
250 ! array with number_of_eligible_files entries. This routine issues a nonstandard
251 ! call (system).
252
253 file_counter = 1
254 need_new_file = .FALSE.
255 CALL unix_ls ( 'wrfout' , parent_grid%id )
256
257 ! Open the input data (wrfout_d01_xxxxxx) for reading.
258
259 CALL wrf_debug ( 100 , 'ndown_em main: calling open_r_dataset for ' // TRIM(eligible_file_name(file_counter)) )
260 CALL open_r_dataset ( fid, TRIM(eligible_file_name(file_counter)) , head_grid , config_flags , "DATASET=AUXINPUT1", ierr )
261 IF ( ierr .NE. 0 ) THEN
262 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(eligible_file_name(file_counter)), &
263 ' for reading ierr=',ierr
264 CALL WRF_ERROR_FATAL ( wrf_err_message )
265 ENDIF
266
267 ! We know how many time periods to process, so we begin.
268
269 big_time_loop_thingy : DO time_loop = 1 , time_loop_max
270
271 ! Which date are we currently soliciting?
272
273 CALL geth_newdate ( date_string , start_date_char , ( time_loop - 1 ) * NINT ( new_bdy_frq) )
274 print *,'-------->>> Processing data: loop=',time_loop,' date/time = ',date_string
275 current_date_char = date_string
276 current_date = date_string // '.0000'
277 start_date = date_string // '.0000'
278 print *,'loopmax = ', time_loop_max, ' ending date = ',end_date_char
279 CALL domain_clock_set( parent_grid, &
280 current_timestr=current_date(1:19) )
281
282 ! Which times are in this file, and more importantly, are any of them the
283 ! ones that we want? We need to loop over times in each files, loop
284 ! over files.
285
286 get_the_right_time : DO
287
288 CALL wrf_get_next_time ( fid , date_string , status_next_var )
289 print *,'file date/time = ',date_string,' desired date = ',current_date_char,' status = ', status_next_var
290
291 IF ( status_next_var .NE. 0 ) THEN
292 CALL wrf_debug ( 100 , 'ndown_em main: calling close_dataset for ' // TRIM(eligible_file_name(file_counter)) )
293 CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
294 file_counter = file_counter + 1
295 IF ( file_counter .GT. number_of_eligible_files ) THEN
296 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: opening too many files'
297 CALL WRF_ERROR_FATAL ( wrf_err_message )
298 END IF
299 CALL wrf_debug ( 100 , 'ndown_em main: calling open_r_dataset for ' // TRIM(eligible_file_name(file_counter)) )
300 CALL open_r_dataset ( fid, TRIM(eligible_file_name(file_counter)) , head_grid , config_flags , "DATASET=INPUT", ierr )
301 IF ( ierr .NE. 0 ) THEN
302 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(eligible_file_name(file_counter)), &
303 ' for reading ierr=',ierr
304 CALL WRF_ERROR_FATAL ( wrf_err_message )
305 ENDIF
306 CYCLE get_the_right_time
307 ELSE IF ( TRIM(date_string) .LT. TRIM(current_date_char) ) THEN
308 CYCLE get_the_right_time
309 ELSE IF ( TRIM(date_string) .EQ. TRIM(current_date_char) ) THEN
310 EXIT get_the_right_time
311 ELSE IF ( TRIM(date_string) .GT. TRIM(current_date_char) ) THEN
312 WRITE( wrf_err_message , FMT='(A,A,A,A,A)' ) 'Found ',TRIM(date_string),' before I found ',TRIM(current_date_char),'.'
313 CALL WRF_ERROR_FATAL ( wrf_err_message )
314 END IF
315 END DO get_the_right_time
316
317 CALL wrf_debug ( 100 , 'wrf: calling input_history' )
318 CALL wrf_get_previous_time ( fid , date_string , status_next_var )
319 CALL input_history ( fid , head_grid , config_flags, ierr )
320 CALL wrf_debug ( 100 , 'wrf: back from input_history' )
321
322 ! Get the coarse grid info for later transfer to the fine grid domain.
323
324 CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' , map_proj , 1 , icnt , ierr )
325 CALL wrf_get_dom_ti_real ( fid , 'DX' , dx , 1 , icnt , ierr )
326 CALL wrf_get_dom_ti_real ( fid , 'DY' , dy , 1 , icnt , ierr )
327 CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , cen_lat , 1 , icnt , ierr )
328 CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , cen_lon , 1 , icnt , ierr )
329 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' , truelat1 , 1 , icnt , ierr )
330 CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' , truelat2 , 1 , icnt , ierr )
331 CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , icnt , ierr )
332 CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' , stand_lon , 1 , icnt , ierr )
333 ! CALL wrf_get_dom_ti_real ( fid , 'GMT' , gmt , 1 , icnt , ierr )
334 ! CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , julyr , 1 , icnt , ierr )
335 ! CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , julday , 1 , icnt , ierr )
336 CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , iswater , 1 , icnt , ierr )
337
338 ! First time in, do this: allocate sapce for the fine grid, get the config flags, open the
339 ! wrfinput and wrfbdy files. This COULD be done outside the time loop, I think, so check it
340 ! out and move it up if you can.
341
342 IF ( time_loop .EQ. 1 ) THEN
343
344 CALL wrf_message ( program_name )
345 CALL wrf_debug ( 100 , 'wrf: calling alloc_and_configure_domain fine ' )
346 CALL alloc_and_configure_domain ( domain_id = 2 , &
347 grid = nested_grid , &
348 parent = parent_grid , &
349 kid = 1 )
350
351 CALL wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' )
352 CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
353 CALL wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' )
354 CALL set_scalar_indices_from_config ( nested_grid%id , idum1, idum2 )
355
356 ! Set up time initializations for the fine grid.
357
358 CALL Setup_Timekeeping ( nested_grid )
359 ! Strictly speaking, nest stop time should come from model_config_rec...
360 CALL domain_clock_get( parent_grid, stop_timestr=stopTimeStr )
361 CALL domain_clock_set( nested_grid, &
362 current_timestr=current_date(1:19), &
363 stop_timestr=stopTimeStr , &
364 time_step_seconds= &
365 model_config_rec%interval_seconds )
366
367 ! Generate an output file from this program, which will be an input file to WRF.
368
369 CALL nl_set_bdyfrq ( nested_grid%id , new_bdy_frq )
370 config_flags%bdyfrq = new_bdy_frq
371
372 #ifdef WRF_CHEM
373 nested_grid%chem_opt = parent_grid%chem_opt
374 nested_grid%chem_in_opt = parent_grid%chem_in_opt
375 #endif
376
377 ! Initialize constants and 1d arrays in fine grid from the parent.
378
379 CALL init_domain_constants_em_ptr ( parent_grid , nested_grid )
380
381 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
382
383 CALL wrf_debug ( 100 , 'ndown_em main: calling open_w_dataset for wrfinput' )
384 CALL construct_filename1( outname , 'wrfinput' , nested_grid%id , 2 )
385 CALL open_w_dataset ( fido, TRIM(outname) , nested_grid , config_flags , output_model_input , "DATASET=INPUT", ierr )
386 IF ( ierr .NE. 0 ) THEN
387 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(outname),' for reading ierr=',ierr
388 CALL WRF_ERROR_FATAL ( wrf_err_message )
389 ENDIF
390
391 ! Various sizes that we need to be concerned about.
392
393 ids = nested_grid%sd31
394 ide = nested_grid%ed31
395 kds = nested_grid%sd32
396 kde = nested_grid%ed32
397 jds = nested_grid%sd33
398 jde = nested_grid%ed33
399
400 ims = nested_grid%sm31
401 ime = nested_grid%em31
402 kms = nested_grid%sm32
403 kme = nested_grid%em32
404 jms = nested_grid%sm33
405 jme = nested_grid%em33
406
407 ips = nested_grid%sp31
408 ipe = nested_grid%ep31
409 kps = nested_grid%sp32
410 kpe = nested_grid%ep32
411 jps = nested_grid%sp33
412 jpe = nested_grid%ep33
413
414
415 print *, ids , ide , jds , jde , kds , kde
416 print *, ims , ime , jms , jme , kms , kme
417 print *, ips , ipe , jps , jpe , kps , kpe
418
419 spec_bdy_width = model_config_rec%spec_bdy_width
420 print *,'spec_bdy_width=',spec_bdy_width
421
422 ! This is the space needed to save the current 3d data for use in computing
423 ! the lateral boundary tendencies.
424
425 ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
426 ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
427 ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
428 ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
429 ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
430 ALLOCATE ( mbdy2dtemp1(ims:ime,1:1, jms:jme) )
431 ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
432 ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
433 ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
434 ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
435 ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
436 ALLOCATE ( mbdy2dtemp2(ims:ime,1:1, jms:jme) )
437 ALLOCATE ( cbdy3dtemp0(ims:ime,kms:kme,jms:jme,1:num_chem) )
438 ALLOCATE ( cbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
439 ALLOCATE ( cbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
440
441 END IF
442
443 CALL domain_clock_set( nested_grid, &
444 current_timestr=current_date(1:19), &
445 time_step_seconds= &
446 model_config_rec%interval_seconds )
447
448 ! Do the horizontal interpolation.
449
450 nested_grid%imask_nostag = 1
451 nested_grid%imask_xstag = 1
452 nested_grid%imask_ystag = 1
453 nested_grid%imask_xystag = 1
454 CALL med_interp_domain ( head_grid , nested_grid )
455 nested_grid%ht_int = nested_grid%ht
456
457 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
458
459 IF ( time_loop .EQ. 1 ) THEN
460
461 ! Open the fine grid SI static file.
462
463 CALL construct_filename1( si_inpname , 'wrfndi' , nested_grid%id , 2 )
464 CALL wrf_debug ( 100 , 'med_sidata_input: calling open_r_dataset for ' // TRIM(si_inpname) )
465 CALL open_r_dataset ( idsi, TRIM(si_inpname) , nested_grid , config_flags , "DATASET=INPUT", ierr )
466 IF ( ierr .NE. 0 ) THEN
467 CALL wrf_error_fatal( 'real: error opening FG input for reading: ' // TRIM (si_inpname) )
468 END IF
469
470 ! Input data.
471
472 CALL wrf_debug ( 100 , 'ndown_em: calling input_aux_model_input2' )
473 CALL input_aux_model_input2 ( idsi , nested_grid , config_flags , ierr )
474 nested_grid%ht_input = nested_grid%ht
475
476 ! Close this fine grid static input file.
477
478 CALL wrf_debug ( 100 , 'ndown_em: closing fine grid static input' )
479 CALL close_dataset ( idsi , config_flags , "DATASET=INPUT" )
480
481 ! We need a fine grid landuse in the interpolation. So we need to generate
482 ! that field now.
483
484 IF ( ( nested_grid%ivgtyp(ips,jps) .GT. 0 ) .AND. &
485 ( nested_grid%isltyp(ips,jps) .GT. 0 ) ) THEN
486 DO j = jps, MIN(jde-1,jpe)
487 DO i = ips, MIN(ide-1,ipe)
488 nested_grid% vegcat(i,j) = nested_grid%ivgtyp(i,j)
489 nested_grid%soilcat(i,j) = nested_grid%isltyp(i,j)
490 END DO
491 END DO
492
493 ELSE IF ( ( nested_grid% vegcat(ips,jps) .GT. 0.5 ) .AND. &
494 ( nested_grid%soilcat(ips,jps) .GT. 0.5 ) ) THEN
495 DO j = jps, MIN(jde-1,jpe)
496 DO i = ips, MIN(ide-1,ipe)
497 nested_grid%ivgtyp(i,j) = NINT(nested_grid% vegcat(i,j))
498 nested_grid%isltyp(i,j) = NINT(nested_grid%soilcat(i,j))
499 END DO
500 END DO
501
502 ELSE
503 num_veg_cat = SIZE ( nested_grid%landusef , DIM=2 )
504 num_soil_top_cat = SIZE ( nested_grid%soilctop , DIM=2 )
505 num_soil_bot_cat = SIZE ( nested_grid%soilcbot , DIM=2 )
506
507 CALL land_percentages ( nested_grid%xland , &
508 nested_grid%landusef , nested_grid%soilctop , nested_grid%soilcbot , &
509 nested_grid%isltyp , nested_grid%ivgtyp , &
510 num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
511 ids , ide , jds , jde , kds , kde , &
512 ims , ime , jms , jme , kms , kme , &
513 ips , ipe , jps , jpe , kps , kpe , &
514 model_config_rec%iswater(nested_grid%id) )
515
516 END IF
517
518 DO j = jps, MIN(jde-1,jpe)
519 DO i = ips, MIN(ide-1,ipe)
520 nested_grid%lu_index(i,j) = nested_grid%ivgtyp(i,j)
521 END DO
522 END DO
523
524 CALL check_consistency ( nested_grid%ivgtyp , nested_grid%isltyp , nested_grid%landmask , &
525 ids , ide , jds , jde , kds , kde , &
526 ims , ime , jms , jme , kms , kme , &
527 ips , ipe , jps , jpe , kps , kpe , &
528 model_config_rec%iswater(nested_grid%id) )
529
530 CALL check_consistency2( nested_grid%ivgtyp , nested_grid%isltyp , nested_grid%landmask , &
531 nested_grid%tmn , nested_grid%tsk , nested_grid%sst , nested_grid%xland , &
532 nested_grid%tslb , nested_grid%smois , nested_grid%sh2o , &
533 config_flags%num_soil_layers , nested_grid%id , &
534 ids , ide , jds , jde , kds , kde , &
535 ims , ime , jms , jme , kms , kme , &
536 ips , ipe , jps , jpe , kps , kpe , &
537 model_config_rec%iswater(nested_grid%id) )
538
539 END IF
540
541 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
542
543 ! We have 2 terrain elevations. One is from input and the other is from the
544 ! the horizontal interpolation.
545
546 nested_grid%ht_fine = nested_grid%ht_input
547 nested_grid%ht = nested_grid%ht_int
548
549 ! We have both the interpolated fields and the higher-resolution static fields. From these
550 ! the rebalancing is now done. Note also that the field nested_grid%ht is now from the
551 ! fine grid input file (after this call is completed).
552
553 CALL rebalance_driver ( nested_grid )
554
555 ! Different things happen during the different time loops:
556 ! first loop - write wrfinput file, close data set, copy files to holder arrays
557 ! middle loops - diff 3d/2d arrays, compute and output bc
558 ! last loop - diff 3d/2d arrays, compute and output bc, write wrfbdy file, close wrfbdy file
559
560 IF ( time_loop .EQ. 1 ) THEN
561
562 ! Set the time info.
563
564 print *,'current_date = ',current_date
565 CALL domain_clock_set( nested_grid, &
566 current_timestr=current_date(1:19) )
567 #ifdef WRF_CHEM
568 !
569 ! SEP Put in chemistry data
570 !
571 IF( nested_grid%chem_opt .NE. 0 ) then
572 ! IF( nested_grid%chem_in_opt .EQ. 0 ) then
573 ! Read the chemistry data from a previous wrf forecast (wrfout file)
574 ! Generate chemistry data from a idealized vertical profile
575 ! message = 'STARTING WITH BACKGROUND CHEMISTRY '
576 CALL wrf_message ( message )
577
578 ! CALL input_chem_profile ( nested_grid )
579
580 if( nested_grid%bio_emiss_opt .eq. 2 )then
581 message = 'READING BEIS3.11 EMISSIONS DATA'
582 CALL wrf_message ( message )
583 CALL med_read_wrf_chem_bioemiss ( nested_grid , config_flags)
584 endif
585 ! ELSE
586 ! message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
587 ! CALL wrf_message ( message )
588 ! ENDIF
589 ENDIF
590 #endif
591
592 ! Output the first time period of the data.
593
594 CALL output_model_input ( fido , nested_grid , config_flags , ierr )
595
596 CALL wrf_put_dom_ti_integer ( fido , 'MAP_PROJ' , map_proj , 1 , ierr )
597 ! CALL wrf_put_dom_ti_real ( fido , 'DX' , dx , 1 , ierr )
598 ! CALL wrf_put_dom_ti_real ( fido , 'DY' , dy , 1 , ierr )
599 CALL wrf_put_dom_ti_real ( fido , 'CEN_LAT' , cen_lat , 1 , ierr )
600 CALL wrf_put_dom_ti_real ( fido , 'CEN_LON' , cen_lon , 1 , ierr )
601 CALL wrf_put_dom_ti_real ( fido , 'TRUELAT1' , truelat1 , 1 , ierr )
602 CALL wrf_put_dom_ti_real ( fido , 'TRUELAT2' , truelat2 , 1 , ierr )
603 CALL wrf_put_dom_ti_real ( fido , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , ierr )
604 CALL wrf_put_dom_ti_real ( fido , 'STAND_LON' , stand_lon , 1 , ierr )
605 CALL wrf_put_dom_ti_integer ( fido , 'ISWATER' , iswater , 1 , ierr )
606
607 ! These change if the initial time for the nest is not the same as the
608 ! first time period in the WRF output file.
609 ! Now that we know the starting date, we need to set the GMT, JULYR, and JULDAY
610 ! values for the global attributes. This call is based on the setting of the
611 ! current_date string.
612
613 CALL geth_julgmt ( julyr , julday , gmt)
614 CALL nl_set_julyr ( nested_grid%id , julyr )
615 CALL nl_set_julday ( nested_grid%id , julday )
616 CALL nl_set_gmt ( nested_grid%id , gmt )
617 CALL wrf_put_dom_ti_real ( fido , 'GMT' , gmt , 1 , ierr )
618 CALL wrf_put_dom_ti_integer ( fido , 'JULYR' , julyr , 1 , ierr )
619 CALL wrf_put_dom_ti_integer ( fido , 'JULDAY' , julday , 1 , ierr )
620 print *,'current_date =',current_date
621 print *,'julyr=',julyr
622 print *,'julday=',julday
623 print *,'gmt=',gmt
624
625 ! Close the input (wrfout_d01_000000, for example) file. That's right, the
626 ! input is an output file. Who'd've thunk.
627
628 CALL close_dataset ( fido , config_flags , "DATASET=INPUT" )
629
630 ! We need to save the 3d/2d data to compute a difference during the next loop. Couple the
631 ! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
632
633 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , ubdy3dtemp1 , nested_grid%em_u_2 , &
634 'u' , nested_grid%msfu , &
635 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
636 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , vbdy3dtemp1 , nested_grid%em_v_2 , &
637 'v' , nested_grid%msfv , &
638 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
639 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , tbdy3dtemp1 , nested_grid%em_t_2 , &
640 't' , nested_grid%msft , &
641 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
642 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , pbdy3dtemp1 , nested_grid%em_ph_2 , &
643 'h' , nested_grid%msft , &
644 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
645 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , qbdy3dtemp1 , nested_grid%moist(:,:,:,P_QV) , &
646 't' , nested_grid%msft , &
647 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
648
649 DO j = jps , jpe
650 DO i = ips , ipe
651 mbdy2dtemp1(i,1,j) = nested_grid%em_mu_2(i,j)
652 END DO
653 END DO
654
655 ! There are 2 components to the lateral boundaries. First, there is the starting
656 ! point of this time period - just the outer few rows and columns.
657
658 CALL stuff_bdy ( ubdy3dtemp1 , nested_grid%em_u_bxs, nested_grid%em_u_bxe, &
659 nested_grid%em_u_bys, nested_grid%em_u_bye, &
660 'U' , spec_bdy_width , &
661 ids , ide , jds , jde , kds , kde , &
662 ims , ime , jms , jme , kms , kme , &
663 ips , ipe , jps , jpe , kps , kpe )
664 CALL stuff_bdy ( vbdy3dtemp1 , nested_grid%em_v_bxs, nested_grid%em_v_bxe, &
665 nested_grid%em_v_bys, nested_grid%em_v_bye, &
666 'V' , spec_bdy_width , &
667 ids , ide , jds , jde , kds , kde , &
668 ims , ime , jms , jme , kms , kme , &
669 ips , ipe , jps , jpe , kps , kpe )
670 CALL stuff_bdy ( tbdy3dtemp1 , nested_grid%em_t_bxs, nested_grid%em_t_bxe, &
671 nested_grid%em_t_bys, nested_grid%em_t_bye, &
672 'T' , spec_bdy_width , &
673 ids , ide , jds , jde , kds , kde , &
674 ims , ime , jms , jme , kms , kme , &
675 ips , ipe , jps , jpe , kps , kpe )
676 CALL stuff_bdy ( pbdy3dtemp1 , nested_grid%em_ph_bxs, nested_grid%em_ph_bxe, &
677 nested_grid%em_ph_bys, nested_grid%em_ph_bye, &
678 'W' , spec_bdy_width , &
679 ids , ide , jds , jde , kds , kde , &
680 ims , ime , jms , jme , kms , kme , &
681 ips , ipe , jps , jpe , kps , kpe )
682 CALL stuff_bdy ( qbdy3dtemp1 , nested_grid%moist_bxs(:,:,:,P_QV), nested_grid%moist_bxe(:,:,:,P_QV), &
683 nested_grid%moist_bys(:,:,:,P_QV), nested_grid%moist_bye(:,:,:,P_QV), &
684 'T' , spec_bdy_width , &
685 ids , ide , jds , jde , kds , kde , &
686 ims , ime , jms , jme , kms , kme , &
687 ips , ipe , jps , jpe , kps , kpe )
688 CALL stuff_bdy ( mbdy2dtemp1 , nested_grid%em_mu_bxs, nested_grid%em_mu_bxe, &
689 nested_grid%em_mu_bys, nested_grid%em_mu_bye, &
690 'M' , spec_bdy_width , &
691 ids , ide , jds , jde , 1 , 1 , &
692 ims , ime , jms , jme , 1 , 1 , &
693 ips , ipe , jps , jpe , 1 , 1 )
694 #ifdef WRF_CHEM
695 do nvchem=1,num_chem
696 ! if(nvchem.eq.p_o3)then
697 ! write(0,*)'fill ch_b',cbdy3dtemp1(5,1,5),nvchem
698 ! endif
699 cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
700 ! if(nvchem.eq.p_o3)then
701 ! write(0,*)'fill ch_b',cbdy3dtemp1(5,1,5)
702 ! endif
703 CALL stuff_bdy ( cbdy3dtemp1 , nested_grid%chem_bxs(:,:,:,nvchem), &
704 nested_grid%chem_bxe(:,:,:,nvchem), &
705 nested_grid%chem_bys(:,:,:,nvchem), &
706 nested_grid%chem_bye(:,:,:,nvchem), &
707 'T' , spec_bdy_width , &
708 ids , ide , jds , jde , kds , kde , &
709 ims , ime , jms , jme , kms , kme , &
710 ips , ipe , jps , jpe , kps , kpe )
711 cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)
712 ! if(nvchem.eq.p_o3)then
713 ! write(0,*)'filled ch_b',time_loop,cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem)
714 ! endif
715 enddo
716 #endif
717 ELSE IF ( ( time_loop .GT. 1 ) .AND. ( time_loop .LT. time_loop_max ) ) THEN
718
719 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , ubdy3dtemp2 , nested_grid%em_u_2 , &
720 'u' , nested_grid%msfu , &
721 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
722 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , vbdy3dtemp2 , nested_grid%em_v_2 , &
723 'v' , nested_grid%msfv , &
724 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
725 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , tbdy3dtemp2 , nested_grid%em_t_2 , &
726 't' , nested_grid%msft , &
727 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
728 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , pbdy3dtemp2 , nested_grid%em_ph_2 , &
729 'h' , nested_grid%msft , &
730 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
731 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , qbdy3dtemp2 , nested_grid%moist(:,:,:,P_QV) , &
732 't' , nested_grid%msft , &
733 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
734
735 DO j = jps , jpe
736 DO i = ips , ipe
737 mbdy2dtemp2(i,1,j) = nested_grid%em_mu_2(i,j)
738 END DO
739 END DO
740
741 ! During all of the loops after the first loop, we first compute the boundary
742 ! tendencies with the current data values and the previously save information
743 ! stored in the *bdy3dtemp1 arrays.
744
745 CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , new_bdy_frq , &
746 nested_grid%em_u_btxs, nested_grid%em_u_btxe , &
747 nested_grid%em_u_btys, nested_grid%em_u_btye , &
748 'U' , &
749 spec_bdy_width , &
750 ids , ide , jds , jde , kds , kde , &
751 ims , ime , jms , jme , kms , kme , &
752 ips , ipe , jps , jpe , kps , kpe )
753 CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , new_bdy_frq , &
754 nested_grid%em_v_btxs, nested_grid%em_v_btxe , &
755 nested_grid%em_v_btys, nested_grid%em_v_btye , &
756 'V' , &
757 spec_bdy_width , &
758 ids , ide , jds , jde , kds , kde , &
759 ims , ime , jms , jme , kms , kme , &
760 ips , ipe , jps , jpe , kps , kpe )
761 CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , new_bdy_frq , &
762 nested_grid%em_t_btxs, nested_grid%em_t_btxe , &
763 nested_grid%em_t_btys, nested_grid%em_t_btye , &
764 'T' , &
765 spec_bdy_width , &
766 ids , ide , jds , jde , kds , kde , &
767 ims , ime , jms , jme , kms , kme , &
768 ips , ipe , jps , jpe , kps , kpe )
769 CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , new_bdy_frq , &
770 nested_grid%em_ph_btxs, nested_grid%em_ph_btxe , &
771 nested_grid%em_ph_btys, nested_grid%em_ph_btye , &
772 'W' , &
773 spec_bdy_width , &
774 ids , ide , jds , jde , kds , kde , &
775 ims , ime , jms , jme , kms , kme , &
776 ips , ipe , jps , jpe , kps , kpe )
777 CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , new_bdy_frq , &
778 nested_grid%moist_btxs(:,:,:,P_QV), nested_grid%moist_btxe(:,:,:,P_QV), &
779 nested_grid%moist_btys(:,:,:,P_QV), nested_grid%moist_btye(:,:,:,P_QV), &
780 'T' , &
781 spec_bdy_width , &
782 ids , ide , jds , jde , kds , kde , &
783 ims , ime , jms , jme , kms , kme , &
784 ips , ipe , jps , jpe , kps , kpe )
785 CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , new_bdy_frq , &
786 nested_grid%em_mu_btxs, nested_grid%em_mu_btxe , &
787 nested_grid%em_mu_btys, nested_grid%em_mu_btye , &
788 'M' , &
789 spec_bdy_width , &
790 ids , ide , jds , jde , 1 , 1 , &
791 ims , ime , jms , jme , 1 , 1 , &
792 ips , ipe , jps , jpe , 1 , 1 )
793 #ifdef WRF_CHEM
794 do nvchem=1,num_chem
795 cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)
796 cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
797 ! if(nvchem.eq.p_o3)then
798 ! write(0,*)'fill 1ch_b2',time_loop,cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
799 ! endif
800 CALL stuff_bdytend ( cbdy3dtemp2 , cbdy3dtemp1 , new_bdy_frq , &
801 nested_grid%chem_btxs(:,:,:,nvchem), nested_grid%chem_btxe(:,:,:,nvchem), &
802 nested_grid%chem_btys(:,:,:,nvchem), nested_grid%chem_btye(:,:,:,nvchem), &
803 'T' , &
804 spec_bdy_width , &
805 ids , ide , jds , jde , kds , kde , &
806 ims , ime , jms , jme , kms , kme , &
807 ips , ipe , jps , jpe , kps , kpe )
808 cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe)
809 ! if(nvchem.eq.p_o3)then
810 ! write(0,*)'fill 2ch_b2',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
811 ! endif
812 enddo
813 #endif
814 IF ( time_loop .EQ. 2 ) THEN
815
816 ! Generate an output file from this program, which will be an input file to WRF.
817
818 CALL wrf_debug ( 100 , 'ndown_em main: calling open_w_dataset for wrfbdy' )
819 CALL construct_filename1( bdyname , 'wrfbdy' , nested_grid%id , 2 )
820 CALL open_w_dataset ( fidb, TRIM(bdyname) , nested_grid , config_flags , output_boundary , &
821 "DATASET=BOUNDARY", ierr )
822 IF ( ierr .NE. 0 ) THEN
823 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(bdyname),' for reading ierr=',ierr
824 CALL WRF_ERROR_FATAL ( wrf_err_message )
825 ENDIF
826
827 END IF
828
829 ! Both pieces of the boundary data are now available to be written.
830
831 CALL domain_clock_set( nested_grid, &
832 current_timestr=current_date(1:19) )
833 temp24= current_date
834 temp24b=start_date_hold
835 start_date = start_date_hold
836 CALL geth_newdate ( temp19 , temp24b(1:19) , (time_loop-2) * model_config_rec%interval_seconds )
837 current_date = temp19 // '.0000'
838 CALL geth_julgmt ( julyr , julday , gmt)
839 CALL nl_set_julyr ( nested_grid%id , julyr )
840 CALL nl_set_julday ( nested_grid%id , julday )
841 CALL nl_set_gmt ( nested_grid%id , gmt )
842 CALL wrf_put_dom_ti_real ( fidb , 'GMT' , gmt , 1 , ierr )
843 CALL wrf_put_dom_ti_integer ( fidb , 'JULYR' , julyr , 1 , ierr )
844 CALL wrf_put_dom_ti_integer ( fidb , 'JULDAY' , julday , 1 , ierr )
845 CALL domain_clock_set( nested_grid, &
846 current_timestr=current_date(1:19) )
847 print *,'bdy time = ',time_loop-1,' bdy date = ',current_date,' ',start_date
848 CALL output_boundary ( fidb , nested_grid , config_flags , ierr )
849 current_date = temp24
850 start_date = temp24b
851 CALL domain_clock_set( nested_grid, &
852 current_timestr=current_date(1:19) )
853
854 IF ( time_loop .EQ. 2 ) THEN
855 CALL wrf_put_dom_ti_real ( fidb , 'BDYFRQ' , new_bdy_frq , 1 , ierr )
856 END IF
857
858 ! We need to save the 3d data to compute a difference during the next loop. Couple the
859 ! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
860 ! We load up the boundary data again for use in the next loop.
861
862 DO j = jps , jpe
863 DO k = kps , kpe
864 DO i = ips , ipe
865 ubdy3dtemp1(i,k,j) = ubdy3dtemp2(i,k,j)
866 vbdy3dtemp1(i,k,j) = vbdy3dtemp2(i,k,j)
867 tbdy3dtemp1(i,k,j) = tbdy3dtemp2(i,k,j)
868 pbdy3dtemp1(i,k,j) = pbdy3dtemp2(i,k,j)
869 qbdy3dtemp1(i,k,j) = qbdy3dtemp2(i,k,j)
870 END DO
871 END DO
872 END DO
873
874 DO j = jps , jpe
875 DO i = ips , ipe
876 mbdy2dtemp1(i,1,j) = mbdy2dtemp2(i,1,j)
877 END DO
878 END DO
879
880 ! There are 2 components to the lateral boundaries. First, there is the starting
881 ! point of this time period - just the outer few rows and columns.
882
883 CALL stuff_bdy ( ubdy3dtemp1 , &
884 nested_grid%em_u_bxs, nested_grid%em_u_bxe , &
885 nested_grid%em_u_bys, nested_grid%em_u_bye , &
886 'U' , spec_bdy_width , &
887 ids , ide , jds , jde , kds , kde , &
888 ims , ime , jms , jme , kms , kme , &
889 ips , ipe , jps , jpe , kps , kpe )
890 CALL stuff_bdy ( vbdy3dtemp1 , &
891 nested_grid%em_v_bxs, nested_grid%em_v_bxe , &
892 nested_grid%em_v_bys, nested_grid%em_v_bye , &
893 'V' , spec_bdy_width , &
894 ids , ide , jds , jde , kds , kde , &
895 ims , ime , jms , jme , kms , kme , &
896 ips , ipe , jps , jpe , kps , kpe )
897 CALL stuff_bdy ( tbdy3dtemp1 , &
898 nested_grid%em_t_bxs, nested_grid%em_t_bxe , &
899 nested_grid%em_t_bys, nested_grid%em_t_bye , &
900 'T' , spec_bdy_width , &
901 ids , ide , jds , jde , kds , kde , &
902 ims , ime , jms , jme , kms , kme , &
903 ips , ipe , jps , jpe , kps , kpe )
904 CALL stuff_bdy ( pbdy3dtemp1 , &
905 nested_grid%em_ph_bxs, nested_grid%em_ph_bxe , &
906 nested_grid%em_ph_bys, nested_grid%em_ph_bye , &
907 'W' , spec_bdy_width , &
908 ids , ide , jds , jde , kds , kde , &
909 ims , ime , jms , jme , kms , kme , &
910 ips , ipe , jps , jpe , kps , kpe )
911 CALL stuff_bdy ( qbdy3dtemp1 , &
912 nested_grid%moist_bxs(:,:,:,P_QV), nested_grid%moist_bxe(:,:,:,P_QV), &
913 nested_grid%moist_bys(:,:,:,P_QV), nested_grid%moist_bye(:,:,:,P_QV), &
914 'T' , spec_bdy_width , &
915 ids , ide , jds , jde , kds , kde , &
916 ims , ime , jms , jme , kms , kme , &
917 ips , ipe , jps , jpe , kps , kpe )
918 #ifdef WRF_CHEM
919 do nvchem=1,num_chem
920 cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)
921 ! if(nvchem.eq.p_o3)then
922 ! write(0,*)'fill 2ch_b3',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem)
923 ! endif
924 CALL stuff_bdy ( cbdy3dtemp1 , &
925 nested_grid%chem_bxs(:,:,:,nvchem), nested_grid%chem_bxe(:,:,:,nvchem), &
926 nested_grid%chem_bys(:,:,:,nvchem), nested_grid%chem_bye(:,:,:,nvchem), &
927 'T' , spec_bdy_width , &
928 ids , ide , jds , jde , kds , kde , &
929 ims , ime , jms , jme , kms , kme , &
930 ips , ipe , jps , jpe , kps , kpe )
931 ! cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)
932 ! if(nvchem.eq.p_o3)then
933 ! write(0,*)'fill 2ch_b3',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem)
934 ! endif
935 enddo
936 #endif
937 CALL stuff_bdy ( mbdy2dtemp1 , &
938 nested_grid%em_mu_bxs, nested_grid%em_mu_bxe , &
939 nested_grid%em_mu_bys, nested_grid%em_mu_bye , &
940 'M' , spec_bdy_width , &
941 ids , ide , jds , jde , 1 , 1 , &
942 ims , ime , jms , jme , 1 , 1 , &
943 ips , ipe , jps , jpe , 1 , 1 )
944
945 ELSE IF ( time_loop .EQ. time_loop_max ) THEN
946
947 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , ubdy3dtemp2 , nested_grid%em_u_2 , &
948 'u' , nested_grid%msfu , &
949 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
950 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , vbdy3dtemp2 , nested_grid%em_v_2 , &
951 'v' , nested_grid%msfv , &
952 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
953 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , tbdy3dtemp2 , nested_grid%em_t_2 , &
954 't' , nested_grid%msft , &
955 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
956 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , pbdy3dtemp2 , nested_grid%em_ph_2 , &
957 'h' , nested_grid%msft , &
958 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
959 CALL couple ( nested_grid%em_mu_2 , nested_grid%em_mub , qbdy3dtemp2 , nested_grid%moist(:,:,:,P_QV) , &
960 't' , nested_grid%msft , &
961 ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
962 mbdy2dtemp2(:,1,:) = nested_grid%em_mu_2(:,:)
963
964 ! During all of the loops after the first loop, we first compute the boundary
965 ! tendencies with the current data values and the previously save information
966 ! stored in the *bdy3dtemp1 arrays.
967 #ifdef WRF_CHEM
968 do nvchem=1,num_chem
969 cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)
970 cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
971 ! if(nvchem.eq.p_o3)then
972 ! write(0,*)'fill 1ch_b4',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
973 ! endif
974 CALL stuff_bdytend ( cbdy3dtemp2 , cbdy3dtemp1 , new_bdy_frq , &
975 nested_grid%chem_btxs(:,:,:,nvchem), nested_grid%chem_btxe(:,:,:,nvchem), &
976 nested_grid%chem_btys(:,:,:,nvchem), nested_grid%chem_btye(:,:,:,nvchem), &
977 'T' , &
978 spec_bdy_width , &
979 ids , ide , jds , jde , kds , kde , &
980 ims , ime , jms , jme , kms , kme , &
981 ips , ipe , jps , jpe , kps , kpe )
982 cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe)
983 ! if(nvchem.eq.p_o3)then
984 ! write(0,*)'fill 2ch_b4',cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
985 ! endif
986 enddo
987 #endif
988
989 CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , new_bdy_frq , &
990 nested_grid%em_u_btxs , nested_grid%em_u_btxe , &
991 nested_grid%em_u_btys , nested_grid%em_u_btye , &
992 'U' , &
993 spec_bdy_width , &
994 ids , ide , jds , jde , kds , kde , &
995 ims , ime , jms , jme , kms , kme , &
996 ips , ipe , jps , jpe , kps , kpe )
997 CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , new_bdy_frq , &
998 nested_grid%em_v_btxs , nested_grid%em_v_btxe , &
999 nested_grid%em_v_btys , nested_grid%em_v_btye , &
1000 'V' , &
1001 spec_bdy_width , &
1002 ids , ide , jds , jde , kds , kde , &
1003 ims , ime , jms , jme , kms , kme , &
1004 ips , ipe , jps , jpe , kps , kpe )
1005 CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , new_bdy_frq , &
1006 nested_grid%em_t_btxs , nested_grid%em_t_btxe , &
1007 nested_grid%em_t_btys , nested_grid%em_t_btye , &
1008 'T' , &
1009 spec_bdy_width , &
1010 ids , ide , jds , jde , kds , kde , &
1011 ims , ime , jms , jme , kms , kme , &
1012 ips , ipe , jps , jpe , kps , kpe )
1013 CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , new_bdy_frq , &
1014 nested_grid%em_ph_btxs , nested_grid%em_ph_btxe , &
1015 nested_grid%em_ph_btys , nested_grid%em_ph_btye , &
1016 'W' , &
1017 spec_bdy_width , &
1018 ids , ide , jds , jde , kds , kde , &
1019 ims , ime , jms , jme , kms , kme , &
1020 ips , ipe , jps , jpe , kps , kpe )
1021 CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , new_bdy_frq , &
1022 nested_grid%moist_btxs(:,:,:,P_QV) , nested_grid%moist_btxe(:,:,:,P_QV) , &
1023 nested_grid%moist_btys(:,:,:,P_QV) , nested_grid%moist_btye(:,:,:,P_QV) , &
1024 'T' , &
1025 spec_bdy_width , &
1026 ids , ide , jds , jde , kds , kde , &
1027 ims , ime , jms , jme , kms , kme , &
1028 ips , ipe , jps , jpe , kps , kpe )
1029 CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , new_bdy_frq , &
1030 nested_grid%em_mu_btxs , nested_grid%em_mu_btxe , &
1031 nested_grid%em_mu_btys , nested_grid%em_mu_btye , &
1032 'M' , &
1033 spec_bdy_width , &
1034 ids , ide , jds , jde , 1 , 1 , &
1035 ims , ime , jms , jme , 1 , 1 , &
1036 ips , ipe , jps , jpe , 1 , 1 )
1037
1038 IF ( time_loop .EQ. 2 ) THEN
1039
1040 ! Generate an output file from this program, which will be an input file to WRF.
1041
1042 CALL wrf_debug ( 100 , 'ndown_em main: calling open_w_dataset for wrfbdy' )
1043 CALL construct_filename1( bdyname , 'wrfbdy' , nested_grid%id , 2 )
1044 CALL open_w_dataset ( fidb, TRIM(bdyname) , nested_grid , config_flags , output_boundary , &
1045 "DATASET=BOUNDARY", ierr )
1046 IF ( ierr .NE. 0 ) THEN
1047 WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(bdyname),' for reading ierr=',ierr
1048 CALL WRF_ERROR_FATAL ( wrf_err_message )
1049 ENDIF
1050
1051 END IF
1052
1053 ! Both pieces of the boundary data are now available to be written.
1054
1055 CALL domain_clock_set( nested_grid, &
1056 current_timestr=current_date(1:19) )
1057 temp24= current_date
1058 temp24b=start_date_hold
1059 start_date = start_date_hold
1060 CALL geth_newdate ( temp19 , temp24b(1:19) , (time_loop-2) * model_config_rec%interval_seconds )
1061 current_date = temp19 // '.0000'
1062 CALL geth_julgmt ( julyr , julday , gmt)
1063 CALL nl_set_julyr ( nested_grid%id , julyr )
1064 CALL nl_set_julday ( nested_grid%id , julday )
1065 CALL nl_set_gmt ( nested_grid%id , gmt )
1066 CALL wrf_put_dom_ti_real ( fidb , 'GMT' , gmt , 1 , ierr )
1067 CALL wrf_put_dom_ti_integer ( fidb , 'JULYR' , julyr , 1 , ierr )
1068 CALL wrf_put_dom_ti_integer ( fidb , 'JULDAY' , julday , 1 , ierr )
1069 CALL domain_clock_set( nested_grid, &
1070 current_timestr=current_date(1:19) )
1071 CALL output_boundary ( fidb , nested_grid , config_flags , ierr )
1072 current_date = temp24
1073 start_date = temp24b
1074 CALL domain_clock_set( nested_grid, &
1075 current_timestr=current_date(1:19) )
1076
1077 IF ( time_loop .EQ. 2 ) THEN
1078 CALL wrf_put_dom_ti_real ( fidb , 'BDYFRQ' , new_bdy_frq , 1 , ierr )
1079 END IF
1080
1081 ! Since this is the last time through here, we need to close the boundary file.
1082
1083 CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
1084 CALL close_dataset ( fidb , config_flags , "DATASET=BOUNDARY" )
1085
1086
1087 END IF
1088
1089 ! Process which time now?
1090
1091 END DO big_time_loop_thingy
1092
1093 CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
1094 CALL med_shutdown_io ( parent_grid , config_flags )
1095
1096 CALL wrf_debug ( 0 , 'ndown_em: SUCCESS COMPLETE NDOWN_EM INIT' )
1097
1098 CALL wrf_shutdown
1099
1100 CALL WRFU_Finalize( rc=rc )
1101
1102 END PROGRAM ndown_em
1103
1104 SUBROUTINE land_percentages ( xland , &
1105 landuse_frac , soil_top_cat , soil_bot_cat , &
1106 isltyp , ivgtyp , &
1107 num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
1108 ids , ide , jds , jde , kds , kde , &
1109 ims , ime , jms , jme , kms , kme , &
1110 its , ite , jts , jte , kts , kte , &
1111 iswater )
1112 USE module_soil_pre
1113
1114 IMPLICIT NONE
1115
1116 INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
1117 ims , ime , jms , jme , kms , kme , &
1118 its , ite , jts , jte , kts , kte , &
1119 iswater
1120
1121 INTEGER , INTENT(IN) :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
1122 REAL , DIMENSION(ims:ime,1:num_veg_cat,jms:jme) , INTENT(INOUT):: landuse_frac
1123 REAL , DIMENSION(ims:ime,1:num_soil_top_cat,jms:jme) , INTENT(IN):: soil_top_cat
1124 REAL , DIMENSION(ims:ime,1:num_soil_bot_cat,jms:jme) , INTENT(IN):: soil_bot_cat
1125 INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(OUT) :: isltyp , ivgtyp
1126 REAL , DIMENSION(ims:ime,jms:jme) , INTENT(OUT) :: xland
1127
1128 CALL process_percent_cat_new ( xland , &
1129 landuse_frac , soil_top_cat , soil_bot_cat , &
1130 isltyp , ivgtyp , &
1131 num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
1132 ids , ide , jds , jde , kds , kde , &
1133 ims , ime , jms , jme , kms , kme , &
1134 its , ite , jts , jte , kts , kte , &
1135 iswater )
1136
1137 END SUBROUTINE land_percentages
1138
1139 SUBROUTINE check_consistency ( ivgtyp , isltyp , landmask , &
1140 ids , ide , jds , jde , kds , kde , &
1141 ims , ime , jms , jme , kms , kme , &
1142 its , ite , jts , jte , kts , kte , &
1143 iswater )
1144
1145 IMPLICIT NONE
1146
1147 INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
1148 ims , ime , jms , jme , kms , kme , &
1149 its , ite , jts , jte , kts , kte , &
1150 iswater
1151 INTEGER , DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: isltyp , ivgtyp
1152 REAL , DIMENSION(ims:ime,jms:jme), INTENT(INOUT) :: landmask
1153
1154 LOGICAL :: oops
1155 INTEGER :: oops_count , i , j
1156
1157 oops = .FALSE.
1158 oops_count = 0
1159
1160 DO j = jts, MIN(jde-1,jte)
1161 DO i = its, MIN(ide-1,ite)
1162 IF ( ( ( landmask(i,j) .LT. 0.5 ) .AND. ( ivgtyp(i,j) .NE. iswater ) ) .OR. &
1163 ( ( landmask(i,j) .GT. 0.5 ) .AND. ( ivgtyp(i,j) .EQ. iswater ) ) ) THEN
1164 print *,'mismatch in landmask and veg type'
1165 print *,'i,j=',i,j, ' landmask =',NINT(landmask(i,j)),' ivgtyp=',ivgtyp(i,j)
1166 oops = .TRUE.
1167 oops_count = oops_count + 1
1168 landmask(i,j) = 0
1169 ivgtyp(i,j)=16
1170 isltyp(i,j)=14
1171 END IF
1172 END DO
1173 END DO
1174
1175 IF ( oops ) THEN
1176 CALL wrf_debug( 0, 'mismatch in check_consistency, turned to water points, be careful' )
1177 END IF
1178
1179 END SUBROUTINE check_consistency
1180
1181 SUBROUTINE check_consistency2( ivgtyp , isltyp , landmask , &
1182 tmn , tsk , sst , xland , &
1183 tslb , smois , sh2o , &
1184 num_soil_layers , id , &
1185 ids , ide , jds , jde , kds , kde , &
1186 ims , ime , jms , jme , kms , kme , &
1187 its , ite , jts , jte , kts , kte , &
1188 iswater )
1189
1190 USE module_configure
1191 USE module_optional_si_input
1192
1193 INTEGER , INTENT(IN) :: ids , ide , jds , jde , kds , kde , &
1194 ims , ime , jms , jme , kms , kme , &
1195 its , ite , jts , jte , kts , kte
1196 INTEGER , INTENT(IN) :: num_soil_layers , id
1197
1198 INTEGER , DIMENSION(ims:ime,jms:jme) :: ivgtyp , isltyp
1199 REAL , DIMENSION(ims:ime,jms:jme) :: landmask , tmn , tsk , sst , xland
1200 REAL , DIMENSION(ims:ime,num_soil_layers,jms:jme) :: tslb , smois , sh2o
1201
1202 INTEGER :: oops1 , oops2
1203 INTEGER :: i , j , k
1204
1205 fix_tsk_tmn : SELECT CASE ( model_config_rec%sf_surface_physics(id) )
1206
1207 CASE ( SLABSCHEME , LSMSCHEME , RUCLSMSCHEME )
1208 DO j = jts, MIN(jde-1,jte)
1209 DO i = its, MIN(ide-1,ite)
1210 IF ( ( landmask(i,j) .LT. 0.5 ) .AND. ( flag_sst .EQ. 1 ) ) THEN
1211 tmn(i,j) = sst(i,j)
1212 tsk(i,j) = sst(i,j)
1213 ELSE IF ( landmask(i,j) .LT. 0.5 ) THEN
1214 tmn(i,j) = tsk(i,j)
1215 END IF
1216 END DO
1217 END DO
1218 END SELECT fix_tsk_tmn
1219
1220 ! Is the TSK reasonable?
1221
1222 DO j = jts, MIN(jde-1,jte)
1223 DO i = its, MIN(ide-1,ite)
1224 IF ( tsk(i,j) .LT. 170 .or. tsk(i,j) .GT. 400. ) THEN
1225 print *,'error in the TSK'
1226 print *,'i,j=',i,j
1227 print *,'landmask=',landmask(i,j)
1228 print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
1229 if(tmn(i,j).gt.170. .and. tmn(i,j).lt.400.)then
1230 tsk(i,j)=tmn(i,j)
1231 else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
1232 tsk(i,j)=sst(i,j)
1233 else
1234 CALL wrf_error_fatal ( 'TSK unreasonable' )
1235 end if
1236 END IF
1237 END DO
1238 END DO
1239
1240 ! Is the TMN reasonable?
1241
1242 DO j = jts, MIN(jde-1,jte)
1243 DO i = its, MIN(ide-1,ite)
1244 IF ( ( ( tmn(i,j) .LT. 170. ) .OR. ( tmn(i,j) .GT. 400. ) ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
1245 print *,'error in the TMN'
1246 print *,'i,j=',i,j
1247 print *,'landmask=',landmask(i,j)
1248 print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
1249 if(tsk(i,j).gt.170. .and. tsk(i,j).lt.400.)then
1250 tmn(i,j)=tsk(i,j)
1251 else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
1252 tmn(i,j)=sst(i,j)
1253 else
1254 CALL wrf_error_fatal ( 'TMN unreasonable' )
1255 endif
1256 END IF
1257 END DO
1258 END DO
1259
1260 ! Is the TSLB reasonable?
1261
1262 DO j = jts, MIN(jde-1,jte)
1263 DO i = its, MIN(ide-1,ite)
1264 IF ( ( ( tslb(i,1,j) .LT. 170. ) .OR. ( tslb(i,1,j) .GT. 400. ) ) .AND. ( landmask(i,j) .GT. 0.5 ) ) THEN
1265 print *,'error in the TSLB'
1266 print *,'i,j=',i,j
1267 print *,'landmask=',landmask(i,j)
1268 print *,'tsk, sst, tmn=',tsk(i,j),sst(i,j),tmn(i,j)
1269 print *,'tslb = ',tslb(i,:,j)
1270 print *,'old smois = ',smois(i,:,j)
1271 DO l = 1 , num_soil_layers
1272 sh2o(i,l,j) = 0.0
1273 END DO
1274 DO l = 1 , num_soil_layers
1275 smois(i,l,j) = 0.3
1276 END DO
1277 if(tsk(i,j).gt.170. .and. tsk(i,j).lt.400.)then
1278 DO l = 1 , num_soil_layers
1279 tslb(i,l,j)=tsk(i,j)
1280 END DO
1281 else if(sst(i,j).gt.170. .and. sst(i,j).lt.400.)then
1282 DO l = 1 , num_soil_layers
1283 tslb(i,l,j)=sst(i,j)
1284 END DO
1285 else if(tmn(i,j).gt.170. .and. tmn(i,j).lt.400.)then
1286 DO l = 1 , num_soil_layers
1287 tslb(i,l,j)=tmn(i,j)
1288 END DO
1289 else
1290 CALL wrf_error_fatal ( 'TSLB unreasonable' )
1291 endif
1292 END IF
1293 END DO
1294 END DO
1295
1296 ! Let us make sure (again) that the landmask and the veg/soil categories match.
1297
1298 oops1=0
1299 oops2=0
1300 DO j = jts, MIN(jde-1,jte)
1301 DO i = its, MIN(ide-1,ite)
1302 IF ( ( ( landmask(i,j) .LT. 0.5 ) .AND. ( ivgtyp(i,j) .NE. iswater .OR. isltyp(i,j) .NE. 14 ) ) .OR. &
1303 ( ( landmask(i,j) .GT. 0.5 ) .AND. ( ivgtyp(i,j) .EQ. iswater .OR. isltyp(i,j) .EQ. 14 ) ) ) THEN
1304 IF ( tslb(i,1,j) .GT. 1. ) THEN
1305 oops1=oops1+1
1306 ivgtyp(i,j) = 5
1307 isltyp(i,j) = 8
1308 landmask(i,j) = 1
1309 xland(i,j) = 1
1310 ELSE IF ( sst(i,j) .GT. 1. ) THEN
1311 oops2=oops2+1
1312 ivgtyp(i,j) = iswater
1313 isltyp(i,j) = 14
1314 landmask(i,j) = 0
1315 xland(i,j) = 2
1316 ELSE
1317 print *,'the landmask and soil/veg cats do not match'
1318 print *,'i,j=',i,j
1319 print *,'landmask=',landmask(i,j)
1320 print *,'ivgtyp=',ivgtyp(i,j)
1321 print *,'isltyp=',isltyp(i,j)
1322 print *,'iswater=', iswater
1323 print *,'tslb=',tslb(i,:,j)
1324 print *,'sst=',sst(i,j)
1325 CALL wrf_error_fatal ( 'mismatch_landmask_ivgtyp' )
1326 END IF
1327 END IF
1328 END DO
1329 END DO
1330 if (oops1.gt.0) then
1331 print *,'points artificially set to land : ',oops1
1332 endif
1333 if(oops2.gt.0) then
1334 print *,'points artificially set to water: ',oops2
1335 endif
1336
1337 END SUBROUTINE check_consistency2
1338
1339 SUBROUTINE init_domain_constants_em_ptr ( parent , nest )
1340 USE module_domain
1341 USE module_configure
1342 IMPLICIT NONE
1343 TYPE(domain), POINTER :: parent , nest
1344 INTERFACE
1345 SUBROUTINE init_domain_constants_em ( parent , nest )
1346 USE module_domain
1347 USE module_configure
1348 TYPE(domain) :: parent , nest
1349 END SUBROUTINE init_domain_constants_em
1350 END INTERFACE
1351 CALL init_domain_constants_em ( parent , nest )
1352 END SUBROUTINE init_domain_constants_em_ptr