source: lmdz_wrf/WRFV3/main/ideal.F @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago
  • -- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 10.8 KB
Line 
1!IDEAL:DRIVER_LAYER
2!
3! create an initial data set for the WRF model based on an ideal condition
4PROGRAM 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
242END PROGRAM ideal
243
244SUBROUTINE 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
294END SUBROUTINE med_initialdata_output
295
Note: See TracBrowser for help on using the repository browser.