| 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_machine |
|---|
| 7 | USE module_domain |
|---|
| 8 | USE module_initialize |
|---|
| 9 | USE module_driver_constants |
|---|
| 10 | USE module_configure |
|---|
| 11 | |
|---|
| 12 | USE module_timing |
|---|
| 13 | USE module_wrf_error |
|---|
| 14 | USE module_utility |
|---|
| 15 | #ifdef DM_PARALLEL |
|---|
| 16 | USE module_dm |
|---|
| 17 | #endif |
|---|
| 18 | USE module_date_time |
|---|
| 19 | |
|---|
| 20 | IMPLICIT NONE |
|---|
| 21 | |
|---|
| 22 | REAL :: time |
|---|
| 23 | |
|---|
| 24 | INTEGER :: loop , & |
|---|
| 25 | levels_to_process |
|---|
| 26 | |
|---|
| 27 | |
|---|
| 28 | TYPE(domain) , POINTER :: keep_grid, grid_ptr, null_domain, grid |
|---|
| 29 | TYPE(domain) :: dummy |
|---|
| 30 | TYPE (grid_config_rec_type) :: config_flags |
|---|
| 31 | TYPE (WRFU_Time) startTime, stopTime, currentTime |
|---|
| 32 | TYPE (WRFU_TimeInterval) stepTime |
|---|
| 33 | |
|---|
| 34 | INTEGER :: max_dom , domain_id , fid , oid , idum1 , idum2 , ierr |
|---|
| 35 | INTEGER :: debug_level, rc |
|---|
| 36 | LOGICAL :: input_from_file |
|---|
| 37 | |
|---|
| 38 | INTERFACE |
|---|
| 39 | SUBROUTINE med_initialdata_output ( grid , config_flags ) |
|---|
| 40 | USE module_domain |
|---|
| 41 | USE module_configure |
|---|
| 42 | TYPE (domain) , POINTER :: grid |
|---|
| 43 | TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags |
|---|
| 44 | END SUBROUTINE med_initialdata_output |
|---|
| 45 | END INTERFACE |
|---|
| 46 | |
|---|
| 47 | #include "version_decl" |
|---|
| 48 | |
|---|
| 49 | |
|---|
| 50 | #ifdef DM_PARALLEL |
|---|
| 51 | INTEGER :: nbytes |
|---|
| 52 | INTEGER, PARAMETER :: configbuflen = 4* CONFIG_BUF_LEN |
|---|
| 53 | INTEGER :: configbuf( configbuflen ) |
|---|
| 54 | LOGICAL , EXTERNAL :: wrf_dm_on_monitor |
|---|
| 55 | #endif |
|---|
| 56 | |
|---|
| 57 | CHARACTER (LEN=80) :: message |
|---|
| 58 | |
|---|
| 59 | ! Define the name of this program (program_name defined in module_domain) |
|---|
| 60 | |
|---|
| 61 | program_name = "IDEAL " // TRIM(release_version) // " PREPROCESSOR" |
|---|
| 62 | |
|---|
| 63 | ! Get the NAMELIST data for input. |
|---|
| 64 | |
|---|
| 65 | CALL init_modules(1) ! Phase 1 returns after MPI_INIT() (if it is called) |
|---|
| 66 | CALL WRFU_Initialize( defaultCalendar=WRFU_CAL_GREGORIAN, rc=rc ) |
|---|
| 67 | CALL init_modules(2) ! Phase 2 resumes after MPI_INIT() (if it is called) |
|---|
| 68 | |
|---|
| 69 | #ifdef DM_PARALLEL |
|---|
| 70 | IF ( wrf_dm_on_monitor() ) THEN |
|---|
| 71 | CALL initial_config |
|---|
| 72 | ENDIF |
|---|
| 73 | CALL get_config_as_buffer( configbuf, configbuflen, nbytes ) |
|---|
| 74 | CALL wrf_dm_bcast_bytes( configbuf, nbytes ) |
|---|
| 75 | CALL set_config_as_buffer( configbuf, configbuflen ) |
|---|
| 76 | CALL wrf_dm_initialize |
|---|
| 77 | #else |
|---|
| 78 | CALL initial_config |
|---|
| 79 | #endif |
|---|
| 80 | CALL nl_get_debug_level ( 1, debug_level ) |
|---|
| 81 | CALL set_wrf_debug_level ( debug_level ) |
|---|
| 82 | |
|---|
| 83 | CALL wrf_message ( program_name ) |
|---|
| 84 | |
|---|
| 85 | |
|---|
| 86 | ! allocated and configure the mother domain |
|---|
| 87 | |
|---|
| 88 | NULLIFY( null_domain ) |
|---|
| 89 | |
|---|
| 90 | CALL alloc_and_configure_domain ( domain_id = 1 , & |
|---|
| 91 | grid = head_grid , & |
|---|
| 92 | parent = null_domain , & |
|---|
| 93 | kid = -1 ) |
|---|
| 94 | |
|---|
| 95 | grid => head_grid |
|---|
| 96 | ! TBH: Note that historically, IDEAL did not set up clocks. These |
|---|
| 97 | ! TBH: are explicit replacements for old default initializations... They |
|---|
| 98 | ! TBH: are needed to ensure that time manager calls do not fail due to |
|---|
| 99 | ! TBH: uninitialized clock. Clean this up later... |
|---|
| 100 | CALL WRFU_TimeSet(startTime, YY=1, MM=1, DD=1, H=0, M=0, S=0, rc=rc) |
|---|
| 101 | stopTime = startTime |
|---|
| 102 | currentTime = startTime |
|---|
| 103 | ! TBH: Bogus time step value -- clock is never advanced... |
|---|
| 104 | CALL WRFU_TimeIntervalSet(stepTime, S=180, rc=rc) |
|---|
| 105 | grid%domain_clock = WRFU_ClockCreate( TimeStep= stepTime, & |
|---|
| 106 | StartTime=startTime, & |
|---|
| 107 | StopTime= stopTime, & |
|---|
| 108 | rc=rc ) |
|---|
| 109 | CALL wrf_check_error( WRFU_SUCCESS, rc, & |
|---|
| 110 | 'grid%domain_clock = WRFU_ClockCreate() FAILED', & |
|---|
| 111 | __FILE__ , & |
|---|
| 112 | __LINE__ ) |
|---|
| 113 | CALL wrf_debug ( 100 , 'wrf: calling model_to_grid_config_rec ' ) |
|---|
| 114 | CALL model_to_grid_config_rec ( head_grid%id , model_config_rec , config_flags ) |
|---|
| 115 | CALL wrf_debug ( 100 , 'wrf: calling set_scalar_indices_from_config ' ) |
|---|
| 116 | CALL set_scalar_indices_from_config ( head_grid%id , idum1, idum2 ) |
|---|
| 117 | |
|---|
| 118 | WRITE ( current_date , FMT = '(I4.4,"-",I2.2,"-",I2.2,"_",I2.2,":",I2.2,":",I2.2,".0000")' ) & |
|---|
| 119 | config_flags%start_year, & |
|---|
| 120 | config_flags%start_month, & |
|---|
| 121 | config_flags%start_day, & |
|---|
| 122 | config_flags%start_hour, & |
|---|
| 123 | config_flags%start_minute, & |
|---|
| 124 | config_flags%start_second |
|---|
| 125 | CALL domain_clockprint ( 150, grid, & |
|---|
| 126 | 'DEBUG assemble_output: clock before 1st currTime set,' ) |
|---|
| 127 | WRITE (wrf_err_message,*) & |
|---|
| 128 | 'DEBUG assemble_output: before 1st currTime set, current_date = ',TRIM(current_date) |
|---|
| 129 | CALL wrf_debug ( 150 , wrf_err_message ) |
|---|
| 130 | CALL domain_clock_set( grid, current_timestr=current_date(1:19) ) |
|---|
| 131 | CALL domain_clockprint ( 150, grid, & |
|---|
| 132 | 'DEBUG assemble_output: clock after 1st currTime set,' ) |
|---|
| 133 | |
|---|
| 134 | CALL wrf_debug ( 100 , 'wrf: calling init_wrfio' ) |
|---|
| 135 | CALL init_wrfio |
|---|
| 136 | |
|---|
| 137 | #ifdef DM_PARALLEL |
|---|
| 138 | CALL get_config_as_buffer( configbuf, configbuflen, nbytes ) |
|---|
| 139 | CALL wrf_dm_bcast_bytes( configbuf, nbytes ) |
|---|
| 140 | CALL set_config_as_buffer( configbuf, configbuflen ) |
|---|
| 141 | #endif |
|---|
| 142 | |
|---|
| 143 | CALL med_initialdata_output( head_grid , config_flags ) |
|---|
| 144 | |
|---|
| 145 | CALL wrf_debug ( 0 , 'wrf: SUCCESS COMPLETE IDEAL INIT' ) |
|---|
| 146 | CALL med_shutdown_io ( head_grid , config_flags ) |
|---|
| 147 | CALL wrf_shutdown |
|---|
| 148 | |
|---|
| 149 | CALL WRFU_Finalize( rc=rc ) |
|---|
| 150 | |
|---|
| 151 | END PROGRAM ideal |
|---|
| 152 | |
|---|
| 153 | SUBROUTINE med_initialdata_output ( grid , config_flags ) |
|---|
| 154 | ! Driver layer |
|---|
| 155 | USE module_domain |
|---|
| 156 | USE module_io_domain |
|---|
| 157 | USE module_initialize |
|---|
| 158 | ! Model layer |
|---|
| 159 | USE module_configure |
|---|
| 160 | |
|---|
| 161 | IMPLICIT NONE |
|---|
| 162 | |
|---|
| 163 | ! Arguments |
|---|
| 164 | TYPE(domain) , POINTER :: grid |
|---|
| 165 | TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags |
|---|
| 166 | ! Local |
|---|
| 167 | INTEGER :: time_step_begin_restart |
|---|
| 168 | INTEGER :: fid , ierr , id |
|---|
| 169 | CHARACTER (LEN=80) :: rstname |
|---|
| 170 | CHARACTER (LEN=80) :: message |
|---|
| 171 | CHARACTER (LEN=80) :: inpname , bdyname |
|---|
| 172 | |
|---|
| 173 | ! Initialize the mother domain. |
|---|
| 174 | |
|---|
| 175 | grid%input_from_file = .false. |
|---|
| 176 | CALL init_domain ( grid ) |
|---|
| 177 | CALL calc_current_date ( grid%id, 0.) |
|---|
| 178 | |
|---|
| 179 | CALL construct_filename1 ( inpname , 'wrfinput' , grid%id , 2 ) |
|---|
| 180 | CALL open_w_dataset ( id, TRIM(inpname) , grid , config_flags , output_model_input , "DATASET=INPUT", ierr ) |
|---|
| 181 | IF ( ierr .NE. 0 ) THEN |
|---|
| 182 | WRITE (wrf_err_message,*)'ideal: error opening wrfinput for writing ',ierr |
|---|
| 183 | CALL wrf_error_fatal( wrf_err_message ) |
|---|
| 184 | ENDIF |
|---|
| 185 | CALL output_model_input ( id, grid , config_flags , ierr ) |
|---|
| 186 | CALL close_dataset ( id , config_flags, "DATASET=INPUT" ) |
|---|
| 187 | |
|---|
| 188 | |
|---|
| 189 | IF ( config_flags%specified ) THEN |
|---|
| 190 | |
|---|
| 191 | CALL construct_filename1 ( bdyname , 'wrfbdy' , grid%id , 2 ) |
|---|
| 192 | CALL open_w_dataset ( id, TRIM(bdyname) , grid , config_flags , output_boundary , "DATASET=BOUNDARY", ierr ) |
|---|
| 193 | IF ( ierr .NE. 0 ) THEN |
|---|
| 194 | WRITE (wrf_err_message,*)'ideal: error opening wrfbdy for writing ',ierr |
|---|
| 195 | CALL wrf_error_fatal( wrf_err_message ) |
|---|
| 196 | ENDIF |
|---|
| 197 | CALL output_boundary ( id, grid , config_flags , ierr ) |
|---|
| 198 | CALL close_dataset ( id , config_flags , "DATASET=BOUNDARY" ) |
|---|
| 199 | |
|---|
| 200 | ENDIF |
|---|
| 201 | |
|---|
| 202 | RETURN |
|---|
| 203 | END SUBROUTINE med_initialdata_output |
|---|
| 204 | |
|---|
