Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / conv2xy.f90
1 !     ######spl
2       MODULE  MODI_CONV2XY
3 !     ####################
4 !
5 INTERFACE
6 !
7 SUBROUTINE CONV2XY(PXX,PYY,PX,PY,K)
8 REAL  ::  PXX,PYY,PX,PY
9 INTEGER,INTENT(IN)          :: K
10 END SUBROUTINE CONV2XY
11 !
12 END INTERFACE
13 !
14 END MODULE MODI_CONV2XY
15 !     ######spl
16       SUBROUTINE CONV2XY(PXX,PYY,PX,PY,K)
17 !     ###################################
18 !
19 !!****  *CONV2XY* - 
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       16/06/98
52 !!      Updated   PM  
53 !-------------------------------------------------------------------------------
54 !
55 !*       0.    DECLARATIONS
56 !              ------------
57 !
58 USE MODD_COORD
59 USE MODD_DIM1
60 USE MODD_CONF
61 USE MODD_GRID1
62 USE MODD_GRID, ONLY: XLONORI,XLATORI
63 USE MODD_RESOLVCAR
64 USE MODD_ALLOC_FORDIACHRO
65 USE MODD_FILES_DIACHRO     
66 USE MODE_GRIDPROJ
67
68 IMPLICIT NONE
69 !
70 !*       0.1   Dummy arguments
71 !              ---------------
72 !
73 REAL  ::  PXX,PYY,PX,PY
74 INTEGER,INTENT(IN)  ::  K
75 !
76 !*       0.1   Local variables
77 !              ---------------
78 !
79 INTEGER  ::  J,JM,JMCUR
80 INTEGER  ::  IINF, IJINF, ISUP, IJSUP
81 LOGICAL  ::  GOK
82 ! !------------------------------------------------------------------------------
83 GOK=.FALSE.
84 IINF=NIINF; ISUP=NISUP; IJINF=NJINF; IJSUP=NJSUP
85 IF(ALLOCATED(XXHAT))THEN
86 ELSE
87   IF (NBFILES == 1)THEN
88   ELSE
89     DO J=1,NBFILES
90       IF(NUMFILES(J)==NUMFILECUR)THEN
91         JMCUR=J
92         if(nverbia > 0)then
93         print *,' CONV2XY J JMCUR ',J,JMCUR
94         endif
95         EXIT
96       ENDIF
97     ENDDO
98     DO J=1,NBFILES
99       IF(NUMFILES(J)==NUMFILECUR)THEN
100         CYCLE
101       ELSE
102         JM=J
103         if(nverbia > 0 )THEN
104           print *,' CONV2XY JM,CFILEDIAS(JM) ',JM,CFILEDIAS(JM)
105         ENDIF
106         CALL READ_FILEHEAD(JM,CFILEDIAS(JM),CLUOUTDIAS(JM))
107         IF(NIMAX /= 0)THEN
108           GOK=.TRUE.
109           EXIT
110         ENDIF
111       ENDIF
112     ENDDO
113   ENDIF
114 ENDIF
115 IF(ALLOCATED(XXHAT))THEN
116 IF(LCONV2XY .AND. NLATLON /= 0)THEN
117   CALL SM_XYHAT_S(XLATORI,XLONORI,PXX,PYY, &
118   PX,PY)
119   IF(K == 11)THEN
120     PXX=PX
121   ELSE IF(K == 12)THEN
122     PXX=PY
123   ELSE IF(K == 21)THEN
124     PYY=PX
125   ELSE IF(K == 22)THEN
126     PYY=PY
127   ENDIF
128 ENDIF
129 ELSE
130   print *,' Absence d''entete dans les differents fichiers ouverts'
131   print *,' Impossibilite de convertir les coordonnees geographiques en conformes '
132   print *,' LCONV2XY remis a .FALSE. '
133   LCONV2XY=.FALSE.
134 ENDIF
135 IF(GOK)THEN
136   CALL READ_FILEHEAD(JMCUR,CFILEDIAS(JMCUR),CLUOUTDIAS(JMCUR))
137 ENDIF
138 NIINF=IINF; NISUP=ISUP; NJINF=IJINF; NJSUP=IJSUP
139 RETURN
140 END SUBROUTINE CONV2XY