Merge branch 'LIBTOOLS-master' into MNH-52X
[MNH-git_open_source-lfs.git] / src / SURFEX / zoom_pgd_orography.F90
1 !SURFEX_LIC Copyright 1994-2014 Meteo-France 
2 !SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence
3 !SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
4 !SURFEX_LIC for details. version 1.
5 !     #########
6       SUBROUTINE ZOOM_PGD_OROGRAPHY(HPROGRAM,PSEA,PWATER,HINIFILE,HINIFILETYPE)
7 !     ###########################################################
8
9 !!
10 !!    PURPOSE
11 !!    -------
12 !!   This program prepares the physiographic data fields.
13 !!
14 !!    METHOD
15 !!    ------
16 !!   
17 !!    EXTERNAL
18 !!    --------
19 !!
20 !!
21 !!    IMPLICIT ARGUMENTS
22 !!    ------------------
23 !!
24 !!
25 !!    REFERENCE
26 !!    ---------
27 !!
28 !!    AUTHOR
29 !!    ------
30 !!
31 !!    V. Masson                   Meteo-France
32 !!
33 !!    MODIFICATION
34 !!    ------------
35 !!
36 !!    Original     13/10/03
37 !----------------------------------------------------------------------------
38 !
39 !*    0.     DECLARATION
40 !            -----------
41 !
42 USE MODD_DATA_COVER_PAR,   ONLY : JPCOVER
43 USE MODD_SURF_ATM_n,       ONLY : XZS, NSIZE_FULL!, XSEA, XWATER
44 USE MODD_SURF_ATM_GRID_n,  ONLY : XLAT, XLON, CGRID, XGRID_PAR
45 USE MODD_SURF_ATM_SSO_n,   ONLY : XSSO_STDEV, XAVG_ZS, XSIL_ZS, XMIN_ZS, XMAX_ZS,&
46                                     XSSO_ANIS, XSSO_DIR, XSSO_SLOPE,               &
47                                     XAOSIP, XAOSIM, XAOSJP, XAOSJM,                &
48                                     XHO2IP, XHO2IM, XHO2JP, XHO2JM  
49 USE MODD_PREP,             ONLY : CINGRID_TYPE, CINTERP_TYPE, LINTERP
50 USE MODD_SURF_PAR,         ONLY : XUNDEF
51 !
52 USE MODI_OPEN_AUX_IO_SURF
53 USE MODI_READ_SURF
54 USE MODI_CLOSE_AUX_IO_SURF
55 USE MODI_PREP_GRID_EXTERN
56 USE MODI_HOR_INTERPOL
57 USE MODI_PREP_OUTPUT_GRID
58 !
59 USE MODI_GOTO_MODEL_MNH
60 !
61 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
62 USE PARKIND1  ,ONLY : JPRB
63 !
64 USE MODI_CLEAN_PREP_OUTPUT_GRID
65 !
66 USE MODI_GET_LUOUT
67 IMPLICIT NONE
68 !
69 !*    0.1    Declaration of dummy arguments
70 !            ------------------------------
71 !
72  CHARACTER(LEN=6),     INTENT(IN)  :: HPROGRAM    ! program calling
73  REAL, DIMENSION(:),   INTENT(IN)  :: PSEA        ! sea fraction
74  REAL, DIMENSION(:),   INTENT(IN)  :: PWATER      ! inland water fraction
75  CHARACTER(LEN=28),    INTENT(IN)  :: HINIFILE    ! input atmospheric file name
76  CHARACTER(LEN=6),     INTENT(IN)  :: HINIFILETYPE! input atmospheric file type
77 !
78 !
79 !*    0.2    Declaration of local variables
80 !            ------------------------------
81 !
82 INTEGER :: IRESP
83 INTEGER :: ILUOUT
84 INTEGER :: INI     ! total 1D dimension (input field)
85 INTEGER :: IL      ! total 1D dimension (output field)
86 REAL, DIMENSION(:), POINTER :: ZZS
87 REAL, DIMENSION(:), POINTER :: ZAVG_ZS
88 REAL, DIMENSION(:), POINTER :: ZSIL_ZS
89 REAL, DIMENSION(:), POINTER :: ZSSO_STDEV
90 REAL, DIMENSION(:), POINTER :: ZMIN_ZS
91 REAL, DIMENSION(:), POINTER :: ZMAX_ZS
92 REAL, DIMENSION(:), POINTER :: ZSSO_ANIS
93 REAL, DIMENSION(:), POINTER :: ZSSO_DIR
94 REAL, DIMENSION(:), POINTER :: ZSSO_SLOPE
95 REAL, DIMENSION(:), POINTER :: ZAOSIP
96 REAL, DIMENSION(:), POINTER :: ZAOSIM
97 REAL, DIMENSION(:), POINTER :: ZAOSJP
98 REAL, DIMENSION(:), POINTER :: ZAOSJM
99 REAL, DIMENSION(:), POINTER :: ZHO2IP
100 REAL, DIMENSION(:), POINTER :: ZHO2IM
101 REAL, DIMENSION(:), POINTER :: ZHO2JP
102 REAL, DIMENSION(:), POINTER :: ZHO2JM
103  CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read
104 REAL(KIND=JPRB) :: ZHOOK_HANDLE
105 INTEGER :: IINFO_ll
106 !------------------------------------------------------------------------------
107 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_OROGRAPHY',0,ZHOOK_HANDLE)
108  CALL GET_LUOUT(HPROGRAM,ILUOUT)
109 !
110 !*      1.     Preparation of IO for reading in the file
111 !              -----------------------------------------
112 !
113 !* Note that all points are read, even those without physical meaning.
114 !  These points will not be used during the horizontal interpolation step.
115 !  Their value must be defined as XUNDEF.
116 !
117 ! get the local sizes of model 1
118 CALL GOTO_MODEL_MNH(HPROGRAM, 1, IINFO_ll)
119 !CALL GOTO_MODEL_SURFEX(1, .TRUE.)   ! cette routine plante don je me demerde sans
120  CALL OPEN_AUX_IO_SURF(HINIFILE,HINIFILETYPE,'FULL  ')
121 !
122 !------------------------------------------------------------------------------
123 !
124 !*      2.     Reading of grid
125 !              ---------------
126 !
127  CALL PREP_GRID_EXTERN(HINIFILETYPE,ILUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
128 !
129  CALL PREP_OUTPUT_GRID(ILUOUT,CGRID,XGRID_PAR,XLAT,XLON)
130 !
131 !------------------------------------------------------------------------------
132 !
133 !*      3.     Reading of orographic parameters
134 !              --------------------------------
135 !
136 ALLOCATE(ZZS        (INI))
137 !
138 ALLOCATE(ZAVG_ZS    (INI))
139 ALLOCATE(ZSIL_ZS    (INI))
140 ALLOCATE(ZSSO_STDEV (INI))
141 ALLOCATE(ZMIN_ZS    (INI))
142 ALLOCATE(ZMAX_ZS    (INI))
143 !
144 ALLOCATE(ZSSO_ANIS  (INI))
145 ALLOCATE(ZSSO_DIR   (INI))
146 ALLOCATE(ZSSO_SLOPE (INI))
147 !
148 ALLOCATE(ZAOSIP     (INI))
149 ALLOCATE(ZAOSIM     (INI))
150 ALLOCATE(ZAOSJP     (INI))
151 ALLOCATE(ZAOSJM     (INI))
152 ALLOCATE(ZHO2IP     (INI))
153 ALLOCATE(ZHO2IM     (INI))
154 ALLOCATE(ZHO2JP     (INI))
155 ALLOCATE(ZHO2JM     (INI))
156 !
157 YRECFM='ZS'
158  CALL READ_SURF(HPROGRAM,YRECFM,ZZS,IRESP,HDIR='A')
159 !
160 YRECFM='AVG_ZS'
161  CALL READ_SURF(HPROGRAM,YRECFM,ZAVG_ZS,IRESP,HDIR='A')
162 YRECFM='SIL_ZS'
163  CALL READ_SURF(HPROGRAM,YRECFM,ZSIL_ZS,IRESP,HDIR='A')
164 YRECFM='SSO_STDEV'
165  CALL READ_SURF(HPROGRAM,YRECFM,ZSSO_STDEV,IRESP,HDIR='A')
166 YRECFM='MIN_ZS'
167  CALL READ_SURF(HPROGRAM,YRECFM,ZMIN_ZS,IRESP,HDIR='A')
168 YRECFM='MAX_ZS'
169  CALL READ_SURF(HPROGRAM,YRECFM,ZMAX_ZS,IRESP,HDIR='A')
170 !
171 YRECFM='SSO_ANIS'
172  CALL READ_SURF(HPROGRAM,YRECFM,ZSSO_ANIS,IRESP,HDIR='A')
173 YRECFM='SSO_DIR'
174  CALL READ_SURF(HPROGRAM,YRECFM,ZSSO_DIR,IRESP,HDIR='A')
175 YRECFM='SSO_SLOPE'
176  CALL READ_SURF(HPROGRAM,YRECFM,ZSSO_SLOPE,IRESP,HDIR='A')
177 !
178 YRECFM='AOSIP'
179  CALL READ_SURF(HPROGRAM,YRECFM,ZAOSIP,IRESP,HDIR='A')
180 YRECFM='AOSIM'
181  CALL READ_SURF(HPROGRAM,YRECFM,ZAOSIM,IRESP,HDIR='A')
182 YRECFM='AOSJP'
183  CALL READ_SURF(HPROGRAM,YRECFM,ZAOSJP,IRESP,HDIR='A')
184 YRECFM='AOSJM'
185  CALL READ_SURF(HPROGRAM,YRECFM,ZAOSJM,IRESP,HDIR='A')
186 YRECFM='HO2IP'
187  CALL READ_SURF(HPROGRAM,YRECFM,ZHO2IP,IRESP,HDIR='A')
188 YRECFM='HO2IM'
189  CALL READ_SURF(HPROGRAM,YRECFM,ZHO2IM,IRESP,HDIR='A')
190 YRECFM='HO2JP'
191  CALL READ_SURF(HPROGRAM,YRECFM,ZHO2JP,IRESP,HDIR='A')
192 YRECFM='HO2JM'
193  CALL READ_SURF(HPROGRAM,YRECFM,ZHO2JM,IRESP,HDIR='A')
194 !
195  CALL CLOSE_AUX_IO_SURF(HINIFILE,HINIFILETYPE)
196 !------------------------------------------------------------------------------
197 !
198 !*      4.     Interpolations
199 !              --------------
200 !
201 IL = SIZE(XLAT)   !size of local child model
202 !
203 ALLOCATE(XZS        (IL))
204 !
205 ALLOCATE(XAVG_ZS    (IL))
206 ALLOCATE(XSIL_ZS    (IL))
207 ALLOCATE(XSSO_STDEV (IL))
208 ALLOCATE(XMIN_ZS    (IL))
209 ALLOCATE(XMAX_ZS    (IL))
210 !
211 ALLOCATE(XSSO_ANIS  (IL))
212 ALLOCATE(XSSO_DIR   (IL))
213 ALLOCATE(XSSO_SLOPE (IL))
214 !
215 ALLOCATE(XAOSIP     (IL))
216 ALLOCATE(XAOSIM     (IL))
217 ALLOCATE(XAOSJP     (IL))
218 ALLOCATE(XAOSJM     (IL))
219 ALLOCATE(XHO2IP     (IL))
220 ALLOCATE(XHO2IM     (IL))
221 ALLOCATE(XHO2JP     (IL))
222 ALLOCATE(XHO2JM     (IL))
223 !
224  CALL ZOOM(ILUOUT,ZZS,XZS)
225  CALL ZOOM(ILUOUT,ZAVG_ZS,XAVG_ZS)
226  CALL ZOOM(ILUOUT,ZSIL_ZS,XSIL_ZS)
227  CALL ZOOM(ILUOUT,ZMIN_ZS,XMIN_ZS)
228  CALL ZOOM(ILUOUT,ZMAX_ZS,XMAX_ZS)
229 !
230 LINTERP(:)=(PSEA(:)<1.)
231  CALL ZOOM(ILUOUT,ZSSO_STDEV,XSSO_STDEV)
232  CALL ZOOM(ILUOUT,ZSSO_ANIS,XSSO_ANIS)
233  CALL ZOOM(ILUOUT,ZSSO_DIR,XSSO_DIR)
234  CALL ZOOM(ILUOUT,ZSSO_SLOPE,XSSO_SLOPE)
235  CALL ZOOM(ILUOUT,ZAOSIP,XAOSIP)
236  CALL ZOOM(ILUOUT,ZAOSIM,XAOSIM)
237  CALL ZOOM(ILUOUT,ZAOSJP,XAOSJP)
238  CALL ZOOM(ILUOUT,ZAOSJM,XAOSJM)
239  CALL ZOOM(ILUOUT,ZHO2IP,XHO2IP)
240  CALL ZOOM(ILUOUT,ZHO2IM,XHO2IM)
241  CALL ZOOM(ILUOUT,ZHO2JP,XHO2JP)
242  CALL ZOOM(ILUOUT,ZHO2JM,XHO2JM)
243 !
244 !* coherence with land sea mask
245 !
246 WHERE(PSEA==1.) XZS=0.
247 WHERE(PSEA(:)==1.) XSSO_STDEV(:) = XUNDEF
248 WHERE(PWATER(:)==1.) XSSO_STDEV(:) = 0.
249 WHERE(PSEA(:)>0.) XMIN_ZS(:) = 0.
250 WHERE(PSEA(:)==1.) XMAX_ZS(:) = 0.
251 !
252 WHERE (PSEA(:)==1.)
253   XSSO_ANIS (:) = XUNDEF
254   XSSO_DIR  (:) = XUNDEF
255   XSSO_SLOPE(:) = XUNDEF
256 END WHERE
257 !
258 WHERE (PWATER(:)==1.)
259   XSSO_ANIS (:) = 1.
260   XSSO_DIR  (:) = 0.
261   XSSO_SLOPE(:) = 0.
262 END WHERE
263 !
264 WHERE (PSEA(:)==1.)
265   XHO2IP(:) = XUNDEF
266   XHO2IM(:) = XUNDEF
267   XHO2JP(:) = XUNDEF
268   XHO2JM(:) = XUNDEF
269   XAOSIP(:) = XUNDEF
270   XAOSIM(:) = XUNDEF
271   XAOSJP(:) = XUNDEF
272   XAOSJM(:) = XUNDEF
273 END WHERE
274 !
275 WHERE (PWATER(:)==1.)
276   XHO2IP(:) = 0.
277   XHO2IM(:) = 0.
278   XHO2JP(:) = 0.
279   XHO2JM(:) = 0.
280   XAOSIP(:) = 0.
281   XAOSIM(:) = 0.
282   XAOSJP(:) = 0.
283   XAOSJM(:) = 0.
284 END WHERE
285 !
286 ! go back to child model
287 !CALL GOTO_MODEL_SURFEX(2, .TRUE.)   ! cette routine plante
288 CALL GOTO_MODEL_MNH(HPROGRAM, 2, IINFO_ll)
289 !_______________________________________________________________________________
290 DEALLOCATE(ZZS        )
291 !
292 DEALLOCATE(ZAVG_ZS    )
293 DEALLOCATE(ZSIL_ZS    )
294 DEALLOCATE(ZSSO_STDEV )
295 DEALLOCATE(ZMIN_ZS    )
296 DEALLOCATE(ZMAX_ZS    )
297 !
298 DEALLOCATE(ZSSO_ANIS  )
299 DEALLOCATE(ZSSO_DIR   )
300 DEALLOCATE(ZSSO_SLOPE )
301 !
302 DEALLOCATE(ZAOSIP     )
303 DEALLOCATE(ZAOSIM     )
304 DEALLOCATE(ZAOSJP     )
305 DEALLOCATE(ZAOSJM     )
306 DEALLOCATE(ZHO2IP     )
307 DEALLOCATE(ZHO2IM     )
308 DEALLOCATE(ZHO2JP     )
309 DEALLOCATE(ZHO2JM     )
310 !_______________________________________________________________________________
311  CALL CLEAN_PREP_OUTPUT_GRID
312 !_______________________________________________________________________________
313 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_OROGRAPHY',1,ZHOOK_HANDLE)
314 CONTAINS
315 !
316 SUBROUTINE ZOOM(KLUOUT,PFIELDIN,PFIELDOUT)
317 INTEGER, INTENT(IN)             :: KLUOUT
318 REAL, DIMENSION(:), POINTER     :: PFIELDIN
319 REAL, DIMENSION(:), INTENT(OUT) :: PFIELDOUT
320 REAL, DIMENSION(:,:), POINTER   :: ZFIELDIN
321 REAL, DIMENSION(:,:), POINTER   :: ZFIELDOUT
322 REAL(KIND=JPRB) :: ZHOOK_HANDLE
323 IF (LHOOK) CALL DR_HOOK('ZOOM',0,ZHOOK_HANDLE)
324 ALLOCATE(ZFIELDIN (SIZE(PFIELDIN, 1),1))
325 ALLOCATE(ZFIELDOUT(SIZE(PFIELDOUT,1),1))
326 ZFIELDIN(:,1) = PFIELDIN(:)
327  CALL HOR_INTERPOL(KLUOUT,ZFIELDIN,ZFIELDOUT)
328 PFIELDOUT(:) = ZFIELDOUT(:,1)
329 DEALLOCATE(ZFIELDIN )
330 DEALLOCATE(ZFIELDOUT)
331 IF (LHOOK) CALL DR_HOOK('ZOOM',1,ZHOOK_HANDLE)
332
333 END SUBROUTINE ZOOM
334 !
335 END SUBROUTINE ZOOM_PGD_OROGRAPHY