ideal.F
References to this file elsewhere.
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_ideal
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_ideal
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