Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / DIAPRO / complat.f90
1 !     ######spl
2       SUBROUTINE COMPLAT(PLAT)
3 !     ############################
4 !
5 !!****  *COMPLAT* - 
6 !!****           
7 !!
8 !!    PURPOSE
9 !!    -------
10 !   
11 !
12 !!**  METHOD
13 !!    ------
14 !!  
15 !! 
16 !!
17 !!    EXTERNAL
18 !!    --------
19 !!      COS  ! trigonometric functions
20 !!      SIN  !
21 !!
22 !!    IMPLICIT ARGUMENTS
23 !!    ------------------
24 !!    
25 !!
26 !!    REFERENCE
27 !!    ---------
28 !!
29 !!
30 !!    AUTHOR
31 !!    ------
32 !!      J. Duron    * Laboratoire d'Aerologie *
33 !!
34 !!    MODIFICATIONS
35 !!    -------------
36 !!      Original       22/02/2000
37 !!      Updated   
38 !-------------------------------------------------------------------------------
39 !
40 !*       0.    DECLARATIONS
41 !              ------------
42 !
43 USE MODD_COORD
44 USE MODD_NMGRID
45 USE MODD_GRID1
46 USE MODD_GRID, ONLY: XLONORI,XLATORI
47 USE MODE_GRIDPROJ 
48 !
49 IMPLICIT NONE
50 !
51 !*       0.1  Dummy arguments and results
52 !
53 REAL, DIMENSION(:,:),  INTENT(OUT) :: PLAT  
54 !
55
56 !*       0.2  Local variables
57 !
58 INTEGER             :: II, IJ
59 INTEGER             :: JILOOP, JJLOOP
60 !
61 REAL,DIMENSION(:), ALLOCATABLE,SAVE :: ZY
62 REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: ZLA, ZLO, ZYY, ZX
63 !
64 !-------------------------------------------------------------------------------
65 !
66 !*        1.   COMPUTING THE LONGITUDINAL AND TRANSVERSE COMPONENTS
67 !              ----------------------------------------------------
68 !
69 !*        1.1  Array sizes calculations
70 !
71 II=SIZE(PLAT,1)
72 IJ=SIZE(PLAT,2)
73 !
74 !*        1.2  Array allocations
75 !
76 IF (ALLOCATED(ZX))THEN
77   DEALLOCATE(ZX)
78 ENDIF
79 IF (ALLOCATED(ZY))THEN
80   DEALLOCATE(ZY)
81 ENDIF
82 IF (ALLOCATED(ZYY))THEN
83   DEALLOCATE(ZYY)
84 ENDIF
85 IF (ALLOCATED(ZLA))THEN
86   DEALLOCATE(ZLA)
87 ENDIF
88 IF (ALLOCATED(ZLO))THEN
89   DEALLOCATE(ZLO)
90 ENDIF
91
92 ALLOCATE(ZX(II,1),ZY(IJ))
93 ALLOCATE(ZYY(II,1),ZLA(II,1),ZLO(II,1))
94 !
95 ZX(:,1)=XXX(:,NMGRID)
96 ZY(:)=XXY(:,NMGRID)
97 DO JJLOOP=1,IJ
98   DO JILOOP=1,II
99     ZYY(JILOOP,1)=ZY(JJLOOP)
100   ENDDO
101   CALL SM_LATLON_A(XLATORI,XLONORI,ZX,ZYY,ZLA,ZLO)
102   PLAT(:,JJLOOP)=ZLA(:,1)
103 ENDDO
104 !------------------------------------------------------------------------------
105 !
106 !*        2.     EXIT
107 !                ----
108 !
109 RETURN
110 END SUBROUTINE COMPLAT