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