Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / FM2DIA / read_and_write_dimgridref.f90
1 !     ######spl
2       MODULE MODI_READ_AND_WRITE_DIMGRIDREF
3 !     #####################################
4 !
5 INTERFACE
6 !
7 SUBROUTINE READ_AND_WRITE_DIMGRIDREF(K,HNAMFILE,HLUOUT)
8 INTEGER :: K
9 CHARACTER(LEN=*) :: HNAMFILE, HLUOUT
10 END SUBROUTINE READ_AND_WRITE_DIMGRIDREF
11 !
12 END INTERFACE
13 !
14 END MODULE MODI_READ_AND_WRITE_DIMGRIDREF
15 !     #######################################################
16       SUBROUTINE READ_AND_WRITE_DIMGRIDREF(K,HNAMFILE,HLUOUT)
17 !     #######################################################
18 !
19 !!****  *READ_AND_WRITE_DIMGRIDREF* - Lecture et ecriture des parametres
20 !!         "intouchables" et des profils 1D de l'etat de reference
21 !! 
22 !!
23 !!    PURPOSE
24 !!    -------
25
26 !
27 !!**  METHOD
28 !!    ------
29 !       Lecture des dimensions par appel a SET_GRID
30 !          "        parametres de grilles par appel a SET_GRID
31 !          "        des 3 var. de l'etat de ref. 
32 !      Ecriture de toutes ces informations dans le fichier diachronique
33 !                  par appel a WRITE_DIMGRIDREF
34 !!      
35 !!
36 !!    REFERENCE
37 !!    ---------
38 !!     
39 !!
40 !!    AUTHORS
41 !!    -------
42 !!    J. Duron      *Lab. Aerologie* 
43 !!
44 !!    Copyright 1994,  Meteo-France and Laboratoire d'Aerologie
45 !!    All Rights Reserved
46 !!
47 !!    MODIFICATIONS
48 !!    -------------
49 !!      Original    30/01/96 
50 !!      Modification 291196 CSTORAGE_TYPE forced to 'PG' (temp.)
51 !!      Modification 01/2003 suppression de l appel a SET_REF_FORDIACHRO
52 !           (=SET_REF modifie en supprimant toute la partie calculs inutile)
53 !-------------------------------------------------------------------------------
54 !
55 !*       0.    DECLARATIONS
56 !              ------------
57 !
58 USE MODD_DIACHRO, ONLY: CMY_NAME_DIA, CDAD_NAME_DIA
59 USE MODD_DIM1  ! NIMAX,NJMAX,NKMAX, NIINF,NISUP, NJINF,NJSUP
60 USE MODD_DIMGRID_FORDIACHRO, ONLY: NNBF
61 USE MODD_GRID  ! XLON0,XLAT0, XBETA,XRPK
62 USE MODD_GRID1
63 USE MODD_OUT_DIA, ONLY : NLUOUTD
64 USE MODD_OUT1
65 USE MODD_PARAMETERS
66 USE MODD_DYN , ONLY: XSEGLEN
67 USE MODD_DYN1, ONLY: XTSTEP
68 USE MODD_CONF, ONLY: CCONF,CSTORAGE_TYPE,LCARTESIAN
69 USE MODD_TIME
70 USE MODD_TIME1
71 USE MODD_REF  ! XRHODREFZ,XTHVREFZ,XEXNTOP
72 USE MODD_REA_LFI
73 !
74 USE MODI_SET_DIM
75 USE MODI_SET_GRID
76 USE MODI_WRITE_DIMGRIDREF
77 USE MODI_FMREAD
78 !
79 !*       0.1   Dummy arguments
80 !
81
82 INTEGER           :: K
83
84 CHARACTER(LEN=*)  :: HNAMFILE
85 CHARACTER(LEN=*)  :: HLUOUT
86 !
87 !*       0.2   Local variables declarations
88 !
89 !
90 INTEGER           :: JJ, J
91 INTEGER           :: IIU, IJU, IKU ! Upper bounds in x, y, z directions
92 INTEGER           :: IIB, IJB, IKB ! Begining useful area in x, y, z directions
93 INTEGER           :: IIE, IJE, IKE ! End useful area in x, y, z directions
94 !
95 REAL              :: ZLAT,ZLON ! Emagram soundings gridpoint location 
96                                ! latitude and longitude (decimal degrees)
97 REAL              :: ZX,ZY     ! Emagram soundings gridpoint location 
98                                ! cartesian east and north coordinates (meters)
99 !
100 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: ZJ ! Jacobian
101 !
102 REAL,DIMENSION(:), ALLOCATABLE,SAVE  :: IIMAX, IJMAX, IKMAX, ITIMECUR
103 REAL,DIMENSION(:), ALLOCATABLE,SAVE  :: ZLON0, ZRPK, ZLONOR, ZLATOR, ZLAT0, &
104                                         ZBETA
105 LOGICAL,DIMENSION(:), ALLOCATABLE,SAVE :: OCARTESIAN
106 !
107 !-------------------------------------------------------------------------------
108 !
109 !*       1.    Preseting the general FM2DIACHRO environment
110 !              ---------------------------------------
111 !
112 !*       1.1   Sets default values
113 !
114 CCONF='POSTP'
115 !
116 !*       1.6   Reads the LFIFM file initial section (i.e. Array dimensions)
117 !
118 NIINF=0 ; NISUP=0 ; NJINF=0 ; NJSUP=0
119 !
120 CALL SET_DIM(HNAMFILE,HLUOUT,NIINF,NISUP,NJINF,NJSUP,NIMAX,NJMAX,NKMAX)
121 !
122 CMY_NAME_DIA(1:LEN(CMY_NAME_DIA))=' '
123 CRECFM='MY_NAME'
124 NLENG=28
125 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,CMY_NAME_DIA,NGRID,NLENCH,CCOMMENT,NRESP)
126 !
127 CDAD_NAME_DIA(1:LEN(CDAD_NAME_DIA))=' '
128 CRECFM='DAD_NAME'
129 NLENG=28
130 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,CDAD_NAME_DIA,NGRID,NLENCH,CCOMMENT,NRESP)
131 print *,'CMY_name CDAD_name ',CMY_NAME_DIA,CDAD_NAME_DIA
132 !
133 !  Reads the geometry configuration selector
134 CRECFM='THINSHELL'
135 NLENG=1
136 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,LTHINSHELL,NGRID,NLENCH,CCOMMENT,NRESP)
137 !
138 CRECFM='CARTESIAN'
139 NLENG=1
140 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,LCARTESIAN,NGRID,NLENCH,CCOMMENT,NRESP)
141 !
142 CRECFM='STORAGE_TYPE'
143 NLENG=2
144 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,CSTORAGE_TYPE,NGRID,NLENCH,CCOMMENT,NRESP)
145 IF(NRESP /= 0) CSTORAGE_TYPE='MT'
146 !
147 !
148 !*       1.7   Allocates the first bunch of input arrays
149 !
150 !*       1.7.1  Local variables :
151 !
152 IIU=NIMAX+2*JPHEXT ; IJU=NJMAX+2*JPHEXT ; IKU=NKMAX+2*JPVEXT
153 !
154 print *,' READ_AND_WRITE_DIMGRIDREF ENTREE CSTORAGE_TYPE ',CSTORAGE_TYPE
155 IF(CSTORAGE_TYPE == 'PG')THEN
156   IKU=1
157   LCARTESIAN=.FALSE.
158   NKMAX=1
159 ENDIF
160 !
161 IIB=1+JPHEXT ; IIE=IIU-JPHEXT
162 IJB=1+JPHEXT ; IJE=IJU-JPHEXT
163 IKB=1+JPVEXT ; IKE=IKU-JPVEXT
164 WRITE(NLUOUTD,*) 'MAIN: IIB, IJB, IKB=',IIB,IJB,IKB
165 WRITE(NLUOUTD,*) 'MAIN: IIE, IJE, IKE=',IIE,IJE,IKE
166 WRITE(NLUOUTD,*) 'MAIN: IIU, IJU, IKU=',IIU,IJU,IKU
167 !
168 !
169 IF(K == 1)THEN ! premier fichier
170   ALLOCATE(ZJ(IIU,IJU,IKU))
171   !
172   !*       1.7.2  Grid variables (MODD_GRID1 module):
173   !
174   ALLOCATE(XXHAT(IIU),XYHAT(IJU),XZHAT(IKU))
175   ALLOCATE(XMAP(IIU,IJU))
176   ALLOCATE(XLAT(IIU,IJU))
177   ALLOCATE(XLON(IIU,IJU))
178   ALLOCATE(XDXHAT(IIU),XDYHAT(IJU))
179   ALLOCATE(XZS(IIU,IJU))
180   ALLOCATE(XZZ(IIU,IJU,IKU))
181   !
182   !*       1.7.3  Reference state variables (MODD_REF1 module):
183   !
184   ALLOCATE(XRHODREFZ(IKU),XTHVREFZ(IKU))
185   !
186   XXHAT=0. ; XYHAT=0. ; XZHAT=0. ; XMAP=0. ; XLAT=0. ; XLON=0.
187   XDXHAT=0. ; XDYHAT=0. ; XZS=0. ; XZZ=0.
188   XRHODREFZ=0. ; XTHVREFZ=0.; XEXNTOP=0.
189   ALLOCATE(IIMAX(NNBF),IJMAX(NNBF),IKMAX(NNBF),ITIMECUR(NNBF))
190   ALLOCATE(ZLON0(NNBF),ZRPK(NNBF),ZLONOR(NNBF),ZLATOR(NNBF),ZLAT0(NNBF),ZBETA(NNBF))
191   ALLOCATE(OCARTESIAN(NNBF))
192   !
193 ENDIF
194 !
195 !*       1.8   Reads the last section of the LFIFM file
196
197 ! Notice: The whole XXHAT, XYHAT arrays have to be set here
198 !         to make provision for any grid selector choice 
199 !
200 NIINF=1 ; NISUP=IIU
201 NJINF=1 ; NJSUP=IJU
202 ! Artifice pour eviter 1 plantage dans SET_GRID
203 XTSTEP=50.
204 XSEGLEN=500.
205 !
206 CALL SET_GRID(1,HNAMFILE,HLUOUT,IIU,IJU,IKU,NIINF,NISUP,NJINF,NJSUP,XTSTEP,&
207               XSEGLEN, XOUT1,XOUT2,XOUT3,XOUT4,XOUT5,XOUT6,XOUT7,XOUT8,    &
208                        XOUT9,XOUT10,XOUT11,XOUT12,XOUT13,XOUT14,XOUT15,    &
209                        XOUT16,XOUT17,XOUT18,XOUT19,XOUT20,                 &
210               XLONOR,XLATOR,XLON,XLAT,XXHAT,XYHAT,                         &
211               XDXHAT,XDYHAT,XMAP,XZS,XZZ,XZHAT,                            &
212               ZJ,                                                          &
213               TDTMOD,TDTCUR,NSTOP,NOUT_TIMES,NOUT_NUMB                     )
214 !
215 IF(CSTORAGE_TYPE == 'PG')THEN
216   IKU=1
217   LCARTESIAN=.FALSE.
218   NKMAX=1
219   TDTMOD%TIME=0.
220   TDTCUR%TIME=0.
221   TDTEXP%TIME=0.
222   TDTSEG%TIME=0.
223   TDTMOD%TDATE%YEAR=0.
224   TDTMOD%TDATE%MONTH=0.
225   TDTMOD%TDATE%DAY=0.
226   TDTCUR%TDATE%YEAR=0.
227   TDTCUR%TDATE%MONTH=0.
228   TDTCUR%TDATE%DAY=0.
229   TDTEXP%TDATE%YEAR=0.
230   TDTEXP%TDATE%MONTH=0.
231   TDTEXP%TDATE%DAY=0.
232   TDTSEG%TDATE%YEAR=0.
233   TDTSEG%TDATE%MONTH=0.
234   TDTSEG%TDATE%DAY=0.
235 ENDIF
236 !
237 !*       1.9   read 3 variables of ref. state without orography (SET_REF)
238 !
239 CRECFM='STORAGE_TYPE'
240 NLENG=2
241 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,CSTORAGE_TYPE,NGRID,NLENCH,CCOMMENT,NRESP)
242 !
243 CRECFM='RHOREFZ'
244 NLENG=SIZE(XRHODREFZ)
245 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,XRHODREFZ,NGRID,NLENCH,CCOMMENT,NRESP)
246 IF(NRESP == -47)THEN
247   print *,' XRHODREFZ ABSENT dans le fichier ',TRIM(HNAMFILE),': MIS a 0. '
248   XRHODREFZ(:)=0.
249 ENDIF
250 !
251 CRECFM='THVREFZ'
252 NLENG=SIZE(XTHVREFZ)
253 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,XTHVREFZ,NGRID,NLENCH,CCOMMENT,NRESP)
254 IF(NRESP == -47)THEN
255   print *,' XTHVREFZ ABSENT dans le fichier ',TRIM(HNAMFILE),': MIS a 0. '
256   XTHVREFZ(:)=0.
257 ENDIF
258 !
259 CRECFM='EXNTOP'
260 NLENG=1
261 CALL FMREAD(HNAMFILE,CRECFM,HLUOUT,NLENG,XEXNTOP,NGRID,NLENCH,CCOMMENT,NRESP)
262 IF(NRESP == -47)THEN
263   print *,' XEXNTOP ABSENT dans le fichier ',TRIM(HNAMFILE),': MIS a 0. '
264   XEXNTOP=0.
265 ENDIF
266 !
267 !-------------------------------------------------------------------------------
268 !
269 !*       2.    WRITING OR CHECKING DIM., GRID., REF. VARIABLES
270 !              -----------------------------------------------
271 !
272 IIMAX(K)=NIMAX ; IJMAX(K)=NJMAX ; IKMAX(K)=NKMAX
273 ITIMECUR(K)=TDTCUR%TIME
274 !
275 ZLON0(K)=XLON0   ; ZLAT0(K)=XLAT0
276 ZLONOR(K)=XLONOR ; ZLATOR(K)=XLATOR
277 ZRPK(K)=XRPK     ; ZBETA(K)=XBETA
278 !
279 OCARTESIAN(K)=LCARTESIAN
280 !
281 !
282 IF(K == 1)THEN  ! premier fichier
283   !
284   CALL WRITE_DIMGRIDREF
285   !
286 ENDIF
287 !
288 IF(K > 1)THEN   ! fichiers suivants
289   !
290   IF(IIMAX(K) /= IIMAX(1))THEN
291     PRINT *,' K IIMAX(K) IIMAX(1) ',K,IIMAX(K),IIMAX(1)
292   ENDIF
293   IF(IJMAX(K) /= IJMAX(1))THEN
294     PRINT *,' K IJMAX(K) IJMAX(1) ',K,IJMAX(K),IJMAX(1)
295   ENDIF
296   IF(IKMAX(K) /= IKMAX(1))THEN
297     PRINT *,' K IKMAX(K) IKMAX(1) ',K,IKMAX(K),IKMAX(1)
298   ENDIF
299   IF(ITIMECUR(K) /= ITIMECUR(1))THEN
300     PRINT *,' K ITIMECUR(K) ITIMECUR(1) ',K,ITIMECUR(K),ITIMECUR(1)
301   ENDIF
302   !
303   IF(ZLON0(K) /= ZLON0(1))THEN
304     PRINT *,' K ZLON0(K) ZLON0(1) ',K,ZLON0(K),ZLON0(1)
305   ENDIF
306   IF(ZRPK(K) /= ZRPK(1))THEN
307     PRINT *,' K ZRPK(K) ZRPK(1) ',K,ZRPK(K),ZRPK(1)
308   ENDIF
309   IF(ZLONOR(K) /= ZLONOR(1))THEN
310     PRINT *,' K ZLONOR(K) ZLONOR(1) ',K,ZLONOR(K),ZLONOR(1)
311   ENDIF
312   IF(ZLATOR(K) /= ZLATOR(1))THEN
313     PRINT *,' K ZLATOR(K) ZLATOR(1) ',K,ZLATOR(K),ZLATOR(1)
314   ENDIF
315   IF(ZLAT0(K) /= ZLAT0(1))THEN
316     PRINT *,' K ZLAT0(K) ZLAT0(1) ',K,ZLAT0(K),ZLAT0(1)
317   ENDIF
318   IF(ZBETA(K) /= ZBETA(1))THEN
319     PRINT *,' K ZBETA(K) ZBETA(1) ',K,ZBETA(K),ZBETA(1)
320   ENDIF
321   !
322   IF((OCARTESIAN(K) .AND..NOT. OCARTESIAN(1)) .OR. &
323      (.NOT. OCARTESIAN(K) .AND. OCARTESIAN(1)))THEN
324     PRINT *,' K OCARTESIAN(K) OCARTESIAN(1) ',K,OCARTESIAN(K),OCARTESIAN(1)
325   ENDIF
326   !
327 ENDIF
328 !------------------------------------------------------------------------------
329 !
330 !*      4.    EPILOG
331 !             ------
332 !
333 IF(K == NNBF)THEN  ! dernier fichier
334   DEALLOCATE(IIMAX,IJMAX,IKMAX,ITIMECUR)
335   DEALLOCATE(ZLON0,ZRPK,ZLONOR,ZLATOR,ZLAT0,ZBETA)
336   DEALLOCATE(OCARTESIAN)
337 END IF
338 !
339 RETURN
340
341 END SUBROUTINE READ_AND_WRITE_DIMGRIDREF