Philippe 01/12/2015: added missing & at the beginning of output message lines
[MNH-git_open_source-lfs.git] / src / MNH / read_hgridn.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_READ_HGRID_n
12 !     #######################
13 !
14 INTERFACE
15       SUBROUTINE READ_HGRID_n(HFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
16 !
17 CHARACTER (LEN=*), INTENT(IN)  :: HFMFILE     ! name of the file n
18 CHARACTER(LEN=28), INTENT(OUT) :: HMY_NAME     ! True Name of FM-file
19 CHARACTER(LEN=28), INTENT(OUT) :: HDAD_NAME    ! Name of father
20 CHARACTER(LEN=2) , INTENT(OUT) :: HSTORAGE_TYPE
21 !
22 END SUBROUTINE READ_HGRID_n
23 !
24 END INTERFACE
25 END MODULE MODI_READ_HGRID_n
26 !
27 !     #################################################################
28       SUBROUTINE READ_HGRID_n(HFMFILE,HMY_NAME,HDAD_NAME,HSTORAGE_TYPE)
29 !     #################################################################
30 !
31 !!****  *READ_HGRID_n* - to read grid information in FM file of model $n
32 !!
33 !!    PURPOSE
34 !!    -------
35 !
36 !!**  METHOD
37 !!    ------
38 !!
39 !!    EXTERNAL
40 !!    --------
41 !!      FMREAD   : to read data in LFIFM file
42 !!
43 !!    IMPLICIT ARGUMENTS
44 !!    ------------------
45 !!      Module MODD_GRID : contains projection definition
46 !!        XLAT0
47 !!        XLON0
48 !!        XRPK
49 !!        XBETA
50 !!        XLATORI
51 !!        XLONORI
52 !!      Module MODD_GRID_n : contains domain definition
53 !!        XXHAT
54 !!        XYHAT
55 !!      Module MODD_DIM_n : contains domain size
56 !!        NIMAX
57 !!        NJMAX
58 !!      Module MODD_PARAMETERS :
59 !!        JPHEXT
60 !!      Module MODD_LUNIT :
61 !!        CLUOUT
62 !!
63 !!    REFERENCE
64 !!    ---------
65 !!      Book2 of the documentation
66 !!
67 !!
68 !!    AUTHOR
69 !!    ------
70 !!      V. Masson       * Meteo France *
71 !!
72 !!    MODIFICATIONS
73 !!    -------------
74 !!      Original        26/09/96
75 !!         M.Faivre     2014
76 !!         M.Moge       06/2015 case ( CPROGRAM .EQ. "NESPGD"  .OR. CPROGRAM .EQ. "SPAWN ")
77 !!   J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
78 !-------------------------------------------------------------------------------
79 !
80 !*       0.    DECLARATIONS
81 !
82 USE MODD_PARAMETERS, ONLY : JPHEXT, JPVEXT, JPMODELMAX
83 USE MODD_GRID
84 USE MODD_GRID_n
85 USE MODD_DIM_n
86 USE MODD_LUNIT_n
87 USE MODD_CONF
88 !
89 USE MODE_FM
90 USE MODE_FMREAD
91 USE MODE_MODELN_HANDLER
92 USE MODE_IO_ll
93 !
94 USE MODE_GRIDPROJ
95 !
96 IMPLICIT NONE
97 !
98 !*       0.1   declarations of arguments
99 !
100 CHARACTER (LEN=*), INTENT(IN)  :: HFMFILE     ! name of the file n
101 CHARACTER(LEN=28), INTENT(OUT) :: HMY_NAME     ! True Name of FM-file
102 CHARACTER(LEN=28), INTENT(OUT) :: HDAD_NAME    ! Name of father
103 CHARACTER(LEN=2) , INTENT(OUT) :: HSTORAGE_TYPE
104 !
105 !*       0.2   declarations of local variables
106 !
107 INTEGER             :: ILUOUT
108 CHARACTER (LEN=16)  :: YRECFM
109 INTEGER             :: ILENCH, IGRID, IRESP
110 CHARACTER (LEN=100) :: YCOMMENT
111 REAL                :: ZLAT0,ZLON0,ZRPK,ZBETA
112 REAL                :: ZEPS = 1.E-10
113 INTEGER             :: IMASDEV
114 INTEGER             :: IMI
115 !$20140506 add YDIR for FMREAD
116 CHARACTER(LEN=2)    :: YDIR
117
118 !
119 !-------------------------------------------------------------------------------
120 REAL :: ZLATOR, ZLONOR, ZXHATM, ZYHATM
121 !-------------------------------------------------------------------------------
122 !JUAN REALZ
123 INTEGER             :: IIU,IJU
124 INTEGER             :: NIMAX2,NJMAX2
125 !JUAN REALZ
126 INTEGER             :: IXOR, IYOR, IXEND, IYEND
127 INTEGER             :: IJPHEXT
128 !
129 CALL FMLOOK_ll(CLUOUT,CLUOUT,ILUOUT,IRESP)
130 !
131 !*       1.     General information :
132 !               -------------------
133 !
134 YRECFM='MY_NAME'
135 YCOMMENT=' '
136 IGRID=0
137 ILENCH=LEN(YCOMMENT)
138 CALL FMREAD(HFMFILE,YRECFM,CLUOUT,'--',HMY_NAME,IGRID,ILENCH,YCOMMENT,IRESP)
139 !
140 YRECFM='DAD_NAME'
141 YCOMMENT=' '
142 IGRID=0
143 ILENCH=LEN(YCOMMENT)
144 CALL FMREAD(HFMFILE,YRECFM,CLUOUT,'--',HDAD_NAME,IGRID,ILENCH,YCOMMENT,IRESP)
145 !
146 YRECFM='STORAGE_TYPE'
147 YCOMMENT=' '
148 IGRID=0
149 ILENCH=LEN(YCOMMENT)
150 CALL FMREAD(HFMFILE,YRECFM,CLUOUT,'--',HSTORAGE_TYPE,IGRID,ILENCH,YCOMMENT,IRESP)
151 !
152 YRECFM='MASDEV'
153 CALL FMREAD(HFMFILE,YRECFM,CLUOUT,'--',IMASDEV,IGRID,ILENCH,YCOMMENT,IRESP)
154 !
155 !*       2.     Grid information :
156 !               ----------------
157 !
158 IF(IMASDEV<=45 .AND. HSTORAGE_TYPE == 'PG') THEN
159   LCARTESIAN=.FALSE.
160 ELSE
161   CALL FMREAD(HFMFILE,'CARTESIAN',CLUOUT,'--',LCARTESIAN,IGRID,ILENCH,YCOMMENT,IRESP)
162 ENDIF
163 CALL FMREAD(HFMFILE,'LAT0',CLUOUT,'--',ZLAT0,IGRID,ILENCH,YCOMMENT,IRESP)
164 CALL FMREAD(HFMFILE,'LON0',CLUOUT,'--',ZLON0,IGRID,ILENCH,YCOMMENT,IRESP)
165 CALL FMREAD(HFMFILE,'BETA',CLUOUT,'--',ZBETA,IGRID,ILENCH,YCOMMENT,IRESP)
166 IF(IRESP/=0) ZBETA=0.
167 IF (.NOT.LCARTESIAN ) THEN
168   CALL FMREAD(HFMFILE,'RPK',CLUOUT,'--',ZRPK,IGRID,ILENCH,YCOMMENT,IRESP)
169   CALL FMREAD(HFMFILE,'LATORI',CLUOUT,'--',XLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
170   CALL FMREAD(HFMFILE,'LONORI',CLUOUT,'--',XLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
171 ENDIF
172 !
173 IMI = GET_CURRENT_MODEL_INDEX()
174 IF (IMI == 1) THEN
175   XLAT0=ZLAT0
176   XLON0=ZLON0
177   XBETA=ZBETA
178   IF (.NOT.LCARTESIAN) XRPK=ZRPK
179 ELSE
180   IF (     ABS(XLAT0-ZLAT0)> ZEPS .OR. ABS(XLON0-ZLON0)> ZEPS  &
181                                   .OR. ABS(XBETA-ZBETA)> ZEPS  ) THEN
182     WRITE(ILUOUT,*) 'projections are different in the two input files:'
183     WRITE(ILUOUT,*) 'model ',IMI,' : XLAT0= ',ZLAT0,' XLON0= ',ZLON0, &
184                                                ' XBETA= ',ZBETA
185     WRITE(ILUOUT,*) 'model 1 : XLAT0= ',XLAT0,' XLON0= ',XLON0, &
186                                               ' XBETA= ',XBETA
187  !callabortstop
188     CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
189     CALL ABORT
190     STOP
191   END IF
192   IF (.NOT.LCARTESIAN ) THEN
193     IF ( ABS(XRPK-ZRPK)> ZEPS ) THEN
194       WRITE(ILUOUT,*) 'projections are different in the two input files:'
195       WRITE(ILUOUT,*) 'model ',IMI,' : XRPK= ',ZRPK
196       WRITE(ILUOUT,*) 'model 1 : XRPK= ',XRPK
197  !callabortstop
198       CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
199       CALL ABORT
200       STOP
201     END IF
202   END IF
203 END IF
204 !
205 IF (CPROGRAM/='IDEAL ') THEN
206   !* WARNING : the following initialization of dimensions is ONLY valid for 
207   !            monoprocessor runs, or if :
208   !            a) NIMAX_ll, NJMAX_ll, and corresponding NIMAX_ll, NJMAX_ll are
209   !               correctly initialized in later routines (e.g. spawn_model2.f90)
210   !            b) and arrays XXHAT, XYHAT, XZS, XZSMT are deallocated after this 
211   !               routine (as in ini_size_spawn.f90)
212   !$20140506 try 'XX','YY' it is FMREADN0_LL scalar reading so leave '--'
213   CALL FMREAD(HFMFILE,'IMAX',CLUOUT,'--',NIMAX,IGRID,ILENCH,YCOMMENT,IRESP)
214   CALL FMREAD(HFMFILE,'JMAX',CLUOUT,'--',NJMAX,IGRID,ILENCH,YCOMMENT,IRESP)
215   CALL FMREAD(HFMFILE,'JPHEXT',CLUOUT,'--',IJPHEXT,IGRID,ILENCH,YCOMMENT,IRESP)
216   IF ( IJPHEXT .NE. JPHEXT ) THEN
217      IF (CPROGRAM == 'REAL' ) THEN
218         WRITE(ILUOUT,FMT=*) ' READ_HGRID_N : JPHEXT in PRE_REAL1.nam/NAM_REAL_CONF ( or default value )&
219            & JPHEXT=',JPHEXT
220      ELSE
221         WRITE(ILUOUT,FMT=*) ' READ_HGRID_N : JPHEXT in PRE_NEST_PGD1.nam/NAM_CONF_NEST ( or default value )&
222            & JPHEXT=',JPHEXT
223      END IF
224
225      WRITE(ILUOUT,FMT=*) ' different from PGD files=',HFMFILE ,' value JPHEXT=',IJPHEXT
226      WRITE(ILUOUT,FMT=*) '-> JOB ABORTED'
227      CALL CLOSE_ll(CLUOUT,IOSTAT=IRESP)
228      CALL ABORT  
229      STOP   
230   END IF
231 END IF
232 !
233 !*       2.1  Read the configuration (MODD_CONF)
234 !
235 IF (IMI == 1) THEN   
236   CALL FMREAD(HFMFILE,'L1D',CLUOUT,'--',L1D,IGRID,ILENCH,YCOMMENT,IRESP)
237   IF (IRESP/=0) THEN
238     L1D=.FALSE.
239     IF( (NIMAX == 1).AND.(NJMAX == 1) ) L1D=.TRUE.
240   ENDIF
241 !
242   CALL FMREAD(HFMFILE,'L2D',CLUOUT,'--',L2D,IGRID,ILENCH,YCOMMENT,IRESP)
243   IF (IRESP/=0) THEN
244     L2D=.FALSE.
245     IF( (NIMAX /= 1).AND.(NJMAX == 1) ) L2D=.TRUE.
246   ENDIF
247 !
248   CALL FMREAD(HFMFILE,'PACK',CLUOUT,'--',LPACK,IGRID,ILENCH,YCOMMENT,IRESP)
249   IF (IRESP/=0) LPACK=.TRUE.
250 !  CALL SET_FMPACK_ll(L1D,L2D,LPACK)
251 END IF
252 !
253 !*       2.2    Grid information :
254 !               ----------------
255 !JUAN REALZ
256 IF ( CPROGRAM .EQ. "REAL  " ) THEN
257   CALL GET_DIM_EXT_ll('B',IIU,IJU)
258   CALL GET_DIM_PHYS_ll('B',NIMAX,NJMAX)
259   IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(IIU))
260   IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(IJU))
261 ELSE IF ( CPROGRAM .EQ. "NESPGD"  .OR. CPROGRAM .EQ. "SPAWN ") THEN
262   NIMAX_ll = NIMAX
263   NJMAX_ll = NJMAX
264   CALL GET_INDICE_ll( IXOR, IYOR, IXEND, IYEND )
265   NIMAX = IXEND - IXOR + 1
266   NJMAX = IYEND - IYOR + 1
267   IIU = NIMAX+2*JPHEXT
268   IJU = NJMAX+2*JPHEXT
269   IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(IIU))
270   IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(IJU))
271 ELSE
272   IF (.NOT. (ASSOCIATED(XXHAT))) ALLOCATE(XXHAT(NIMAX+2*JPHEXT))
273   IF (.NOT. (ASSOCIATED(XYHAT))) ALLOCATE(XYHAT(NJMAX+2*JPHEXT))
274 ENDIF
275 !JUAN REALZ
276
277 YDIR='XX'
278 CALL FMREAD(HFMFILE,'XHAT',CLUOUT,YDIR,XXHAT,IGRID,ILENCH,YCOMMENT,IRESP)
279 !
280 YDIR='YY'
281 CALL FMREAD(HFMFILE,'YHAT',CLUOUT,YDIR,XYHAT,IGRID,ILENCH,YCOMMENT,IRESP)
282 !
283 !JUAN REALZ
284 IF ( CPROGRAM .EQ. "REAL  " ) THEN
285 IF (.NOT. (ASSOCIATED(XZS))) ALLOCATE(XZS(IIU,IJU))
286 ELSE
287 IF (.NOT. (ASSOCIATED(XZS))) ALLOCATE(XZS(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
288 ENDIF
289 !JUAN REALZ
290
291 !$20140506 replace 'XY' by YDIR !!
292 YDIR='XY'
293 CALL FMREAD(HFMFILE,'ZS',CLUOUT,YDIR,XZS,IGRID,ILENCH,YCOMMENT,IRESP)
294 !
295 !JUAN REALZ
296 IF ( CPROGRAM .EQ. "REAL  " ) THEN
297 IF (.NOT. (ASSOCIATED(XZSMT))) ALLOCATE(XZSMT(IIU,IJU))
298 ELSE
299 IF (.NOT. (ASSOCIATED(XZSMT))) ALLOCATE(XZSMT(NIMAX+2*JPHEXT,NJMAX+2*JPHEXT))
300 ENDIF
301 !JUAN REALZ
302
303 IF (IMASDEV<=46) THEN
304   XZSMT = XZS
305 ELSE
306 !$20140506 replace 'XY' by YDIR !!
307 YDIR='XY'
308   CALL FMREAD(HFMFILE,'ZSMT',CLUOUT,YDIR,XZSMT,IGRID,ILENCH,YCOMMENT,IRESP)
309 !
310 END IF
311 !
312 !-------------------------------------------------------------------------------
313 IF (IMASDEV<=45) THEN
314   CALL FMREAD(HFMFILE,'LATOR',CLUOUT,'--',XLATORI,IGRID,ILENCH,YCOMMENT,IRESP)
315   CALL FMREAD(HFMFILE,'LONOR',CLUOUT,'--',XLONORI,IGRID,ILENCH,YCOMMENT,IRESP)
316   ZXHATM = - 0.5 * (XXHAT(1)+XXHAT(2))
317   ZYHATM = - 0.5 * (XYHAT(1)+XYHAT(2))
318   CALL SM_LATLON(XLATORI,XLONORI,ZXHATM,ZYHATM,ZLATOR,ZLONOR)
319   XLATORI = ZLATOR
320   XLONORI = ZLONOR
321 END IF
322 !-------------------------------------------------------------------------------
323 !
324 END SUBROUTINE READ_HGRID_n