Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / TOOL / zinter.f90
1 !     ##################
2       MODULE MODI_ZINTER
3 !     ##################
4 !
5 INTERFACE ZINTER
6       SUBROUTINE ZINTER(PVMNH,PZGMNH,PVZL,PLZL,KKB,PUNDEF,KNIVMOD)
7 !
8 REAL,DIMENSION(:,:,:),INTENT(IN) :: PVMNH
9 REAL,DIMENSION(:,:,:),INTENT(IN) :: PZGMNH 
10 REAL,DIMENSION(:,:,:),INTENT(OUT):: PVZL 
11 REAL,DIMENSION(:),INTENT(IN)     :: PLZL
12 REAL,INTENT(IN)         :: PUNDEF
13 !
14 INTEGER,INTENT(IN)      :: KKB
15 INTEGER,DIMENSION(:,:),INTENT(OUT),OPTIONAL:: KNIVMOD 
16 !
17 END SUBROUTINE ZINTER
18 !
19       SUBROUTINE SINTER(PVMNH,PZGMNH,PVZL,PLZL,KKB,PUNDEF,KNIVMOD)
20 !
21 REAL,DIMENSION(:,:,:),INTENT(IN) :: PVMNH
22 REAL,DIMENSION(:,:,:),INTENT(IN) :: PZGMNH 
23 REAL,DIMENSION(:,:,:),INTENT(OUT):: PVZL 
24 REAL,DIMENSION(:,:,:),INTENT(IN) :: PLZL
25 REAL,INTENT(IN)         :: PUNDEF
26 !
27 INTEGER,INTENT(IN)      :: KKB
28 INTEGER,DIMENSION(:,:),INTENT(OUT),OPTIONAL:: KNIVMOD 
29 !
30 END SUBROUTINE SINTER
31 !
32 END INTERFACE ZINTER
33 END MODULE MODI_ZINTER
34 !     ##################
35       MODULE MODI_SINTER
36 !     ##################
37 !
38 INTERFACE SINTER
39       SUBROUTINE SINTER(PVMNH,PZGMNH,PVZL,PLZL,KKB,PUNDEF,KNIVMOD)
40 !
41 REAL,DIMENSION(:,:,:),INTENT(IN) :: PVMNH
42 REAL,DIMENSION(:,:,:),INTENT(IN) :: PZGMNH 
43 REAL,DIMENSION(:,:,:),INTENT(OUT):: PVZL 
44 REAL,DIMENSION(:,:,:),INTENT(IN) :: PLZL
45 REAL,INTENT(IN)         :: PUNDEF
46 !
47 INTEGER,INTENT(IN)      :: KKB
48 INTEGER,DIMENSION(:,:),INTENT(OUT),OPTIONAL:: KNIVMOD 
49 !
50 END SUBROUTINE SINTER
51 END INTERFACE SINTER
52 END MODULE MODI_SINTER
53 !
54 !------------------------------------------------------------------------------
55 !
56 !     ####################################################
57       SUBROUTINE SINTER(PVMNH,PZGMNH,PVZL,PLZL,KKB,PUNDEF,KNIVMOD)
58 !     ####################################################
59 !
60 !
61 !!****  *ZINTER * - routine to linearly interpolate
62 !!
63 !!     PURPOSE
64 !!     -------
65 !    This routine interpolates an input field on Gal-Chen grid, linearly in 
66 !    another Z-grid (regular or not).
67 !
68 !!**   METHOD
69 !!     ------
70 !!
71 !!
72 !!     EXTERNAL
73 !!     --------
74 !!
75 !!     IMPLICIT ARGUMENTS
76 !!     ------------------
77 !!      None
78 !!
79 !!     REFERENCE
80 !!     ---------
81 !!      Research manual 2 ECMWF forecast model, 1988, Ref M1.6/3
82 !!      "adiabatic part", Appendix 6 postprocessing
83 !!      Section 3.  Vertical interpolation, p. A6.5-6
84 !!      Section 3.4 Extrapolation, pp. A6.6-7
85 !!
86 !!     AUTHOR
87 !!     ------
88 !!       P. Mascart     * LA *
89 !!
90 !!     MODIFICATIONS
91 !!     -------------
92 !!       Original       22/04/96
93 !!       Modification   11/02/99 Chaboureau - some simplifications
94 !!-----------------------------------------------------------------------
95 !
96 !*       0.   DECLARATIONS
97 !             ------------
98 !
99 IMPLICIT NONE
100 !
101 !*       0.1  Declaration of arguments 
102 !
103 INTEGER,INTENT(IN)           :: KKB  ! 1st level above ground    
104 REAL,DIMENSION(:,:,:),INTENT(IN) :: PVMNH
105 !!  PVMNH  = tableau du champ donne au points masse Meso-NH
106 REAL,DIMENSION(:,:,:),INTENT(IN) :: PZGMNH 
107 !!  PZGMNH = altitude geopotentiel au point masse Meso-NH
108 REAL,DIMENSION(:,:,:),INTENT(IN) :: PLZL ! list of the new vertical levels
109 REAL,DIMENSION(:,:,:),INTENT(OUT):: PVZL ! interpolated output field
110 REAL,INTENT(IN)         :: PUNDEF  ! undefined value
111 INTEGER,DIMENSION(:,:),INTENT(OUT),OPTIONAL:: KNIVMOD 
112 !!                                   first model level above PLZL(:,:,1)
113 !
114 !*       0.2  Declaration of local variables
115 !
116 INTEGER   :: ILT,ILN  ! number of points in the 1st and 2nd dimensions
117 INTEGER   :: IKU      ! number of input vertical levels
118 INTEGER   :: INP      ! number of new vertical levels (1: base ; INP: top)
119
120 REAL      :: ZSLOPE
121 INTEGER   :: JI,JJ,JKZL,JK
122 INTEGER   :: IKD
123 !
124 !------------------------------------------------------------------------------
125 !
126 !*       1.   INITIALIZATION
127 !             --------------
128 !
129 ILT=SIZE(PVMNH,1)
130 ILN=SIZE(PVMNH,2)
131 IKU=SIZE(PVMNH,3)
132 INP=SIZE(PVZL,3)
133 PVZL=PUNDEF
134 IF (PRESENT (KNIVMOD)) KNIVMOD=KKB
135 !
136 print*,'in SINTER ',ILT,ILN,IKU,INP
137 !------------------------------------------------------------------------------
138 !
139 !*       2.   INTERPOLATION
140 !             -------------
141 !
142 OX: DO  JI =1,ILT
143   OY:  DO   JJ =1,ILN
144     PLEV:  DO   JKZL=1,INP
145       !
146       !   i) Zones flagging
147       !
148       IKD=0
149       IF(PLZL(JI,JJ,JKZL).GE.PZGMNH(JI,JJ,IKU))       IKD=10*IKU
150       DO  JK  =IKU-1,KKB,-1
151          IF((PZGMNH(JI,JJ,JK+1).GT.PLZL(JI,JJ,JKZL)).AND.   &
152            (PLZL(JI,JJ,JKZL).GE.PZGMNH(JI,JJ,JK)))    IKD=JK
153       END DO
154       IF(PLZL(JI,JJ,JKZL).LT.PZGMNH(JI,JJ,KKB))       IKD=-10*IKU
155       IF(IKD==0) IKD=10*IKU  !! pas propre...
156       !
157       !   ii) Regular points interpolation
158       !
159       IF(ABS(IKD).NE.(10*IKU)) THEN
160         IF ( PVMNH(JI,JJ,IKD) /= PUNDEF .AND. PVMNH(JI,JJ,IKD+1)/= PUNDEF) THEN
161           ZSLOPE=(PLZL(JI,JJ,JKZL)-PZGMNH(JI,JJ,IKD))      &
162                  /(PZGMNH(JI,JJ,IKD+1)-PZGMNH(JI,JJ,IKD))
163           PVZL(JI,JJ,JKZL)=PVMNH(JI,JJ,IKD)                &
164                            +ZSLOPE*(PVMNH(JI,JJ,IKD+1)-PVMNH(JI,JJ,IKD))
165           IF (PRESENT (KNIVMOD)) THEN
166             KNIVMOD(JI,JJ)=IKD+1
167           ENDIF
168         ELSE
169           PVZL(JI,JJ,JKZL)=PUNDEF
170         ENDIF
171       ELSE
172       !
173       !   iii) No extrapolation below the ground and above the top
174       !
175         PVZL(JI,JJ,JKZL)=PUNDEF
176       ENDIF
177     END DO PLEV
178   END DO OY 
179 END DO OX
180 !
181 END SUBROUTINE SINTER
182 !
183 !     ####################################################
184       SUBROUTINE ZINTER(PVMNH,PZGMNH,PVZL,PLZL,KKB,PUNDEF,KNIVMOD)
185 !     ####################################################
186 !
187 !
188 !!****  *ZINTER * - routine to linearly interpolate
189 !!
190 !!     PURPOSE
191 !!     -------
192 !    This routine interpolates an input field on Gal-Chen grid, linearly in 
193 !    another Z-grid (regular or not).
194 !
195 !!**   METHOD
196 !!     ------
197 !!
198 !!
199 !!     EXTERNAL
200 !!     --------
201 !!
202 !!     IMPLICIT ARGUMENTS
203 !!     ------------------
204 !!      None
205 !!
206 !!     REFERENCE
207 !!     ---------
208 !!      Research manual 2 ECMWF forecast model, 1988, Ref M1.6/3
209 !!      "adiabatic part", Appendix 6 postprocessing
210 !!      Section 3.  Vertical interpolation, p. A6.5-6
211 !!      Section 3.4 Extrapolation, pp. A6.6-7
212 !!
213 !!     AUTHOR
214 !!     ------
215 !!       P. Mascart     * LA *
216 !!
217 !!     MODIFICATIONS
218 !!     -------------
219 !!       Original       22/04/96
220 !!       Modification   11/02/99 Chaboureau - some simplifications
221 !!-----------------------------------------------------------------------
222 !
223 !*       0.   DECLARATIONS
224 !             ------------
225 !
226 USE MODI_SINTER
227 IMPLICIT NONE
228 !
229 !*       0.1  Declaration of arguments 
230 !
231 REAL,DIMENSION(:,:,:),INTENT(IN) :: PVMNH
232 REAL,DIMENSION(:,:,:),INTENT(IN) :: PZGMNH 
233 REAL,DIMENSION(:,:,:),INTENT(OUT):: PVZL 
234 REAL,DIMENSION(:),INTENT(IN)     :: PLZL
235 REAL,INTENT(IN)         :: PUNDEF
236 !
237 INTEGER,INTENT(IN)      :: KKB
238 INTEGER,DIMENSION(:,:),INTENT(OUT),OPTIONAL:: KNIVMOD 
239 !
240 !*       0.2  Declaration of local variables
241 !
242 INTEGER   :: ILT,ILN  ! number of points in the 1st and 2nd dimensions
243 INTEGER   :: IKU      ! number of input vertical levels
244 INTEGER   :: INP      ! number of new vertical levels (1: base ; INP: top)
245 REAL,DIMENSION(:,:,:),ALLOCATABLE :: ZLZL 
246 !
247 !------------------------------------------------------------------------------
248 !
249 !*       1.   INITIALIZATION
250 !             --------------
251 !
252 ILT=SIZE(PVMNH,1)
253 ILN=SIZE(PVMNH,2)
254 INP=SIZE(PVZL,3)
255 !
256 ALLOCATE(ZLZL(ILT,ILN,INP))
257 ZLZL(:,:,:) = SPREAD( SPREAD( PLZL(1:INP),1,ILT ) ,2,ILN )
258 !
259 !------------------------------------------------------------------------------
260 !
261 !*       2.   INTERPOLATION
262 !             -------------
263 !
264 CALL SINTER(PVMNH,PZGMNH,PVZL,ZLZL,KKB,PUNDEF,KNIVMOD)
265 !
266 END SUBROUTINE ZINTER