Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / convxy2ij.f90
1 !     ############################
2       SUBROUTINE CONVXY2IJ(HCARIN)
3 !     ############################
4 !
5 !!****  *CONVXY2IJ* - Convertit des coordonnees conformes et coordonnees
6 !!                    geographiques en indices de grille I,J
7 !!
8 !!    PURPOSE
9 !!    -------
10 !
11 !
12 !!**  METHOD
13 !!    ------
14 !!
15 !!    EXTERNAL
16 !!    --------
17 !!
18 !!    IMPLICIT ARGUMENTS
19 !!    ------------------
20 !!
21 !!      Module MODD_CONVIJ2XY
22 !!
23 !!      Module MODD_COORD  : declares gridpoint coordinates (TRACE use)
24 !!         XXX : XXHAT coordinate values for all the MESO-NH grids
25 !!         XXY : XYHAT                      "
26 !!
27 !!      Module MODE_GRIDPROJ   
28 !!
29 !!    REFERENCE
30 !!    ---------
31 !!
32 !!      MESO-NH User's Manual, TRACE Post Processing sections, Version 1.0:
33 !!       + Book1: Concepts and Fundamentals, to appear in 1994;
34 !!       + Book2: Technical Reference and Flowcharts, to appear in 1994;
35 !!       + Book3: Tutorial, November 1994.
36 !!
37 !!    AUTHOR
38 !!    ------
39 !!      J. Duron    * Laboratoire d'Aerologie *
40 !!
41 !!    MODIFICATIONS
42 !!    -------------
43 !!      Original       01/04/99
44 !!      Updated   
45 !-------------------------------------------------------------------------------
46 !
47 !*       0.    DECLARATIONS
48 !              ------------
49 !
50 USE MODE_GRIDPROJ
51 USE MODD_COORD
52 USE MODD_FILES_DIACHRO
53 USE MODD_CONF
54 USE MODD_GRID
55 USE MODD_DIM1
56 USE MODD_GRID1
57 USE MODD_ALLOC_FORDIACHRO
58 USE MODD_RESOLVCAR
59 ! Utilisation du meme module pour les operations inverses
60 USE MODD_CONVIJ2XY
61 USE MODD_PARAMETERS
62 USE MODI_RESOLVXISOLEV
63 !
64 IMPLICIT NONE
65 !
66 !*       0.1   Dummy arguments
67 !
68 CHARACTER(LEN=800) :: HCARIN
69 !
70 !*       0.2   Local variables
71 !
72 INTEGER           :: IMGRID, J, I, JM
73 INTEGER           :: II, IJ, IIM, IJM
74 INTEGER           :: IIU, IJU, ICONVXY2IJ
75 REAL              :: ZLAT,ZLON,ZX,ZY
76 !REAL,DIMENSION(:),ALLOCATABLE :: ZCONVLAT, ZCONVLON
77 !
78 REAL,DIMENSION(100) :: ZIJ
79 CHARACTER(LEN=8)    :: YMGRID
80 !
81 !-------------------------------------------------------------------------------
82 !
83 !*      1.     
84 !              ----------------------------
85 !
86 IIU=NIMAX+2*JPHEXT
87 IJU=NJMAX+2*JPHEXT
88 CALL INI_CST
89 !
90 !
91 !*      1.1    
92 !
93 HCARIN=ADJUSTL(HCARIN)
94 if(nverbia >0)then
95   print *,' **CONVXY2IJ HCARIN ',HCARIN
96 endif
97 IF(NBFILES == 0)THEN
98   print *,' Vous devez ouvrir le fichier pour lequel vous demandez l''information avec _file1_...'
99   print *,' puis entrer a nouveau votre directive '
100   LPBREAD=.TRUE.
101   RETURN
102 ENDIF
103 IF (LCARTESIAN) THEN
104   print *,' In the cartesian geometry, reference latitude and longitude are the same for the whole domain:'
105   print *,XLAT0,XLON0
106   LPBREAD=.TRUE.
107   RETURN
108 ENDIF
109
110 ICONVXY2IJ=INDEX(HCARIN,'CONVXY2IJ')
111 ZIJ(:)=9999.
112 CALL RESOLVXISOLEV(HCARIN(1:LEN_TRIM(HCARIN)),ICONVXY2IJ,ZIJ)
113 DO J=SIZE(ZIJ,1),1,-1
114   IF(ZIJ(J) /= 9999.)THEN
115     JM=J
116     EXIT
117   ENDIF
118 ENDDO
119 if(nverbia >0)then
120   print *,' convxy2ij: ZIJ ',ZIJ(1:JM)
121 endif
122 ALLOCATE(XCONVI(JM/2))
123 ALLOCATE(XCONVJ(JM/2))
124 ALLOCATE(XCONVX(JM/2))
125 ALLOCATE(XCONVY(JM/2))
126 ALLOCATE(XCONVLAT(JM/2))
127 ALLOCATE(XCONVLON(JM/2))
128 !ALLOCATE(ZCONVLAT(JM/2*7))
129 !ALLOCATE(ZCONVLON(JM/2*7))
130 J=JM/2
131 XCONVLAT(1:J)=ZIJ(1:JM-1:2)
132 XCONVLON(1:J)=ZIJ(2:JM:2)
133 IF(NVERBIA > 0)THEN
134   print *,' convxy2ij: XCONVLAT, XCONVLON'
135   print *,XCONVLAT
136   print *,XCONVLON
137 ENDIF
138 DO IMGRID=1,7
139 DO I=1,J
140 ZLAT=XCONVLAT(I)
141 ZLON=XCONVLON(I)
142
143 !
144 CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZX,ZY)
145
146 XCONVX(I)=ZX
147 XCONVY(I)=ZY
148
149 DO II=2,SIZE(XXX,1)
150   IF(ZX >= XXX(II-1,IMGRID) .AND. ZX < XXX(II,IMGRID))THEN
151     IIM=II-1
152     EXIT
153   ELSE
154     IF(II == SIZE(XXX,1))THEN
155       IIM=II
156       EXIT
157     ENDIF
158   ENDIF
159 ENDDO
160 IF(IIM == SIZE(XXX,1))THEN
161   XCONVI(I)=IIM
162 ELSE
163   XCONVI(I)=IIM+((ZX-XXX(IIM,IMGRID))/(XXX(IIM+1,IMGRID)-XXX(IIM,IMGRID)))
164 ENDIF
165
166 DO IJ=2,SIZE(XXY,1)
167   IF(ZY >= XXY(IJ-1,IMGRID) .AND. ZY < XXY(IJ,IMGRID))THEN
168     IJM=IJ-1
169     EXIT
170   ELSE
171     IF(IJ == SIZE(XXY,1))THEN
172       IJM=IJ
173       EXIT
174     ENDIF
175   ENDIF
176 ENDDO
177 IF(IJM == SIZE(XXY,1))THEN
178   XCONVJ(I)=IJM
179 ELSE
180   XCONVJ(I)=IJM+((ZY-XXY(IJM,IMGRID))/(XXY(IJM+1,IMGRID)-XXY(IJM,IMGRID)))
181 ENDIF
182 !
183 !IF(I == 1)THEN
184 ! ZCONVLAT(IMGRID*2-1)=ZLAT
185 ! ZCONVLON(IMGRID*2-1)=ZLON
186 !ELSE
187 ! ZCONVLAT(IMGRID*2)=ZLAT
188 ! ZCONVLON(IMGRID*2)=ZLON
189 !ENDIF
190 IF(IMGRID == 1 .AND. I == 1)THEN
191
192 print *,' GRILLES *    LAT     *    LON     *      X      *      Y      *   I   *   J  '
193 print *,'******************************************************************************'
194 endif
195 IF(IMGRID == 1)THEN
196 YMGRID=' 1 et 4 '
197 ELSE IF(IMGRID == 2)THEN
198 YMGRID=' 2 et 6 '
199 ELSE IF(IMGRID == 3)THEN
200 YMGRID=' 3 et 7 '
201 ELSE IF(IMGRID == 5)THEN
202 YMGRID=' 5      '
203 ENDIF
204 IF(IMGRID == 1 .OR. IMGRID == 2 .OR. IMGRID == 3 .OR. IMGRID == 5)THEN
205 print 10,YMGRID,XCONVLAT(I),XCONVLON(I),XCONVX(I),XCONVY(I),XCONVI(I),XCONVJ(I)
206 print *,'------------------------------------------------------------------------------'
207 ENDIF
208 ENDDO
209 ENDDO
210 !if (nverbia > 0)then
211 !DO I=1,J*7
212 ! ZLAT=ZCONVLAT(I)
213 ! ZLON=ZCONVLON(I)
214 ! CALL SM_XYHAT_S(XLATORI,XLONORI,ZLAT,ZLON,ZX,ZY)
215 ! print *,' ZLAT=',ZLAT,' ZLON=',ZLON,' ZX=',ZX,' ZY=',ZY
216 !ENDDO
217 !endif
218 10 FORMAT(1X,A8,' * ',F10.6,' * ',F11.6,'* ',F10.0,'  * ',F10.0,'  *',F6.2,' *',F6.2)
219 DEALLOCATE(XCONVI)
220 DEALLOCATE(XCONVJ)
221 DEALLOCATE(XCONVX)
222 DEALLOCATE(XCONVY)
223 DEALLOCATE(XCONVLAT)
224 DEALLOCATE(XCONVLON)
225 !DEALLOCATE(ZCONVLAT)
226 !DEALLOCATE(ZCONVLON)
227
228 !
229 !
230 !------------------------------------------------------------------------------
231 !
232 !*      2.    EXIT
233 !             ----
234 !
235 !
236 RETURN
237 END SUBROUTINE CONVXY2IJ