source: trunk/WRF.COMMON/WRFV3/share/mediation_wrfmain.F @ 3568

Last change on this file since 3568 was 2759, checked in by aslmd, 3 years ago

adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 10.2 KB
RevLine 
[2759]1!WRF:MEDIATION_LAYER:
2!
3
4SUBROUTINE med_initialdata_input_ptr ( grid , config_flags )
5   USE module_domain
6   USE module_configure
7   IMPLICIT NONE
8   TYPE (domain) , POINTER :: grid
9   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
10   INTERFACE
11      SUBROUTINE med_initialdata_input ( grid , config_flags )
12         USE module_domain
13         USE module_configure
14         TYPE (domain) :: grid
15         TYPE (grid_config_rec_type) , INTENT(IN) :: config_flags
16      END SUBROUTINE med_initialdata_input
17   END INTERFACE
18   CALL  med_initialdata_input ( grid , config_flags )
19
20
21END SUBROUTINE med_initialdata_input_ptr
22
23SUBROUTINE med_initialdata_input ( grid , config_flags )
24  ! Driver layer
25   USE module_domain
26   USE module_io_domain
27   USE module_timing
28use module_io
29  ! Model layer
30   USE module_configure
31   USE module_bc_time_utilities
32   USE module_utility
33
34   IMPLICIT NONE
35
36  ! Interface
37   INTERFACE
38     SUBROUTINE start_domain ( grid , allowed_to_read )  ! comes from module_start in appropriate dyn_ directory
39       USE module_domain
40       TYPE (domain) grid
41       LOGICAL, INTENT(IN) :: allowed_to_read
42     END SUBROUTINE start_domain
43   END INTERFACE
44
45  ! Arguments
46   TYPE(domain)                               :: grid
47   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
48  ! Local
49   INTEGER                :: fid , ierr , myproc
50   CHARACTER (LEN=80)     :: inpname , rstname, timestr
51   CHARACTER (LEN=80)     :: message
52   LOGICAL                :: restart
53
54   CALL nl_get_restart( 1, restart )
55   IF ( .NOT. restart ) THEN
56     !  Initialize the mother domain.
57     grid%input_from_file = .true.
58     IF ( grid%input_from_file ) THEN
59
60        CALL       wrf_debug ( 1 , 'wrf main: calling open_r_dataset for wrfinput' )
61
62! typically <date> will not be part of input_inname but allow for it
63        CALL domain_clock_get( grid, current_timestr=timestr )
64        CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
65
66        CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
67        IF ( ierr .NE. 0 ) THEN
68          WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
69          CALL WRF_ERROR_FATAL ( wrf_err_message )
70        ENDIF
71        IF      ( ( grid%id .EQ. 1 ) .OR. ( config_flags%fine_input_stream .EQ. 0 ) ) THEN
72           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_model_input' )
73           CALL input_model_input      ( fid ,  grid , config_flags , ierr )
74           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_model_input' )
75        ELSE IF   ( config_flags%fine_input_stream .EQ. 1 ) THEN
76           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input1' )
77           CALL input_aux_model_input1 ( fid ,   grid , config_flags , ierr )
78           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input1' )
79        ELSE IF   ( config_flags%fine_input_stream .EQ. 2 ) THEN
80           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input2' )
81           CALL input_aux_model_input2 ( fid ,   grid , config_flags , ierr )
82           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input2' )
83        ELSE IF   ( config_flags%fine_input_stream .EQ. 3 ) THEN
84           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input3' )
85           CALL input_aux_model_input3 ( fid ,   grid , config_flags , ierr )
86           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input3' )
87        ELSE IF   ( config_flags%fine_input_stream .EQ. 4 ) THEN
88           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input4' )
89           CALL input_aux_model_input4 ( fid ,   grid , config_flags , ierr )
90           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input4' )
91        ELSE IF   ( config_flags%fine_input_stream .EQ. 5 ) THEN
92           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input5' )
93           CALL input_aux_model_input5 ( fid ,   grid , config_flags , ierr )
94           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input5' )
95        ELSE IF   ( config_flags%fine_input_stream .EQ. 6 ) THEN
96           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input6' )
97           CALL input_aux_model_input6 ( fid ,   grid , config_flags , ierr )
98           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input6' )
99        ELSE IF   ( config_flags%fine_input_stream .EQ. 7 ) THEN
100           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input7' )
101           CALL input_aux_model_input7 ( fid ,   grid , config_flags , ierr )
102           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input7' )
103        ELSE IF   ( config_flags%fine_input_stream .EQ. 8 ) THEN
104           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input8' )
105           CALL input_aux_model_input8 ( fid ,   grid , config_flags , ierr )
106           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input8' )
107        ELSE IF   ( config_flags%fine_input_stream .EQ. 9 ) THEN
108           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input9' )
109           CALL input_aux_model_input9 ( fid ,   grid , config_flags , ierr )
110           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input9' )
111        ELSE IF   ( config_flags%fine_input_stream .EQ. 10 ) THEN
112           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input10' )
113           CALL input_aux_model_input10 ( fid ,   grid , config_flags , ierr )
114           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input10' )
115        ELSE IF   ( config_flags%fine_input_stream .EQ. 11 ) THEN
116           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input11' )
117           CALL input_aux_model_input11 ( fid ,   grid , config_flags , ierr )
118           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input11' )
119        ELSE
120           WRITE( message , '("med_initialdata_input: bad fine_input_stream = ",I4)') config_flags%fine_input_stream
121           CALL WRF_ERROR_FATAL ( message )
122        END IF
123        CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
124#ifdef MOVE_NESTS
125        grid%nest_pos = grid%ht
126        where ( grid%nest_pos .gt. 0 ) grid%nest_pos = grid%nest_pos + 500.  ! make a cliff
127#endif
128     ENDIF
129     grid%imask_nostag = 1
130     grid%imask_xstag = 1
131     grid%imask_ystag = 1
132     grid%imask_xystag = 1
133#if (EM_CORE == 1)
134     grid%press_adj = .FALSE.
135#endif
136     CALL start_domain ( grid , .TRUE. )
137   ELSE
138     CALL domain_clock_get( grid, current_timestr=timestr )
139     CALL construct_filename2a ( rstname , config_flags%rst_inname , grid%id , 2 , timestr )
140
141     WRITE(message,*)'RESTART run: opening ',TRIM(rstname),' for reading'
142     CALL wrf_message (  message )
143     CALL open_r_dataset ( fid , TRIM(rstname) , grid , config_flags , "DATASET=RESTART", ierr )
144     IF ( ierr .NE. 0 ) THEN
145       WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
146       CALL WRF_ERROR_FATAL ( message )
147     ENDIF
148     CALL input_restart ( fid,   grid , config_flags , ierr )
149     CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
150     grid%imask_nostag = 1
151     grid%imask_xstag = 1
152     grid%imask_ystag = 1
153     grid%imask_xystag = 1
154#if (EM_CORE == 1)
155     grid%press_adj = .FALSE.
156#endif
157     CALL start_domain ( grid , .TRUE. )
158   ENDIF
159
160   RETURN
161END SUBROUTINE med_initialdata_input
162
163SUBROUTINE med_shutdown_io ( grid , config_flags )
164  ! Driver layer
165   USE module_domain
166   USE module_io_domain
167  ! Model layer
168   USE module_configure
169
170   IMPLICIT NONE
171
172  ! Arguments
173   TYPE(domain)                               :: grid
174   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
175  ! Local
176   CHARACTER (LEN=80)      :: message
177   INTEGER                 :: ierr
178
179   IF ( grid%oid > 0 ) CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" )
180   IF ( grid%auxhist1_oid > 0 ) CALL close_dataset ( grid%auxhist1_oid , config_flags , "DATASET=AUXHIST1" )
181   IF ( grid%auxhist2_oid > 0 ) CALL close_dataset ( grid%auxhist2_oid , config_flags , "DATASET=AUXHIST2" )
182   IF ( grid%auxhist3_oid > 0 ) CALL close_dataset ( grid%auxhist3_oid , config_flags , "DATASET=AUXHIST3" )
183   IF ( grid%auxhist4_oid > 0 ) CALL close_dataset ( grid%auxhist4_oid , config_flags , "DATASET=AUXHIST4" )
184   IF ( grid%auxhist5_oid > 0 ) CALL close_dataset ( grid%auxhist5_oid , config_flags , "DATASET=AUXHIST5" )
185#if 0
186   IF ( grid%auxhist6_oid > 0 ) CALL close_dataset ( grid%auxhist6_oid , config_flags , "DATASET=AUXHIST6" )
187   IF ( grid%auxhist7_oid > 0 ) CALL close_dataset ( grid%auxhist7_oid , config_flags , "DATASET=AUXHIST7" )
188   IF ( grid%auxhist8_oid > 0 ) CALL close_dataset ( grid%auxhist8_oid , config_flags , "DATASET=AUXHIST8" )
189   IF ( grid%auxhist9_oid > 0 ) CALL close_dataset ( grid%auxhist9_oid , config_flags , "DATASET=AUXHIST9" )
190   IF ( grid%auxhist10_oid > 0 ) CALL close_dataset ( grid%auxhist10_oid , config_flags , "DATASET=AUXHIST10" )
191   IF ( grid%auxhist11_oid > 0 ) CALL close_dataset ( grid%auxhist11_oid , config_flags , "DATASET=AUXHIST11" )
192#endif
193
194   IF ( grid%lbc_fid > 0 ) CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
195
196   CALL wrf_ioexit( ierr )    ! shut down the quilt I/O
197
198   RETURN
199
200END SUBROUTINE med_shutdown_io
201
202SUBROUTINE med_add_config_info_to_grid ( grid )
203
204   USE module_domain
205   USE module_configure
206 
207   IMPLICIT NONE
208
209   !  Input data.
210
211   TYPE(domain) , TARGET          :: grid
212
213#define SOURCE_RECORD model_config_rec %
214#define SOURCE_REC_DEX (grid%id)
215#define DEST_RECORD   grid %
216#include <config_assigns.inc>
217
218   RETURN
219
220END SUBROUTINE med_add_config_info_to_grid
221
Note: See TracBrowser for help on using the repository browser.