Philippe 02/05/2016: moved all LIBTOOLS files in LIBTOOLS directory
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / readrefint_iso.f90
1 !     ######spl
2       MODULE MODI_READREFINT_ISO 
3 !     ###########################
4 !
5 INTERFACE
6 !
7 SUBROUTINE READREFINT_ISO(HCARIN,PTABMN,PTABMX,PINT,PISOLEV)
8 CHARACTER(LEN=*)   :: HCARIN
9 REAL, INTENT(IN)   :: PTABMN,PTABMX
10 REAL               :: PINT
11 REAL, DIMENSION(:) :: PISOLEV
12 END SUBROUTINE READREFINT_ISO
13 !
14 END INTERFACE
15 END MODULE MODI_READREFINT_ISO
16 !     ######spl
17       SUBROUTINE READREFINT_ISO(HCARIN,PTABMN,PTABMX,PINT,PISOLEV)
18 !     ###############################################
19 !
20 !!****  *READREFINT_ISO* - 
21 !!
22 !!    PURPOSE
23 !!    -------
24 !      
25 !
26 !!**  METHOD
27 !!    ------
28 !!     
29 !!     N.A.
30 !!
31 !!    EXTERNAL
32 !!    --------
33 !!      None
34 !!
35 !!    IMPLICIT ARGUMENTS
36 !!    ------------------
37 !!      Module
38 !!
39 !!      Module
40 !!
41 !!    REFERENCE
42 !!    ---------
43 !!
44 !!
45 !!    AUTHOR
46 !!    ------
47 !!      J. Duron    * Laboratoire d'Aerologie *
48 !!
49 !!
50 !!    MODIFICATIONS
51 !!    -------------
52 !!      Original       2/09/96
53 !!      Updated   PM   
54 !-------------------------------------------------------------------------------
55 !
56 !*       0.    DECLARATIONS
57 !              ------------
58 !
59 USE MODD_RESOLVCAR
60
61 IMPLICIT NONE
62 !
63 !*       0.1   Dummy arguments
64 !              ---------------
65
66 CHARACTER(LEN=*) :: HCARIN
67 REAL, INTENT(IN)   :: PTABMN,PTABMX
68 REAL               :: PINT
69 REAL, DIMENSION(:) :: PISOLEV
70 !
71 !*       0.1   Local variables
72 !              ---------------
73
74 INTEGER           :: IMASK,II,IIMIN,IIMAX,IIDEB,IIFIN,INBISO
75 INTEGER           :: J,JM
76 REAL              :: ZMEMINT,ZREF,ZVALMIN,ZVALMAX
77 LOGICAL           :: GOKREF, GOKINT
78 REAL, DIMENSION(SIZE(PISOLEV)) :: ZISOLEV
79 CHARACTER(LEN=LEN(HCARIN)) :: YCARIN, YCARIN2
80 !
81 !------------------------------------------------------------------------------
82 GOKREF=.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 !
116 IF(NBISOREF == 0)THEN
117   GOKREF=.FALSE.
118   print *,' AUCUN REF USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
119 ELSE
120   DO J=1,NBISOREF
121     IF(YCARIN(1:LEN_TRIM(YCARIN)) == CISOREF(J)(1:LEN_TRIM(YCARIN)))THEN
122       ZREF=XISOREFP(J)
123       GOKREF=.TRUE.
124       EXIT
125     ENDIF
126   ENDDO
127   IF(.NOT.GOKREF)THEN
128     print *,' AUCUN REF USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
129   ENDIF
130 ENDIF
131 !
132 IF(NBISOINT == 0)THEN
133   GOKINT=.FALSE.
134   print *,' AUCUN INT USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
135 ELSE
136   DO J=1,NBISOINT
137     IF(YCARIN(1:LEN_TRIM(YCARIN)) == CISOINT(J)(1:LEN_TRIM(YCARIN)))THEN
138       PINT=XISOINT(J)
139       GOKINT=.TRUE.
140       EXIT
141     ENDIF
142   ENDDO
143   IF(.NOT.GOKINT)THEN
144     print *,' AUCUN INT USER ENREGISTRE POUR :  ',YCARIN(1:LEN_TRIM(YCARIN))
145   ENDIF
146 ENDIF
147 IF(.NOT.GOKREF .OR. .NOT.GOKINT)THEN
148   LISOREF=.FALSE.
149   print *,' UTILISATION DES VALEURS DE XISOREF,XDIAINT POUR : ',YCARIN(1:LEN_TRIM(YCARIN))
150 ELSE
151   LISOREF=.TRUE.
152 ENDIF
153 !------------------------------------------------------------------------------
154
155 IF(.NOT. LISOREF)THEN
156   PINT=XDIAINT
157   IF(PINT == 0.)THEN
158     PINT=ZMEMINT
159   ENDIF
160   ZREF=XISOREF
161   IF (ZREF.LT.PTABMN .OR. ZREF.GT.PTABMX) THEN
162 if (nverbia>5) then
163   print*,'TABmin-max= ',PTABMN,PTABMX
164   print*,'ISO REF hors des valeurs extremes du champ = ',XISOREF
165 endif
166     ZREF=0.5*(PTABMN+PTABMX)
167 if (nverbia>5) then
168   print*,'ISO REF calcule = ',ZREF
169 endif
170   ENDIF
171 ELSE
172   LISOREF=.FALSE.
173 ENDIF
174 !------------------------------------------------------------------------------
175 ZISOLEV(:)=0.
176 ZVALMIN=ZREF ; ZVALMAX=ZREF
177 ! ZISOLEV contient les valeurs des differentes isolignes a tracer
178 !rempli ainsi: ZREF -PINT +PINT -2.PINT +2.PINT ...
179 II=1 ; IIMIN=II ; IIMAX=II
180 ZISOLEV(1)=ZREF
181 DO J=1,SIZE(ZISOLEV)
182   ZVALMIN=ZVALMIN-PINT
183   IF (ZVALMIN.GT.PTABMN) THEN
184     II=II+1
185     ZISOLEV(II)=ZVALMIN
186     IIMIN=II
187   ENDIF
188   ZVALMAX=ZVALMAX+PINT
189   IF (ZVALMAX.LT.PTABMX) THEN
190     II=II+1
191     ZISOLEV(II)=ZVALMAX
192     IIMAX=II
193   ENDIF
194 ENDDO
195 if (nverbia>=5) then
196   print*,'IIMIN,IIMAX,II= ',IIMIN,IIMAX,II
197 endif
198 if (nverbia>5) then
199   print*,'ZISOLEV= ',ZISOLEV
200 endif
201
202 ! reordonne pour PISOLEV de la valeur min a la valeur max
203 INBISO=II
204 IF (INBISO.LE.2) THEN
205   PISOLEV(1)=ZISOLEV(1)
206   PISOLEV(2)=ZISOLEV(2)
207 ELSE
208   II=1
209   IF (IIMIN .GT. (IIMAX+1)) THEN   ! premiers min contigus
210     DO J=IIMIN,IIMAX+1,-1
211       PISOLEV(II)=ZISOLEV(J)
212       II=II+1
213     END DO
214     IIDEB=IIMAX+1-2
215   ELSE
216     IIDEB=IIMIN
217   ENDIF
218   !
219   IF (IIDEB.GT.0) THEN             ! traite les valeurs inf a ZREF
220     ! une valeur sur 2 pour les min suivants
221     DO J=IIDEB,2,-2
222       PISOLEV(II)=ZISOLEV(J)
223       II=II+1
224     END DO
225     IIFIN=MIN(IIMAX,IIMIN+1)
226     ! une valeur sur 2 pour les premiers max
227     DO J=1,IIFIN,2
228       PISOLEV(II)=ZISOLEV(J)
229       II=II+1
230     END DO
231   ELSE                             ! toutes les valeurs sont sup a ZREF
232     IIFIN=0
233   ENDIF
234   !
235   IF (IIMAX.GT.IIMIN+1) THEN       ! derniers max contigus
236     DO J=IIFIN+1,IIMAX
237       PISOLEV(II)=ZISOLEV(J)
238       II=II+1
239     ENDDO
240   ENDIF
241 ENDIF
242 if (nverbia>5) then
243   print*,'II= ',II
244 endif
245
246 END SUBROUTINE READREFINT_ISO