Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / readmnmxint_iso.f90
1 !     ######spl
2       MODULE MODI_READMNMXINT_ISO 
3 !     ###########################
4 !
5 INTERFACE
6 !
7 SUBROUTINE READMNMXINT_ISO(KIMNMX,HCARIN,PMN,PMX,PINT)
8 INTEGER, INTENT(INOUT) :: KIMNMX
9 CHARACTER(LEN=*) :: HCARIN
10 REAL             :: PMN, PMX, PINT
11 END SUBROUTINE READMNMXINT_ISO
12 !
13 END INTERFACE
14 END MODULE MODI_READMNMXINT_ISO
15 !     ######spl
16       SUBROUTINE READMNMXINT_ISO(KIMNMX,HCARIN,PMN,PMX,PINT)
17 !     ###############################################
18 !
19 !!****  *READMNMXINT_ISO* - 
20 !!
21 !!    PURPOSE
22 !!    -------
23 !      
24 !
25 !!**  METHOD
26 !!    ------
27 !!     
28 !!     N.A.
29 !!
30 !!    EXTERNAL
31 !!    --------
32 !!      None
33 !!
34 !!    IMPLICIT ARGUMENTS
35 !!    ------------------
36 !!      Module
37 !!
38 !!      Module
39 !!
40 !!    REFERENCE
41 !!    ---------
42 !!
43 !!
44 !!    AUTHOR
45 !!    ------
46 !!      J. Duron    * Laboratoire d'Aerologie *
47 !!
48 !!
49 !!    MODIFICATIONS
50 !!    -------------
51 !!      Original       2/09/96
52 !!      Updated   PM   
53 !-------------------------------------------------------------------------------
54 !
55 !*       0.    DECLARATIONS
56 !              ------------
57 !
58 USE MODD_RESOLVCAR
59
60 IMPLICIT NONE
61 !
62 !*       0.1   Dummy arguments
63 !              ---------------
64 !
65 INTEGER, INTENT(INOUT) :: KIMNMX
66 CHARACTER(LEN=*) :: HCARIN
67 REAL             :: PMN, PMX, PINT
68 !
69 !*       0.1   Local variables
70 !              ---------------
71
72 INTEGER           :: IMASK
73 INTEGER           :: J,JM
74 LOGICAL           :: GOKMN, GOKMX, GOKINT
75 REAL              :: ZMEMINT
76 !REAL,DIMENSION(:),ALLOCATABLE  :: ZISOMN, ZISOMX, ZISOINT
77 !CHARACTER(LEN=100),DIMENSION(:),ALLOCATABLE  :: YISOMN, YISOMX, YISOINT
78 CHARACTER(LEN=LEN(HCARIN)) :: YCARIN, YCARIN2
79 !
80 !------------------------------------------------------------------------------
81 GOKMN=.FALSE.
82 GOKMX=.FALSE.
83 GOKINT=.FALSE.
84 !
85 YCARIN(1:LEN(YCARIN))=' '
86 HCARIN=ADJUSTL(HCARIN)
87 YCARIN=HCARIN
88 IMASK=INDEX(YCARIN,'MASK')
89 IF(IMASK /=0)THEN
90 DO J=1,LEN(YCARIN)
91  IF(YCARIN(J:J) == ' ')THEN
92    JM=J-1
93    EXIT
94  ENDIF
95 ENDDO
96 YCARIN(1:LEN(YCARIN))=' '
97 YCARIN=HCARIN(JM+2:LEN_TRIM(HCARIN))
98 YCARIN=ADJUSTL(YCARIN)
99 ENDIF
100 JM=0
101 DO J=1,LEN(YCARIN)
102  IF(YCARIN(J:J) == ' ')THEN
103    JM=J-1
104    EXIT
105  ENDIF
106 ENDDO
107 IF(JM /= 0)THEN
108   YCARIN2(1:LEN(YCARIN2))=' '
109   YCARIN2=YCARIN(1:JM)
110   YCARIN(1:LEN(YCARIN))=' '
111   YCARIN=ADJUSTL(YCARIN2)
112 ENDIF
113 !
114 ZMEMINT=PINT
115 PINT=0.
116 !
117 IF(NBISOMN == 0)THEN
118   GOKMN=.FALSE.
119   print *,' AUCUN MIN USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
120 ELSE
121   DO J=1,NBISOMN
122     IF(YCARIN(1:LEN_TRIM(YCARIN)) == CISOMN(J)(1:LEN_TRIM(CISOMN(J))))THEN
123       PMN=XISOMN(J)
124       GOKMN=.TRUE.
125       EXIT
126     ENDIF
127   ENDDO
128   IF(.NOT.GOKMN)THEN
129     print *,' AUCUN MIN USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
130   ENDIF
131 ENDIF
132 !
133 IF(NBISOMX == 0)THEN
134   GOKMX=.FALSE.
135   print *,' AUCUN MAX USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
136 ELSE
137   DO J=1,NBISOMX
138     IF(YCARIN(1:LEN_TRIM(YCARIN)) == CISOMX(J)(1:LEN_TRIM(CISOMX(J))))THEN
139       PMX=XISOMX(J)
140       GOKMX=.TRUE.
141       EXIT
142     ENDIF
143   ENDDO
144   IF(.NOT.GOKMX)THEN
145     print *,' AUCUN MAX USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
146   ENDIF
147 ENDIF
148 IF(NBISOINT == 0)THEN
149   GOKINT=.FALSE.
150   print *,' AUCUN INT USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
151 ELSE
152   DO J=1,NBISOINT
153     IF(YCARIN(1:LEN_TRIM(YCARIN)) == CISOINT(J)(1:LEN_TRIM(CISOINT(J))))THEN
154       PINT=XISOINT(J)
155       GOKINT=.TRUE.
156       EXIT
157     ENDIF
158   ENDDO
159   IF(.NOT.GOKINT)THEN
160     print *,' AUCUN INT USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
161   ENDIF
162 ENDIF
163 IF(.NOT.GOKMN .OR. .NOT.GOKMX .OR. .NOT.GOKINT)THEN
164   LISOK=.FALSE.
165   print *,' UTILISATION DES VALEURS DE XISOMIN,XISOMAX,XDIAINT POUR : ',YCARIN(1:LEN_TRIM(YCARIN))
166 ELSE
167   LISOK=.TRUE.
168 ENDIF
169 !
170 !------------------------------------------------------------------------------
171 IF(.NOT. LISOK)THEN
172
173   IF(PINT == 0.)THEN
174     PINT=ZMEMINT
175   ENDIF
176   IF((KIMNMX == 0 .OR. KIMNMX == 1) .AND. PINT == 0.)THEN
177 !     IF(XISOMIN == XISOMAX)THEN
178 ! 230498
179     IF(XISOMIN == XISOMAX .AND. XISOMIN /= 0. .AND. XISOMAX /= 0.)THEN
180       PMN=XISOMIN
181       PMX=XISOMAX
182     ELSE
183     print *,' AVEC NIMNMX = ',KIMNMX,' VOUS DEVEZ FOURNIR DANS XDIAINT (OU',&
184     &' XDIAINT_PROCESSUS) UN INTERVALLE D''ISOCONTOURS NON NUL.'
185     print *,' NIMNMX FORCE A LA VALEUR -1'
186     KIMNMX=-1
187     ENDIF
188   ELSE IF(KIMNMX == 1 .AND. PINT /= 0.)THEN
189     IF(XISOMAX == XISOMIN .OR. XISOMAX-XISOMIN <0 .OR. (XISOMAX-XISOMIN)/PINT <1)THEN
190       IF(XISOMAX == XISOMIN)THEN
191         PMN=XISOMIN
192         PMX=XISOMAX
193       ELSE
194         print *,' AVEC NIMNMX = ',KIMNMX,' VOUS DEVEZ FOURNIR DANS XDIAINT (OU',&
195         &' XDIAINT_PROCESSUS) UN INTERVALLE D''ISOCONTOURS NON NUL.'
196         print *,' DANS XISOMIN (OU XISOMIN_PROCESSUS)  et XISOMAX (OU', &
197         &' XISOMAX_PROCESSUS) DES VALEURS EXTREMES D''ISOCONTOURS COHERENTES'
198         print *,' VALEURS ACTUELLES XISOMIN,XISOMAX,XDIAINT :',XISOMIN,XISOMAX,XDIAINT
199         print *,' NIMNMX FORCE A LA VALEUR -1'
200         KIMNMX=-1
201       ENDIF
202     ELSE
203     !  On explore la table utilisateur en premier
204       PMN=XISOMIN
205       PMX=XISOMAX
206     ENDIF
207   ENDIF
208 ELSE
209   LISOK=.FALSE.
210 ENDIF
211
212
213 END SUBROUTINE READMNMXINT_ISO