source: trunk/WRF.COMMON/WRFV2/share/mediation_wrfmain.F @ 3709

Last change on this file since 3709 was 11, checked in by aslmd, 15 years ago

spiga@svn-planeto:ajoute le modele meso-echelle martien
File size: 7.8 KB
Line 
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
28  ! Model layer
29   USE module_configure
30   USE module_bc_time_utilities
31   USE module_utility
32
33   IMPLICIT NONE
34
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
55   CALL nl_get_restart( 1, restart )
56   IF ( .NOT. restart ) THEN
57     !  Initialize the mother domain.
58     grid%input_from_file = .true.
59     IF ( grid%input_from_file ) THEN
60
61        CALL       wrf_debug ( 1 , 'wrf main: calling open_r_dataset for wrfinput' )
62
63! typically <date> will not be part of input_inname but allow for it
64        CALL domain_clock_get( grid, current_timestr=timestr )
65        CALL construct_filename2a ( inpname , config_flags%input_inname , grid%id , 2 , timestr )
66
67        CALL open_r_dataset ( fid, TRIM(inpname) , grid , config_flags , "DATASET=INPUT", ierr )
68        IF ( ierr .NE. 0 ) THEN
69          WRITE( wrf_err_message , * ) 'program wrf: error opening ',TRIM(inpname),' for reading ierr=',ierr
70          CALL WRF_ERROR_FATAL ( wrf_err_message )
71        ENDIF
72        IF      ( ( grid%id .EQ. 1 ) .OR. ( config_flags%fine_input_stream .EQ. 0 ) ) THEN
73           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_model_input' )
74           CALL input_model_input      ( fid ,  grid , config_flags , ierr )
75           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_model_input' )
76        ELSE IF   ( config_flags%fine_input_stream .EQ. 1 ) THEN
77           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input1' )
78           CALL input_aux_model_input1 ( fid ,   grid , config_flags , ierr )
79           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input1' )
80        ELSE IF   ( config_flags%fine_input_stream .EQ. 2 ) THEN
81           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input2' )
82           CALL input_aux_model_input2 ( fid ,   grid , config_flags , ierr )
83           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input2' )
84        ELSE IF   ( config_flags%fine_input_stream .EQ. 3 ) THEN
85           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input3' )
86           CALL input_aux_model_input3 ( fid ,   grid , config_flags , ierr )
87           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input3' )
88        ELSE IF   ( config_flags%fine_input_stream .EQ. 4 ) THEN
89           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input4' )
90           CALL input_aux_model_input4 ( fid ,   grid , config_flags , ierr )
91           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input4' )
92        ELSE IF   ( config_flags%fine_input_stream .EQ. 5 ) THEN
93           CALL wrf_debug              (   0 , 'med_initialdata_input: calling input_aux_model_input5' )
94           CALL input_aux_model_input5 ( fid ,   grid , config_flags , ierr )
95           CALL wrf_debug              ( 100 , 'med_initialdata_input: back from input_aux_model_input5' )
96        END IF
97        CALL close_dataset ( fid , config_flags , "DATASET=INPUT" )
98#ifdef MOVE_NESTS
99        grid%nest_pos = grid%ht
100        where ( grid%nest_pos .gt. 0 ) grid%nest_pos = grid%nest_pos + 500.  ! make a cliff
101#endif
102     ENDIF
103     grid%imask_nostag = 1
104     grid%imask_xstag = 1
105     grid%imask_ystag = 1
106     grid%imask_xystag = 1
107     CALL start_domain ( grid , .TRUE. )
108   ELSE
109     CALL domain_clock_get( grid, current_timestr=timestr )
110     CALL construct_filename2a ( rstname , config_flags%rst_inname , grid%id , 2 , timestr )
111
112     WRITE(message,*)'RESTART run: opening ',TRIM(rstname),' for reading'
113     CALL wrf_message (  message )
114     CALL open_r_dataset ( fid , TRIM(rstname) , grid , config_flags , "DATASET=RESTART", ierr )
115     IF ( ierr .NE. 0 ) THEN
116       WRITE( message , '("program wrf: error opening ",A32," for reading")') TRIM(rstname)
117       CALL WRF_ERROR_FATAL ( message )
118     ENDIF
119     CALL input_restart ( fid,   grid , config_flags , ierr )
120     CALL close_dataset ( fid , config_flags , "DATASET=RESTART" )
121     grid%imask_nostag = 1
122     grid%imask_xstag = 1
123     grid%imask_ystag = 1
124     grid%imask_xystag = 1
125     CALL start_domain ( grid , .TRUE. )
126   ENDIF
127
128   RETURN
129END SUBROUTINE med_initialdata_input
130
131SUBROUTINE med_shutdown_io ( grid , config_flags )
132  ! Driver layer
133   USE module_domain
134   USE module_io_domain
135  ! Model layer
136   USE module_configure
137
138   IMPLICIT NONE
139
140  ! Arguments
141   TYPE(domain)                               :: grid
142   TYPE (grid_config_rec_type) , INTENT(IN)   :: config_flags
143  ! Local
144   CHARACTER (LEN=80)      :: message
145   INTEGER                 :: ierr
146
147   IF ( grid%oid > 0 ) CALL close_dataset ( grid%oid , config_flags , "DATASET=HISTORY" )
148   IF ( grid%auxhist1_oid > 0 ) CALL close_dataset ( grid%auxhist1_oid , config_flags , "DATASET=AUXHIST1" )
149   IF ( grid%auxhist2_oid > 0 ) CALL close_dataset ( grid%auxhist2_oid , config_flags , "DATASET=AUXHIST2" )
150   IF ( grid%auxhist3_oid > 0 ) CALL close_dataset ( grid%auxhist3_oid , config_flags , "DATASET=AUXHIST3" )
151   IF ( grid%auxhist4_oid > 0 ) CALL close_dataset ( grid%auxhist4_oid , config_flags , "DATASET=AUXHIST4" )
152   IF ( grid%auxhist5_oid > 0 ) CALL close_dataset ( grid%auxhist5_oid , config_flags , "DATASET=AUXHIST5" )
153#if 0
154   IF ( grid%auxhist6_oid > 0 ) CALL close_dataset ( grid%auxhist6_oid , config_flags , "DATASET=AUXHIST6" )
155   IF ( grid%auxhist7_oid > 0 ) CALL close_dataset ( grid%auxhist7_oid , config_flags , "DATASET=AUXHIST7" )
156   IF ( grid%auxhist8_oid > 0 ) CALL close_dataset ( grid%auxhist8_oid , config_flags , "DATASET=AUXHIST8" )
157   IF ( grid%auxhist9_oid > 0 ) CALL close_dataset ( grid%auxhist9_oid , config_flags , "DATASET=AUXHIST9" )
158   IF ( grid%auxhist10_oid > 0 ) CALL close_dataset ( grid%auxhist10_oid , config_flags , "DATASET=AUXHIST10" )
159   IF ( grid%auxhist11_oid > 0 ) CALL close_dataset ( grid%auxhist11_oid , config_flags , "DATASET=AUXHIST11" )
160#endif
161
162   IF ( grid%lbc_fid > 0 ) CALL close_dataset ( grid%lbc_fid , config_flags , "DATASET=BOUNDARY" )
163
164   CALL wrf_ioexit( ierr )    ! shut down the quilt I/O
165
166   RETURN
167
168END SUBROUTINE med_shutdown_io
169
170SUBROUTINE med_add_config_info_to_grid ( grid )
171
172   USE module_domain
173   USE module_configure
174 
175   IMPLICIT NONE
176
177   !  Input data.
178
179   TYPE(domain) , TARGET          :: grid
180
181#define SOURCE_RECORD model_config_rec %
182#define SOURCE_REC_DEX (grid%id)
183#define DEST_RECORD   grid %
184#include <config_assigns.inc>
185
186   RETURN
187
188END SUBROUTINE med_add_config_info_to_grid
189
Note: See TracBrowser for help on using the repository browser.