Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / read_th_pr.f90
1 !     ##################################################
2       SUBROUTINE READ_TH_PR(HFILEDIA,HLUOUTDIA,KMT,KIND)
3 !     ##################################################
4 !
5 !!****  *READ_TH_PR* - 
6 !!
7 !!    PURPOSE
8 !!    -------
9 !      
10 !
11 !!**  METHOD
12 !!    ------
13 !!     
14 !!     N.A.
15 !!
16 !!    EXTERNAL
17 !!    --------
18 !!      None
19 !!
20 !!    IMPLICIT ARGUMENTS
21 !!    ------------------
22 !!      Module
23 !!
24 !!    REFERENCE
25 !!    ---------
26 !!
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!      J. Duron    * Laboratoire d'Aerologie *
31 !!
32 !!
33 !!    MODIFICATIONS
34 !!    -------------
35 !!      Original       08/01/97
36 !!      Updated   PM 
37 !-------------------------------------------------------------------------------
38 !
39 !*       0.    DECLARATIONS
40 !              ------------
41 !
42 USE MODD_ALLOC_FORDIACHRO
43 USE MODD_PT_FOR_CH_FORDIACHRO
44 USE MODD_SEVERAL_RECORDS
45 USE MODD_RESOLVCAR
46 USE MODD_FILES_DIACHRO
47 USE MODD_MASK3D
48
49 IMPLICIT NONE
50 !
51 !*       0.1   Dummy arguments
52 !              ---------------
53
54 INTEGER :: KMT, KIND
55 CHARACTER(LEN=*) :: HFILEDIA, HLUOUTDIA
56 !
57 !*       0.1   Local variables
58 !              ---------------
59
60 !
61 INTEGER   ::   J 
62 CHARACTER(LEN=12) :: YGP, YGPM
63 !------------------------------------------------------------------------------
64 !
65 ! KIND=1 --> LTK=.TRUE. or LEV=.TRUE.
66 !
67 YGP='      '
68 YGPM='      '
69 IF(KIND == 1)THEN
70   IF(KMT == 1)THEN
71     IF(LTK .OR. LRS .OR. LRS1)THEN
72       YGP='THM'
73     ELSE IF(LEV)THEN
74       YGP='POVOM'
75     ELSE IF(LSV3)THEN
76       IF(LXYZ00)THEN
77         YGP=CGROUPSV3(1:LEN_TRIM(CGROUPSV3))
78       ELSE
79         YGP='LGZM'
80       ENDIF
81       YGPM=YGP
82       CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,YGP)
83       IF(LPBREAD .AND. .NOT.LXYZ00)THEN
84         LPBREAD=.FALSE.
85         YGP='SVM003'
86         CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,YGP)
87         IF(LPBREAD)THEN
88           LPBREAD=.FALSE.
89           YGP='SVM3'
90         ENDIF
91       ENDIF
92     ENDIF
93   ELSE IF(KMT == 2)THEN
94     IF(LTK .OR. LRS .OR. LRS1)THEN
95       YGP='THT'
96     ELSE IF(LEV)THEN
97       YGP='POVOT'
98     ELSE IF(LSV3)THEN
99       IF(LXYZ00)THEN
100         YGP=CGROUPSV3(1:LEN_TRIM(CGROUPSV3))
101       ELSE
102         YGP='LGZT'
103       ENDIF
104       YGPM=YGP
105       CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,YGP)
106       IF(LPBREAD .AND. .NOT.LXYZ00)THEN
107         LPBREAD=.FALSE.
108         YGP='SVT003'
109         CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,YGP)
110         IF(LPBREAD)THEN
111           LPBREAD=.FALSE.
112           YGP='SVT3'
113         ENDIF
114       ENDIF
115     ENDIF
116   ENDIF
117   SELECT CASE(KMT)
118     CASE(1)
119       CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,YGP)
120       IF(LPBREAD)THEN
121 !       LPBREAD=.FALSE.
122         IF(LSV3)THEN
123 !         IF(.NOT.LXY00)THEN
124             IF(YGP /= YGPM)THEN
125               IF(INDEX(YGP,'00') == 0)THEN
126                 print *,' **READ_TH_PR requete peut-etre impossible.', YGPM, &
127                        ', ',YGP(1:3)//'00'//YGP(4:4),' et ',YGP,' n''existent pas'
128               ELSE
129                 print *,' **READ_TH_PR requete peut-etre impossible.',YGPM, &
130                         ' et ',YGP,' n''existent pas'
131               ENDIF
132             ENDIF
133 !         ENDIF
134         ELSE
135           print *,' REQUETE IMPOSSIBLE .',YGP,' N''EXISTE PAS'
136         ENDIF
137         IF(.NOT.LSV3)THEN
138           YGP(LEN_TRIM(YGP):LEN_TRIM(YGP))='T'
139           print *,' **READ_TH_PR  Recherche de  ** ',YGP,' ** pour resoudre le pb'
140         ENDIF
141         RETURN
142       ELSE
143         print *,' **READ_TH_PR Utilisation de   ** ',YGP,' **'
144       ENDIF
145       IF(LGROUP)THEN
146         CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,YGP)
147       ENDIF
148       IF(.NOT.LFIC1)THEN
149         CALL REALLOC_AND_LOAD(YGP)
150         IF(LPBREAD)THEN
151 !         LPBREAD=.FALSE.
152           print *,' REQUETE IMPOSSIBLE .',YGP,' N''EXISTE PAS DANS', &
153           ' L''UN DES FICHIERS '
154           IF(ALLOCATED(XVAR))THEN
155             CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
156           ENDIF
157           RETURN
158         ENDIF
159       ENDIF
160     CASE(2)
161       CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,YGP)
162       IF(LPBREAD)THEN
163 !       LPBREAD=.FALSE.
164         IF(LSV3)THEN
165 !         IF(.NOT.LXY00)THEN
166             IF(YGP /= YGPM)THEN
167               IF(INDEX(YGP,'00') == 0)THEN
168                 print *,' **READ_TH_PR requete peut-etre impossible. ',YGPM, &
169                        ', ',YGP(1:3)//'00'//YGP(4:4),' et ',YGP,' n''existent pas'
170               ELSE
171                 print *,' **READ_TH_PR requete peut-etre impossible. ',YGPM, &
172                         ' et ',YGP,' n''existent pas'
173               ENDIF
174             ENDIF
175 !         ENDIF
176         ELSE
177           print *,' REQUETE IMPOSSIBLE .',YGP,' N''EXISTE PAS'
178         ENDIF
179         IF(.NOT.LSV3)THEN
180           YGP(LEN_TRIM(YGP):LEN_TRIM(YGP))='M'
181           print *,' **READ_TH_PR  Recherche de   ** ',YGP,' ** pour resoudre le pb'
182         ENDIF
183         RETURN
184       ELSE
185         print *,' **READ_TH_PR  Utilisation de   ** ',YGP,' **'
186       ENDIF
187       IF(LGROUP)THEN
188         CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,YGP)
189       ENDIF
190       IF(.NOT.LFIC1)THEN
191         CALL REALLOC_AND_LOAD(YGP)
192         IF(LPBREAD)THEN
193 !         LPBREAD=.FALSE.
194           print *,' REQUETE IMPOSSIBLE .',YGP,' N''EXISTE PAS DANS', &
195           ' L''UN DES FICHIERS '
196           IF(ALLOCATED(XVAR))THEN
197             CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
198           ENDIF
199           RETURN
200         ENDIF
201       ENDIF
202   END SELECT
203   IF(ALLOCATED(XTH)) DEALLOCATE(XTH)
204   ALLOCATE(XTH(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
205   SIZE(XVAR,5),SIZE(XVAR,6)))
206   XTH(:,:,:,:,:,:)=XVAR(:,:,:,:,:,:)
207   CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
208
209 ! KIND=2 --> LPR=.TRUE.
210 ELSE IF(KIND == 2)THEN
211
212   SELECT CASE(KMT)
213     CASE(1)
214       CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,'PABSM')
215 !     CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,'PHIM')
216       IF(LPBREAD)THEN
217 !       LPBREAD=.FALSE.
218         print *,' REQUETE a priori IMPOSSIBLE . PABSM N''EXISTE PAS . '
219         print *,' **READ_TH_PR  Recherche de  **  PABST  ** pour resoudre le pb'
220         RETURN
221       ELSE
222         print *,' **READ_TH_PR  Utilisation de  ** PABSM **'
223       ENDIF
224       IF(LGROUP)THEN
225         CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,'PABSM')
226 !       CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,'PHIM')
227       ENDIF
228       IF(.NOT.LFIC1)THEN
229         CALL REALLOC_AND_LOAD('PABSM')
230 !       CALL REALLOC_AND_LOAD('PHIM')
231         IF(LPBREAD)THEN
232 !         LPBREAD=.FALSE.
233           print *,' REQUETE IMPOSSIBLE . PABSM N''EXISTE PAS DANS', &
234           ' L''UN DES FICHIERS '
235           IF(ALLOCATED(XVAR))THEN
236             CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
237           ENDIF
238           RETURN
239         ENDIF
240       ENDIF
241     CASE(2)
242       CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,'PABST')
243 !     CALL VERIF_GROUP(HFILEDIA,HLUOUTDIA,'PHIT')
244       IF(LPBREAD)THEN
245 !       LPBREAD=.FALSE.
246         print *,' REQUETE a priori IMPOSSIBLE . PABST N''EXISTE PAS . '
247         print *,' **READ_TH_PR  Recherche de  **  PABSM  ** pour resoudre le pb'
248          RETURN
249        ELSE
250          print *,' **READ_TH_PR  Utilisation de   ** PABST **'
251        ENDIF
252        IF(LGROUP)THEN
253          CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,'PABST')
254 !        CALL READ_DIACHRO(HFILEDIA,HLUOUTDIA,'PHIT')
255        ENDIF
256        IF(.NOT.LFIC1)THEN
257          CALL REALLOC_AND_LOAD('PABST')
258 !        CALL REALLOC_AND_LOAD('PHIT')
259          IF(LPBREAD)THEN
260 !          LPBREAD=.FALSE.
261            print *,' REQUETE IMPOSSIBLE . PABST N''EXISTE PAS DANS', &
262            ' L''UN DES FICHIERS '
263            IF(ALLOCATED(XVAR))THEN
264              CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
265            ENDIF
266            RETURN
267          ENDIF
268        ENDIF
269     END SELECT
270     ALLOCATE(XPHI(SIZE(XVAR,1),SIZE(XVAR,2),SIZE(XVAR,3),SIZE(XVAR,4), &
271         SIZE(XVAR,5),SIZE(XVAR,6)))
272     XPHI(:,:,:,:,:,:)=XVAR(:,:,:,:,:,:)
273     IF(.NOT.LRS .AND. .NOT.LRS1)THEN
274       CALL ALLOC_FORDIACHRO(1,1,1,1,1,1,3)
275     ENDIF
276     IF(ALLOCATED(XPRES))THEN
277       DEALLOCATE(XPRES)
278     ENDIF
279     ALLOCATE(XPRES(SIZE(XPHI,1),SIZE(XPHI,2),SIZE(XPHI,3),SIZE(XPHI,4), &
280       SIZE(XPHI,5),SIZE(XPHI,6)))
281     IF(SIZE(XPHI,5) /= 1 .OR. SIZE(XPHI,6) /= 1)THEN
282       print *,' SIZE(XPHI,5) SIZE(XPHI,6) /= 1 ',SIZE(XPHI,5),SIZE(XPHI,6)
283       print *,' CALCUL DE LA PRESSION IMPOSSIBLE. REQUETE NON TRAITEE '
284       DEALLOCATE(XPHI,XPRES)
285       LPBREAD=.TRUE.
286       RETURN
287     ENDIF
288 !!  Calcul de la pres/sion
289 !   Chargement de la pression
290     DO J=1,SIZE(XPHI,4)
291 !     XPRES(:,:,:,J,1,1)=XP00*(XEXNREF(:,:,:)+XPHI(:,:,:,J,1,1) &
292 !                        /(XCPD*XTHVREF(:,:,:)))**(XCPD/XRD)
293       XPRES(:,:,:,J,1,1)=XPHI(:,:,:,J,1,1)
294     ENDDO
295     DEALLOCATE(XPHI)
296 ENDIF
297 !
298 !-----------------------------------------------------------------------------
299 !
300 !*       2.       RETURNS
301 !                 -----
302
303 RETURN
304 END SUBROUTINE READ_TH_PR