78be2fd6464feea52319d3e1a426b2df46960ced
[MNH-git_open_source-lfs.git] / src / MNH / ini_size_spawn.f90
1 !MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
2 !MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
3 !MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
4 !MNH_LIC for details. version 1.
5 !-----------------------------------------------------------------
6 !--------------- special set of characters for RCS information
7 !-----------------------------------------------------------------
8 ! $Source$ $Revision$
9 !-----------------------------------------------------------------
10 !#########################
11 MODULE MODI_INI_SIZE_SPAWN
12 !#########################
13 !
14 INTERFACE
15 !
16 SUBROUTINE INI_SIZE_SPAWN(HLBCX,HLBCY,HPRESOPT,KITR,HINIFILE)
17 !
18 CHARACTER (LEN=4),DIMENSION(2), INTENT(IN)  :: HLBCX,HLBCY !  LBC types for model1
19 CHARACTER (LEN=5),  INTENT(IN)              :: HPRESOPT        ! Pressure solver option of model1
20 INTEGER,            INTENT(IN)              :: KITR            ! Iterations of pressure solver of model1
21 CHARACTER (LEN=*),  INTENT(IN)              :: HINIFILE ! name of the model 1 file
22 !
23 END SUBROUTINE INI_SIZE_SPAWN
24 !
25 END INTERFACE
26 !
27 END MODULE MODI_INI_SIZE_SPAWN
28 !
29 !
30 !     #############################################################
31       SUBROUTINE INI_SIZE_SPAWN(HLBCX,HLBCY,HPRESOPT,KITR,HINIFILE)
32 !     #############################################################
33 !
34 !!****  *INI_SIZE_SPAWN * - subroutine to compute dimensions and position of model 2,
35 !!                          initialize its LBC and call the // initialisation routines
36 !!                          and fill variables in MODD_PGDGRID before possibly testing
37 !!                          coherence between model 1 and spawned grid
38 !
39 !!    PURPOSE
40 !!    -------
41 !!
42 !!      This subroutine is only for spawning purpose. It ends the initialization of the
43 !!      MODD_SPAWN variables corresponding to the model2 configuration and call
44 !!      // routines .
45 !
46 !!    EXTERNAL
47 !!    --------
48 !!    FMLOOK_ll
49 !!    DEFAULT_DESFM2
50 !!    FMOPEN_ll
51 !!    READ_HGRID
52 !!    FMCLOS_ll
53 !!    RETRIEVE_NEST_INFO
54 !!
55 !!    IMPLICIT ARGUMENTS
56 !!    ------------------
57 !!
58 !!    AUTHOR
59 !!    ------
60 !!
61 !!       P. Jabouille     * METEO-FRANCE *
62 !!
63 !!    MODIFICATIONS
64 !!    -------------
65 !!
66 !!      Original     13/07/99
67 !!         M.Faivre  2014
68 !!         M.Moge    07/2015  bug fix : files opened multiple times
69 !!         M.Moge    08/2015  bug fix : turning the special case for // case into general case in part 1.4
70 !!   J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
71 !-------------------------------------------------------------------------------
72 !
73 !*       0.     DECLARATIONS
74 !               ------------
75 !
76 USE MODD_SPAWN
77 USE MODD_PARAMETERS
78 USE MODD_CONF
79 USE MODD_GRID
80 USE MODD_PGDGRID
81 USE MODD_PGDDIM
82 !
83 USE MODE_ll
84 USE MODE_IO_ll
85 USE MODE_FM
86 USE MODE_FMREAD
87 USE MODE_GRIDPROJ
88 !
89 USE MODD_DIM_n, ONLY : DIM_MODEL
90 !
91 USE MODD_DYN_n, ONLY : CPRESOPT, NITR
92 USE MODD_LBC_n
93 USE MODD_GRID_n
94 USE MODD_LUNIT_n
95 !
96 USE MODI_DEFAULT_DESFM_n   ! Only for model 2
97 USE MODI_READ_HGRID
98 USE MODI_RETRIEVE1_NEST_INFO_n
99 USE MODI_COMPARE_DAD
100 USE MODE_MODELN_HANDLER
101 !
102 !$20140602 for NPROC
103 !USE MODD_VAR_ll
104 USE MODD_IO_ll, ONLY : ISNPROC, ISP
105 !20140602 for INI_PARAZ_ll
106 USE MODE_SPLITTINGZ_ll
107 !
108 USE MODE_SPLITTING_ll, ONLY : SPLIT2
109 USE MODD_VAR_ll, ONLY : YSPLITTING, NMNH_COMM_WORLD
110 USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
111 !$
112 IMPLICIT NONE
113 !
114 !*       0.1  Declarations of dummy arguments :
115 !
116 CHARACTER (LEN=4),DIMENSION(2), INTENT(IN)  :: HLBCX,HLBCY !  LBC types for model1
117 CHARACTER (LEN=5),  INTENT(IN)              :: HPRESOPT        ! Pressure solver option of model1
118 INTEGER,            INTENT(IN)              :: KITR            ! Iterations of pressure solver of model1
119 CHARACTER (LEN=*),  INTENT(IN)              :: HINIFILE ! name of the model 1 file
120 !
121 !*       0.2  Declarations of local variables :
122 !
123 INTEGER :: IRESP    ! Return codes in FM routines
124 INTEGER :: ILUOUT   ! Logical unit number for the output listing
125 INTEGER :: ININAR   ! Number of articles present in the LFIFM file
126 INTEGER :: IMASDEV
127 CHARACTER(LEN=2)    :: YDIR   ! Type  of the data field in LFIFM file
128 !
129 CHARACTER (LEN=28) :: YINIFILE        ! Name of the model 1 FM-file
130 CHARACTER (LEN=5)  :: YPRESOPT        ! Pressure solver option of model 1
131 INTEGER            :: IITR            ! Iterations of pressure solver of model 1
132 CHARACTER (LEN=28) :: YMY_NAME, YDAD_NAME
133 CHARACTER (LEN=2)  :: YSTORAGE_TYPE
134 CHARACTER (LEN=16) :: YRECFM
135 INTEGER            :: ILENCH, IGRID
136 CHARACTER (LEN=100):: YCOMMENT
137 INTEGER            :: IMI
138 !
139 !$20140602
140 INTEGER            :: IIU, IJU
141 INTEGER            :: IINFO_ll    ! return code of // routines
142 INTEGER            :: NIMAX, NJMAX
143 CHARACTER(LEN=28), DIMENSION(JPMODELMAX) :: CPGD     ! name of input  pgd files
144 LOGICAL, DIMENSION(JPMODELMAX) :: L1D_ALL  ! Flag for      1D conf. for each PGD
145 LOGICAL, DIMENSION(JPMODELMAX) :: L2D_ALL  ! Flag for      2D conf. for each PGD
146 LOGICAL, DIMENSION(JPMODELMAX) :: LPACK_ALL! Flag for packing conf. for each PGD
147 INTEGER            :: IDIMX, IDIMY, IIB, IJB, IIE, IJE
148 !$
149 !-------------------------------------------------------------------------------
150 REAL :: ZLATOR, ZLONOR, ZXHATM, ZYHATM
151 INTEGER :: IIMAX_ll,IJMAX_ll
152 TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
153 !-------------------------------------------------------------------------------
154 !
155 !
156 IMI = GET_CURRENT_MODEL_INDEX()
157 CALL GOTO_MODEL(2)
158 !
159 CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
160 !
161 !*   1.    INITIALIZATIONS :
162 !
163 !*     1.1   set default values :
164 !
165 YINIFILE = CINIFILE
166 YPRESOPT = HPRESOPT
167 IITR     = KITR
168 CALL DEFAULT_DESFM_n(2)
169 CINIFILE = YINIFILE
170 CPRESOPT = YPRESOPT
171 NITR     = IITR
172 !
173 IF (NDXRATIO==NUNDEF) NDXRATIO=1
174 IF (NDYRATIO==NUNDEF) NDYRATIO=1
175 IF (NXSIZE  ==NUNDEF) NXSIZE  =DIM_MODEL(1)%NIMAX_ll
176 IF (NYSIZE  ==NUNDEF) NYSIZE  =DIM_MODEL(1)%NJMAX_ll
177 IF (NXOR    ==NUNDEF) NXOR    =1
178 IF (NYOR    ==NUNDEF) NYOR    =1
179 !
180 !*     1.2   special cases :
181 !
182 IF (L1D) THEN
183   NXSIZE=1
184   NDXRATIO=1
185 ENDIF
186 !
187 IF (L1D .OR. L2D) THEN
188   NYSIZE=1
189   NDYRATIO=1
190 ENDIF
191 !
192 IF (LBAL_ONLY) THEN
193   NDXRATIO=1
194   NDYRATIO=1
195   NXSIZE  =DIM_MODEL(1)%NIMAX_ll
196   NYSIZE  =DIM_MODEL(1)%NJMAX_ll
197   NXOR    =1
198   NYOR    =1
199   IF (LEN_TRIM(CDADSPAFILE) >0 ) THEN
200     IF (LEN_TRIM(CDADINIFILE) == 0 ) THEN
201       WRITE(ILUOUT,*) 'ERROR in INI_SIZE_SPAWN: YDADINIFILE not initialized in namelist NAM_LUNIT2_SPA'
202 !callabortstop
203       CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
204       CALL ABORT
205       STOP
206     ELSE
207       YRECFM='DAD_NAME'
208       YDIR='--'
209       CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,YDAD_NAME,IGRID,ILENCH,YCOMMENT,IRESP)
210       IF (ADJUSTL(ADJUSTR(YDAD_NAME)) .NE. ADJUSTL(ADJUSTR(CDADINIFILE))) THEN
211         WRITE(ILUOUT,*) 'ERROR in INI_SIZE_SPAWN: YDADINIFILE is NOT the DAD of model 1'
212         WRITE(ILUOUT,*) ' YDADINIFILE='//TRIM(CDADINIFILE)
213         WRITE(ILUOUT,*) ' DAD_NAME of model1='//TRIM(YDAD_NAME)
214 !callabortstop
215         CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
216         CALL ABORT
217         STOP
218       ELSE
219         !
220         CALL COMPARE_DAD(CDADINIFILE,CDADSPAFILE,IRESP)
221         IF (IRESP .NE. 0) THEN
222           WRITE(ILUOUT,*) 'ERROR in INI_SIZE_SPAWN: Unable to replace the DAD of model 1 with YDADSPAFILE'
223 !callabortstop
224           CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
225           CALL ABORT
226           STOP
227         ENDIF
228         !
229       ENDIF
230     ENDIF
231   ENDIF
232 ENDIF
233 !
234 !
235 !*     1.3   set some variables related to model 1 grid
236 !
237 IF (LEN_TRIM(CDOMAIN)>0) THEN
238 !
239   YRECFM='LON0'
240   YDIR='--'
241   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XLON0,IGRID,ILENCH,YCOMMENT,IRESP)
242 !
243   YRECFM='LAT0'
244   YDIR='--'
245   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XLAT0,IGRID,ILENCH,YCOMMENT,IRESP)
246 !
247   YRECFM='BETA'
248   YDIR='--'
249   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XBETA,IGRID,ILENCH,YCOMMENT,IRESP)
250 !
251   YRECFM='RPK'
252   YDIR='--'
253   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XRPK,IGRID,ILENCH,YCOMMENT,IRESP)
254 !
255   YRECFM='LONORI'
256   YDIR='--'
257   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDLONOR,IGRID,ILENCH,YCOMMENT,IRESP)
258   !
259   YRECFM='LATORI'
260   YDIR='--'
261   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDLATOR,IGRID,ILENCH,YCOMMENT,IRESP)
262   !
263   !$20140602 INSERT BIG MODIF JUAN May27
264 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
265 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
266 !
267 !*     1.4   read grid in file CDOMAIN if available :
268 ! initialize grid2 dims, xor, xend and ratio so to initialize in INI_CHILD 
269 ! structures TCRRT_COMDATA%T_CHILDREN%T_SPLITB and TCRRT_PROCONF%T_CHILDREN
270 !$20140602 add condition on npproc
271   CALL FMOPEN_ll(CDOMAIN,'READ',CLUOUT,0,2,NVERB,ININAR,IRESP)
272   !
273   YDIR='--'
274   CALL FMREAD(CDOMAIN,'DXRATIO',CLUOUT,YDIR,NDXRATIO,IGRID,ILENCH,YCOMMENT,IRESP)
275   CALL FMREAD(CDOMAIN,'DYRATIO',CLUOUT,YDIR,NDYRATIO,IGRID,ILENCH,YCOMMENT,IRESP)
276   CALL FMREAD(CDOMAIN,'XOR',CLUOUT,YDIR,NXOR,IGRID,ILENCH,YCOMMENT,IRESP)
277   CALL FMREAD(CDOMAIN,'YOR',CLUOUT,YDIR,NYOR,IGRID,ILENCH,YCOMMENT,IRESP)
278   CALL FMREAD(CDOMAIN,'IMAX',CLUOUT,YDIR,IIMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
279   CALL FMREAD(CDOMAIN,'JMAX',CLUOUT,YDIR,IJMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
280   CALL FMCLOS_ll(CDOMAIN,'KEEP',CLUOUT,IRESP)
281   NXEND=NXOR+IIMAX_ll/NDXRATIO+2*JPHEXT-1
282   NYEND=NYOR+IJMAX_ll/NDYRATIO+2*JPHEXT-1
283   !
284   !*   1.5    CALL OF INITIALIZATION PARALLEL ROUTINES
285   !
286   CALL SET_LBX_ll(CLBCX(1), 2)
287   CALL SET_LBY_ll(CLBCY(1), 2)
288   CALL SET_XRATIO_ll(NDXRATIO, 2)
289   CALL SET_YRATIO_ll(NDYRATIO, 2)
290   CALL SET_XOR_ll(NXOR, 2)
291   CALL SET_XEND_ll(NXEND, 2)
292   CALL SET_YOR_ll(NYOR, 2)
293   CALL SET_YEND_ll(NYEND, 2)
294   CALL SET_DAD_ll(1, 2)
295   !
296   CALL INI_PARAZ_ll(IINFO_ll)
297   ! get dimensions of father model
298   CALL GET_DIM_PHYS_ll( YSPLITTING, DIM_MODEL(1)%NIMAX, DIM_MODEL(1)%NJMAX )
299 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
300 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
301   !$
302   ALLOCATE(XPGDXHAT(DIM_MODEL(1)%NIMAX+2*JPHEXT))
303   !ALLOCATE(XPGDXHAT(15+2*JPHEXT))
304   YRECFM='XHAT'
305   !$20140505 test '--'
306   !YDIR='XX'
307   !YDIR='--'
308   !$20140520 retour a 'XX'
309   !$then np1 works, but np4 stops here
310   !$20140602 use NPROC
311   IF (ISNPROC.EQ.1) YDIR='XX'
312   IF (ISNPROC.GT.1) YDIR='XX'!'--'
313   !$
314   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
315   !
316   ALLOCATE(XPGDYHAT(DIM_MODEL(1)%NJMAX+2*JPHEXT))
317   YRECFM='YHAT'
318   !$20140506 test '--'
319   !YDIR='YY'
320   !YDIR='--'
321   !$20140520 retour a 'YY'
322   !$20140602 use NPROC
323   IF (ISNPROC.EQ.1) YDIR='YY'
324   IF (ISNPROC.GT.1) YDIR='YY'!'--'
325   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
326   !
327   YRECFM='MASDEV' 
328   YDIR='--'
329   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
330   !
331   IF (IMASDEV<=45) THEN
332     CALL FMREAD(HINIFILE,'LATOR',CLUOUT,'--',XPGDLATOR,IGRID,ILENCH,YCOMMENT,IRESP)
333     CALL FMREAD(HINIFILE,'LONOR',CLUOUT,'--',XPGDLONOR,IGRID,ILENCH,YCOMMENT,IRESP)
334     ZXHATM = - 0.5 * (XPGDXHAT(1)+XPGDXHAT(2))
335     ZYHATM = - 0.5 * (XPGDYHAT(1)+XPGDYHAT(2))
336     CALL SM_LATLON(XPGDLATOR,XPGDLONOR,ZXHATM,ZYHATM,ZLATOR,ZLONOR)
337     XPGDLATOR = ZLATOR
338     XPGDLONOR = ZLONOR
339   END IF
340   !
341 !
342 !*     1.4   read grid in file CDOMAIN if available :
343 !
344   CALL FMOPEN_ll(CDOMAIN,'READ',CLUOUT,0,2,NVERB,ININAR,IRESP)
345   CALL READ_HGRID(2,CDOMAIN,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
346   CALL FMCLOS_ll(CDOMAIN,'KEEP',CLUOUT,IRESP)
347   CALL RETRIEVE1_NEST_INFO_n(1,2,NXOR,NYOR,NXSIZE,NYSIZE,NDXRATIO,NDYRATIO)
348   DEALLOCATE(XZS,XZSMT,XXHAT,XYHAT)
349 !
350 END IF
351 !
352 !*     1.5   Position of model 2 domain relative to model 1 
353 !
354 NXEND = NXOR + NXSIZE +2*JPHEXT -1
355 NYEND = NYOR + NYSIZE +2*JPHEXT -1
356 !
357 !*     1.6  model 2 LBC   (caution: implicitely JPHEXT = 1)
358 !
359 CLBCX(:) = 'OPEN'
360 IF (NXOR  == 1          .AND. NXEND    == DIM_MODEL(1)%NIMAX_ll+2*JPHEXT) CLBCX(:) = HLBCX(:)
361 IF (NXOR  == 1          .AND. HLBCX(1) == 'WALL')     CLBCX(1) = 'WALL'
362 IF (NXEND == DIM_MODEL(1)%NIMAX_ll+2*JPHEXT .AND. HLBCX(2) == 'WALL')     CLBCX(2) = 'WALL'
363 !
364 CLBCY(:) = 'OPEN'
365 IF (NYOR  == 1          .AND. NYEND    == DIM_MODEL(1)%NJMAX_ll+2*JPHEXT) CLBCY(:) = HLBCY(:)
366 IF (NYOR  == 1          .AND. HLBCY(1) == 'WALL')     CLBCY(1) = 'WALL'
367 IF (NYEND == DIM_MODEL(1)%NJMAX_ll+2*JPHEXT .AND. HLBCY(2) == 'WALL')     CLBCY(2) = 'WALL'
368 !
369 !
370 !*   2    CALL OF INITIALIZATION PARALLEL ROUTINES
371 !
372 CALL SET_LBX_ll(CLBCX(1), 2)
373 CALL SET_LBY_ll(CLBCY(1), 2)
374 CALL SET_XRATIO_ll(NDXRATIO, 2)
375 CALL SET_YRATIO_ll(NDYRATIO, 2)
376 CALL SET_XOR_ll(NXOR, 2)
377 CALL SET_XEND_ll(NXEND, 2)
378 CALL SET_YOR_ll(NYOR, 2)
379 CALL SET_YEND_ll(NYEND, 2)
380 CALL SET_DAD_ll(1, 2)
381 !
382 CALL GOTO_MODEL(IMI)
383 !
384 END SUBROUTINE INI_SIZE_SPAWN