PageRenderTime 53ms CodeModel.GetById 17ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/main/ndown_em.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 2059 lines | 1235 code | 364 blank | 460 comment | 24 complexity | 8de7c7fb44afcf03ef9273f44114eb38 MD5 | raw file
Possible License(s): AGPL-1.0

Large files files are truncated, but you can click here to view the full file

  1. !WRF:DRIVER_LAYER:MAIN
  2. !
  3. PROGRAM ndown_em
  4. USE module_machine
  5. USE module_domain, ONLY : domain, head_grid, alloc_and_configure_domain, &
  6. domain_clock_set, domain_clock_get, get_ijk_from_grid
  7. USE module_domain_type, ONLY : program_name
  8. USE module_initialize_real, ONLY : wrfu_initialize, rebalance_driver
  9. USE module_integrate
  10. USE module_driver_constants
  11. USE module_configure, ONLY : grid_config_rec_type, model_config_rec
  12. USE module_io_domain
  13. USE module_utility
  14. USE module_check_a_mundo
  15. USE module_timing
  16. USE module_wrf_error
  17. #ifdef DM_PARALLEL
  18. USE module_dm
  19. #endif
  20. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  21. !new for bc
  22. USE module_bc
  23. USE module_big_step_utilities_em
  24. USE module_get_file_names
  25. #ifdef WRF_CHEM
  26. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  27. ! for chemistry
  28. USE module_input_chem_data
  29. ! USE module_input_chem_bioemiss
  30. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  31. #endif
  32. IMPLICIT NONE
  33. ! interface
  34. INTERFACE
  35. ! mediation-supplied
  36. SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags)
  37. USE module_domain
  38. TYPE (domain) grid
  39. TYPE (grid_config_rec_type) config_flags
  40. END SUBROUTINE med_read_wrf_chem_bioemiss
  41. SUBROUTINE init_domain_constants_em_ptr ( parent , nest )
  42. USE module_domain
  43. USE module_configure
  44. TYPE(domain), POINTER :: parent , nest
  45. END SUBROUTINE init_domain_constants_em_ptr
  46. SUBROUTINE vertical_interp (nested_grid,znw_c,znu_c,cf1_c,cf2_c,cf3_c,cfn_c,cfn1_c,k_dim_c)
  47. USE module_domain
  48. USE module_configure
  49. TYPE(domain), POINTER :: nested_grid
  50. INTEGER , INTENT (IN) :: k_dim_c
  51. REAL , INTENT (IN) :: cf1_c,cf2_c,cf3_c,cfn_c,cfn1_c
  52. REAL , DIMENSION(k_dim_c) , INTENT (IN) :: znw_c,znu_c
  53. END SUBROUTINE vertical_interp
  54. END INTERFACE
  55. INTEGER :: ids , ide , jds , jde , kds , kde
  56. INTEGER :: ims , ime , jms , jme , kms , kme
  57. INTEGER :: ips , ipe , jps , jpe , kps , kpe
  58. INTEGER :: its , ite , jts , jte , kts , kte
  59. INTEGER :: nids, nide, njds, njde, nkds, nkde, &
  60. nims, nime, njms, njme, nkms, nkme, &
  61. nips, nipe, njps, njpe, nkps, nkpe
  62. INTEGER :: spec_bdy_width
  63. INTEGER :: i , j , k , nvchem
  64. INTEGER :: time_loop_max , time_loop
  65. INTEGER :: total_time_sec , file_counter
  66. INTEGER :: julyr , julday , iswater , map_proj
  67. INTEGER :: icnt
  68. REAL :: dt , new_bdy_frq
  69. REAL :: gmt , cen_lat , cen_lon , dx , dy , truelat1 , truelat2 , moad_cen_lat , stand_lon
  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. CHARACTER(LEN=19) :: start_date_char , current_date_char , end_date_char
  77. CHARACTER(LEN=19) :: stopTimeStr
  78. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  79. INTEGER :: num_veg_cat , num_soil_top_cat , num_soil_bot_cat
  80. REAL :: time
  81. INTEGER :: rc
  82. INTEGER :: loop , levels_to_process
  83. INTEGER , PARAMETER :: max_sanity_file_loop = 100
  84. TYPE (domain) , POINTER :: keep_grid, grid_ptr, null_domain, parent_grid , nested_grid
  85. TYPE (domain) :: dummy
  86. TYPE (grid_config_rec_type) :: config_flags
  87. INTEGER :: number_at_same_level
  88. INTEGER :: time_step_begin_restart
  89. INTEGER :: max_dom , domain_id , fid , fido, fidb , oid , idum1 , idum2 , ierr
  90. INTEGER :: status_next_var
  91. INTEGER :: debug_level
  92. LOGICAL :: input_from_file , need_new_file
  93. CHARACTER (LEN=19) :: date_string
  94. #ifdef DM_PARALLEL
  95. INTEGER :: nbytes
  96. INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN
  97. INTEGER :: configbuf( configbuflen )
  98. LOGICAL , EXTERNAL :: wrf_dm_on_monitor
  99. #endif
  100. INTEGER :: idsi
  101. CHARACTER (LEN=80) :: inpname , outname , bdyname
  102. CHARACTER (LEN=80) :: si_inpname
  103. character *19 :: temp19
  104. character *24 :: temp24 , temp24b
  105. character(len=24) :: start_date_hold
  106. CHARACTER (LEN=256) :: message
  107. integer :: ii
  108. #include "version_decl"
  109. !!!!!!!!!!!!!!!!!!!!! mousta
  110. integer :: n_ref_m,k_dim_c,k_dim_n
  111. real :: cf1_c,cf2_c,cf3_c,cfn_c,cfn1_c
  112. REAL , DIMENSION(:) , ALLOCATABLE :: znw_c,znu_c
  113. !!!!!!!!!!!!!!!!!!!!!!!!!!11
  114. ! Interface block for routine that passes pointers and needs to know that they
  115. ! are receiving pointers.
  116. INTERFACE
  117. SUBROUTINE med_interp_domain ( parent_grid , nested_grid )
  118. USE module_domain
  119. USE module_configure
  120. TYPE(domain), POINTER :: parent_grid , nested_grid
  121. END SUBROUTINE med_interp_domain
  122. SUBROUTINE Setup_Timekeeping( parent_grid )
  123. USE module_domain
  124. TYPE(domain), POINTER :: parent_grid
  125. END SUBROUTINE Setup_Timekeeping
  126. SUBROUTINE vert_cor(parent_grid,znw_c,k_dim_c)
  127. USE module_domain
  128. TYPE(domain), POINTER :: parent_grid
  129. integer , intent(in) :: k_dim_c
  130. real , dimension(k_dim_c), INTENT(IN) :: znw_c
  131. END SUBROUTINE vert_cor
  132. END INTERFACE
  133. ! Define the name of this program (program_name defined in module_domain)
  134. program_name = "NDOWN_EM " // TRIM(release_version) // " PREPROCESSOR"
  135. #ifdef DM_PARALLEL
  136. CALL disable_quilting
  137. #endif
  138. ! Initialize the modules used by the WRF system. Many of the CALLs made from the
  139. ! init_modules routine are NO-OPs. Typical initializations are: the size of a
  140. ! REAL, setting the file handles to a pre-use value, defining moisture and
  141. ! chemistry indices, etc.
  142. CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
  143. #ifdef NO_LEAP_CALENDAR
  144. CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_NOLEAP, rc=rc )
  145. #else
  146. CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_GREGORIAN, rc=rc )
  147. #endif
  148. CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
  149. ! Get the NAMELIST data. This is handled in the initial_config routine. All of the
  150. ! NAMELIST input variables are assigned to the model_config_rec structure. Below,
  151. ! note for parallel processing, only the monitor processor handles the raw Fortran
  152. ! I/O, and then broadcasts the info to each of the other nodes.
  153. #ifdef DM_PARALLEL
  154. IF ( wrf_dm_on_monitor() ) THEN
  155. CALL initial_config
  156. ENDIF
  157. CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
  158. CALL wrf_dm_bcast_bytes( configbuf, nbytes )
  159. CALL set_config_as_buffer( configbuf, configbuflen )
  160. CALL wrf_dm_initialize
  161. #else
  162. CALL initial_config
  163. #endif
  164. CALL check_nml_consistency
  165. CALL set_physics_rconfigs
  166. ! If we are running ndown, and that is WHERE we are now, make sure that we account
  167. ! for folks forgetting to say that the aux_input2 stream is in place.
  168. IF ( model_config_rec%io_form_auxinput2 .EQ. 0 ) THEN
  169. CALL wrf_error_fatal( 'ndown: Please set io_form_auxinput2 in the time_control namelist record (probably to 2).')
  170. END IF
  171. !!!!!!!!!!!!!!! mousta
  172. n_ref_m = model_config_rec % vert_refine_fact
  173. k_dim_c = model_config_rec % e_vert(1)
  174. k_dim_n = k_dim_c
  175. if (n_ref_m .ge. 2) k_dim_n = (k_dim_c - 1) * n_ref_m + 1
  176. model_config_rec % e_vert(1) = k_dim_n
  177. model_config_rec % e_vert(2) = k_dim_n
  178. ALLOCATE(znw_c(k_dim_c))
  179. ALLOCATE(znu_c(k_dim_c))
  180. WRITE ( message , FMT = '(A,3I5)' ) 'KDIM_C', k_dim_c , model_config_rec % e_vert(1) , model_config_rec % e_vert(2)
  181. CALL wrf_debug ( 99,message )
  182. !!!!!!!!!!!!!!! mousta
  183. ! And here is an instance of using the information in the NAMELIST.
  184. CALL nl_get_debug_level ( 1, debug_level )
  185. CALL set_wrf_debug_level ( debug_level )
  186. ! Allocated and configure the mother domain. Since we are in the nesting down
  187. ! mode, we know a) we got a nest, and b) we only got 1 nest.
  188. NULLIFY( null_domain )
  189. CALL wrf_message ( program_name )
  190. CALL wrf_debug ( 100 , 'ndown_em: calling alloc_and_configure_domain coarse ' )
  191. CALL alloc_and_configure_domain ( domain_id = 1 , &
  192. grid = head_grid , &
  193. parent = null_domain , &
  194. kid = -1 )
  195. parent_grid => head_grid
  196. ! Set up time initializations.
  197. CALL Setup_Timekeeping ( parent_grid )
  198. CALL domain_clock_set( head_grid, &
  199. time_step_seconds=model_config_rec%interval_seconds )
  200. CALL wrf_debug ( 100 , 'ndown_em: calling model_to_grid_config_rec ' )
  201. CALL model_to_grid_config_rec ( parent_grid%id , model_config_rec , config_flags )
  202. CALL wrf_debug ( 100 , 'ndown_em: calling set_scalar_indices_from_config ' )
  203. CALL set_scalar_indices_from_config ( parent_grid%id , idum1, idum2 )
  204. ! Initialize the I/O for WRF.
  205. CALL wrf_debug ( 100 , 'ndown_em: calling init_wrfio' )
  206. CALL init_wrfio
  207. ! Some of the configuration values may have been modified from the initial READ
  208. ! of the NAMELIST, so we re-broadcast the configuration records.
  209. #ifdef DM_PARALLEL
  210. CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
  211. CALL wrf_dm_bcast_bytes( configbuf, nbytes )
  212. CALL set_config_as_buffer( configbuf, configbuflen )
  213. #endif
  214. ! We need to current and starting dates for the output files. The times need to be incremented
  215. ! so that the lateral BC files are not overwritten.
  216. #ifdef PLANET
  217. WRITE ( start_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
  218. model_config_rec%start_year (parent_grid%id) , &
  219. model_config_rec%start_day (parent_grid%id) , &
  220. model_config_rec%start_hour (parent_grid%id) , &
  221. model_config_rec%start_minute(parent_grid%id) , &
  222. model_config_rec%start_second(parent_grid%id)
  223. WRITE ( end_date_char , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2)' ) &
  224. model_config_rec% end_year (parent_grid%id) , &
  225. model_config_rec% end_day (parent_grid%id) , &
  226. model_config_rec% end_hour (parent_grid%id) , &
  227. model_config_rec% end_minute(parent_grid%id) , &
  228. model_config_rec% end_second(parent_grid%id)
  229. #else
  230. WRITE ( start_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
  231. model_config_rec%start_year (parent_grid%id) , &
  232. model_config_rec%start_month (parent_grid%id) , &
  233. model_config_rec%start_day (parent_grid%id) , &
  234. model_config_rec%start_hour (parent_grid%id) , &
  235. model_config_rec%start_minute(parent_grid%id) , &
  236. model_config_rec%start_second(parent_grid%id)
  237. WRITE ( end_date_char , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
  238. model_config_rec% end_year (parent_grid%id) , &
  239. model_config_rec% end_month (parent_grid%id) , &
  240. model_config_rec% end_day (parent_grid%id) , &
  241. model_config_rec% end_hour (parent_grid%id) , &
  242. model_config_rec% end_minute(parent_grid%id) , &
  243. model_config_rec% end_second(parent_grid%id)
  244. #endif
  245. ! Override stop time with value computed above.
  246. CALL domain_clock_set( parent_grid, stop_timestr=end_date_char )
  247. CALL geth_idts ( end_date_char , start_date_char , total_time_sec )
  248. new_bdy_frq = model_config_rec%interval_seconds
  249. time_loop_max = total_time_sec / model_config_rec%interval_seconds + 1
  250. start_date = start_date_char // '.0000'
  251. current_date = start_date_char // '.0000'
  252. start_date_hold = start_date_char // '.0000'
  253. current_date_char = start_date_char
  254. ! Get a list of available file names to try. This fills up the eligible_file_name
  255. ! array with number_of_eligible_files entries. This routine issues a nonstandard
  256. ! call (system).
  257. file_counter = 1
  258. need_new_file = .FALSE.
  259. CALL unix_ls ( 'wrfout' , parent_grid%id )
  260. ! Open the input data (wrfout_d01_xxxxxx) for reading.
  261. CALL wrf_debug ( 100 , 'ndown_em main: calling open_r_dataset for ' // TRIM(eligible_file_name(file_counter)) )
  262. CALL open_r_dataset ( fid, TRIM(eligible_file_name(file_counter)) , head_grid , config_flags , "DATASET=AUXINPUT1", ierr )
  263. IF ( ierr .NE. 0 ) THEN
  264. WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(eligible_file_name(file_counter)), &
  265. ' for reading ierr=',ierr
  266. CALL WRF_ERROR_FATAL ( wrf_err_message )
  267. ENDIF
  268. ! We know how many time periods to process, so we begin.
  269. big_time_loop_thingy : DO time_loop = 1 , time_loop_max
  270. ! Which date are we currently soliciting?
  271. CALL geth_newdate ( date_string , start_date_char , ( time_loop - 1 ) * NINT ( new_bdy_frq) )
  272. WRITE ( message , FMT = '(A,I5," ",A,A)' ) '-------->>> Processing data: loop=',time_loop,' date/time = ',date_string
  273. CALL wrf_debug ( 99,message )
  274. current_date_char = date_string
  275. current_date = date_string // '.0000'
  276. start_date = date_string // '.0000'
  277. WRITE ( message , FMT = '(A,I5," ",A,A)' ) 'loopmax = ', time_loop_max, ' ending date = ',end_date_char
  278. CALL wrf_debug ( 99,message )
  279. CALL domain_clock_set( parent_grid, &
  280. current_timestr=current_date(1:19) )
  281. ! Which times are in this file, and more importantly, are any of them the
  282. ! ones that we want? We need to loop over times in each files, loop
  283. ! over files.
  284. get_the_right_time : DO
  285. CALL wrf_get_next_time ( fid , date_string , status_next_var )
  286. WRITE ( message , FMT = '(A,A,A,A,A,I5)' ) 'file date/time = ',date_string,' desired date = ',&
  287. current_date_char,' status = ', status_next_var
  288. CALL wrf_debug ( 99,message )
  289. IF ( status_next_var .NE. 0 ) THEN
  290. CALL wrf_debug ( 100 , 'ndown_em main: calling close_dataset for ' // TRIM(eligible_file_name(file_counter)) )
  291. CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
  292. file_counter = file_counter + 1
  293. IF ( file_counter .GT. number_of_eligible_files ) THEN
  294. WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: opening too many files'
  295. CALL WRF_ERROR_FATAL ( wrf_err_message )
  296. END IF
  297. CALL wrf_debug ( 100 , 'ndown_em main: calling open_r_dataset for ' // TRIM(eligible_file_name(file_counter)) )
  298. CALL open_r_dataset ( fid, TRIM(eligible_file_name(file_counter)) , head_grid , config_flags , "DATASET=INPUT", ierr )
  299. IF ( ierr .NE. 0 ) THEN
  300. WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(eligible_file_name(file_counter)), &
  301. ' for reading ierr=',ierr
  302. CALL WRF_ERROR_FATAL ( wrf_err_message )
  303. ENDIF
  304. CYCLE get_the_right_time
  305. ELSE IF ( TRIM(date_string) .LT. TRIM(current_date_char) ) THEN
  306. CYCLE get_the_right_time
  307. ELSE IF ( TRIM(date_string) .EQ. TRIM(current_date_char) ) THEN
  308. EXIT get_the_right_time
  309. ELSE IF ( TRIM(date_string) .GT. TRIM(current_date_char) ) THEN
  310. WRITE( wrf_err_message , FMT='(A,A,A,A,A)' ) 'Found ',TRIM(date_string),' before I found ',TRIM(current_date_char),'.'
  311. CALL WRF_ERROR_FATAL ( wrf_err_message )
  312. END IF
  313. END DO get_the_right_time
  314. CALL wrf_debug ( 100 , 'wrf: calling input_history' )
  315. CALL wrf_get_previous_time ( fid , date_string , status_next_var )
  316. WRITE ( message , * ) 'CFB' ,cf1_c,cf2_c,cf3_c,cfn_c,cfn1_c,znw_c(1),znu_c(1)
  317. CALL wrf_debug ( 99,message )
  318. CALL input_history ( fid , head_grid , config_flags, ierr)
  319. !!!!!!!!!!!!!1 mousta
  320. cf1_c = head_grid%cf1
  321. cf2_c = head_grid%cf2
  322. cf3_c = head_grid%cf3
  323. cfn_c = head_grid%cfn
  324. cfn1_c = head_grid%cfn1
  325. do k = 1,k_dim_c
  326. znw_c(k) = head_grid%znw(k)
  327. znu_c(k) = head_grid%znu(k)
  328. enddo
  329. call vert_cor(head_grid,znw_c,k_dim_c)
  330. WRITE ( message , * ) 'CFA' ,cf1_c,cf2_c,cf3_c,cfn_c,cfn1_c,znw_c(1),znu_c(1)
  331. CALL wrf_debug ( 99,message )
  332. WRITE ( message , * ) 'CFV' ,head_grid%cf1,head_grid%cf2,head_grid%cf3,head_grid%cfn,head_grid%cfn1,&
  333. head_grid%znw(1),head_grid%znu(1) , head_grid%e_vert , parent_grid%cf1 , parent_grid%znw(1) , parent_grid%znu(1)
  334. CALL wrf_debug ( 99,message )
  335. !!!!!!!!!!!!!1 mousta
  336. CALL wrf_debug ( 100 , 'wrf: back from input_history' )
  337. ! Get the coarse grid info for later transfer to the fine grid domain.
  338. CALL wrf_get_dom_ti_integer ( fid , 'MAP_PROJ' , map_proj , 1 , icnt , ierr )
  339. CALL wrf_get_dom_ti_real ( fid , 'DX' , dx , 1 , icnt , ierr )
  340. CALL wrf_get_dom_ti_real ( fid , 'DY' , dy , 1 , icnt , ierr )
  341. CALL wrf_get_dom_ti_real ( fid , 'CEN_LAT' , cen_lat , 1 , icnt , ierr )
  342. CALL wrf_get_dom_ti_real ( fid , 'CEN_LON' , cen_lon , 1 , icnt , ierr )
  343. CALL wrf_get_dom_ti_real ( fid , 'TRUELAT1' , truelat1 , 1 , icnt , ierr )
  344. CALL wrf_get_dom_ti_real ( fid , 'TRUELAT2' , truelat2 , 1 , icnt , ierr )
  345. CALL wrf_get_dom_ti_real ( fid , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , icnt , ierr )
  346. CALL wrf_get_dom_ti_real ( fid , 'STAND_LON' , stand_lon , 1 , icnt , ierr )
  347. ! CALL wrf_get_dom_ti_real ( fid , 'GMT' , gmt , 1 , icnt , ierr )
  348. ! CALL wrf_get_dom_ti_integer ( fid , 'JULYR' , julyr , 1 , icnt , ierr )
  349. ! CALL wrf_get_dom_ti_integer ( fid , 'JULDAY' , julday , 1 , icnt , ierr )
  350. CALL wrf_get_dom_ti_integer ( fid , 'ISWATER' , iswater , 1 , icnt , ierr )
  351. ! First time in, do this: allocate sapce for the fine grid, get the config flags, open the
  352. ! wrfinput and wrfbdy files. This COULD be done outside the time loop, I think, so check it
  353. ! out and move it up if you can.
  354. IF ( time_loop .EQ. 1 ) THEN
  355. CALL wrf_message ( program_name )
  356. CALL wrf_debug ( 100 , 'wrf: calling alloc_and_configure_domain fine ' )
  357. CALL alloc_and_configure_domain ( domain_id = 2 , &
  358. grid = nested_grid , &
  359. parent = parent_grid , &
  360. kid = 1 )
  361. CALL wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' )
  362. CALL model_to_grid_config_rec ( nested_grid%id , model_config_rec , config_flags )
  363. CALL wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' )
  364. CALL set_scalar_indices_from_config ( nested_grid%id , idum1, idum2 )
  365. ! Set up time initializations for the fine grid.
  366. CALL Setup_Timekeeping ( nested_grid )
  367. ! Strictly speaking, nest stop time should come from model_config_rec...
  368. CALL domain_clock_get( parent_grid, stop_timestr=stopTimeStr )
  369. CALL domain_clock_set( nested_grid, &
  370. current_timestr=current_date(1:19), &
  371. stop_timestr=stopTimeStr , &
  372. time_step_seconds= &
  373. model_config_rec%interval_seconds )
  374. ! Generate an output file from this program, which will be an input file to WRF.
  375. CALL nl_set_bdyfrq ( nested_grid%id , new_bdy_frq )
  376. config_flags%bdyfrq = new_bdy_frq
  377. #ifdef WRF_CHEM
  378. nested_grid%chem_opt = parent_grid%chem_opt
  379. nested_grid%chem_in_opt = parent_grid%chem_in_opt
  380. #endif
  381. ! Initialize constants and 1d arrays in fine grid from the parent.
  382. CALL init_domain_constants_em_ptr ( parent_grid , nested_grid )
  383. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  384. CALL wrf_debug ( 100 , 'ndown_em main: calling open_w_dataset for wrfinput' )
  385. CALL construct_filename1( outname , 'wrfinput' , nested_grid%id , 2 )
  386. CALL open_w_dataset ( fido, TRIM(outname) , nested_grid , config_flags , output_input , "DATASET=INPUT", ierr )
  387. IF ( ierr .NE. 0 ) THEN
  388. WRITE( wrf_err_message , FMT='(A,A,A,I8)' ) 'program ndown: error opening ',TRIM(outname),' for reading ierr=',ierr
  389. CALL WRF_ERROR_FATAL ( wrf_err_message )
  390. ENDIF
  391. ! Various sizes that we need to be concerned about.
  392. ids = nested_grid%sd31
  393. ide = nested_grid%ed31
  394. kds = nested_grid%sd32
  395. kde = nested_grid%ed32
  396. jds = nested_grid%sd33
  397. jde = nested_grid%ed33
  398. ims = nested_grid%sm31
  399. ime = nested_grid%em31
  400. kms = nested_grid%sm32
  401. kme = nested_grid%em32
  402. jms = nested_grid%sm33
  403. jme = nested_grid%em33
  404. ips = nested_grid%sp31
  405. ipe = nested_grid%ep31
  406. kps = nested_grid%sp32
  407. kpe = nested_grid%ep32
  408. jps = nested_grid%sp33
  409. jpe = nested_grid%ep33
  410. print *, ids , ide , jds , jde , kds , kde
  411. print *, ims , ime , jms , jme , kms , kme
  412. print *, ips , ipe , jps , jpe , kps , kpe
  413. spec_bdy_width = model_config_rec%spec_bdy_width
  414. print *,'spec_bdy_width=',spec_bdy_width
  415. ! This is the space needed to save the current 3d data for use in computing
  416. ! the lateral boundary tendencies.
  417. ALLOCATE ( ubdy3dtemp1(ims:ime,kms:kme,jms:jme) )
  418. ALLOCATE ( vbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
  419. ALLOCATE ( tbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
  420. ALLOCATE ( pbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
  421. ALLOCATE ( qbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
  422. ALLOCATE ( mbdy2dtemp1(ims:ime,1:1, jms:jme) )
  423. ALLOCATE ( ubdy3dtemp2(ims:ime,kms:kme,jms:jme) )
  424. ALLOCATE ( vbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
  425. ALLOCATE ( tbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
  426. ALLOCATE ( pbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
  427. ALLOCATE ( qbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
  428. ALLOCATE ( mbdy2dtemp2(ims:ime,1:1, jms:jme) )
  429. ALLOCATE ( cbdy3dtemp0(ims:ime,kms:kme,jms:jme,1:num_chem) )
  430. ALLOCATE ( cbdy3dtemp1(ims:ime,kms:kme,jms:jme) )
  431. ALLOCATE ( cbdy3dtemp2(ims:ime,kms:kme,jms:jme) )
  432. END IF
  433. CALL domain_clock_set( nested_grid, &
  434. current_timestr=current_date(1:19), &
  435. time_step_seconds= &
  436. model_config_rec%interval_seconds )
  437. ! Do the horizontal interpolation.
  438. nested_grid%imask_nostag = 1
  439. nested_grid%imask_xstag = 1
  440. nested_grid%imask_ystag = 1
  441. nested_grid%imask_xystag = 1
  442. CALL med_interp_domain ( head_grid , nested_grid )
  443. WRITE ( message , * ) 'MOUSTA_L', nested_grid%mu_2(ips,jps) , nested_grid%u_2(ips,kde-2,jps)
  444. CALL wrf_debug ( 99,message )
  445. CALL vertical_interp (nested_grid,znw_c,znu_c,cf1_c,cf2_c,cf3_c,cfn_c,cfn1_c,k_dim_c)
  446. WRITE ( message , * ) 'MOUSTA_V', nested_grid%mu_2(ips,jps) , nested_grid%u_2(ips,kde-2,jps)
  447. CALL wrf_debug ( 99,message )
  448. nested_grid%ht_int = nested_grid%ht
  449. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  450. IF ( time_loop .EQ. 1 ) THEN
  451. ! Dimension info for fine grid.
  452. CALL get_ijk_from_grid ( nested_grid , &
  453. nids, nide, njds, njde, nkds, nkde, &
  454. nims, nime, njms, njme, nkms, nkme, &
  455. nips, nipe, njps, njpe, nkps, nkpe )
  456. ! Store horizontally interpolated terrain in temp location
  457. CALL copy_3d_field ( nested_grid%ht_fine , nested_grid%ht , &
  458. nids , nide , njds , njde , 1 , 1 , &
  459. nims , nime , njms , njme , 1 , 1 , &
  460. nips , nipe , njps , njpe , 1 , 1 )
  461. ! Open the fine grid SI static file.
  462. CALL construct_filename1( si_inpname , 'wrfndi' , nested_grid%id , 2 )
  463. CALL wrf_debug ( 100 , 'med_sidata_input: calling open_r_dataset for ' // TRIM(si_inpname) )
  464. CALL open_r_dataset ( idsi, TRIM(si_inpname) , nested_grid , config_flags , "DATASET=INPUT", ierr )
  465. IF ( ierr .NE. 0 ) THEN
  466. CALL wrf_error_fatal( 'real: error opening FG input for reading: ' // TRIM (si_inpname) )
  467. END IF
  468. ! Input data.
  469. CALL wrf_debug ( 100 , 'ndown_em: calling input_auxinput2' )
  470. CALL input_auxinput2 ( idsi , nested_grid , config_flags , ierr )
  471. nested_grid%ht_input = nested_grid%ht
  472. ! Close this fine grid static input file.
  473. CALL wrf_debug ( 100 , 'ndown_em: closing fine grid static input' )
  474. CALL close_dataset ( idsi , config_flags , "DATASET=INPUT" )
  475. ! Blend parent and nest field of terrain.
  476. CALL blend_terrain ( nested_grid%ht_fine , nested_grid%ht , &
  477. nids , nide , njds , njde , 1 , 1 , &
  478. nims , nime , njms , njme , 1 , 1 , &
  479. nips , nipe , njps , njpe , 1 , 1 )
  480. nested_grid%ht_input = nested_grid%ht
  481. nested_grid%ht_int = nested_grid%ht_fine
  482. ! We need a fine grid landuse in the interpolation. So we need to generate
  483. ! that field now.
  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. ELSE IF ( ( nested_grid% vegcat(ips,jps) .GT. 0.5 ) .AND. &
  493. ( nested_grid%soilcat(ips,jps) .GT. 0.5 ) ) THEN
  494. DO j = jps, MIN(jde-1,jpe)
  495. DO i = ips, MIN(ide-1,ipe)
  496. nested_grid%ivgtyp(i,j) = NINT(nested_grid% vegcat(i,j))
  497. nested_grid%isltyp(i,j) = NINT(nested_grid%soilcat(i,j))
  498. END DO
  499. END DO
  500. ELSE
  501. num_veg_cat = SIZE ( nested_grid%landusef , DIM=2 )
  502. num_soil_top_cat = SIZE ( nested_grid%soilctop , DIM=2 )
  503. num_soil_bot_cat = SIZE ( nested_grid%soilcbot , DIM=2 )
  504. CALL land_percentages ( nested_grid%xland , &
  505. nested_grid%landusef , nested_grid%soilctop , nested_grid%soilcbot , &
  506. nested_grid%isltyp , nested_grid%ivgtyp , &
  507. num_veg_cat , num_soil_top_cat , num_soil_bot_cat , &
  508. ids , ide , jds , jde , kds , kde , &
  509. ims , ime , jms , jme , kms , kme , &
  510. ips , ipe , jps , jpe , kps , kpe , &
  511. model_config_rec%iswater(nested_grid%id) )
  512. END IF
  513. DO j = jps, MIN(jde-1,jpe)
  514. DO i = ips, MIN(ide-1,ipe)
  515. nested_grid%lu_index(i,j) = nested_grid%ivgtyp(i,j)
  516. END DO
  517. END DO
  518. #ifndef PLANET
  519. CALL check_consistency ( nested_grid%ivgtyp , nested_grid%isltyp , nested_grid%landmask , &
  520. ids , ide , jds , jde , kds , kde , &
  521. ims , ime , jms , jme , kms , kme , &
  522. ips , ipe , jps , jpe , kps , kpe , &
  523. model_config_rec%iswater(nested_grid%id) )
  524. CALL check_consistency2( nested_grid%ivgtyp , nested_grid%isltyp , nested_grid%landmask , &
  525. nested_grid%tmn , nested_grid%tsk , nested_grid%sst , nested_grid%xland , &
  526. nested_grid%tslb , nested_grid%smois , nested_grid%sh2o , &
  527. config_flags%num_soil_layers , nested_grid%id , &
  528. ids , ide , jds , jde , kds , kde , &
  529. ims , ime , jms , jme , kms , kme , &
  530. ips , ipe , jps , jpe , kps , kpe , &
  531. model_config_rec%iswater(nested_grid%id) )
  532. #endif
  533. END IF
  534. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  535. ! We have 2 terrain elevations. One is from input and the other is from the
  536. ! the horizontal interpolation.
  537. nested_grid%ht_fine = nested_grid%ht_input
  538. nested_grid%ht = nested_grid%ht_int
  539. ! We have both the interpolated fields and the higher-resolution static fields. From these
  540. ! the rebalancing is now done. Note also that the field nested_grid%ht is now from the
  541. ! fine grid input file (after this call is completed).
  542. CALL rebalance_driver ( nested_grid )
  543. ! Different things happen during the different time loops:
  544. ! first loop - write wrfinput file, close data set, copy files to holder arrays
  545. ! middle loops - diff 3d/2d arrays, compute and output bc
  546. ! last loop - diff 3d/2d arrays, compute and output bc, write wrfbdy file, close wrfbdy file
  547. IF ( time_loop .EQ. 1 ) THEN
  548. ! Set the time info.
  549. print *,'current_date = ',current_date
  550. CALL domain_clock_set( nested_grid, &
  551. current_timestr=current_date(1:19) )
  552. #ifdef WRF_CHEM
  553. !
  554. ! Put in chemistry data
  555. !
  556. IF( nested_grid%chem_opt .NE. 0 ) then
  557. ! IF( nested_grid%chem_in_opt .EQ. 0 ) then
  558. ! Read the chemistry data from a previous wrf forecast (wrfout file)
  559. ! Generate chemistry data from a idealized vertical profile
  560. ! message = 'STARTING WITH BACKGROUND CHEMISTRY '
  561. CALL wrf_message ( message )
  562. ! CALL input_chem_profile ( nested_grid )
  563. if(nested_grid%biomass_burn_opt == BIOMASSB) THEN
  564. message = 'READING BIOMASS BURNING EMISSIONS DATA '
  565. CALL wrf_message ( message )
  566. CALL med_read_wrf_chem_emissopt3 ( nested_grid , config_flags)
  567. end if
  568. if(nested_grid%dust_opt == 1 .or. nested_grid%dmsemis_opt == 1 &
  569. .or. nested_grid%chem_opt == 300 .or. nested_grid%chem_opt == 301) then
  570. message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS'
  571. CALL wrf_message ( message )
  572. CALL med_read_wrf_chem_gocart_bg ( nested_grid , config_flags)
  573. end if
  574. if( nested_grid%bio_emiss_opt .eq. 2 )then
  575. message = 'READING BEIS3.11 EMISSIONS DATA'
  576. CALL wrf_message ( message )
  577. CALL med_read_wrf_chem_bioemiss ( nested_grid , config_flags)
  578. else if( nested_grid%bio_emiss_opt == 3 ) THEN
  579. message = 'READING MEGAN 2 EMISSIONS DATA'
  580. CALL wrf_message ( message )
  581. CALL med_read_wrf_chem_bioemiss ( nested_grid , config_flags)
  582. endif
  583. ! ELSE
  584. ! message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
  585. ! CALL wrf_message ( message )
  586. ! ENDIF
  587. ENDIF
  588. #endif
  589. ! Output the first time period of the data.
  590. CALL output_input ( fido , nested_grid , config_flags , ierr )
  591. CALL wrf_put_dom_ti_integer ( fido , 'MAP_PROJ' , map_proj , 1 , ierr )
  592. ! CALL wrf_put_dom_ti_real ( fido , 'DX' , dx , 1 , ierr )
  593. ! CALL wrf_put_dom_ti_real ( fido , 'DY' , dy , 1 , ierr )
  594. CALL wrf_put_dom_ti_real ( fido , 'CEN_LAT' , cen_lat , 1 , ierr )
  595. CALL wrf_put_dom_ti_real ( fido , 'CEN_LON' , cen_lon , 1 , ierr )
  596. CALL wrf_put_dom_ti_real ( fido , 'TRUELAT1' , truelat1 , 1 , ierr )
  597. CALL wrf_put_dom_ti_real ( fido , 'TRUELAT2' , truelat2 , 1 , ierr )
  598. CALL wrf_put_dom_ti_real ( fido , 'MOAD_CEN_LAT' , moad_cen_lat , 1 , ierr )
  599. CALL wrf_put_dom_ti_real ( fido , 'STAND_LON' , stand_lon , 1 , ierr )
  600. CALL wrf_put_dom_ti_integer ( fido , 'ISWATER' , iswater , 1 , ierr )
  601. ! These change if the initial time for the nest is not the same as the
  602. ! first time period in the WRF output file.
  603. ! Now that we know the starting date, we need to set the GMT, JULYR, and JULDAY
  604. ! values for the global attributes. This call is based on the setting of the
  605. ! current_date string.
  606. CALL geth_julgmt ( julyr , julday , gmt)
  607. CALL nl_set_julyr ( nested_grid%id , julyr )
  608. CALL nl_set_julday ( nested_grid%id , julday )
  609. CALL nl_set_gmt ( nested_grid%id , gmt )
  610. CALL wrf_put_dom_ti_real ( fido , 'GMT' , gmt , 1 , ierr )
  611. CALL wrf_put_dom_ti_integer ( fido , 'JULYR' , julyr , 1 , ierr )
  612. CALL wrf_put_dom_ti_integer ( fido , 'JULDAY' , julday , 1 , ierr )
  613. print *,'current_date =',current_date
  614. print *,'julyr=',julyr
  615. print *,'julday=',julday
  616. print *,'gmt=',gmt
  617. ! Close the input (wrfout_d01_000000, for example) file. That's right, the
  618. ! input is an output file. Who'd've thunk.
  619. CALL close_dataset ( fido , config_flags , "DATASET=INPUT" )
  620. ! We need to save the 3d/2d data to compute a difference during the next loop. Couple the
  621. ! 3d fields with total mu (mub + mu_2) and the stagger-specific map scale factor.
  622. ! u, theta, h, scalars coupled with my, v coupled with mx
  623. CALL couple ( nested_grid%mu_2 , nested_grid%mub , ubdy3dtemp1 , nested_grid%u_2 , &
  624. 'u' , nested_grid%msfuy , &
  625. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  626. CALL couple ( nested_grid%mu_2 , nested_grid%mub , vbdy3dtemp1 , nested_grid%v_2 , &
  627. 'v' , nested_grid%msfvx , &
  628. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  629. CALL couple ( nested_grid%mu_2 , nested_grid%mub , tbdy3dtemp1 , nested_grid%t_2 , &
  630. 't' , nested_grid%msfty , &
  631. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  632. CALL couple ( nested_grid%mu_2 , nested_grid%mub , pbdy3dtemp1 , nested_grid%ph_2 , &
  633. 'h' , nested_grid%msfty , &
  634. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  635. CALL couple ( nested_grid%mu_2 , nested_grid%mub , qbdy3dtemp1 , nested_grid%moist(ims:ime,kms:kme,jms:jme,P_QV) , &
  636. 't' , nested_grid%msfty , &
  637. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  638. DO j = jps , jpe
  639. DO i = ips , ipe
  640. mbdy2dtemp1(i,1,j) = nested_grid%mu_2(i,j)
  641. END DO
  642. END DO
  643. ! There are 2 components to the lateral boundaries. First, there is the starting
  644. ! point of this time period - just the outer few rows and columns.
  645. CALL stuff_bdy ( ubdy3dtemp1 , nested_grid%u_bxs, nested_grid%u_bxe, &
  646. nested_grid%u_bys, nested_grid%u_bye, &
  647. 'U' , spec_bdy_width , &
  648. ids , ide , jds , jde , kds , kde , &
  649. ims , ime , jms , jme , kms , kme , &
  650. ips , ipe , jps , jpe , kps , kpe )
  651. CALL stuff_bdy ( vbdy3dtemp1 , nested_grid%v_bxs, nested_grid%v_bxe, &
  652. nested_grid%v_bys, nested_grid%v_bye, &
  653. 'V' , spec_bdy_width , &
  654. ids , ide , jds , jde , kds , kde , &
  655. ims , ime , jms , jme , kms , kme , &
  656. ips , ipe , jps , jpe , kps , kpe )
  657. CALL stuff_bdy ( tbdy3dtemp1 , nested_grid%t_bxs, nested_grid%t_bxe, &
  658. nested_grid%t_bys, nested_grid%t_bye, &
  659. 'T' , spec_bdy_width , &
  660. ids , ide , jds , jde , kds , kde , &
  661. ims , ime , jms , jme , kms , kme , &
  662. ips , ipe , jps , jpe , kps , kpe )
  663. CALL stuff_bdy ( pbdy3dtemp1 , nested_grid%ph_bxs, nested_grid%ph_bxe, &
  664. nested_grid%ph_bys, nested_grid%ph_bye, &
  665. 'W' , spec_bdy_width , &
  666. ids , ide , jds , jde , kds , kde , &
  667. ims , ime , jms , jme , kms , kme , &
  668. ips , ipe , jps , jpe , kps , kpe )
  669. CALL stuff_bdy ( qbdy3dtemp1 , nested_grid%moist_bxs(jms:jme,kms:kme,1:spec_bdy_width,P_QV), &
  670. nested_grid%moist_bxe(jms:jme,kms:kme,1:spec_bdy_width,P_QV), &
  671. nested_grid%moist_bys(ims:ime,kms:kme,1:spec_bdy_width,P_QV), &
  672. nested_grid%moist_bye(ims:ime,kms:kme,1:spec_bdy_width,P_QV), &
  673. 'T' , spec_bdy_width , &
  674. ids , ide , jds , jde , kds , kde , &
  675. ims , ime , jms , jme , kms , kme , &
  676. ips , ipe , jps , jpe , kps , kpe )
  677. CALL stuff_bdy ( mbdy2dtemp1 , nested_grid%mu_bxs, nested_grid%mu_bxe, &
  678. nested_grid%mu_bys, nested_grid%mu_bye, &
  679. 'M' , spec_bdy_width , &
  680. ids , ide , jds , jde , 1 , 1 , &
  681. ims , ime , jms , jme , 1 , 1 , &
  682. ips , ipe , jps , jpe , 1 , 1 )
  683. #ifdef WRF_CHEM
  684. do nvchem=1,num_chem
  685. ! if(nvchem.eq.p_o3)then
  686. ! write(0,*)'fill ch_b',cbdy3dtemp1(5,1,5),nvchem
  687. ! endif
  688. cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
  689. ! if(nvchem.eq.p_o3)then
  690. ! write(0,*)'fill ch_b',cbdy3dtemp1(5,1,5)
  691. ! endif
  692. CALL stuff_bdy ( cbdy3dtemp1 , nested_grid%chem_bxs(jms:jme,kms:kme,1:spec_bdy_width,nvchem), &
  693. nested_grid%chem_bxe(jms:jme,kms:kme,1:spec_bdy_width,nvchem), &
  694. nested_grid%chem_bys(ims:ime,kms:kme,1:spec_bdy_width,nvchem), &
  695. nested_grid%chem_bye(ims:ime,kms:kme,1:spec_bdy_width,nvchem), &
  696. 'T' , spec_bdy_width , &
  697. ids , ide , jds , jde , kds , kde , &
  698. ims , ime , jms , jme , kms , kme , &
  699. ips , ipe , jps , jpe , kps , kpe )
  700. cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)=cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)
  701. ! if(nvchem.eq.p_o3)then
  702. ! write(0,*)'filled ch_b',time_loop,cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem)
  703. ! endif
  704. enddo
  705. #endif
  706. ELSE IF ( ( time_loop .GT. 1 ) .AND. ( time_loop .LT. time_loop_max ) ) THEN
  707. ! u, theta, h, scalars coupled with my, v coupled with mx
  708. CALL couple ( nested_grid%mu_2 , nested_grid%mub , ubdy3dtemp2 , nested_grid%u_2 , &
  709. 'u' , nested_grid%msfuy , &
  710. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  711. CALL couple ( nested_grid%mu_2 , nested_grid%mub , vbdy3dtemp2 , nested_grid%v_2 , &
  712. 'v' , nested_grid%msfvx , &
  713. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  714. CALL couple ( nested_grid%mu_2 , nested_grid%mub , tbdy3dtemp2 , nested_grid%t_2 , &
  715. 't' , nested_grid%msfty , &
  716. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  717. CALL couple ( nested_grid%mu_2 , nested_grid%mub , pbdy3dtemp2 , nested_grid%ph_2 , &
  718. 'h' , nested_grid%msfty , &
  719. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  720. CALL couple ( nested_grid%mu_2 , nested_grid%mub , qbdy3dtemp2 , nested_grid%moist(ims:ime,kms:kme,jms:jme,P_QV) , &
  721. 't' , nested_grid%msfty , &
  722. ids, ide, jds, jde, kds, kde, ims, ime, jms, jme, kms, kme, ips, ipe, jps, jpe, kps, kpe )
  723. DO j = jps , jpe
  724. DO i = ips , ipe
  725. mbdy2dtemp2(i,1,j) = nested_grid%mu_2(i,j)
  726. END DO
  727. END DO
  728. ! During all of the loops after the first loop, we first compute the boundary
  729. ! tendencies with the current data values and the previously save information
  730. ! stored in the *bdy3dtemp1 arrays.
  731. CALL stuff_bdytend ( ubdy3dtemp2 , ubdy3dtemp1 , new_bdy_frq , &
  732. nested_grid%u_btxs, nested_grid%u_btxe , &
  733. nested_grid%u_btys, nested_grid%u_btye , &
  734. 'U' , &
  735. spec_bdy_width , &
  736. ids , ide , jds , jde , kds , kde , &
  737. ims , ime , jms , jme , kms , kme , &
  738. ips , ipe , jps , jpe , kps , kpe )
  739. CALL stuff_bdytend ( vbdy3dtemp2 , vbdy3dtemp1 , new_bdy_frq , &
  740. nested_grid%v_btxs, nested_grid%v_btxe , &
  741. nested_grid%v_btys, nested_grid%v_btye , &
  742. 'V' , &
  743. spec_bdy_width , &
  744. ids , ide , jds , jde , kds , kde , &
  745. ims , ime , jms , jme , kms , kme , &
  746. ips , ipe , jps , jpe , kps , kpe )
  747. CALL stuff_bdytend ( tbdy3dtemp2 , tbdy3dtemp1 , new_bdy_frq , &
  748. nested_grid%t_btxs, nested_grid%t_btxe , &
  749. nested_grid%t_btys, nested_grid%t_btye , &
  750. 'T' , &
  751. spec_bdy_width , &
  752. ids , ide , jds , jde , kds , kde , &
  753. ims , ime , jms , jme , kms , kme , &
  754. ips , ipe , jps , jpe , kps , kpe )
  755. CALL stuff_bdytend ( pbdy3dtemp2 , pbdy3dtemp1 , new_bdy_frq , &
  756. nested_grid%ph_btxs, nested_grid%ph_btxe , &
  757. nested_grid%ph_btys, nested_grid%ph_btye , &
  758. 'W' , &
  759. spec_bdy_width , &
  760. ids , ide , jds , jde , kds , kde , &
  761. ims , ime , jms , jme , kms , kme , &
  762. ips , ipe , jps , jpe , kps , kpe )
  763. CALL stuff_bdytend ( qbdy3dtemp2 , qbdy3dtemp1 , new_bdy_frq , &
  764. nested_grid%moist_btxs(jms:jme,kms:kme,1:spec_bdy_width,P_QV), &
  765. nested_grid%moist_btxe(jms:jme,kms:kme,1:spec_bdy_width,P_QV), &
  766. nested_grid%moist_btys(ims:ime,kms:kme,1:spec_bdy_width,P_QV), &
  767. nested_grid%moist_btye(ims:ime,kms:kme,1:spec_bdy_width,P_QV), &
  768. 'T' , &
  769. spec_bdy_width , &
  770. ids , ide , jds , jde , kds , kde , &
  771. ims , ime , jms , jme , kms , kme , &
  772. ips , ipe , jps , jpe , kps , kpe )
  773. CALL stuff_bdytend ( mbdy2dtemp2 , mbdy2dtemp1 , new_bdy_frq , &
  774. nested_grid%mu_btxs, nested_grid%mu_btxe , &
  775. nested_grid%mu_btys, nested_grid%mu_btye , &
  776. 'M' , &
  777. spec_bdy_width , &
  778. ids , ide , jds , jde , 1 , 1 , &
  779. ims , ime , jms , jme , 1 , 1 , &
  780. ips , ipe , jps , jpe , 1 , 1 )
  781. #ifdef WRF_CHEM
  782. do nvchem=1,num_chem
  783. cbdy3dtemp1(ips:ipe,kps:kpe,jps:jpe)=cbdy3dtemp0(ips:ipe,kps:kpe,jps:jpe,nvchem)
  784. cbdy3dtemp2(ips:ipe,kps:kpe,jps:jpe)=nested_grid%chem(ips:ipe,kps:kpe,jps:jpe,nvchem)
  785. ! if(nvchem.eq.p_o3)then
  786. ! write(0,*)'fill 1ch_b2',time_loop,cbdy3dtemp1(ips,kps,jps),cbdy3dtemp0(ips,kps,jps,nvchem),cbdy3dtemp2(ips,kps,jps)
  787. ! endif
  788. CALL stuff_bdytend ( cbdy3dtemp2 , cbdy3dtemp1 , new_bdy_frq , &
  789. nested_grid%chem_btxs(jms:jme,kms:kme,1:spec_bdy_width,nvchem), &
  790. nested_grid%chem_btxe(jms:jme,kms:kme,1:spec_bdy_width,nvchem), &
  791. nested_grid%chem_btys(ims:ime,kms:kme,1:spec_bdy_width,nvchem), &
  792. nested_grid%chem_btye(ims:ime,kms:kme,1:spec_bdy_width,nvchem), &
  793. 'T' , &

Large files files are truncated, but you can click here to view the full file