| 1 | !IDEAL:DRIVER_LAYER |
|---|
| 2 | ! |
|---|
| 3 | ! create an initial data set for the WRF model based on an ideal condition |
|---|
| 4 | PROGRAM ideal |
|---|
| 5 | |
|---|
| 6 | USE module_domain , ONLY : domain |
|---|
| 7 | USE module_initialize_ideal |
|---|
| 8 | USE module_configure , ONLY : grid_config_rec_type |
|---|
| 9 | |
|---|
| 10 | USE module_timing |
|---|
| 11 | USE module_wrf_error |
|---|
| 12 | #ifdef WRF_CHEM |
|---|
| 13 | USE module_input_chem_data |
|---|
| 14 | USE module_input_chem_bioemiss |
|---|
| 15 | USE module_input_chem_emissopt3 |
|---|
| 16 | #endif |
|---|
| 17 | |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | #ifdef WRF_CHEM |
|---|
| 20 | ! interface |
|---|
| 21 | INTERFACE |
|---|
| 22 | ! mediation-supplied |
|---|
| 23 | SUBROUTINE med_read_wrf_chem_bioemiss ( grid , config_flags) |
|---|
| 24 | USE module_domain |
|---|
| 25 | TYPE (domain) grid |
|---|
| 26 | TYPE (grid_config_rec_type) config_flags |
|---|
| 27 | END SUBROUTINE med_read_wrf_chem_bioemiss |
|---|
| 28 | END INTERFACE |
|---|
| 29 | #endif |
|---|
| 30 | |
|---|
| 31 | REAL :: time |
|---|
| 32 | |
|---|
| 33 | INTEGER :: loop , & |
|---|
| 34 | levels_to_process |
|---|
| 35 | |
|---|
| 36 | |
|---|
| 37 | TYPE(domain) , POINTER :: keep_grid, grid_ptr, null_domain, grid |
|---|
| 38 | TYPE(domain) :: dummy |
|---|
| 39 | TYPE (grid_config_rec_type) :: config_flags |
|---|
| 40 | TYPE (WRFU_Time) startTime, stopTime, currentTime |
|---|
| 41 | TYPE (WRFU_TimeInterval) stepTime |
|---|
| 42 | |
|---|
| 43 | INTEGER :: max_dom , domain_id , fid , oid , idum1 , idum2 , ierr |
|---|
| 44 | INTEGER :: debug_level, rc |
|---|
| 45 | LOGICAL :: input_from_file |
|---|
| 46 | |
|---|
| 47 | INTERFACE |
|---|
| 48 | SUBROUTINE med_initialdata_output ( grid , config_flags ) |
|---|
| 49 | USE module_domain , ONLY : domain |
|---|
| 50 | USE module_configure , ONLY : grid_config_rec_type |
|---|
| 51 | TYPE (domain) , POINTER :: grid |
|---|
| 52 | TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags |
|---|
| 53 | END SUBROUTINE med_initialdata_output |
|---|
| 54 | END INTERFACE |
|---|
| 55 | |
|---|
| 56 | #include "version_decl" |
|---|
| 57 | |
|---|
| 58 | |
|---|
| 59 | #ifdef DM_PARALLEL |
|---|
| 60 | INTEGER :: nbytes |
|---|
| 61 | INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN |
|---|
| 62 | INTEGER :: configbuf( configbuflen ) |
|---|
| 63 | LOGICAL , EXTERNAL :: wrf_dm_on_monitor |
|---|
| 64 | #endif |
|---|
| 65 | |
|---|
| 66 | CHARACTER (LEN=80) :: message |
|---|
| 67 | |
|---|
| 68 | ! Define the name of this program (program_name defined in module_domain) |
|---|
| 69 | |
|---|
| 70 | program_name = "IDEAL " // TRIM(release_version) // " PREPROCESSOR" |
|---|
| 71 | |
|---|
| 72 | ! Get the NAMELIST data for input. |
|---|
| 73 | |
|---|
| 74 | CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called) |
|---|
| 75 | #ifdef NO_LEAP_CALENDAR |
|---|
| 76 | CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_NOLEAP, rc=rc ) |
|---|
| 77 | #else |
|---|
| 78 | CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc ) |
|---|
| 79 | #endif |
|---|
| 80 | CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called) |
|---|
| 81 | |
|---|
| 82 | #ifdef DM_PARALLEL |
|---|
| 83 | IF ( wrf_dm_on_monitor() ) THEN |
|---|
| 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 nl_get_debug_level ( 1, debug_level ) |
|---|
| 94 | CALL set_wrf_debug_level ( debug_level ) |
|---|
| 95 | |
|---|
| 96 | CALL wrf_message ( program_name ) |
|---|
| 97 | |
|---|
| 98 | |
|---|
| 99 | ! allocated and configure the mother domain |
|---|
| 100 | |
|---|
| 101 | NULLIFY( null_domain ) |
|---|
| 102 | |
|---|
| 103 | CALL alloc_and_configure_domain ( domain_id = 1 , & |
|---|
| 104 | grid = head_grid , & |
|---|
| 105 | parent = null_domain , & |
|---|
| 106 | kid = -1 ) |
|---|
| 107 | |
|---|
| 108 | grid => head_grid |
|---|
| 109 | ! TBH: Note that historically, IDEAL did not set up clocks. These |
|---|
| 110 | ! TBH: are explicit replacements for old default initializations... They |
|---|
| 111 | ! TBH: are needed to ensure that time manager calls do not fail due to |
|---|
| 112 | ! TBH: uninitialized clock. Clean this up later... |
|---|
| 113 | CALL WRFU_TimeSet(startTime, YY=1, MM=1, DD=1, H=0, M=0, S=0, rc=rc) |
|---|
| 114 | stopTime = startTime |
|---|
| 115 | currentTime = startTime |
|---|
| 116 | ! TBH: Bogus time step value -- clock is never advanced... |
|---|
| 117 | CALL WRFU_TimeIntervalSet(stepTime, S=180, rc=rc) |
|---|
| 118 | grid%domain_clock = WRFU_ClockCreate( TimeStep= stepTime, & |
|---|
| 119 | StartTime=startTime, & |
|---|
| 120 | StopTime= stopTime, & |
|---|
| 121 | rc=rc ) |
|---|
| 122 | CALL wrf_check_error( WRFU_SUCCESS, rc, & |
|---|
| 123 | 'grid%domain_clock = WRFU_ClockCreate() FAILED', & |
|---|
| 124 | __FILE__ , & |
|---|
| 125 | __LINE__ ) |
|---|
| 126 | CALL wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' ) |
|---|
| 127 | CALL model_to_grid_config_rec ( head_grid%id , model_config_rec , config_flags ) |
|---|
| 128 | CALL wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' ) |
|---|
| 129 | CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 ) |
|---|
| 130 | |
|---|
| 131 | #ifdef PLANET |
|---|
| 132 | WRITE ( current_date , FMT = '(I4.4,"-",I5.5,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) & |
|---|
| 133 | config_flags%start_year, & |
|---|
| 134 | config_flags%start_day, & |
|---|
| 135 | config_flags%start_hour, & |
|---|
| 136 | config_flags%start_minute, & |
|---|
| 137 | config_flags%start_second |
|---|
| 138 | #else |
|---|
| 139 | WRITE ( current_date , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) & |
|---|
| 140 | config_flags%start_year, & |
|---|
| 141 | config_flags%start_month, & |
|---|
| 142 | config_flags%start_day, & |
|---|
| 143 | config_flags%start_hour, & |
|---|
| 144 | config_flags%start_minute, & |
|---|
| 145 | config_flags%start_second |
|---|
| 146 | #endif |
|---|
| 147 | CALL domain_clockprint ( 150, grid, & |
|---|
| 148 | 'DEBUG assemble_output: clock before 1st currTime set,' ) |
|---|
| 149 | WRITE (wrf_err_message,*) & |
|---|
| 150 | 'DEBUG assemble_output: before 1st currTime set, current_date = ',TRIM(current_date) |
|---|
| 151 | CALL wrf_debug ( 150 , wrf_err_message ) |
|---|
| 152 | CALL domain_clock_set( grid, current_timestr=current_date(1:19) ) |
|---|
| 153 | CALL domain_clockprint ( 150, grid, & |
|---|
| 154 | 'DEBUG assemble_output: clock after 1st currTime set,' ) |
|---|
| 155 | |
|---|
| 156 | CALL wrf_debug ( 100 , 'wrf: calling init_wrfio' ) |
|---|
| 157 | CALL init_wrfio |
|---|
| 158 | |
|---|
| 159 | #ifdef DM_PARALLEL |
|---|
| 160 | CALL get_config_as_buffer( configbuf, configbuflen, nbytes ) |
|---|
| 161 | CALL wrf_dm_bcast_bytes( configbuf, nbytes ) |
|---|
| 162 | CALL set_config_as_buffer( configbuf, configbuflen ) |
|---|
| 163 | #endif |
|---|
| 164 | |
|---|
| 165 | #ifdef WRF_CHEM |
|---|
| 166 | IF( grid%chem_opt > 0 ) then |
|---|
| 167 | ! Read the chemistry data from a previous wrf forecast (wrfout file) |
|---|
| 168 | IF(grid%chem_in_opt == 1 ) THEN |
|---|
| 169 | message = 'INITIALIZING CHEMISTRY WITH OLD SIMULATION' |
|---|
| 170 | CALL wrf_message ( message ) |
|---|
| 171 | |
|---|
| 172 | CALL input_ext_chem_file( grid ) |
|---|
| 173 | IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC & |
|---|
| 174 | .or. grid%biomass_burn_opt == BIOMASSB) THEN |
|---|
| 175 | message = 'READING EMISSIONS DATA OPT 3' |
|---|
| 176 | CALL wrf_message ( message ) |
|---|
| 177 | ! CALL med_read_bin_chem_emissopt3 ( grid , config_flags) |
|---|
| 178 | CALL med_read_wrf_chem_emissopt3 ( grid , config_flags) |
|---|
| 179 | END IF |
|---|
| 180 | |
|---|
| 181 | IF(grid%bio_emiss_opt == 2 ) THEN |
|---|
| 182 | message = 'READING BEIS3.11 EMISSIONS DATA' |
|---|
| 183 | CALL wrf_message ( message ) |
|---|
| 184 | CALL med_read_wrf_chem_bioemiss ( grid , config_flags) |
|---|
| 185 | else IF(grid%bio_emiss_opt == 3 ) THEN !shc |
|---|
| 186 | message = 'READING MEGAN 2 EMISSIONS DATA' |
|---|
| 187 | CALL wrf_message ( message ) |
|---|
| 188 | CALL med_read_wrf_chem_bioemiss ( grid , config_flags) |
|---|
| 189 | END IF |
|---|
| 190 | |
|---|
| 191 | IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc |
|---|
| 192 | message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS' |
|---|
| 193 | CALL wrf_message ( message ) |
|---|
| 194 | CALL med_read_wrf_chem_gocart_bg ( grid , config_flags) |
|---|
| 195 | END IF |
|---|
| 196 | |
|---|
| 197 | ELSEIF(grid%chem_in_opt == 0)then |
|---|
| 198 | ! Generate chemistry data from a idealized vertical profile |
|---|
| 199 | message = 'STARTING WITH BACKGROUND CHEMISTRY ' |
|---|
| 200 | CALL wrf_message ( message ) |
|---|
| 201 | |
|---|
| 202 | CALL input_chem_profile ( grid ) |
|---|
| 203 | |
|---|
| 204 | IF(grid%bio_emiss_opt == 2 ) THEN |
|---|
| 205 | message = 'READING BEIS3.11 EMISSIONS DATA' |
|---|
| 206 | CALL wrf_message ( message ) |
|---|
| 207 | CALL med_read_wrf_chem_bioemiss ( grid , config_flags) |
|---|
| 208 | else IF(grid%bio_emiss_opt == 3 ) THEN !shc |
|---|
| 209 | message = 'READING MEGAN 2 EMISSIONS DATA' |
|---|
| 210 | CALL wrf_message ( message ) |
|---|
| 211 | CALL med_read_wrf_chem_bioemiss ( grid , config_flags) |
|---|
| 212 | END IF |
|---|
| 213 | IF(grid%emiss_opt == ECPTEC .or. grid%emiss_opt == GOCART_ECPTEC & |
|---|
| 214 | .or. grid%biomass_burn_opt == BIOMASSB) THEN |
|---|
| 215 | message = 'READING EMISSIONS DATA OPT 3' |
|---|
| 216 | CALL wrf_message ( message ) |
|---|
| 217 | ! CALL med_read_bin_chem_emissopt3 ( grid , config_flags) |
|---|
| 218 | CALL med_read_wrf_chem_emissopt3 ( grid , config_flags) |
|---|
| 219 | END IF |
|---|
| 220 | |
|---|
| 221 | IF(grid%dust_opt == 1 .or. grid%dmsemis_opt == 1 .or. grid%chem_opt == 300) THEN !shc |
|---|
| 222 | message = 'READING GOCART BG AND/OR DUST and DMS REF FIELDS' |
|---|
| 223 | CALL wrf_message ( message ) |
|---|
| 224 | CALL med_read_wrf_chem_gocart_bg ( grid , config_flags) |
|---|
| 225 | END IF |
|---|
| 226 | |
|---|
| 227 | ELSE |
|---|
| 228 | message = 'RUNNING WITHOUT CHEMISTRY INITIALIZATION' |
|---|
| 229 | CALL wrf_message ( message ) |
|---|
| 230 | END IF |
|---|
| 231 | END IF |
|---|
| 232 | #endif |
|---|
| 233 | |
|---|
| 234 | CALL med_initialdata_output( head_grid , config_flags ) |
|---|
| 235 | |
|---|
| 236 | CALL wrf_debug ( 0 , 'wrf: SUCCESS COMPLETE IDEAL INIT' ) |
|---|
| 237 | CALL med_shutdown_io ( head_grid , config_flags ) |
|---|
| 238 | CALL wrf_shutdown |
|---|
| 239 | |
|---|
| 240 | CALL WRFU_Finalize( rc=rc ) |
|---|
| 241 | |
|---|
| 242 | END PROGRAM ideal |
|---|
| 243 | |
|---|
| 244 | SUBROUTINE med_initialdata_output ( grid , config_flags ) |
|---|
| 245 | ! Driver layer |
|---|
| 246 | USE module_domain |
|---|
| 247 | USE module_io_domain |
|---|
| 248 | USE module_initialize_ideal |
|---|
| 249 | ! Model layer |
|---|
| 250 | USE module_configure |
|---|
| 251 | |
|---|
| 252 | IMPLICIT NONE |
|---|
| 253 | |
|---|
| 254 | ! Arguments |
|---|
| 255 | TYPE(domain) , POINTER :: grid |
|---|
| 256 | TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags |
|---|
| 257 | ! Local |
|---|
| 258 | INTEGER :: time_step_begin_restart |
|---|
| 259 | INTEGER :: fid , ierr , id |
|---|
| 260 | CHARACTER (LEN=80) :: rstname |
|---|
| 261 | CHARACTER (LEN=80) :: message |
|---|
| 262 | CHARACTER (LEN=80) :: inpname , bdyname |
|---|
| 263 | |
|---|
| 264 | ! Initialize the mother domain. |
|---|
| 265 | |
|---|
| 266 | grid%input_from_file = .false. |
|---|
| 267 | CALL init_domain ( grid ) |
|---|
| 268 | CALL calc_current_date ( grid%id, 0.) |
|---|
| 269 | |
|---|
| 270 | CALL construct_filename1 ( inpname , 'wrfinput' , grid%id , 2 ) |
|---|
| 271 | CALL open_w_dataset ( id, TRIM(inpname) , grid , config_flags , output_input , "DATASET=INPUT", ierr ) |
|---|
| 272 | IF ( ierr .NE. 0 ) THEN |
|---|
| 273 | WRITE (wrf_err_message,*)'ideal: error opening wrfinput for writing ',ierr |
|---|
| 274 | CALL wrf_error_fatal( wrf_err_message ) |
|---|
| 275 | ENDIF |
|---|
| 276 | CALL output_input ( id, grid , config_flags , ierr ) |
|---|
| 277 | CALL close_dataset ( id , config_flags, "DATASET=INPUT" ) |
|---|
| 278 | |
|---|
| 279 | |
|---|
| 280 | IF ( config_flags%specified ) THEN |
|---|
| 281 | |
|---|
| 282 | CALL construct_filename1 ( bdyname , 'wrfbdy' , grid%id , 2 ) |
|---|
| 283 | CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr ) |
|---|
| 284 | IF ( ierr .NE. 0 ) THEN |
|---|
| 285 | WRITE (wrf_err_message,*)'ideal: error opening wrfbdy for writing ',ierr |
|---|
| 286 | CALL wrf_error_fatal( wrf_err_message ) |
|---|
| 287 | ENDIF |
|---|
| 288 | CALL output_boundary ( id, grid , config_flags , ierr ) |
|---|
| 289 | CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" ) |
|---|
| 290 | |
|---|
| 291 | ENDIF |
|---|
| 292 | |
|---|
| 293 | RETURN |
|---|
| 294 | END SUBROUTINE med_initialdata_output |
|---|
| 295 | |
|---|