Juan 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
[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 !!         J.Escobar : 19/04/2016 : Pb IOZ/NETCDF , missing OPARALLELIO=.FALSE. for PGD files
72 !-------------------------------------------------------------------------------
73 !
74 !*       0.     DECLARATIONS
75 !               ------------
76 !
77 USE MODD_SPAWN
78 USE MODD_PARAMETERS
79 USE MODD_CONF
80 USE MODD_GRID
81 USE MODD_PGDGRID
82 USE MODD_PGDDIM
83 !
84 USE MODE_ll
85 USE MODE_IO_ll
86 USE MODE_FM
87 USE MODE_FMREAD
88 USE MODE_GRIDPROJ
89 !
90 USE MODD_DIM_n, ONLY : DIM_MODEL
91 !
92 USE MODD_DYN_n, ONLY : CPRESOPT, NITR
93 USE MODD_LBC_n
94 USE MODD_GRID_n
95 USE MODD_LUNIT_n
96 !
97 USE MODI_DEFAULT_DESFM_n   ! Only for model 2
98 USE MODI_READ_HGRID
99 USE MODI_RETRIEVE1_NEST_INFO_n
100 USE MODI_COMPARE_DAD
101 USE MODE_MODELN_HANDLER
102 !
103 !$20140602 for NPROC
104 !USE MODD_VAR_ll
105 USE MODD_IO_ll, ONLY : ISNPROC, ISP
106 !20140602 for INI_PARAZ_ll
107 USE MODE_SPLITTINGZ_ll
108 !
109 USE MODE_SPLITTING_ll, ONLY : SPLIT2
110 USE MODD_VAR_ll, ONLY : YSPLITTING, NMNH_COMM_WORLD
111 USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
112 !$
113 IMPLICIT NONE
114 !
115 !*       0.1  Declarations of dummy arguments :
116 !
117 CHARACTER (LEN=4),DIMENSION(2), INTENT(IN)  :: HLBCX,HLBCY !  LBC types for model1
118 CHARACTER (LEN=5),  INTENT(IN)              :: HPRESOPT        ! Pressure solver option of model1
119 INTEGER,            INTENT(IN)              :: KITR            ! Iterations of pressure solver of model1
120 CHARACTER (LEN=*),  INTENT(IN)              :: HINIFILE ! name of the model 1 file
121 !
122 !*       0.2  Declarations of local variables :
123 !
124 INTEGER :: IRESP    ! Return codes in FM routines
125 INTEGER :: ILUOUT   ! Logical unit number for the output listing
126 INTEGER :: ININAR   ! Number of articles present in the LFIFM file
127 INTEGER :: IMASDEV
128 CHARACTER(LEN=2)    :: YDIR   ! Type  of the data field in LFIFM file
129 !
130 CHARACTER (LEN=28) :: YINIFILE        ! Name of the model 1 FM-file
131 CHARACTER (LEN=5)  :: YPRESOPT        ! Pressure solver option of model 1
132 INTEGER            :: IITR            ! Iterations of pressure solver of model 1
133 CHARACTER (LEN=28) :: YMY_NAME, YDAD_NAME
134 CHARACTER (LEN=2)  :: YSTORAGE_TYPE
135 CHARACTER (LEN=16) :: YRECFM
136 INTEGER            :: ILENCH, IGRID
137 CHARACTER (LEN=100):: YCOMMENT
138 INTEGER            :: IMI
139 !
140 !$20140602
141 INTEGER            :: IIU, IJU
142 INTEGER            :: IINFO_ll    ! return code of // routines
143 INTEGER            :: NIMAX, NJMAX
144 CHARACTER(LEN=28), DIMENSION(JPMODELMAX) :: CPGD     ! name of input  pgd files
145 LOGICAL, DIMENSION(JPMODELMAX) :: L1D_ALL  ! Flag for      1D conf. for each PGD
146 LOGICAL, DIMENSION(JPMODELMAX) :: L2D_ALL  ! Flag for      2D conf. for each PGD
147 LOGICAL, DIMENSION(JPMODELMAX) :: LPACK_ALL! Flag for packing conf. for each PGD
148 INTEGER            :: IDIMX, IDIMY, IIB, IJB, IIE, IJE
149 !$
150 !-------------------------------------------------------------------------------
151 REAL :: ZLATOR, ZLONOR, ZXHATM, ZYHATM
152 INTEGER :: IIMAX_ll,IJMAX_ll
153 TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
154 !-------------------------------------------------------------------------------
155 !
156 !
157 IMI = GET_CURRENT_MODEL_INDEX()
158 CALL GOTO_MODEL(2)
159 !
160 CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
161 !
162 !*   1.    INITIALIZATIONS :
163 !
164 !*     1.1   set default values :
165 !
166 YINIFILE = CINIFILE
167 YPRESOPT = HPRESOPT
168 IITR     = KITR
169 CALL DEFAULT_DESFM_n(2)
170 CINIFILE = YINIFILE
171 CPRESOPT = YPRESOPT
172 NITR     = IITR
173 !
174 IF (NDXRATIO==NUNDEF) NDXRATIO=1
175 IF (NDYRATIO==NUNDEF) NDYRATIO=1
176 IF (NXSIZE  ==NUNDEF) NXSIZE  =DIM_MODEL(1)%NIMAX_ll
177 IF (NYSIZE  ==NUNDEF) NYSIZE  =DIM_MODEL(1)%NJMAX_ll
178 IF (NXOR    ==NUNDEF) NXOR    =1
179 IF (NYOR    ==NUNDEF) NYOR    =1
180 !
181 !*     1.2   special cases :
182 !
183 IF (L1D) THEN
184   NXSIZE=1
185   NDXRATIO=1
186 ENDIF
187 !
188 IF (L1D .OR. L2D) THEN
189   NYSIZE=1
190   NDYRATIO=1
191 ENDIF
192 !
193 IF (LBAL_ONLY) THEN
194   NDXRATIO=1
195   NDYRATIO=1
196   NXSIZE  =DIM_MODEL(1)%NIMAX_ll
197   NYSIZE  =DIM_MODEL(1)%NJMAX_ll
198   NXOR    =1
199   NYOR    =1
200   IF (LEN_TRIM(CDADSPAFILE) >0 ) THEN
201     IF (LEN_TRIM(CDADINIFILE) == 0 ) THEN
202       WRITE(ILUOUT,*) 'ERROR in INI_SIZE_SPAWN: YDADINIFILE not initialized in namelist NAM_LUNIT2_SPA'
203 !callabortstop
204       CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
205       CALL ABORT
206       STOP
207     ELSE
208       YRECFM='DAD_NAME'
209       YDIR='--'
210       CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,YDAD_NAME,IGRID,ILENCH,YCOMMENT,IRESP)
211       IF (ADJUSTL(ADJUSTR(YDAD_NAME)) .NE. ADJUSTL(ADJUSTR(CDADINIFILE))) THEN
212         WRITE(ILUOUT,*) 'ERROR in INI_SIZE_SPAWN: YDADINIFILE is NOT the DAD of model 1'
213         WRITE(ILUOUT,*) ' YDADINIFILE='//TRIM(CDADINIFILE)
214         WRITE(ILUOUT,*) ' DAD_NAME of model1='//TRIM(YDAD_NAME)
215 !callabortstop
216         CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
217         CALL ABORT
218         STOP
219       ELSE
220         !
221         CALL COMPARE_DAD(CDADINIFILE,CDADSPAFILE,IRESP)
222         IF (IRESP .NE. 0) THEN
223           WRITE(ILUOUT,*) 'ERROR in INI_SIZE_SPAWN: Unable to replace the DAD of model 1 with YDADSPAFILE'
224 !callabortstop
225           CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
226           CALL ABORT
227           STOP
228         ENDIF
229         !
230       ENDIF
231     ENDIF
232   ENDIF
233 ENDIF
234 !
235 !
236 !*     1.3   set some variables related to model 1 grid
237 !
238 IF (LEN_TRIM(CDOMAIN)>0) THEN
239 !
240   YRECFM='LON0'
241   YDIR='--'
242   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XLON0,IGRID,ILENCH,YCOMMENT,IRESP)
243 !
244   YRECFM='LAT0'
245   YDIR='--'
246   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XLAT0,IGRID,ILENCH,YCOMMENT,IRESP)
247 !
248   YRECFM='BETA'
249   YDIR='--'
250   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XBETA,IGRID,ILENCH,YCOMMENT,IRESP)
251 !
252   YRECFM='RPK'
253   YDIR='--'
254   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XRPK,IGRID,ILENCH,YCOMMENT,IRESP)
255 !
256   YRECFM='LONORI'
257   YDIR='--'
258   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDLONOR,IGRID,ILENCH,YCOMMENT,IRESP)
259   !
260   YRECFM='LATORI'
261   YDIR='--'
262   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDLATOR,IGRID,ILENCH,YCOMMENT,IRESP)
263   !
264   !$20140602 INSERT BIG MODIF JUAN May27
265 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
266 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
267 !
268 !*     1.4   read grid in file CDOMAIN if available :
269 ! initialize grid2 dims, xor, xend and ratio so to initialize in INI_CHILD 
270 ! structures TCRRT_COMDATA%T_CHILDREN%T_SPLITB and TCRRT_PROCONF%T_CHILDREN
271 !$20140602 add condition on npproc
272   CALL FMOPEN_ll(CDOMAIN,'READ',CLUOUT,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
273   !
274   YDIR='--'
275   CALL FMREAD(CDOMAIN,'DXRATIO',CLUOUT,YDIR,NDXRATIO,IGRID,ILENCH,YCOMMENT,IRESP)
276   CALL FMREAD(CDOMAIN,'DYRATIO',CLUOUT,YDIR,NDYRATIO,IGRID,ILENCH,YCOMMENT,IRESP)
277   CALL FMREAD(CDOMAIN,'XOR',CLUOUT,YDIR,NXOR,IGRID,ILENCH,YCOMMENT,IRESP)
278   CALL FMREAD(CDOMAIN,'YOR',CLUOUT,YDIR,NYOR,IGRID,ILENCH,YCOMMENT,IRESP)
279   CALL FMREAD(CDOMAIN,'IMAX',CLUOUT,YDIR,IIMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
280   CALL FMREAD(CDOMAIN,'JMAX',CLUOUT,YDIR,IJMAX_ll,IGRID,ILENCH,YCOMMENT,IRESP)
281   CALL FMCLOS_ll(CDOMAIN,'KEEP',CLUOUT,IRESP,OPARALLELIO=.FALSE.)
282   NXEND=NXOR+IIMAX_ll/NDXRATIO+2*JPHEXT-1
283   NYEND=NYOR+IJMAX_ll/NDYRATIO+2*JPHEXT-1
284   !
285   !*   1.5    CALL OF INITIALIZATION PARALLEL ROUTINES
286   !
287   CALL SET_LBX_ll(CLBCX(1), 2)
288   CALL SET_LBY_ll(CLBCY(1), 2)
289   CALL SET_XRATIO_ll(NDXRATIO, 2)
290   CALL SET_YRATIO_ll(NDYRATIO, 2)
291   CALL SET_XOR_ll(NXOR, 2)
292   CALL SET_XEND_ll(NXEND, 2)
293   CALL SET_YOR_ll(NYOR, 2)
294   CALL SET_YEND_ll(NYEND, 2)
295   CALL SET_DAD_ll(1, 2)
296   !
297   CALL INI_PARAZ_ll(IINFO_ll)
298   ! get dimensions of father model
299   CALL GET_DIM_PHYS_ll( YSPLITTING, DIM_MODEL(1)%NIMAX, DIM_MODEL(1)%NJMAX )
300 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
301 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
302   !$
303   ALLOCATE(XPGDXHAT(DIM_MODEL(1)%NIMAX+2*JPHEXT))
304   !ALLOCATE(XPGDXHAT(15+2*JPHEXT))
305   YRECFM='XHAT'
306   !$20140505 test '--'
307   !YDIR='XX'
308   !YDIR='--'
309   !$20140520 retour a 'XX'
310   !$then np1 works, but np4 stops here
311   !$20140602 use NPROC
312   IF (ISNPROC.EQ.1) YDIR='XX'
313   IF (ISNPROC.GT.1) YDIR='XX'!'--'
314   !$
315   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
316   !
317   ALLOCATE(XPGDYHAT(DIM_MODEL(1)%NJMAX+2*JPHEXT))
318   YRECFM='YHAT'
319   !$20140506 test '--'
320   !YDIR='YY'
321   !YDIR='--'
322   !$20140520 retour a 'YY'
323   !$20140602 use NPROC
324   IF (ISNPROC.EQ.1) YDIR='YY'
325   IF (ISNPROC.GT.1) YDIR='YY'!'--'
326   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,XPGDYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
327   !
328   YRECFM='MASDEV' 
329   YDIR='--'
330   CALL FMREAD(HINIFILE,YRECFM,CLUOUT,YDIR,IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
331   !
332   IF (IMASDEV<=45) THEN
333     CALL FMREAD(HINIFILE,'LATOR',CLUOUT,'--',XPGDLATOR,IGRID,ILENCH,YCOMMENT,IRESP)
334     CALL FMREAD(HINIFILE,'LONOR',CLUOUT,'--',XPGDLONOR,IGRID,ILENCH,YCOMMENT,IRESP)
335     ZXHATM = - 0.5 * (XPGDXHAT(1)+XPGDXHAT(2))
336     ZYHATM = - 0.5 * (XPGDYHAT(1)+XPGDYHAT(2))
337     CALL SM_LATLON(XPGDLATOR,XPGDLONOR,ZXHATM,ZYHATM,ZLATOR,ZLONOR)
338     XPGDLATOR = ZLATOR
339     XPGDLONOR = ZLONOR
340   END IF
341   !
342 !
343 !*     1.4   read grid in file CDOMAIN if available :
344 !
345   CALL FMOPEN_ll(CDOMAIN,'READ',CLUOUT,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
346   CALL READ_HGRID(2,CDOMAIN,YMY_NAME,YDAD_NAME,YSTORAGE_TYPE)
347   CALL FMCLOS_ll(CDOMAIN,'KEEP',CLUOUT,IRESP,OPARALLELIO=.FALSE.)
348   CALL RETRIEVE1_NEST_INFO_n(1,2,NXOR,NYOR,NXSIZE,NYSIZE,NDXRATIO,NDYRATIO)
349   DEALLOCATE(XZS,XZSMT,XXHAT,XYHAT)
350 !
351 END IF
352 !
353 !*     1.5   Position of model 2 domain relative to model 1 
354 !
355 NXEND = NXOR + NXSIZE +2*JPHEXT -1
356 NYEND = NYOR + NYSIZE +2*JPHEXT -1
357 !
358 !*     1.6  model 2 LBC   (caution: implicitely JPHEXT = 1)
359 !
360 CLBCX(:) = 'OPEN'
361 IF (NXOR  == 1          .AND. NXEND    == DIM_MODEL(1)%NIMAX_ll+2*JPHEXT) CLBCX(:) = HLBCX(:)
362 IF (NXOR  == 1          .AND. HLBCX(1) == 'WALL')     CLBCX(1) = 'WALL'
363 IF (NXEND == DIM_MODEL(1)%NIMAX_ll+2*JPHEXT .AND. HLBCX(2) == 'WALL')     CLBCX(2) = 'WALL'
364 !
365 CLBCY(:) = 'OPEN'
366 IF (NYOR  == 1          .AND. NYEND    == DIM_MODEL(1)%NJMAX_ll+2*JPHEXT) CLBCY(:) = HLBCY(:)
367 IF (NYOR  == 1          .AND. HLBCY(1) == 'WALL')     CLBCY(1) = 'WALL'
368 IF (NYEND == DIM_MODEL(1)%NJMAX_ll+2*JPHEXT .AND. HLBCY(2) == 'WALL')     CLBCY(2) = 'WALL'
369 !
370 !
371 !*   2    CALL OF INITIALIZATION PARALLEL ROUTINES
372 !
373 CALL SET_LBX_ll(CLBCX(1), 2)
374 CALL SET_LBY_ll(CLBCY(1), 2)
375 CALL SET_XRATIO_ll(NDXRATIO, 2)
376 CALL SET_YRATIO_ll(NDYRATIO, 2)
377 CALL SET_XOR_ll(NXOR, 2)
378 CALL SET_XEND_ll(NXEND, 2)
379 CALL SET_YOR_ll(NYOR, 2)
380 CALL SET_YEND_ll(NYEND, 2)
381 CALL SET_DAD_ll(1, 2)
382 !
383 CALL GOTO_MODEL(IMI)
384 !
385 END SUBROUTINE INI_SIZE_SPAWN