PageRenderTime 56ms CodeModel.GetById 13ms RepoModel.GetById 0ms app.codeStats 0ms

/wrfv2_fire/main/real_nmm.F

http://github.com/jbeezley/wrf-fire
FORTRAN Legacy | 1681 lines | 952 code | 302 blank | 427 comment | 42 complexity | 97c07765bfd653bc871ca2764f9471fa 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. ! Create an initial data set for the WRF model based on real data. This
  2. ! program is specifically set up for the NMM core.
  3. PROGRAM real_data
  4. USE module_machine
  5. USE module_domain
  6. USE module_initialize_real
  7. USE module_io_domain
  8. USE module_driver_constants
  9. USE module_configure
  10. USE module_timing
  11. USE module_check_a_mundo
  12. #ifdef WRF_CHEM
  13. USE module_input_chem_data
  14. USE module_input_chem_bioemiss
  15. #endif
  16. USE module_utility
  17. #ifdef DM_PARALLEL
  18. USE module_dm
  19. #endif
  20. IMPLICIT NONE
  21. REAL :: time , bdyfrq
  22. INTEGER :: loop , levels_to_process , debug_level
  23. TYPE(domain) , POINTER :: null_domain
  24. TYPE(domain) , POINTER :: grid
  25. TYPE (grid_config_rec_type) :: config_flags
  26. INTEGER :: number_at_same_level
  27. INTEGER :: max_dom, domain_id
  28. INTEGER :: idum1, idum2
  29. #ifdef DM_PARALLEL
  30. INTEGER :: nbytes
  31. ! INTEGER, PARAMETER :: configbuflen = 2*1024
  32. INTEGER, PARAMETER :: configbuflen = 4*CONFIG_BUF_LEN
  33. INTEGER :: configbuf( configbuflen )
  34. LOGICAL , EXTERNAL :: wrf_dm_on_monitor
  35. #endif
  36. INTEGER :: ids , ide , jds , jde , kds , kde
  37. INTEGER :: ims , ime , jms , jme , kms , kme
  38. INTEGER :: ips , ipe , jps , jpe , kps , kpe
  39. INTEGER :: ijds , ijde , spec_bdy_width
  40. INTEGER :: i , j , k , idts
  41. #ifdef DEREF_KLUDGE
  42. ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
  43. INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
  44. INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  45. INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  46. #endif
  47. CHARACTER (LEN=80) :: message
  48. INTEGER :: start_year , start_month , start_day
  49. INTEGER :: start_hour , start_minute , start_second
  50. INTEGER :: end_year , end_month , end_day , &
  51. end_hour , end_minute , end_second
  52. INTEGER :: interval_seconds , real_data_init_type
  53. INTEGER :: time_loop_max , time_loop, rc
  54. REAL :: t1,t2
  55. #include "version_decl"
  56. INTERFACE
  57. SUBROUTINE Setup_Timekeeping( grid )
  58. USE module_domain
  59. TYPE(domain), POINTER :: grid
  60. END SUBROUTINE Setup_Timekeeping
  61. END INTERFACE
  62. ! Define the name of this program (program_name defined in module_domain)
  63. program_name = "REAL_NMM " // TRIM(release_version) // " PREPROCESSOR"
  64. #ifdef DM_PARALLEL
  65. CALL disable_quilting
  66. #endif
  67. ! CALL start()
  68. ! Initialize the modules used by the WRF system.
  69. ! Many of the CALLs made from the
  70. ! init_modules routine are NO-OPs. Typical initializations
  71. ! are: the size of a
  72. ! REAL, setting the file handles to a pre-use value, defining moisture and
  73. ! chemistry indices, etc.
  74. CALL wrf_debug ( 100 , 'real_nmm: calling init_modules ' )
  75. !!!! CALL init_modules
  76. CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called)
  77. CALL WRFU_Initialize( defaultCalKind=WRFU_CAL_GREGORIAN, rc=rc )
  78. CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called)
  79. ! The configuration switches mostly come from the NAMELIST input.
  80. #ifdef DM_PARALLEL
  81. IF ( wrf_dm_on_monitor() ) THEN
  82. write(message,*) 'call initial_config'
  83. CALL wrf_message ( message )
  84. CALL initial_config
  85. ENDIF
  86. CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
  87. CALL wrf_dm_bcast_bytes( configbuf, nbytes )
  88. CALL set_config_as_buffer( configbuf, configbuflen )
  89. CALL wrf_dm_initialize
  90. #else
  91. CALL initial_config
  92. #endif
  93. CALL check_nml_consistency
  94. CALL set_physics_rconfigs
  95. CALL nl_get_debug_level ( 1, debug_level )
  96. CALL set_wrf_debug_level ( debug_level )
  97. CALL wrf_message ( program_name )
  98. ! Allocate the space for the mother of all domains.
  99. NULLIFY( null_domain )
  100. CALL wrf_debug ( 100 , 'real_nmm: calling alloc_and_configure_domain ' )
  101. CALL alloc_and_configure_domain ( domain_id = 1 , &
  102. grid = head_grid , &
  103. parent = null_domain , &
  104. kid = -1 )
  105. grid => head_grid
  106. #include "deref_kludge.h"
  107. CALL Setup_Timekeeping ( grid )
  108. CALL domain_clock_set( grid, &
  109. time_step_seconds=model_config_rec%interval_seconds )
  110. CALL wrf_debug ( 100 , 'real_nmm: calling set_scalar_indices_from_config ' )
  111. CALL set_scalar_indices_from_config ( grid%id , idum1, idum2 )
  112. CALL wrf_debug ( 100 , 'real_nmm: calling model_to_grid_config_rec ' )
  113. CALL model_to_grid_config_rec ( grid%id , model_config_rec , config_flags )
  114. write(message,*) 'after model_to_grid_config_rec, e_we, e_sn are: ', &
  115. config_flags%e_we, config_flags%e_sn
  116. CALL wrf_message(message)
  117. ! Initialize the WRF IO: open files, init file handles, etc.
  118. CALL wrf_debug ( 100 , 'real_nmm: calling init_wrfio' )
  119. CALL init_wrfio
  120. ! Some of the configuration values may have been modified from the initial READ
  121. ! of the NAMELIST, so we re-broadcast the configuration records.
  122. #ifdef DM_PARALLEL
  123. CALL wrf_debug ( 100 , 'real_nmm: re-broadcast the configuration records' )
  124. CALL get_config_as_buffer( configbuf, configbuflen, nbytes )
  125. CALL wrf_dm_bcast_bytes( configbuf, nbytes )
  126. CALL set_config_as_buffer( configbuf, configbuflen )
  127. #endif
  128. ! No looping in this layer.
  129. CALL med_sidata_input ( grid , config_flags )
  130. ! We are done.
  131. CALL wrf_debug ( 0 , 'real_nmm: SUCCESS COMPLETE REAL_NMM INIT' )
  132. #ifdef DM_PARALLEL
  133. CALL wrf_dm_shutdown
  134. #endif
  135. CALL WRFU_Finalize( rc=rc )
  136. END PROGRAM real_data
  137. SUBROUTINE med_sidata_input ( grid , config_flags )
  138. ! Driver layer
  139. USE module_domain
  140. USE module_io_domain
  141. ! Model layer
  142. USE module_configure
  143. USE module_bc_time_utilities
  144. USE module_initialize_real
  145. USE module_optional_input
  146. #ifdef WRF_CHEM
  147. USE module_input_chem_data
  148. USE module_input_chem_bioemiss
  149. #endif
  150. USE module_si_io_nmm
  151. USE module_date_time
  152. IMPLICIT NONE
  153. ! Interface
  154. INTERFACE
  155. SUBROUTINE start_domain ( grid , allowed_to_read )
  156. USE module_domain
  157. TYPE (domain) grid
  158. LOGICAL, INTENT(IN) :: allowed_to_read
  159. END SUBROUTINE start_domain
  160. END INTERFACE
  161. ! Arguments
  162. TYPE(domain) :: grid
  163. TYPE (grid_config_rec_type) :: config_flags
  164. ! Local
  165. INTEGER :: time_step_begin_restart
  166. INTEGER :: idsi , ierr , myproc
  167. CHARACTER (LEN=80) :: si_inpname
  168. CHARACTER (LEN=132) :: message
  169. CHARACTER(LEN=19) :: start_date_char , end_date_char , &
  170. current_date_char , next_date_char
  171. INTEGER :: time_loop_max , loop
  172. INTEGER :: julyr , julday , LEN
  173. INTEGER :: io_form_auxinput1
  174. INTEGER, EXTERNAL :: use_package
  175. LOGICAL :: using_binary_wrfsi
  176. REAL :: gmt
  177. REAL :: t1,t2
  178. INTEGER :: numx_sm_levels_input,numx_st_levels_input
  179. REAL,DIMENSION(100) :: smx_levels_input,stx_levels_input
  180. #ifdef DEREF_KLUDGE
  181. ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
  182. INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
  183. INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  184. INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  185. #endif
  186. #if defined(HWRF)
  187. ! Sam Says:
  188. ! The *INIT arrays are used to read init data written out by hwrf_prep_hybrid
  189. REAL,ALLOCATABLE,DIMENSION(:,:,:)::TINIT,UINIT,VINIT,QINIT,CWMINIT
  190. REAL,ALLOCATABLE,DIMENSION(:,:,:)::PINIT
  191. REAL,ALLOCATABLE,DIMENSION(:,:)::PDINIT
  192. ! The *B arrays are used to read boundary data written out by hwrf_prep_hybrid
  193. REAL,ALLOCATABLE,DIMENSION(:,:,:)::TB,UB,VB,QB,CWMB
  194. REAL,ALLOCATABLE,DIMENSION(:,:)::PDB
  195. INTEGER :: KB, LM, IM, JM, iunit_gfs, N
  196. integer :: i,j,k
  197. LOGICAL,EXTERNAL :: WRF_DM_ON_MONITOR
  198. integer :: ids,ide, jds,jde, kds,kde
  199. integer :: ims,ime, jms,jme, kms,kme
  200. integer :: its,ite, jts,jte, kts,kte
  201. integer :: ioerror
  202. #endif
  203. #include "deref_kludge.h"
  204. grid%input_from_file = .true.
  205. grid%input_from_file = .false.
  206. CALL compute_si_start_and_end ( model_config_rec%start_year (grid%id) , &
  207. model_config_rec%start_month (grid%id) , &
  208. model_config_rec%start_day (grid%id) , &
  209. model_config_rec%start_hour (grid%id) , &
  210. model_config_rec%start_minute(grid%id) , &
  211. model_config_rec%start_second(grid%id) , &
  212. model_config_rec% end_year (grid%id) , &
  213. model_config_rec% end_month (grid%id) , &
  214. model_config_rec% end_day (grid%id) , &
  215. model_config_rec% end_hour (grid%id) , &
  216. model_config_rec% end_minute(grid%id) , &
  217. model_config_rec% end_second(grid%id) , &
  218. model_config_rec%interval_seconds , &
  219. model_config_rec%real_data_init_type , &
  220. start_date_char , end_date_char , time_loop_max )
  221. ! Here we define the initial time to process, for later use by the code.
  222. current_date_char = start_date_char
  223. ! start_date = start_date_char // '.0000'
  224. start_date = start_date_char
  225. current_date = start_date
  226. CALL nl_set_bdyfrq ( grid%id , REAL(model_config_rec%interval_seconds) )
  227. ! Loop over each time period to process.
  228. write(message,*) 'time_loop_max: ', time_loop_max
  229. CALL wrf_message(message)
  230. DO loop = 1 , time_loop_max
  231. internal_time_loop=loop
  232. write(message,*) 'loop=', loop
  233. CALL wrf_message(message)
  234. write(message,*) '-----------------------------------------------------------'
  235. CALL wrf_message(message)
  236. write(message,*) ' '
  237. CALL wrf_message(message)
  238. write(message,'(A,A,A,I2,A,I2)') ' Current date being processed: ', &
  239. current_date, ', which is loop #',loop,' out of ',time_loop_max
  240. CALL wrf_message(message)
  241. ! After current_date has been set, fill in the julgmt stuff.
  242. CALL geth_julgmt ( config_flags%julyr , config_flags%julday , &
  243. config_flags%gmt )
  244. ! Now that the specific Julian info is available,
  245. ! save these in the model config record.
  246. CALL nl_set_gmt (grid%id, config_flags%gmt)
  247. CALL nl_set_julyr (grid%id, config_flags%julyr)
  248. CALL nl_set_julday (grid%id, config_flags%julday)
  249. CALL nl_get_io_form_auxinput1( 1, io_form_auxinput1 )
  250. using_binary_wrfsi=.false.
  251. write(message,*) 'TRIM(config_flags%auxinput1_inname): ', TRIM(config_flags%auxinput1_inname)
  252. CALL wrf_message(message)
  253. #if defined(HWRF)
  254. ifph_onlyfirst: if(.not.grid%use_prep_hybrid .or. loop==1) then
  255. #endif
  256. IF (config_flags%auxinput1_inname(1:10) .eq. 'real_input') THEN
  257. using_binary_wrfsi=.true.
  258. ENDIF
  259. SELECT CASE ( use_package(io_form_auxinput1) )
  260. #ifdef NETCDF
  261. CASE ( IO_NETCDF )
  262. ! Open the wrfinput file.
  263. current_date_char(11:11)='_'
  264. WRITE ( wrf_err_message , FMT='(A,A)' )'med_sidata_input: calling open_r_dataset for ',TRIM(config_flags%auxinput1_inname)
  265. CALL wrf_debug ( 100 , wrf_err_message )
  266. IF ( config_flags%auxinput1_inname(1:8) .NE. 'wrf_real' ) THEN
  267. CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
  268. config_flags%io_form_auxinput1 )
  269. ELSE
  270. CALL construct_filename2a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char )
  271. END IF
  272. CALL open_r_dataset ( idsi, TRIM(si_inpname) , grid , config_flags , "DATASET=AUXINPUT1", ierr )
  273. IF ( ierr .NE. 0 ) THEN
  274. CALL wrf_error_fatal( 'error opening ' // TRIM(si_inpname) // ' for input; bad date in namelist or file not in directory' )
  275. ENDIF
  276. ! Input data.
  277. CALL wrf_debug (100, 'med_sidata_input: call input_auxinput1_wrf')
  278. CALL input_auxinput1 ( idsi, grid, config_flags, ierr )
  279. ! Possible optional SI input. This sets flags used by init_domain.
  280. IF ( loop .EQ. 1 ) THEN
  281. CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
  282. CALL init_module_optional_input ( grid , config_flags )
  283. CALL wrf_debug ( 100 , 'med_sidata_input: calling optional_input' )
  284. !
  285. CALL optional_input ( grid , idsi , config_flags )
  286. write(0,*) 'maxval st_input(1) within real_nmm: ', maxval(st_input(:,1,:))
  287. END IF
  288. !
  289. CALL close_dataset ( idsi , config_flags , "DATASET=AUXINPUT1" )
  290. #endif
  291. #ifdef INTIO
  292. CASE ( IO_INTIO )
  293. ! Possible optional SI input. This sets flags used by init_domain.
  294. IF ( loop .EQ. 1 ) THEN
  295. CALL wrf_debug (100, 'med_sidata_input: call init_module_optional_input' )
  296. CALL init_module_optional_input ( grid , config_flags )
  297. END IF
  298. IF (using_binary_wrfsi) THEN
  299. current_date_char(11:11)='_'
  300. CALL read_si ( grid, current_date_char )
  301. current_date_char(11:11)='T'
  302. ELSE
  303. write(message,*) 'binary WPS branch'
  304. CALL wrf_message(message)
  305. current_date_char(11:11)='_'
  306. CALL construct_filename4a( si_inpname , config_flags%auxinput1_inname , grid%id , 2 , current_date_char , &
  307. config_flags%io_form_auxinput1 )
  308. CALL read_wps ( grid, trim(si_inpname), current_date_char, config_flags%num_metgrid_levels )
  309. !!! bogus set some flags??
  310. flag_metgrid=1
  311. flag_soilhgt=1
  312. ENDIF
  313. #endif
  314. CASE DEFAULT
  315. CALL wrf_error_fatal('real: not valid io_form_auxinput1')
  316. END SELECT
  317. #if defined(HWRF)
  318. endif ifph_onlyfirst
  319. #endif
  320. grid%islope=1
  321. grid%vegfra=grid%vegfrc
  322. grid%dfrlg=grid%dfl/9.81
  323. grid%isurban=1
  324. grid%isoilwater=14
  325. ! Initialize the mother domain for this time period with input data.
  326. CALL wrf_debug ( 100 , 'med_sidata_input: calling init_domain' )
  327. grid%input_from_file = .true.
  328. CALL init_domain ( grid )
  329. #if defined(HWRF)
  330. read_phinit: if(grid%use_prep_hybrid) then
  331. #if defined(DM_PARALLEL)
  332. if(.not. wrf_dm_on_monitor()) then
  333. call wrf_error_fatal('real: in use_prep_hybrid mode, threading and mpi are forbidden.')
  334. endif
  335. #endif
  336. ph_loop1: if(loop==1) then
  337. ! determine kds, ids, jds
  338. SELECT CASE ( model_data_order )
  339. CASE ( DATA_ORDER_ZXY )
  340. kds = grid%sd31 ; kde = grid%ed31 ;
  341. ids = grid%sd32 ; ide = grid%ed32 ;
  342. jds = grid%sd33 ; jde = grid%ed33 ;
  343. kms = grid%sm31 ; kme = grid%em31 ;
  344. ims = grid%sm32 ; ime = grid%em32 ;
  345. jms = grid%sm33 ; jme = grid%em33 ;
  346. kts = grid%sp31 ; kte = grid%ep31 ; ! tile is entire patch
  347. its = grid%sp32 ; ite = grid%ep32 ; ! tile is entire patch
  348. jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
  349. CASE ( DATA_ORDER_XYZ )
  350. ids = grid%sd31 ; ide = grid%ed31 ;
  351. jds = grid%sd32 ; jde = grid%ed32 ;
  352. kds = grid%sd33 ; kde = grid%ed33 ;
  353. ims = grid%sm31 ; ime = grid%em31 ;
  354. jms = grid%sm32 ; jme = grid%em32 ;
  355. kms = grid%sm33 ; kme = grid%em33 ;
  356. its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
  357. jts = grid%sp32 ; jte = grid%ep32 ; ! tile is entire patch
  358. kts = grid%sp33 ; kte = grid%ep33 ; ! tile is entire patch
  359. CASE ( DATA_ORDER_XZY )
  360. ids = grid%sd31 ; ide = grid%ed31 ;
  361. kds = grid%sd32 ; kde = grid%ed32 ;
  362. jds = grid%sd33 ; jde = grid%ed33 ;
  363. ims = grid%sm31 ; ime = grid%em31 ;
  364. kms = grid%sm32 ; kme = grid%em32 ;
  365. jms = grid%sm33 ; jme = grid%em33 ;
  366. its = grid%sp31 ; ite = grid%ep31 ; ! tile is entire patch
  367. kts = grid%sp32 ; kte = grid%ep32 ; ! tile is entire patch
  368. jts = grid%sp33 ; jte = grid%ep33 ; ! tile is entire patch
  369. END SELECT
  370. ! Allocate 3D initialization arrays:
  371. call wrf_message('ALLOCATE PREP_HYBRID INIT ARRAYS')
  372. ALLOCATE ( TINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
  373. ALLOCATE ( PINIT (ids:(ide-1),kds:kde ,jds:(jde-1)) )
  374. ALLOCATE ( UINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
  375. ALLOCATE ( VINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
  376. ALLOCATE ( QINIT (ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
  377. ALLOCATE ( CWMINIT(ids:(ide-1),kds:(kde-1) ,jds:(jde-1)) )
  378. ALLOCATE ( PDINIT (ids:(ide-1), jds:(jde-1)) )
  379. REWIND 900
  380. READ(900,iostat=ioerror) PDINIT,TINIT,QINIT,CWMINIT,UINIT,VINIT,PINIT
  381. if(ioerror/=0) then
  382. call wrf_error_fatal('Unable to read MAKBND output from unit 900.')
  383. endif
  384. WRITE(0,*) 'U V T AT 10 10 10 ',UINIT(10,10,10),VINIT(10,10,10),TINIT(10,10,10)
  385. ! Switch from IKJ to IJK ordering
  386. DO I = ids,ide-1
  387. DO J = jds,jde-1
  388. grid%pd(I,J) = PDINIT(I,J)
  389. DO K = kds,kde-1
  390. grid%q2(I,J,K) = 0
  391. grid%u(I,J,K) = UINIT(I,K,J)
  392. grid%v(I,J,K) = VINIT(I,K,J)
  393. grid%t(I,J,K) = TINIT(I,K,J)
  394. grid%q(I,J,K) = QINIT(I,K,J)
  395. grid%cwm(I,J,K) = CWMINIT(I,K,J)
  396. ENDDO
  397. ! Was commented out in original V2 HWRF too:
  398. ! DO K = kds,kde
  399. ! grid%nmm_pint(I,J,K) = pinit(I,K,J)
  400. ! ENDDO
  401. ENDDO
  402. ENDDO
  403. call wrf_message('DEALLOCATE PREP_HYBRID INIT ARRAYS')
  404. deallocate(TINIT,PINIT,UINIT,VINIT,QINIT,CWMINIT,PDINIT)
  405. end if ph_loop1
  406. end if read_phinit
  407. #endif
  408. CALL model_to_grid_config_rec ( grid%id, model_config_rec, config_flags )
  409. ! Close this file that is output from the SI and input to this pre-proc.
  410. CALL wrf_debug ( 100 , 'med_sidata_input: back from init_domain' )
  411. !!! not sure about this, but doesnt seem like needs to be called each time
  412. IF ( loop .EQ. 1 ) THEN
  413. CALL start_domain ( grid , .TRUE.)
  414. END IF
  415. #ifdef WRF_CHEM
  416. IF ( loop == 1 ) THEN
  417. ! IF ( ( grid%chem_opt .EQ. RADM2 ) .OR. &
  418. ! ( grid%chem_opt .EQ. RADM2SORG ) .OR. &
  419. ! ( grid%chem_opt .EQ. RACM ) .OR. &
  420. ! ( grid%chem_opt .EQ. RACMSORG ) ) THEN
  421. IF( grid%chem_opt > 0 ) then
  422. ! Read the chemistry data from a previous wrf forecast (wrfout file)
  423. IF(grid%chem_in_opt == 1 ) THEN
  424. message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION'
  425. CALL wrf_message ( message )
  426. CALL input_ext_chem_file( grid )
  427. IF(grid%bio_emiss_opt == BEIS311 ) THEN
  428. message = 'READING BEIS3.11 EMISSIONS DATA'
  429. CALL wrf_message ( message )
  430. CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
  431. else IF(grid%bio_emiss_opt == 3 ) THEN !shc
  432. message = 'READING MEGAN 2 EMISSIONS DATA'
  433. CALL wrf_message ( message )
  434. CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
  435. END IF
  436. ELSEIF(grid%chem_in_opt == 0)then
  437. ! Generate chemistry data from a idealized vertical profile
  438. message = 'STARTING WITH BACKGROUND CHEMISTRY '
  439. CALL wrf_message ( message )
  440. write(message,*)' ETA1 '
  441. CALL wrf_message ( message )
  442. ! write(message,*) grid%eta1
  443. ! CALL wrf_message ( message )
  444. CALL input_chem_profile ( grid )
  445. IF(grid%bio_emiss_opt == BEIS311 ) THEN
  446. message = 'READING BEIS3.11 EMISSIONS DATA'
  447. CALL wrf_message ( message )
  448. CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
  449. else IF(grid%bio_emiss_opt == 3 ) THEN !shc
  450. message = 'READING MEGAN 2 EMISSIONS DATA'
  451. CALL wrf_message ( message )
  452. CALL med_read_wrf_chem_bioemiss ( grid , config_flags)
  453. END IF
  454. ELSE
  455. message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION'
  456. CALL wrf_message ( message )
  457. ENDIF
  458. ENDIF
  459. ENDIF
  460. #endif
  461. config_flags%isurban=1
  462. config_flags%isoilwater=14
  463. CALL assemble_output ( grid , config_flags , loop , time_loop_max )
  464. ! Here we define the next time that we are going to process.
  465. CALL geth_newdate ( current_date_char , start_date_char , &
  466. loop * model_config_rec%interval_seconds )
  467. current_date = current_date_char // '.0000'
  468. CALL domain_clock_set( grid, current_date(1:19) )
  469. write(message,*) 'current_date= ', current_date
  470. CALL wrf_message(message)
  471. END DO
  472. END SUBROUTINE med_sidata_input
  473. SUBROUTINE compute_si_start_and_end ( &
  474. start_year, start_month, start_day, start_hour, &
  475. start_minute, start_second, &
  476. end_year , end_month , end_day , end_hour , &
  477. end_minute , end_second , &
  478. interval_seconds , real_data_init_type , &
  479. start_date_char , end_date_char , time_loop_max )
  480. USE module_date_time
  481. IMPLICIT NONE
  482. INTEGER :: start_year , start_month , start_day , &
  483. start_hour , start_minute , start_second
  484. INTEGER :: end_year , end_month , end_day , &
  485. end_hour , end_minute , end_second
  486. INTEGER :: interval_seconds , real_data_init_type
  487. INTEGER :: time_loop_max , time_loop
  488. CHARACTER(LEN=132) :: message
  489. CHARACTER(LEN=19) :: current_date_char , start_date_char , &
  490. end_date_char , next_date_char
  491. ! WRITE ( start_date_char , FMT = &
  492. ! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
  493. ! start_year,start_month,start_day,start_hour,start_minute,start_second
  494. ! WRITE ( end_date_char , FMT = &
  495. ! '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2)' ) &
  496. ! end_year, end_month, end_day, end_hour, end_minute, end_second
  497. WRITE ( start_date_char , FMT = &
  498. '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
  499. start_year,start_month,start_day,start_hour,start_minute,start_second
  500. WRITE ( end_date_char , FMT = &
  501. '(I4.4,"-",I2.2,"-",I2.2,"T",I2.2,":",I2.2,":",I2.2)' ) &
  502. end_year, end_month, end_day, end_hour, end_minute, end_second
  503. ! start_date = start_date_char // '.0000'
  504. ! Figure out our loop count for the processing times.
  505. time_loop = 1
  506. PRINT '(A,I4,A,A,A)','Time period #',time_loop, &
  507. ' to process = ',start_date_char,'.'
  508. current_date_char = start_date_char
  509. loop_count : DO
  510. CALL geth_newdate (next_date_char, current_date_char, interval_seconds )
  511. IF ( next_date_char .LT. end_date_char ) THEN
  512. time_loop = time_loop + 1
  513. PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
  514. ' to process = ',next_date_char,'.'
  515. current_date_char = next_date_char
  516. ELSE IF ( next_date_char .EQ. end_date_char ) THEN
  517. time_loop = time_loop + 1
  518. PRINT '(A,I4,A,A,A)','Time period #',time_loop,&
  519. ' to process = ',next_date_char,'.'
  520. PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
  521. time_loop_max = time_loop
  522. EXIT loop_count
  523. ELSE IF ( next_date_char .GT. end_date_char ) THEN
  524. PRINT '(A,I4,A)','Total analysis times to input = ',time_loop,'.'
  525. time_loop_max = time_loop
  526. EXIT loop_count
  527. END IF
  528. END DO loop_count
  529. write(message,*) 'done in si_start_and_end'
  530. CALL wrf_message(message)
  531. END SUBROUTINE compute_si_start_and_end
  532. SUBROUTINE assemble_output ( grid , config_flags , loop , time_loop_max )
  533. !!! replace with something? USE module_big_step_utilities_em
  534. USE module_domain
  535. USE module_io_domain
  536. USE module_configure
  537. USE module_date_time
  538. USE module_bc
  539. IMPLICIT NONE
  540. #if defined(HWRF)
  541. external get_wrf_debug_level
  542. integer :: debug
  543. #endif
  544. TYPE(domain) :: grid
  545. TYPE (grid_config_rec_type) :: config_flags
  546. INTEGER , INTENT(IN) :: loop , time_loop_max
  547. INTEGER :: ids , ide , jds , jde , kds , kde
  548. INTEGER :: ims , ime , jms , jme , kms , kme
  549. INTEGER :: ips , ipe , jps , jpe , kps , kpe
  550. INTEGER :: ijds , ijde , spec_bdy_width
  551. INTEGER :: inc_h,inc_v
  552. INTEGER :: i , j , k , idts
  553. INTEGER :: id1 , interval_seconds , ierr, rc, sst_update
  554. INTEGER , SAVE :: id ,id4
  555. CHARACTER (LEN=80) :: inpname , bdyname
  556. CHARACTER(LEN= 4) :: loop_char
  557. CHARACTER(LEN=132) :: message
  558. character *19 :: temp19
  559. character *24 :: temp24 , temp24b
  560. REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp1 , vbdy3dtemp1 ,&
  561. tbdy3dtemp1 , &
  562. cwmbdy3dtemp1 , qbdy3dtemp1,&
  563. q2bdy3dtemp1 , pdbdy2dtemp1
  564. REAL, DIMENSION(:,:,:), ALLOCATABLE, SAVE :: ubdy3dtemp2 , vbdy3dtemp2 , &
  565. tbdy3dtemp2 , &
  566. cwmbdy3dtemp2 , qbdy3dtemp2, &
  567. q2bdy3dtemp2, pdbdy2dtemp2
  568. REAL :: t1,t2
  569. #ifdef DEREF_KLUDGE
  570. ! see http://www.mmm.ucar.edu/wrf/WG2/topics/deref_kludge.htm
  571. INTEGER :: sm31 , em31 , sm32 , em32 , sm33 , em33
  572. INTEGER :: sm31x, em31x, sm32x, em32x, sm33x, em33x
  573. INTEGER :: sm31y, em31y, sm32y, em32y, sm33y, em33y
  574. #endif
  575. #if defined(HWRF)
  576. ! Sam says:
  577. ! The *B arrays are used to read boundary data written out by hwrf_prep_hybrid
  578. REAL,ALLOCATABLE,DIMENSION(:,:,:)::TB,UB,VB,QB,CWMB
  579. REAL,ALLOCATABLE,DIMENSION(:,:)::PDB
  580. ! Dimensions and looping variables:
  581. INTEGER :: KB, LM, IM, JM, N
  582. ! Unit number to read boundary data from (changes each time)
  583. INTEGER :: iunit_gfs
  584. ! Did we allocate the prep_hybrid input arrays?
  585. LOGICAL :: alloc_ph_arrays
  586. integer :: ioerror
  587. #endif
  588. #include "deref_kludge.h"
  589. #if defined(HWRF)
  590. alloc_ph_arrays=.false.
  591. call get_wrf_debug_level(debug)
  592. #endif
  593. ! Various sizes that we need to be concerned about.
  594. ids = grid%sd31
  595. ide = grid%ed31-1 ! 030730tst
  596. jds = grid%sd32
  597. jde = grid%ed32-1 ! 030730tst
  598. kds = grid%sd33
  599. kde = grid%ed33-1 ! 030730tst
  600. ims = grid%sm31
  601. ime = grid%em31
  602. jms = grid%sm32
  603. jme = grid%em32
  604. kms = grid%sm33
  605. kme = grid%em33
  606. ips = grid%sp31
  607. ipe = grid%ep31-1 ! 030730tst
  608. jps = grid%sp32
  609. jpe = grid%ep32-1 ! 030730tst
  610. kps = grid%sp33
  611. kpe = grid%ep33-1 ! 030730tst
  612. if (IPE .ne. IDE) IPE=IPE+1
  613. if (JPE .ne. JDE) JPE=JPE+1
  614. write(message,*) 'assemble output (ids,ide): ', ids,ide
  615. CALL wrf_message(message)
  616. write(message,*) 'assemble output (ims,ime): ', ims,ime
  617. CALL wrf_message(message)
  618. write(message,*) 'assemble output (ips,ipe): ', ips,ipe
  619. CALL wrf_message(message)
  620. write(message,*) 'assemble output (jds,jde): ', jds,jde
  621. CALL wrf_message(message)
  622. write(message,*) 'assemble output (jms,jme): ', jms,jme
  623. CALL wrf_message(message)
  624. write(message,*) 'assemble output (jps,jpe): ', jps,jpe
  625. CALL wrf_message(message)
  626. write(message,*) 'assemble output (kds,kde): ', kds,kde
  627. CALL wrf_message(message)
  628. write(message,*) 'assemble output (kms,kme): ', kms,kme
  629. CALL wrf_message(message)
  630. write(message,*) 'assemble output (kps,kpe): ', kps,kpe
  631. CALL wrf_message(message)
  632. ijds = MIN ( ids , jds )
  633. !mptest030805 ijde = MAX ( ide , jde )
  634. ijde = MAX ( ide , jde ) + 1 ! to make stuff_bdy dimensions consistent with alloc
  635. ! Boundary width, scalar value.
  636. spec_bdy_width = model_config_rec%spec_bdy_width
  637. interval_seconds = model_config_rec%interval_seconds
  638. sst_update = model_config_rec%sst_update
  639. !-----------------------------------------------------------------------
  640. !
  641. main_loop_test: IF ( loop .EQ. 1 ) THEN
  642. !
  643. !-----------------------------------------------------------------------
  644. IF ( time_loop_max .NE. 1 ) THEN
  645. IF(sst_update .EQ. 1)THEN
  646. CALL construct_filename1( inpname , 'wrflowinp' , grid%id , 2 )
  647. CALL open_w_dataset ( id4, TRIM(inpname) , grid , config_flags , output_auxinput4 , "DATASET=AUXINPUT4", ierr )
  648. IF ( ierr .NE. 0 ) THEN
  649. CALL wrf_error_fatal( 'real: error opening wrflowinp for writing' )
  650. END IF
  651. CALL output_auxinput4 ( id4, grid , config_flags , ierr )
  652. END IF
  653. END IF
  654. ! This is the space needed to save the current 3d data for use in computing
  655. ! the lateral boundary tendencies.
  656. ALLOCATE ( ubdy3dtemp1(ims:ime,jms:jme,kms:kme) )
  657. ALLOCATE ( vbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
  658. ALLOCATE ( tbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
  659. ALLOCATE ( qbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
  660. ALLOCATE ( cwmbdy3dtemp1(ims:ime,jms:jme,kms:kme) )
  661. ALLOCATE ( q2bdy3dtemp1(ims:ime,jms:jme,kms:kme) )
  662. ALLOCATE ( pdbdy2dtemp1(ims:ime,jms:jme,1:1) )
  663. ubdy3dtemp1=0.
  664. vbdy3dtemp1=0.
  665. tbdy3dtemp1=0.
  666. qbdy3dtemp1=0.
  667. cwmbdy3dtemp1=0.
  668. q2bdy3dtemp1=0.
  669. pdbdy2dtemp1=0.
  670. ALLOCATE ( ubdy3dtemp2(ims:ime,jms:jme,kms:kme) )
  671. ALLOCATE ( vbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
  672. ALLOCATE ( tbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
  673. ALLOCATE ( qbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
  674. ALLOCATE ( cwmbdy3dtemp2(ims:ime,jms:jme,kms:kme) )
  675. ALLOCATE ( q2bdy3dtemp2(ims:ime,jms:jme,kms:kme) )
  676. ALLOCATE ( pdbdy2dtemp2(ims:ime,jms:jme,1:1) )
  677. ubdy3dtemp2=0.
  678. vbdy3dtemp2=0.
  679. tbdy3dtemp2=0.
  680. qbdy3dtemp2=0.
  681. cwmbdy3dtemp2=0.
  682. q2bdy3dtemp2=0.
  683. pdbdy2dtemp2=0.
  684. ! Open the wrfinput file. From this program, this is an *output* file.
  685. CALL construct_filename1( inpname , 'wrfinput' , grid%id , 2 )
  686. CALL open_w_dataset ( id1, TRIM(inpname) , grid , config_flags , &
  687. output_input , "DATASET=INPUT", ierr )
  688. IF ( ierr .NE. 0 ) THEN
  689. CALL wrf_error_fatal( 'real: error opening wrfinput for writing' )
  690. ENDIF
  691. ! CALL calc_current_date ( grid%id , 0. )
  692. ! grid%write_metadata = .true.
  693. write(message,*) 'making call to output_input'
  694. CALL wrf_message(message)
  695. CALL output_input ( id1, grid , config_flags , ierr )
  696. !***
  697. !*** CLOSE THE WRFINPUT DATASET
  698. !***
  699. CALL close_dataset ( id1 , config_flags , "DATASET=INPUT" )
  700. ! We need to save the 3d data to compute a
  701. ! difference during the next loop.
  702. !
  703. !-----------------------------------------------------------------------
  704. !*** SOUTHERN BOUNDARY
  705. !-----------------------------------------------------------------------
  706. !
  707. IF(JPS==JDS)THEN
  708. J=1
  709. DO k = kps , MIN(kde,kpe)
  710. DO i = ips , MIN(ide,ipe)
  711. ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
  712. vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
  713. tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
  714. qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
  715. cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
  716. q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
  717. END DO
  718. END DO
  719. DO i = ips , MIN(ide,ipe)
  720. pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
  721. END DO
  722. ENDIF
  723. !
  724. !-----------------------------------------------------------------------
  725. !*** NORTHERN BOUNDARY
  726. !-----------------------------------------------------------------------
  727. !
  728. IF(JPE==JDE)THEN
  729. J=MIN(JDE,JPE)
  730. DO k = kps , MIN(kde,kpe)
  731. DO i = ips , MIN(ide,ipe)
  732. ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
  733. vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
  734. tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
  735. qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
  736. cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
  737. q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
  738. END DO
  739. END DO
  740. DO i = ips , MIN(ide,ipe)
  741. pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
  742. END DO
  743. ENDIF
  744. !
  745. !-----------------------------------------------------------------------
  746. !*** WESTERN BOUNDARY
  747. !-----------------------------------------------------------------------
  748. !
  749. write(message,*) 'western boundary, store winds over J: ', jps, min(jpe,jde)
  750. CALL wrf_message(message)
  751. IF(IPS==IDS)THEN
  752. I=1
  753. DO k = kps , MIN(kde,kpe)
  754. inc_h=mod(jps+1,2)
  755. DO j = jps+inc_h, min(jde,jpe),2
  756. if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
  757. tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
  758. qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
  759. cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
  760. q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
  761. if(k==1)then
  762. write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
  763. CALL wrf_debug(10,message)
  764. endif
  765. endif
  766. END DO
  767. END DO
  768. DO k = kps , MIN(kde,kpe)
  769. inc_v=mod(jps,2)
  770. DO j = jps+inc_v, min(jde,jpe),2
  771. if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
  772. ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
  773. vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
  774. endif
  775. END DO
  776. END DO
  777. !
  778. inc_h=mod(jps+1,2)
  779. DO j = jps+inc_h, min(jde,jpe),2
  780. if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
  781. pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
  782. write(message,*)' loop=',loop,' i=',i,' j=',j,' pdbdy2dtemp1(i,j)=',pdbdy2dtemp1(i,j,1)
  783. CALL wrf_debug(10,message)
  784. endif
  785. END DO
  786. ENDIF
  787. !
  788. !-----------------------------------------------------------------------
  789. !*** EASTERN BOUNDARY
  790. !-----------------------------------------------------------------------
  791. !
  792. IF(IPE==IDE)THEN
  793. I=MIN(IDE,IPE)
  794. !
  795. DO k = kps , MIN(kde,kpe)
  796. !
  797. !*** Make sure the J loop is on the global boundary
  798. !
  799. inc_h=mod(jps+1,2)
  800. DO j = jps+inc_h, min(jde,jpe),2
  801. if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
  802. tbdy3dtemp1(i,j,k) = grid%t(i,j,k)
  803. qbdy3dtemp1(i,j,k) = grid%q(i,j,k)
  804. cwmbdy3dtemp1(i,j,k) = grid%cwm(i,j,k)
  805. q2bdy3dtemp1(i,j,k) = grid%q2(i,j,k)
  806. endif
  807. END DO
  808. END DO
  809. DO k = kps , MIN(kde,kpe)
  810. inc_v=mod(jps,2)
  811. DO j = jps+inc_v, min(jde,jpe),2
  812. if (J .ge. 2 .and. J .le. JDE-1 .and. mod(J,2) .eq. 0) then
  813. ubdy3dtemp1(i,j,k) = grid%u(i,j,k)
  814. vbdy3dtemp1(i,j,k) = grid%v(i,j,k)
  815. endif
  816. END DO
  817. END DO
  818. !
  819. inc_h=mod(jps+1,2)
  820. DO j = jps+inc_h, min(jde,jpe),2
  821. if (J .ge. 3 .and. J .le. JDE-2 .and. mod(J,2) .eq. 1) then
  822. pdbdy2dtemp1(i,j,1) = grid%pd(i,j)
  823. endif
  824. END DO
  825. ENDIF
  826. ! There are 2 components to the lateral boundaries.
  827. ! First, there is the starting
  828. ! point of this time period - just the outer few rows and columns.
  829. CALL stuff_bdy_ijk (ubdy3dtemp1, grid%u_bxs, grid%u_bxe, &
  830. grid%u_bys, grid%u_bye, &
  831. 'N', spec_bdy_width , &
  832. ids , ide+1 , jds , jde+1 , kds , kde+1 , &
  833. ims , ime , jms , jme , kms , kme , &
  834. ips , ipe , jps , jpe , kps , kpe+1 )
  835. CALL stuff_bdy_ijk (vbdy3dtemp1, grid%v_bxs, grid%v_bxe, &
  836. grid%v_bys, grid%v_bye, &
  837. 'N', spec_bdy_width , &
  838. ids , ide+1 , jds , jde+1 , kds , kde+1 , &
  839. ims , ime , jms , jme , kms , kme , &
  840. ips , ipe , jps , jpe , kps , kpe+1 )
  841. CALL stuff_bdy_ijk (tbdy3dtemp1, grid%t_bxs, grid%t_bxe, &
  842. grid%t_bys, grid%t_bye, &
  843. 'N', spec_bdy_width , &
  844. ids , ide+1 , jds , jde+1 , kds , kde+1 , &
  845. ims , ime , jms , jme , kms , kme , &
  846. ips , ipe , jps , jpe , kps , kpe+1 )
  847. CALL stuff_bdy_ijk (cwmbdy3dtemp1, grid%cwm_bxs, grid%cwm_bxe, &
  848. grid%cwm_bys, grid%cwm_bye, &
  849. 'N', spec_bdy_width , &
  850. ids , ide+1 , jds , jde+1 , kds , kde+1 , &
  851. ims , ime , jms , jme , kms , kme , &
  852. ips , ipe , jps , jpe , kps , kpe+1 )
  853. CALL stuff_bdy_ijk (qbdy3dtemp1, grid%q_bxs, grid%q_bxe, &
  854. grid%q_bys, grid%q_bye, &
  855. 'N', spec_bdy_width , &
  856. ids , ide+1 , jds , jde+1 , kds , kde+1 , &
  857. ims , ime , jms , jme , kms , kme , &
  858. ips , ipe , jps , jpe , kps , kpe+1 )
  859. CALL stuff_bdy_ijk (q2bdy3dtemp1, grid%q2_bxs, grid%q2_bxe, &
  860. grid%q2_bys, grid%q2_bye, &
  861. 'N', spec_bdy_width , &
  862. ids , ide+1 , jds , jde+1 , kds , kde+1 , &
  863. ims , ime , jms , jme , kms , kme , &
  864. ips , ipe , jps , jpe , kps , kpe+1 )
  865. CALL stuff_bdy_ijk (pdbdy2dtemp1, grid%pd_bxs, grid%pd_bxe, &
  866. grid%pd_bys, grid%pd_bye, &
  867. 'M', spec_bdy_width, &
  868. ids , ide+1 , jds , jde+1 , 1 , 1 , &
  869. ims , ime , jms , jme , 1 , 1 , &
  870. ips , ipe , jps , jpe , 1 , 1 )
  871. !-----------------------------------------------------------------------
  872. !
  873. ELSE IF ( loop .GT. 1 ) THEN
  874. !
  875. !-----------------------------------------------------------------------
  876. call wrf_debug(1,'LOOP>1, so start making non-init boundary conditions')
  877. #if defined(HWRF)
  878. bdytmp_useph: if(grid%use_prep_hybrid) then
  879. call wrf_debug(1,'ALLOCATE PREP_HYBRID BOUNDARY ARRAYS')
  880. !! When running in prep_hybrid mode, we must read in the data here.
  881. ! Allocate boundary arrays:
  882. KB = 2*IDE + JDE - 3
  883. LM = KDE
  884. IM = IDE
  885. JM = JDE
  886. ALLOCATE(TB(KB,LM,2))
  887. ALLOCATE(QB(KB,LM,2))
  888. ALLOCATE(CWMB(KB,LM,2))
  889. ALLOCATE(UB(KB,LM,2))
  890. ALLOCATE(VB(KB,LM,2))
  891. ALLOCATE(PDB(KB,2))
  892. alloc_ph_arrays=.true.
  893. ! Read in the data:
  894. IUNIT_GFS = 900 + LOOP - 1
  895. READ(IUNIT_GFS,iostat=ioerror) PDB,TB,QB,CWMB,UB,VB
  896. if(ioerror/=0) then
  897. write(message,*) 'Unable to read MAKBND output from unit ',IUNIT_GFS
  898. call wrf_error_fatal(message)
  899. endif
  900. ! Now copy the data into the temporary boundary arrays, and
  901. ! switch from IKJ to IJK while we do it.
  902. !! Southern boundary
  903. IF(JPS.EQ.JDS)THEN
  904. J=1
  905. DO k = kps , MIN(kde,kpe)
  906. N=1
  907. DO i = ips , MIN(ide,ipe)
  908. tbdy3dtemp2(i,j,k) = TB(N,k,1)
  909. qbdy3dtemp2(i,j,k) = QB(N,k,1)
  910. cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
  911. q2bdy3dtemp2(i,j,k) = 0.0 !KWON
  912. write(message,*)'southtend t',k,i,n,tbdy3dtemp2(i,j,k)
  913. call wrf_debug(10,message)
  914. write(message,*)'southtend q',k,i,n,qbdy3dtemp2(i,j,k)
  915. call wrf_debug(10,message)
  916. if (K .eq. 1 ) then
  917. write(0,*) 'S boundary values T,Q : ', I,tbdy3dtemp2(i,j,k), &
  918. qbdy3dtemp2(i,j,k)
  919. endif
  920. N=N+1
  921. END DO
  922. END DO
  923. DO k = kps , MIN(kde,kpe)
  924. N=1
  925. DO i = ips , MIN(ide,ipe)
  926. ubdy3dtemp2(i,j,k) = UB(N,k,1)
  927. vbdy3dtemp2(i,j,k) = VB(N,k,1)
  928. N=N+1
  929. ENDDO
  930. END DO
  931. N=1
  932. DO i = ips , MIN(ide,ipe)
  933. pdbdy2dtemp2(i,j,1) = PDB(N,1)
  934. write(message,*)'southtend p',i,n,pdbdy2dtemp1(i,j,1)
  935. call wrf_debug(10,message)
  936. N=N+1
  937. END DO
  938. ENDIF
  939. ! Northern boundary
  940. IF(JPE.EQ.JDE)THEN
  941. J=MIN(JDE,JPE)
  942. DO k = kps , MIN(kde,kpe)
  943. N=IM+1
  944. DO i = ips , MIN(ide,ipe)
  945. tbdy3dtemp2(i,j,k) = TB(N,k,1)
  946. qbdy3dtemp2(i,j,k) = QB(N,k,1)
  947. cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
  948. q2bdy3dtemp2(i,j,k) = 0.0 !KWON
  949. write(message,*)'northtend t',k,i,n,tbdy3dtemp2(i,j,k)
  950. call wrf_debug(10,message)
  951. write(message,*)'northtend q',k,i,n,qbdy3dtemp2(i,j,k)
  952. call wrf_debug(10,message)
  953. N=N+1
  954. END DO
  955. END DO
  956. DO k = kps , MIN(kde,kpe)
  957. N=IM
  958. DO i = ips , MIN(ide,ipe)
  959. ubdy3dtemp2(i,j,k) = UB(N,k,1)
  960. vbdy3dtemp2(i,j,k) = VB(N,k,1)
  961. N=N+1
  962. END DO
  963. END DO
  964. N=IM+1
  965. DO i = ips , MIN(ide,ipe)
  966. pdbdy2dtemp2(i,j,1) = PDB(N,1)
  967. write(message,*)'northtend p',i,n,pdbdy2dtemp1(i,j,1)
  968. call wrf_debug(10,message)
  969. N=N+1
  970. END DO
  971. ENDIF
  972. !! Western boundary
  973. IF(IPS.EQ.IDS)THEN
  974. I=1
  975. DO k = kps , MIN(kde,kpe)
  976. N=2*IM+1
  977. inc_h=mod(jps+1,2)
  978. DO j = jps+inc_h, MIN(jde,jpe),2
  979. if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
  980. tbdy3dtemp2(i,j,k) = TB(N,k,1)
  981. qbdy3dtemp2(i,j,k) = QB(N,k,1)
  982. cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
  983. q2bdy3dtemp2(i,j,k) = 0.0 !KWON
  984. write(message,*)'westtend t',k,j,n,tbdy3dtemp2(i,j,k)
  985. call wrf_debug(10,message)
  986. write(message,*)'westtend q',k,j,n,qbdy3dtemp2(i,j,k)
  987. call wrf_debug(10,message)
  988. N=N+1
  989. endif
  990. END DO
  991. END DO
  992. DO k = kps , MIN(kde,kpe)
  993. N=2*IM-1
  994. inc_v=mod(jps,2)
  995. DO j = jps+inc_v, MIN(jde,jpe),2
  996. if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
  997. ubdy3dtemp2(i,j,k) = UB(N,k,1)
  998. vbdy3dtemp2(i,j,k) = VB(N,k,1)
  999. N=N+1
  1000. endif
  1001. END DO
  1002. END DO
  1003. N=2*IM+1
  1004. inc_h=mod(jps+1,2)
  1005. DO j = jps+inc_h, MIN(jde,jpe),2
  1006. if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
  1007. pdbdy2dtemp2(i,j,1) = PDB(N,1)
  1008. write(message,*)'westtend p',j,n,pdbdy2dtemp1(i,j,1)
  1009. call wrf_debug(10,message)
  1010. N=N+1
  1011. endif
  1012. END DO
  1013. ENDIF
  1014. !! Eastern boundary
  1015. IF(IPE.EQ.IDE)THEN
  1016. I=MIN(IDE,IPE)
  1017. DO k = kps , MIN(kde,kpe)
  1018. N=2*IM+(JM/2)
  1019. inc_h=mod(jps+1,2)
  1020. DO j = jps+inc_h, MIN(jde,jpe),2
  1021. if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
  1022. tbdy3dtemp2(i,j,k) = TB(N,k,1)
  1023. qbdy3dtemp2(i,j,k) = QB(N,k,1)
  1024. cwmbdy3dtemp2(i,j,k) = CWMB(N,k,1)
  1025. q2bdy3dtemp2(i,j,k) = 0.0 !KWON
  1026. write(message,*)'easttend t',k,j,n,tbdy3dtemp2(i,j,k)
  1027. call wrf_debug(10,message)
  1028. write(message,*)'easttend q',k,j,n,qbdy3dtemp2(i,j,k)
  1029. call wrf_debug(10,message)
  1030. N=N+1
  1031. endif
  1032. END DO
  1033. END DO
  1034. DO k = kps , MIN(kde,kpe)
  1035. N=2*IM+(JM/2)-1
  1036. inc_v=mod(jps,2)
  1037. DO j = jps+inc_v, MIN(jde,jpe),2
  1038. if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
  1039. ubdy3dtemp2(i,j,k) = UB(N,k,1)
  1040. vbdy3dtemp2(i,j,k) = VB(N,k,1)
  1041. N=N+1
  1042. endif
  1043. END DO
  1044. END DO
  1045. N=2*IM+(JM/2)
  1046. inc_h=mod(jps+1,2)
  1047. DO j = jps+inc_h, MIN(jde,jpe),2
  1048. if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
  1049. pdbdy2dtemp2(i,j,1) = PDB(N,1)
  1050. write(message,*)'easttend p',j,n,pdbdy2dtemp1(i,j,1)
  1051. call wrf_debug(10,message)
  1052. N=N+1
  1053. endif
  1054. END DO
  1055. ENDIF
  1056. else
  1057. #endif
  1058. CALL output_auxinput4 ( id4, grid , config_flags , ierr )
  1059. #if defined( HWRF)
  1060. endif bdytmp_useph
  1061. #endif
  1062. write(message,*)' assemble_output loop=',loop,' in IF block'
  1063. call wrf_message(message)
  1064. ! Open the boundary file.
  1065. IF ( loop .eq. 2 ) THEN
  1066. CALL construct_filename1( bdyname , 'wrfbdy' , grid%id , 2 )
  1067. CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , &
  1068. output_boundary , "DATASET=BOUNDARY", ierr )
  1069. IF ( ierr .NE. 0 ) THEN
  1070. CALL wrf_error_fatal( 'real: error opening wrfbdy for writing' )
  1071. ENDIF
  1072. ! grid%write_metadata = .true.
  1073. ELSE
  1074. ! what's this do?
  1075. ! grid%write_metadata = .true.
  1076. ! grid%write_metadata = .false.
  1077. CALL domain_clockadvance( grid )
  1078. END IF
  1079. #if defined(HWRF)
  1080. bdytmp_notph: if(.not.grid%use_prep_hybrid) then
  1081. #endif
  1082. !-----------------------------------------------------------------------
  1083. !*** SOUTHERN BOUNDARY
  1084. !-----------------------------------------------------------------------
  1085. !
  1086. IF(JPS==JDS)THEN
  1087. J=1
  1088. DO k = kps , MIN(kde,kpe)
  1089. DO i = ips , MIN(ide,ipe)
  1090. ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
  1091. vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
  1092. tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
  1093. qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
  1094. cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
  1095. q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
  1096. END DO
  1097. END DO
  1098. !
  1099. DO i = ips , MIN(ide,ipe)
  1100. pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
  1101. END DO
  1102. ENDIF
  1103. !
  1104. !-----------------------------------------------------------------------
  1105. !*** NORTHERN BOUNDARY
  1106. !-----------------------------------------------------------------------
  1107. !
  1108. IF(JPE==JDE)THEN
  1109. J=MIN(JDE,JPE)
  1110. DO k = kps , MIN(kde,kpe)
  1111. DO i = ips , MIN(ide,ipe)
  1112. ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
  1113. vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
  1114. tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
  1115. qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
  1116. cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
  1117. q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
  1118. END DO
  1119. END DO
  1120. DO i = ips , MIN(ide,ipe)
  1121. pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
  1122. END DO
  1123. ENDIF
  1124. !
  1125. !-----------------------------------------------------------------------
  1126. !*** WESTERN BOUNDARY
  1127. !-----------------------------------------------------------------------
  1128. !
  1129. IF(IPS==IDS)THEN
  1130. I=1
  1131. DO k = kps , MIN(kde,kpe)
  1132. inc_h=mod(jps+1,2)
  1133. if(k==1)then
  1134. write(message,*)' assemble_ouput loop=',loop,' inc_h=',inc_h,' jps=',jps
  1135. call wrf_debug(10,message)
  1136. endif
  1137. DO j = jps+inc_h, MIN(jde,jpe),2
  1138. if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
  1139. tbdy3dtemp2(i,j,k) = grid%t(i,j,k)
  1140. if(k==1)then
  1141. write(message,*)' loop=',loop,' i=',i,' j=',j,' tbdy3dtemp1(i,j,k)=',tbdy3dtemp1(i,j,k)
  1142. call wrf_debug(10,message)
  1143. endif
  1144. qbdy3dtemp2(i,j,k) = grid%q(i,j,k)
  1145. cwmbdy3dtemp2(i,j,k) = grid%cwm(i,j,k)
  1146. q2bdy3dtemp2(i,j,k) = grid%q2(i,j,k)
  1147. endif
  1148. END DO
  1149. END DO
  1150. !
  1151. DO k = kps , MIN(kde,kpe)
  1152. inc_v=mod(jps,2)
  1153. DO j = jps+inc_v, MIN(jde,jpe),2
  1154. if (J .ge. 2 .and. J .le. jde-1 .and. mod(J,2) .eq. 0) then
  1155. ubdy3dtemp2(i,j,k) = grid%u(i,j,k)
  1156. vbdy3dtemp2(i,j,k) = grid%v(i,j,k)
  1157. endif
  1158. END DO
  1159. END DO
  1160. inc_h=mod(jps+1,2)
  1161. DO j = jps+inc_h, MIN(jde,jpe),2
  1162. if (J .ge. 3 .and. J .le. jde-2 .and. mod(J,2) .eq. 1) then
  1163. pdbdy2dtemp2(i,j,1) = grid%pd(i,j)
  1164. write(message,*)'…

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