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