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