GCC Code Coverage Report


Directory: ./
File: rad/surface_fields.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 586 0.0%
Branches: 0 1376 0.0%

Line Branch Exec Source
1 MODULE SURFACE_FIELDS
2
3 ! Purpose.
4 ! --------
5
6 ! SURFACE_FIELDS contains data structures and manipulation routines
7 ! for the surface (physics) fields in the IFS
8
9 ! This module is a mix of declarations, type definitions and
10 ! subroutines linked with surface fields. There are four parts:
11 ! 1/ Declaration of dimensions (including some parameter variables).
12 ! 2/ Definition of types.
13 ! 3/ Declarations:
14 ! Declaration of variables SP_[group], YSP_[group]D, YSP_[group]
15 ! (prognostic surface fields).
16 ! Declaration of variables SD_[group], YSD_[group]D, YSD_[group]
17 ! (diagnostic surface fields).
18 ! 4/ Some routines linked to the surface data flow:
19 ! * INI_SFLP3: Initialize 3-D surface field group
20 ! * SETUP_SFLP3: Setup 3-D surface field
21 ! * INI_SFLP2: Initialize 2-D surface field group
22 ! * SETUP_SFLP2: Setup 2-D surface field
23 ! * GPPOPER: Operations on prognostic surface fields
24 ! * GPOPER: Operations on ALL surface groups
25 ! * GPOPER_2: Operations on 2-D surface groups
26 ! * GPOPER_3: Operations on 3-D surface groups
27 ! * SURF_STORE: Store all surface fields
28 ! * SURF_RESTORE: Restore all surface fields
29 ! * ALLO_SURF: Allocate surface field arrays
30 ! * DEALLO_SURF: Deallocate surface field arrays
31
32 ! Author.
33 ! -------
34 ! Mats Hamrud(ECMWF)
35
36 ! Modifications.
37 ! --------------
38 ! Original : 2006-07-01
39 ! Modifications:
40 ! K. Yessad (25 Oct 2006): rephase ALARO0 contribution.
41 ! K. Yessad (26 Oct 2006): add missing comments.
42
43 !-------------------------------------------------------------------------
44
45 USE PARKIND1 ,ONLY : JPIM ,JPRB
46 USE YOMDIM ,ONLY : NPROMA, NGPBLKS, NUNDEFLD
47 USE YOMLUN ,ONLY : NULOUT, NULERR
48 USE YOMCT0 ,ONLY : LTWOTL
49 USE YOMDYN , ONLY : REPSP1
50 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
51 IMPLICIT NONE
52 SAVE
53
54 !#include "abor1.intfb.h"
55 ! -------------------------------------------------------------------------
56
57 INTEGER(KIND=JPIM), PARAMETER :: JPMAXSFLDS=100 ! Max number of fields in individual group
58 INTEGER(KIND=JPIM), PARAMETER :: JPMAXSTRAJ=100 ! Dimension of NSTRAJGRIB
59 INTEGER(KIND=JPIM) :: NSURF=0 ! Number of surf var.
60 INTEGER(KIND=JPIM) :: NSURFL=0 ! Number of surf flds (fields*levels)
61 INTEGER(KIND=JPIM) :: NDIMSURF=0 ! Total of surf var (includes timelevels etc)
62 INTEGER(KIND=JPIM) :: NDIMSURFL=0 ! Total dimension of all surface variables
63 INTEGER(KIND=JPIM) :: NPROGSURF=0 ! Number of prognostic surf var.
64 INTEGER(KIND=JPIM) :: NPROGSURFL=0 ! Number of prognostic surf flds (fields*levels)
65 INTEGER(KIND=JPIM) :: NOFFTRAJ ! Offset in surf trajectory
66 INTEGER(KIND=JPIM) :: NOFFTRAJ_CST ! Offset in "constant" surf trajectory
67 INTEGER(KIND=JPIM) :: NPTRSURF ! Used by routine GPOPER
68 INTEGER(KIND=JPIM) :: NSTRAJGRIB(JPMAXSTRAJ) ! Used in trajectory setup
69
70 REAL(KIND=JPRB),ALLOCATABLE :: SURF_STORE_ARRAY(:,:,:) ! Backup array for surf (see routineSURF_STORE )
71 ! General type defintions
72
73 ! 2D surface field structure
74 TYPE TYPE_SURF_MTL_2D
75 INTEGER(KIND=JPIM) :: MP ! Basic field pointer
76 INTEGER(KIND=JPIM) :: MP0 ! Field pointer timelevel 0 (prognostic fields)
77 INTEGER(KIND=JPIM) :: MP9 ! Field pointer timelevel -1 (prognostic fields)
78 INTEGER(KIND=JPIM) :: MP1 ! Field pointer timelevel +1 (prognostic fields)
79 INTEGER(KIND=JPIM) :: MP5 ! Field pointer trajectory
80 INTEGER(KIND=JPIM) :: IGRBCODE ! GRIB parameter code (default: -999)
81 CHARACTER(LEN=16) :: CNAME ! ARPEGE field name (default: all spaces)
82 REAL(KIND=JPRB) :: REFVALI ! Default value (default: 0.0)
83 INTEGER(KIND=JPIM) :: NREQIN ! -1 - initial value from default (default)
84 ! +1 - initial value from reading file
85 ! 0 - no initial value
86 INTEGER(KIND=JPIM) :: ITRAJ ! 0 not in trajectory (default)
87 ! 1 in trajectory
88 ! 2 in "constant" trajectory
89 END TYPE TYPE_SURF_MTL_2D
90
91 ! 3D surface field structure
92 TYPE TYPE_SURF_MTL_3D
93 INTEGER(KIND=JPIM) :: MP ! Basic field pointer
94 INTEGER(KIND=JPIM) :: MP0 ! Field pointer timelevel 0 (prognostic fields)
95 INTEGER(KIND=JPIM) :: MP9 ! Field pointer timelevel -1 (prognostic fields)
96 INTEGER(KIND=JPIM) :: MP1 ! Field pointer timelevel +1 (prognostic fields)
97 INTEGER(KIND=JPIM) :: MP5 ! Field pointer trajectory
98 INTEGER(KIND=JPIM),POINTER :: IGRBCODE(:) ! GRIB parameter code (default: -999)
99 CHARACTER(LEN=16) ,POINTER :: CNAME(:) ! ARPEGE field name (default: all spaces)
100 REAL(KIND=JPRB) ,POINTER :: REFVALI(:) ! Default value (default: 0.0)
101 INTEGER(KIND=JPIM),POINTER :: NREQIN(:) ! -1 - initial value from default (default)
102 ! +1 - initial value from reading file
103 ! 0 - no initial value
104 INTEGER(KIND=JPIM) :: ITRAJ ! 0 not in trajectory (default)
105 ! 1 in trajectory
106 ! 2 in "constant" trajectory
107 END TYPE TYPE_SURF_MTL_3D
108
109 ! Descriptor pertaining to group
110 TYPE TYPE_SURF_GEN
111 INTEGER(KIND=JPIM) :: NUMFLDS ! Number of field in group
112 INTEGER(KIND=JPIM) :: NDIM ! Field dimenion
113 INTEGER(KIND=JPIM) :: NLEVS ! Number of levels (for multi level groups)
114 INTEGER(KIND=JPIM) :: IPTR ! Internal use
115 INTEGER(KIND=JPIM) :: IPTR5 ! Internal use
116 INTEGER(KIND=JPIM) :: NDIM5 ! Dimension of trajectory array
117 INTEGER(KIND=JPIM) :: NOFFTRAJ ! Internal use
118 INTEGER(KIND=JPIM) :: NOFFTRAJ_CST ! Internal use
119 CHARACTER(LEN=16) :: CGRPNAME ! Name of group (for prints)
120 LOGICAL :: L3D ! TRUE if multi-level field (3-D)
121 LOGICAL :: LMTL ! TRUE if prognostic field (multi time level)
122 END TYPE TYPE_SURF_GEN
123
124 ! Type descriptor for derived type for communicating with GPOPER (see below)
125 TYPE TYPE_SFL_COMM
126 INTEGER(KIND=JPIM) :: IGRBCODE
127 LOGICAL :: L_OK
128 CHARACTER(LEN=16) :: CNAME
129 INTEGER(KIND=JPIM) :: IFLDNUM
130 REAL(KIND=JPRB) :: VALUE
131 INTEGER(KIND=JPIM) :: IPTRSURF
132 INTEGER(KIND=JPIM) :: ICODES(JPMAXSFLDS)
133 INTEGER(KIND=JPIM) :: ICOUNT
134 END TYPE TYPE_SFL_COMM
135
136 ! Group specific type definitions
137
138 ! * Group SB=SOILB: soil prognostic quantities for the different reservoirs
139 ! (four reservoirs at ECMWF, deep reservoir at METEO-FRANCE):
140 TYPE TYPE_SFL_SOILB
141 TYPE(TYPE_SURF_MTL_3D),POINTER :: YT ! temperature
142 TYPE(TYPE_SURF_MTL_3D),POINTER :: YQ ! liquid water content
143 TYPE(TYPE_SURF_MTL_3D),POINTER :: YTL ! ice water content (for MF)
144 TYPE(TYPE_SURF_MTL_3D),POINTER :: YSB(:)
145 END TYPE TYPE_SFL_SOILB
146
147 ! * Group SG=SNOWG: surface snow prognostic quantities:
148 TYPE TYPE_SFL_SNOWG
149 TYPE(TYPE_SURF_MTL_2D),POINTER :: YF ! content of surface snow
150 TYPE(TYPE_SURF_MTL_2D),POINTER :: YA ! snow albedo
151 TYPE(TYPE_SURF_MTL_2D),POINTER :: YR ! snow density
152 TYPE(TYPE_SURF_MTL_2D),POINTER :: YT ! total albedo (diagnostic for MF for LVGSN)
153 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSG(:)
154 END TYPE TYPE_SFL_SNOWG
155
156 ! * Group RR=RESVR: surface prognostic quantities (ECMWF) or
157 ! surface + superficial reservoir prognostic quantities (MF):
158 ! Remark:
159 ! at ECMWF there are 4 soil reservoirs and there is a
160 ! clear distinction between the soil reservoirs (group SOILB)
161 ! and the surface (group RESVR);
162 ! at METEO-FRANCE there is a deep reservoir (group SOILB) and a
163 ! superficial reservoir (group RESVR):
164 ! - there is a skin surface temperature (Ts) which is the temperature at the
165 ! interface surface/superficial reservoir (and not two separate quantities
166 ! for superficial reservoir and surface)
167 ! - there is a skin surface water content (denoted by Wl) and a superficial
168 ! reservoir water content (denoted by Ws).
169 ! - there is a superficial reservoir ice content but no surface ice content.
170 ! (remark k.y.: it would have been more logical to use group name
171 ! RESVR for internal reservoirs and group name SOILB for surface!).
172 TYPE TYPE_SFL_RESVR
173 TYPE(TYPE_SURF_MTL_2D),POINTER :: YT ! skin temperature (Ts)
174 TYPE(TYPE_SURF_MTL_2D),POINTER :: YW ! skin water content (Wskin) at ECMWF
175 ! superficial reservoir water content (Ws) at MF
176 TYPE(TYPE_SURF_MTL_2D),POINTER :: YFC ! skin water content (Wl) at MF
177 TYPE(TYPE_SURF_MTL_2D),POINTER :: YIC ! superficial reservoir ice
178 TYPE(TYPE_SURF_MTL_2D),POINTER :: YFP1 ! interpolated Ts for 2nd part of 927-FULLPOS
179 TYPE(TYPE_SURF_MTL_2D),POINTER :: YRR(:)
180 END TYPE TYPE_SFL_RESVR
181
182 ! * Group WS=WAVES: surface prognostic quantities over sea:
183 TYPE TYPE_SFL_WAVES
184 TYPE(TYPE_SURF_MTL_2D),POINTER :: YWS(:)
185 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCHAR ! Charnock constant
186 END TYPE TYPE_SFL_WAVES
187
188 ! * Group EP=EXTRP: extra 3-d prognostic fields:
189 TYPE TYPE_SFL_EXTRP
190 TYPE(TYPE_SURF_MTL_3D),POINTER :: YEP(:)
191 END TYPE TYPE_SFL_EXTRP
192
193 ! * Group X2=XTRP2: extra 2-d prognostic fields:
194 ! (is used for precipitation fields in CANARI)
195 TYPE TYPE_SFL_XTRP2
196 TYPE(TYPE_SURF_MTL_2D),POINTER :: YX2(:)
197 END TYPE TYPE_SFL_XTRP2
198
199 ! * Group CI=CANRI: 2-d prognostic fields for CANARI:
200 TYPE TYPE_SFL_CANRI
201 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCI(:)
202 END TYPE TYPE_SFL_CANRI
203
204 ! * Group VF=VARSF: climatological/geographical diagnostic fields:
205 TYPE TYPE_SFL_VARSF
206 TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0F ! gravity * surface roughness length
207 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALBF ! surface shortwave albedo
208 TYPE(TYPE_SURF_MTL_2D),POINTER :: YEMISF ! surface longwave emissivity
209 TYPE(TYPE_SURF_MTL_2D),POINTER :: YGETRL ! standard deviation of orography
210 TYPE(TYPE_SURF_MTL_2D),POINTER :: YITM ! land-sea mask
211 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVEG ! vegetation cover
212 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVRLAN ! anisotropy of the sub-grid scale orography
213 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVRLDI ! angle of the direction of orography with the x axis
214 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSIG ! characteristic orographic slope
215 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALBSF ! soil shortwave albedo
216 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCONT ! fraction of land
217 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSST ! (open) sea surface temperature
218 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLZ0H ! logarithm of roughness length for heat
219 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCVL ! low vegetation cover
220 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCVH ! high vegetation cover
221 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTVL ! low vegetation type
222 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTVH ! high vegetation type
223 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCI ! sea ice fraction
224 TYPE(TYPE_SURF_MTL_2D),POINTER :: YUCUR ! U-component of the ocean current
225 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVCUR ! V-component of the ocean current
226 TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0RLF ! gravity * vegetation roughness length
227 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCO2O ! oceanic CO2 flux
228 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCO2B ! biosphere CO2 flux
229 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCO2A ! anthropogenic CO2 flux
230 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSDFOR ! SD filtered orography
231 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALUVP ! MODIS-derived parallel albedo for shortwave radiation
232 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALUVD ! MODIS-derived diffuse albedo for shortwave radiation
233 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALNIP ! MODIS-derived parallel albedo for longwave radiation
234 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALNID ! MODIS-derived diffuse albedo for longwave radiation
235 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSF6 ! anthropogenic SF6 flux
236 TYPE(TYPE_SURF_MTL_2D),POINTER :: YFP1 ! surface orography in the 2nd part of FULLPOS-927
237 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVF(:)
238 END TYPE TYPE_SFL_VARSF
239
240 ! * Group VP=VCLIP: deep soil diagnostic fields:
241 TYPE TYPE_SFL_VCLIP
242 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTPC ! climatological deep layer temperature
243 TYPE(TYPE_SURF_MTL_2D),POINTER :: YWPC ! climatological deep layer moisture
244 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVP(:)
245 END TYPE TYPE_SFL_VCLIP
246
247 ! * Group VV=VCLIV: vegetation diagnostic fields:
248 TYPE TYPE_SFL_VCLIV
249 TYPE(TYPE_SURF_MTL_2D),POINTER :: YARG ! silt percentage within soil
250 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSAB ! percentage of sand within the soil
251 TYPE(TYPE_SURF_MTL_2D),POINTER :: YD2 ! soil depth
252 TYPE(TYPE_SURF_MTL_2D),POINTER :: YIVEG ! type of vegetation
253 TYPE(TYPE_SURF_MTL_2D),POINTER :: YRSMIN ! stomatal minimum resistance
254 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLAI ! leaf area index
255 TYPE(TYPE_SURF_MTL_2D),POINTER :: YHV ! resistance to evapotranspiration
256 TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0H ! gravity * roughness length for heat
257 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALS ! albedo of bare ground
258 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALV ! albedo of vegetation
259 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVV(:)
260 END TYPE TYPE_SFL_VCLIV
261
262 ! * Group VN=VCLIN: cloudiness diagnostic predictors:
263 TYPE TYPE_SFL_VCLIN
264 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTOP ! index of convective cloud top
265 TYPE(TYPE_SURF_MTL_2D),POINTER :: YBAS ! index of convective cloud base
266 TYPE(TYPE_SURF_MTL_2D),POINTER :: YACPR ! averaged convective precipitaion rate
267 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVN(:)
268 END TYPE TYPE_SFL_VCLIN
269
270 ! * Group VH=VCLIH: convective cloud diagnostic fields:
271 TYPE TYPE_SFL_VCLIH
272 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCCH ! total convective cloudiness
273 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSCCH ! convective cloud summit
274 TYPE(TYPE_SURF_MTL_2D),POINTER :: YBCCH ! convective cloud base
275 TYPE(TYPE_SURF_MTL_2D),POINTER :: YPBLH ! PBL height
276 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSPSH ! variable for prognostic convection scheme (ALARO)
277 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVH(:)
278 END TYPE TYPE_SFL_VCLIH
279
280 ! * Group VA=VCLIA: aerosol diagnostic fields:
281 TYPE TYPE_SFL_VCLIA
282 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSEA ! aerosol: sea
283 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLAN ! aerosol: land
284 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSOO ! aerosol: soot
285 TYPE(TYPE_SURF_MTL_2D),POINTER :: YDES ! aerosol: desert
286 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSUL ! aerosol: sulfate
287 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVOL ! aerosol: volcano
288 TYPE(TYPE_SURF_MTL_2D),POINTER :: YNUD ! aerosol: nudging
289 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVA(:)
290 END TYPE TYPE_SFL_VCLIA
291
292 ! * Group VG=VCLIG: ice-coupler diagnostic fields:
293 TYPE TYPE_SFL_VCLIG
294 TYPE(TYPE_SURF_MTL_2D),POINTER :: YICFR ! sea-ice fraction
295 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSOUP ! upward solar flux over sea-ice
296 TYPE(TYPE_SURF_MTL_2D),POINTER :: YIRUP ! upward IR flux over sea-ice
297 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCHSS ! sensible heat over sea-ice
298 TYPE(TYPE_SURF_MTL_2D),POINTER :: YEVAP ! evaporation over sea-ice
299 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTAUX ! U-component of stress over sea-ice
300 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTAUY ! V-component of stress over sea-ice
301 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVG(:)
302 END TYPE TYPE_SFL_VCLIG
303
304 ! * Group VC=VO3ABC: A,B and C (Climatological ozone profiles) diagnostic fields:
305 TYPE TYPE_SFL_VO3ABC
306 TYPE(TYPE_SURF_MTL_2D),POINTER :: YA ! A climatological ozone profile
307 TYPE(TYPE_SURF_MTL_2D),POINTER :: YB ! B climatological ozone profile
308 TYPE(TYPE_SURF_MTL_2D),POINTER :: YC ! C climatological ozone profile
309 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVC(:)
310 END TYPE TYPE_SFL_VO3ABC
311
312 ! * Group VD=VDIAG: (ECMWF) diagnostic fields:
313 TYPE TYPE_SFL_VDIAG
314 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSP !Large scale precipitation
315 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCP !Convective precipitation
316 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSF !Snowfall
317 TYPE(TYPE_SURF_MTL_2D),POINTER :: YBLD !Boundary layer dissipation
318 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSHF !Surface sensible heat flux
319 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSLHF !Surface latent heat flux
320 TYPE(TYPE_SURF_MTL_2D),POINTER :: YMSL !Mean sea level pressure
321 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCC !Total cloud cover
322 TYPE(TYPE_SURF_MTL_2D),POINTER :: Y10U !U-wind at 10 m
323 TYPE(TYPE_SURF_MTL_2D),POINTER :: Y10V !V-wind at 10 m
324 TYPE(TYPE_SURF_MTL_2D),POINTER :: Y2T !Temperature at 2 m
325 TYPE(TYPE_SURF_MTL_2D),POINTER :: Y2D !Dewpoint temperature at 2 m
326 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSR !Surface solar radiation
327 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTR !Surface thermal radiation
328 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTSR !Top solar radiation
329 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTTR !Top thermal radiation
330 TYPE(TYPE_SURF_MTL_2D),POINTER :: YEWSS !Instantaneous surface U-wind stress
331 TYPE(TYPE_SURF_MTL_2D),POINTER :: YNSSS !Instantaneous surface V-wind stress
332 TYPE(TYPE_SURF_MTL_2D),POINTER :: YE !Water evaporation
333 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCCC !Convective cloud cover
334 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLCC !Low cloud cover
335 TYPE(TYPE_SURF_MTL_2D),POINTER :: YMCC !Medium cloud cover
336 TYPE(TYPE_SURF_MTL_2D),POINTER :: YHCC !High cloud cover
337 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLGWS !Zonal gravity wave stress
338 TYPE(TYPE_SURF_MTL_2D),POINTER :: YMGWS !Meridian gravity wave stress
339 TYPE(TYPE_SURF_MTL_2D),POINTER :: YGWD !Gravity wave dissipation
340 TYPE(TYPE_SURF_MTL_2D),POINTER :: YMX2T !Maximum temperature at 2 m
341 TYPE(TYPE_SURF_MTL_2D),POINTER :: YMN2T !Minimum temperature at 2 m
342 TYPE(TYPE_SURF_MTL_2D),POINTER :: YRO !Runoff
343 TYPE(TYPE_SURF_MTL_2D),POINTER :: YALB !(surface shortwave) albedo
344 TYPE(TYPE_SURF_MTL_2D),POINTER :: YIEWSS !Instantaneous surface zonal component of stress
345 TYPE(TYPE_SURF_MTL_2D),POINTER :: YINSSS !Instantaneous surface meridian component of stress
346 TYPE(TYPE_SURF_MTL_2D),POINTER :: YISSHF !Instantaneous surface heat flux
347 TYPE(TYPE_SURF_MTL_2D),POINTER :: YIE !Instantaneous surface moisture flux
348 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCSF !Convective snow fall
349 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSSF !Large scale snowfall
350 TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0F !Gravity * surface roughness length
351 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLZ0H !Logarithm of z0 times heat flux
352 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCW !Total water content in a vertical column
353 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCWV !Total water vapor content in a vertical column
354 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCLW !Total liquid water content in a vertical column
355 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCIW !Total ice water content in a vertical column
356 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSRD !Downward surface solar radiation
357 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTRD !Downward surface thermic radiation
358 TYPE(TYPE_SURF_MTL_2D),POINTER :: YBLH !Height of boundary layer
359 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSUND !Sunshine duration
360 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSPAR !Surface downward PARadiation
361 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSUVB !Surface downward UV-B radiation
362 TYPE(TYPE_SURF_MTL_2D),POINTER :: YCAPE !Conv.avail.potential energy (CAPE)
363 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTSRC !Top solar radiation clear sky
364 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTTRC !Top thermal radiation clear sky
365 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSRC !Surface solar radiation clear sky
366 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTRC !Surface thermal radiation clear sky
367 TYPE(TYPE_SURF_MTL_2D),POINTER :: YES !Evaporation of snow
368 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSMLT !Snow melt
369 TYPE(TYPE_SURF_MTL_2D),POINTER :: Y10FG !Wind gust at 10 m (max since previous pp)
370 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSPF !Large scale precipitation fraction
371 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCO3 !Total ozone content in a vertical column
372 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVIMD !Vertically integrated mass divergence
373 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSPARC !Surface clear-sky parallel radiation
374 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTINC !TOA (top of atmosph?) incident solar radiation
375 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCGHG(:) !Total column greenhouse gases
376 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCGRG(:) !Total column reactive gases
377 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCTRAC(:) !Total column tracers
378 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVD(:)
379 END TYPE TYPE_SFL_VDIAG
380
381 ! * Group VX=VCLIX: auxilary climatological diagnostic fields:
382 TYPE TYPE_SFL_VCLIX
383 TYPE(TYPE_SURF_MTL_2D),POINTER :: YORO ! climatological surface geopotential
384 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTSC ! climatological surface temperature
385 TYPE(TYPE_SURF_MTL_2D),POINTER :: YPWS ! climatological surface max. prop. moisture
386 TYPE(TYPE_SURF_MTL_2D),POINTER :: YPWP ! climatological deep soil max. prop. moisture
387 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSNO ! climatological snow cover
388 TYPE(TYPE_SURF_MTL_2D),POINTER :: YTPC ! climatological deep soil temperature
389 TYPE(TYPE_SURF_MTL_2D),POINTER :: YSAB ! climatologic percentage of sand within the soil
390 TYPE(TYPE_SURF_MTL_2D),POINTER :: YXD2 ! climatologic soil depth
391 TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSM ! climatologic land sea mask
392 TYPE(TYPE_SURF_MTL_2D),POINTER :: YIVEG ! climatologic type of vegetation
393 TYPE(TYPE_SURF_MTL_2D),POINTER :: YVX(:)
394 END TYPE TYPE_SFL_VCLIX
395
396 ! * Group XA=VEXTRA: extra 3-d diagnostic fields:
397 TYPE TYPE_SFL_VEXTRA
398 TYPE(TYPE_SURF_MTL_3D),POINTER :: YXA(:)
399 END TYPE TYPE_SFL_VEXTRA
400
401 ! * Group X2=VEXTR2: extra 2-d diagnostic fields:
402 TYPE TYPE_SFL_VEXTR2
403 TYPE(TYPE_SURF_MTL_2D),POINTER :: YX2(:)
404 END TYPE TYPE_SFL_VEXTR2
405
406 ! End of type definitions
407
408 ! Data structures
409
410 ! Prognostic (multi time level) fields
411
412 ! Soilb
413 REAL(KIND=JPRB),ALLOCATABLE :: SP_SB (:,:,:,:)
414 TYPE(TYPE_SURF_GEN) :: YSP_SBD
415 TYPE(TYPE_SFL_SOILB) :: YSP_SB
416
417 ! Snowg
418 REAL(KIND=JPRB),ALLOCATABLE :: SP_SG (:,:,:)
419 TYPE(TYPE_SURF_GEN) :: YSP_SGD
420 TYPE(TYPE_SFL_SNOWG) :: YSP_SG
421
422 ! Resvr
423 REAL(KIND=JPRB),ALLOCATABLE :: SP_RR (:,:,:)
424 TYPE(TYPE_SURF_GEN) :: YSP_RRD
425 TYPE(TYPE_SFL_RESVR) :: YSP_RR
426
427
428 ! Extrp
429 REAL(KIND=JPRB),ALLOCATABLE :: SP_EP (:,:,:,:)
430 TYPE(TYPE_SURF_GEN) :: YSP_EPD
431 TYPE(TYPE_SFL_EXTRP) :: YSP_EP
432
433 ! Xtrp2
434 REAL(KIND=JPRB),ALLOCATABLE :: SP_X2 (:,:,:)
435 TYPE(TYPE_SURF_GEN) :: YSP_X2D
436 TYPE(TYPE_SFL_XTRP2) :: YSP_X2
437
438 ! Canri
439 REAL(KIND=JPRB),ALLOCATABLE :: SP_CI (:,:,:)
440 TYPE(TYPE_SURF_GEN) :: YSP_CID
441 TYPE(TYPE_SFL_CANRI) :: YSP_CI
442
443 ! One time level fields
444
445 ! Varsf
446 REAL(KIND=JPRB),ALLOCATABLE :: SD_VF (:,:,:)
447 TYPE(TYPE_SURF_GEN) :: YSD_VFD
448 TYPE(TYPE_SFL_VARSF) :: YSD_VF
449
450 ! Vclip
451 REAL(KIND=JPRB),ALLOCATABLE :: SD_VP (:,:,:)
452 TYPE(TYPE_SURF_GEN) :: YSD_VPD
453 TYPE(TYPE_SFL_VCLIP) :: YSD_VP
454
455 ! Vcliv
456 REAL(KIND=JPRB),ALLOCATABLE :: SD_VV (:,:,:)
457 TYPE(TYPE_SURF_GEN) :: YSD_VVD
458 TYPE(TYPE_SFL_VCLIV) :: YSD_VV
459
460 ! Vclin
461 REAL(KIND=JPRB),ALLOCATABLE :: SD_VN (:,:,:)
462 TYPE(TYPE_SURF_GEN) :: YSD_VND
463 TYPE(TYPE_SFL_VCLIN) :: YSD_VN
464
465 ! Vclih
466 REAL(KIND=JPRB),ALLOCATABLE :: SD_VH (:,:,:)
467 TYPE(TYPE_SURF_GEN) :: YSD_VHD
468 TYPE(TYPE_SFL_VCLIH) :: YSD_VH
469
470 ! Vclia
471 REAL(KIND=JPRB),ALLOCATABLE :: SD_VA (:,:,:)
472 TYPE(TYPE_SURF_GEN) :: YSD_VAD
473 TYPE(TYPE_SFL_VCLIA) :: YSD_VA
474
475 ! Vo3abc
476 REAL(KIND=JPRB),ALLOCATABLE :: SD_VC (:,:,:)
477 TYPE(TYPE_SURF_GEN) :: YSD_VCD
478 TYPE(TYPE_SFL_VO3ABC) :: YSD_VC
479
480 ! Vdiag
481 REAL(KIND=JPRB),ALLOCATABLE :: SD_VD (:,:,:)
482 TYPE(TYPE_SURF_GEN) :: YSD_VDD
483 TYPE(TYPE_SFL_VDIAG) :: YSD_VD
484
485 ! Waves
486 REAL(KIND=JPRB),ALLOCATABLE :: SD_WS (:,:,:)
487 TYPE(TYPE_SURF_GEN) :: YSD_WSD
488 TYPE(TYPE_SFL_WAVES) :: YSD_WS
489
490 ! Vclix
491 REAL(KIND=JPRB),ALLOCATABLE :: SD_VX (:,:,:)
492 TYPE(TYPE_SURF_GEN) :: YSD_VXD
493 TYPE(TYPE_SFL_VCLIX) :: YSD_VX
494
495 ! Vextra
496
497 REAL(KIND=JPRB),ALLOCATABLE :: SD_XA (:,:,:,:)
498 TYPE(TYPE_SURF_GEN) :: YSD_XAD
499 TYPE(TYPE_SFL_VEXTRA) :: YSD_XA
500
501 ! Vextr2
502
503 REAL(KIND=JPRB),ALLOCATABLE :: SD_X2 (:,:,:)
504 TYPE(TYPE_SURF_GEN) :: YSD_X2D
505 TYPE(TYPE_SFL_VEXTR2) :: YSD_X2
506
507 !$OMP THREADPRIVATE(ndimsurf,ndimsurfl,nofftraj,nofftraj_cst,nprogsurf)
508 !$OMP THREADPRIVATE(nprogsurfl,nptrsurf,nstrajgrib,nsurf,nsurfl,ysd_va,ysd_vad)
509 !$OMP THREADPRIVATE(ysd_vc,ysd_vcd,ysd_vd,ysd_vdd,ysd_vf,ysd_vfd,ysd_vh,ysd_vhd)
510 !$OMP THREADPRIVATE(ysd_vn,ysd_vnd,ysd_vp,ysd_vpd,ysd_vv,ysd_vvd,ysd_vx,ysd_vxd)
511 !$OMP THREADPRIVATE(ysd_ws,ysd_wsd,ysd_x2,ysd_x2d,ysd_xa,ysd_xad,ysp_ci,ysp_cid)
512 !$OMP THREADPRIVATE(ysp_ep,ysp_epd,ysp_rr,ysp_rrd,ysp_sb,ysp_sbd,ysp_sg,ysp_sgd)
513 !$OMP THREADPRIVATE(ysp_x2,ysp_x2d)
514
515 !$OMP THREADPRIVATE(sd_va,sd_vc,sd_vd,sd_vf,sd_vh,sd_vn,sd_vp,sd_vv,sd_vx,sd_ws)
516 !$OMP THREADPRIVATE(sd_x2,sd_xa,sp_ci,sp_ep,sp_rr,sp_sb,sp_sg,sp_x2,surf_store_array)
517
518
519 !-------------------------------------------------------------------------
520
521 CONTAINS
522
523 !=========================================================================
524
525 SUBROUTINE INI_SFLP3(YDSC,YD,KFLDS,KLEVS,LDMTL,CDGRPNAME)
526 ! Initialize 3-D surface field group
527 TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
528 TYPE(TYPE_SURF_MTL_3D),INTENT(INOUT) :: YD(:)
529 INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS
530 INTEGER(KIND=JPIM),INTENT(IN) :: KLEVS
531 LOGICAL,INTENT(IN) :: LDMTL
532 CHARACTER(LEN=*),INTENT(IN) :: CDGRPNAME
533
534 INTEGER(KIND=JPIM) :: JFLD, IMAXF
535 REAL(KIND=JPRB) :: ZHOOK_HANDLE
536
537 !-------------------------------------------------------------------------
538
539 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP3',0,ZHOOK_HANDLE)
540
541 IMAXF = SIZE(YD)
542 YDSC%NUMFLDS = KFLDS
543 YDSC%NLEVS = KLEVS
544 YDSC%IPTR = 1
545 YDSC%LMTL = LDMTL
546 YDSC%CGRPNAME = CDGRPNAME
547 YDSC%NDIM5 = 0
548 YDSC%NOFFTRAJ = NOFFTRAJ
549 YDSC%NOFFTRAJ_CST = NOFFTRAJ_CST
550
551 NSURF = NSURF+YDSC%NUMFLDS
552 NSURFL = NSURFL+YDSC%NUMFLDS*YDSC%NLEVS
553 IF(LDMTL) THEN
554 NPROGSURF = NPROGSURF+YDSC%NUMFLDS
555 NPROGSURFL = NPROGSURFL+YDSC%NUMFLDS*YDSC%NLEVS
556 ENDIF
557
558 IF(LDMTL) THEN
559 IF (LTWOTL) THEN
560 YDSC%NDIM = 2*YDSC%NUMFLDS
561 ELSE
562 YDSC%NDIM = 3*YDSC%NUMFLDS
563 ENDIF
564 ELSE
565 YDSC%NDIM = YDSC%NUMFLDS
566 ENDIF
567 NDIMSURF = NDIMSURF + YDSC%NDIM
568 NDIMSURFL = NDIMSURFL + YDSC%NDIM*YDSC%NLEVS
569
570 DO JFLD=1,KFLDS
571 ALLOCATE(YD(JFLD)%IGRBCODE(KLEVS))
572 ALLOCATE(YD(JFLD)%CNAME(KLEVS))
573 ALLOCATE(YD(JFLD)%REFVALI(KLEVS))
574 ALLOCATE(YD(JFLD)%NREQIN(KLEVS))
575 YD(JFLD)%IGRBCODE(:) = -999
576 YD(JFLD)%CNAME(:) = ''
577 YD(JFLD)%REFVALI(:) = 0.0_JPRB
578 YD(JFLD)%NREQIN(:) = -1
579 YD(JFLD)%MP = JFLD
580 IF (YDSC%LMTL) THEN
581 YD(JFLD)%MP0 = YD(JFLD)%MP
582 IF(LTWOTL) THEN
583 YD(JFLD)%MP9 = YD(JFLD)%MP0
584 YD(JFLD)%MP1 = YD(JFLD)%MP0+YDSC%NUMFLDS
585 ELSE
586 YD(JFLD)%MP9 = YD(JFLD)%MP0+YDSC%NUMFLDS
587 YD(JFLD)%MP1 = YD(JFLD)%MP0+2*YDSC%NUMFLDS
588 ENDIF
589 ELSE
590 YD(JFLD)%MP0 = NUNDEFLD
591 YD(JFLD)%MP9 = NUNDEFLD
592 YD(JFLD)%MP1 = NUNDEFLD
593 ENDIF
594 YD(JFLD)%MP5 = NUNDEFLD
595 YD(JFLD)%ITRAJ = 0
596 ENDDO
597
598 DO JFLD=KFLDS+1,IMAXF
599 YD(JFLD)%MP = NUNDEFLD
600 YD(JFLD)%MP0 = NUNDEFLD
601 YD(JFLD)%MP9 = NUNDEFLD
602 YD(JFLD)%MP1 = NUNDEFLD
603 YD(JFLD)%MP5 = NUNDEFLD
604 YD(JFLD)%ITRAJ = 0
605 ENDDO
606
607 WRITE(NULOUT,*) 'INITIALIZING 3-D SURFACE FIELD GROUP ', YDSC%CGRPNAME
608 WRITE(NULOUT,*) 'NUMFLDS=',YDSC%NUMFLDS,' NLEVS=',YDSC%NLEVS,' LMTL=',YDSC%LMTL
609
610 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP3',1,ZHOOK_HANDLE)
611 END SUBROUTINE INI_SFLP3
612
613 !=========================================================================
614
615 SUBROUTINE SETUP_SFLP3(YDSC,YD,KGRIB,CDNAME,PDEFAULT,KTRAJ,KREQIN)
616 ! Setup 3-D surface field
617 TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
618 TYPE(TYPE_SURF_MTL_3D),INTENT(INOUT) :: YD
619 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB(:)
620 CHARACTER(LEN=16) ,OPTIONAL,INTENT(IN) :: CDNAME(:)
621 REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PDEFAULT(:)
622 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTRAJ
623 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREQIN(:)
624
625 INTEGER(KIND=JPIM) :: IPTR,JLEV
626 REAL(KIND=JPRB) :: ZHOOK_HANDLE
627
628 !-------------------------------------------------------------------------
629
630 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP3',0,ZHOOK_HANDLE)
631 IPTR = YDSC%IPTR
632 IF(IPTR > YDSC%NUMFLDS) THEN
633 WRITE(NULERR,*) 'SURFACE FIELDS UNDER-DIMENSINED - GROUP ',&
634 & YDSC%CGRPNAME,YDSC%NUMFLDS,KGRIB(1),CDNAME(1)
635 CALL ABOR1('IPTR > YDSC%NUMFLDS')
636 ENDIF
637 IF(PRESENT(KGRIB)) THEN
638 YD%IGRBCODE(:) = KGRIB(:)
639 ENDIF
640 IF(PRESENT(KREQIN)) THEN
641 YD%NREQIN(:) = KREQIN(:)
642 ENDIF
643 IF(PRESENT(CDNAME)) THEN
644 YD%CNAME(:) = CDNAME(:)
645 ENDIF
646 IF(PRESENT(PDEFAULT)) THEN
647 YD%REFVALI(:) = PDEFAULT
648 ENDIF
649 IF(PRESENT(KTRAJ)) THEN
650 IF(KTRAJ == 1) THEN
651 DO JLEV=1,YDSC%NLEVS
652 NSTRAJGRIB(NOFFTRAJ+JLEV) = YD%IGRBCODE(JLEV)
653 ENDDO
654 NOFFTRAJ = NOFFTRAJ+YDSC%NLEVS
655 ELSEIF(KTRAJ == 2) THEN
656 NOFFTRAJ_CST = NOFFTRAJ_CST+YDSC%NLEVS
657 ELSEIF(KTRAJ /= 0) THEN
658 CALL ABOR1('SURFACE_FIELDS:SETUP_SFLP3 - UNKNOWN KTRAJ')
659 ENDIF
660 YD%ITRAJ = KTRAJ
661 YDSC%NDIM5 = YDSC%NDIM5+1
662 YD%MP5 = YDSC%NDIM5
663 ENDIF
664 DO JLEV=1,YDSC%NLEVS
665 IF(YDSC%LMTL) THEN
666 WRITE(NULOUT,'(1X,A,2I4,1X,A,6I4)') &
667 & YDSC%CGRPNAME(1:6),YDSC%IPTR,JLEV,YD%CNAME(JLEV),YD%IGRBCODE(JLEV),&
668 & YD%MP0,YD%MP9,YD%MP1,YD%ITRAJ,YD%NREQIN(JLEV)
669 ELSE
670 WRITE(NULOUT,'(1X,A,2I4,1X,A,4I4)') &
671 & YDSC%CGRPNAME(1:6),YDSC%IPTR,JLEV,YD%CNAME(JLEV),YD%IGRBCODE(JLEV),&
672 & YD%MP,YD%ITRAJ,YD%NREQIN(JLEV)
673 ENDIF
674 ENDDO
675 YDSC%IPTR = YDSC%IPTR+1
676
677 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP3',1,ZHOOK_HANDLE)
678 END SUBROUTINE SETUP_SFLP3
679
680 !=========================================================================
681
682 SUBROUTINE INI_SFLP2(YDSC,YD,KFLDS,LDMTL,CDGRPNAME)
683 ! Initialize 2-D surface field group
684 TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
685 TYPE(TYPE_SURF_MTL_2D),INTENT(INOUT) :: YD(:)
686 INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS
687 LOGICAL,INTENT(IN) :: LDMTL
688 CHARACTER(LEN=*),INTENT(IN) :: CDGRPNAME
689
690 INTEGER(KIND=JPIM) :: JFLD, IMAXF
691 REAL(KIND=JPRB) :: ZHOOK_HANDLE
692
693 !-------------------------------------------------------------------------
694
695 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP2',0,ZHOOK_HANDLE)
696
697 IMAXF = SIZE(YD)
698 YDSC%NUMFLDS = KFLDS
699 YDSC%NLEVS = -1
700 YDSC%IPTR = 1
701 YDSC%LMTL = LDMTL
702 YDSC%CGRPNAME = CDGRPNAME
703 YDSC%NDIM5 = 0
704 YDSC%NOFFTRAJ = NOFFTRAJ
705 YDSC%NOFFTRAJ_CST = NOFFTRAJ_CST
706
707 NSURF = NSURF+YDSC%NUMFLDS
708 NSURFL = NSURFL+YDSC%NUMFLDS
709 IF(LDMTL) THEN
710 NPROGSURF = NPROGSURF+YDSC%NUMFLDS
711 NPROGSURFL = NPROGSURFL+YDSC%NUMFLDS
712 ENDIF
713
714 IF(LDMTL) THEN
715 IF (LTWOTL) THEN
716 YDSC%NDIM = 2*YDSC%NUMFLDS
717 ELSE
718 YDSC%NDIM = 3*YDSC%NUMFLDS
719 ENDIF
720 ELSE
721 YDSC%NDIM = YDSC%NUMFLDS
722 ENDIF
723 NDIMSURF = NDIMSURF + YDSC%NDIM
724 NDIMSURFL = NDIMSURFL + YDSC%NDIM
725 DO JFLD=1,KFLDS
726 YD(JFLD)%IGRBCODE = -999
727 YD(JFLD)%CNAME = ''
728 YD(JFLD)%REFVALI = 0.0_JPRB
729 YD(JFLD)%NREQIN = -1
730 YD(JFLD)%MP = JFLD
731 IF (YDSC%LMTL) THEN
732 YD(JFLD)%MP0 = YD(JFLD)%MP
733 IF(LTWOTL) THEN
734 YD(JFLD)%MP9 = YD(JFLD)%MP0
735 YD(JFLD)%MP1 = YD(JFLD)%MP0+YDSC%NUMFLDS
736 ELSE
737 YD(JFLD)%MP9 = YD(JFLD)%MP0+YDSC%NUMFLDS
738 YD(JFLD)%MP1 = YD(JFLD)%MP0+2*YDSC%NUMFLDS
739 ENDIF
740 ELSE
741 YD(JFLD)%MP0 = NUNDEFLD
742 YD(JFLD)%MP9 = NUNDEFLD
743 YD(JFLD)%MP1 = NUNDEFLD
744 ENDIF
745 YD(JFLD)%MP5 = NUNDEFLD
746 YD(JFLD)%ITRAJ = 0
747 ENDDO
748
749 DO JFLD=KFLDS+1,IMAXF
750 YD(JFLD)%MP = NUNDEFLD
751 YD(JFLD)%MP0 = NUNDEFLD
752 YD(JFLD)%MP9 = NUNDEFLD
753 YD(JFLD)%MP1 = NUNDEFLD
754 YD(JFLD)%MP5 = NUNDEFLD
755 YD(JFLD)%ITRAJ = 0
756 ENDDO
757
758 WRITE(NULOUT,*) 'INITIALIZING 2-D SURFACE FIELD GROUP ', YDSC%CGRPNAME
759 WRITE(NULOUT,*) 'NUMFLDS=',YDSC%NUMFLDS,' LMTL=',YDSC%LMTL
760
761 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP2',1,ZHOOK_HANDLE)
762 END SUBROUTINE INI_SFLP2
763
764 !=========================================================================
765
766 SUBROUTINE SETUP_SFLP2(YDSC,YD,KGRIB,CDNAME,PDEFAULT,KTRAJ,KREQIN)
767 ! Setup 2-D surface field
768 TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
769 TYPE(TYPE_SURF_MTL_2D),INTENT(INOUT) :: YD
770 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB
771 CHARACTER(LEN=16) ,OPTIONAL,INTENT(IN) :: CDNAME
772 REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PDEFAULT
773 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTRAJ
774 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREQIN
775
776 INTEGER(KIND=JPIM) :: IPTR
777 REAL(KIND=JPRB) :: ZHOOK_HANDLE
778
779 !-------------------------------------------------------------------------
780
781 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP2',0,ZHOOK_HANDLE)
782 IPTR = YDSC%IPTR
783 IF(IPTR > YDSC%NUMFLDS) THEN
784 WRITE(NULERR,*) 'SURFACE FIELDS UNDER-DIMENSINED - GROUP ',YDSC%CGRPNAME,YDSC%NUMFLDS,KGRIB,CDNAME
785 CALL ABOR1('IPTR > YDSC%NUMFLDS')
786 ENDIF
787 IF(PRESENT(KGRIB)) THEN
788 YD%IGRBCODE = KGRIB
789 ENDIF
790 IF(PRESENT(KREQIN)) THEN
791 YD%NREQIN = KREQIN
792 ENDIF
793 IF(PRESENT(CDNAME)) THEN
794 YD%CNAME = CDNAME
795 ENDIF
796 IF(PRESENT(PDEFAULT)) THEN
797 YD%REFVALI = PDEFAULT
798 ENDIF
799 IF(PRESENT(KTRAJ)) THEN
800 IF(KTRAJ == 1) THEN
801 NSTRAJGRIB(NOFFTRAJ+1) = YD%IGRBCODE
802 NOFFTRAJ = NOFFTRAJ+1
803 ELSEIF(KTRAJ == 2) THEN
804 NOFFTRAJ_CST = NOFFTRAJ_CST+1
805 ELSEIF(KTRAJ /= 0) THEN
806 CALL ABOR1('SURFACE_FIELDS:SETUP_SFLP2 - UNKNOWN KTRAJ')
807 ENDIF
808 YD%ITRAJ = KTRAJ
809 YDSC%NDIM5 = YDSC%NDIM5+1
810 YD%MP5 = YDSC%NDIM5
811 ENDIF
812 IF(YDSC%LMTL) THEN
813 WRITE(NULOUT,'(1X,A,I4,1X,A,6I4)') &
814 & YDSC%CGRPNAME(1:6),YDSC%IPTR,YD%CNAME,YD%IGRBCODE,&
815 & YD%MP0,YD%MP9,YD%MP1,YD%ITRAJ,YD%NREQIN
816 ELSE
817 WRITE(NULOUT,'(1X,A,I4,1X,A,4I4)') &
818 & YDSC%CGRPNAME(1:6),YDSC%IPTR,YD%CNAME,YD%IGRBCODE,YD%MP,YD%ITRAJ,YD%NREQIN
819 ENDIF
820
821 YDSC%IPTR = YDSC%IPTR+1
822 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP2',1,ZHOOK_HANDLE)
823 END SUBROUTINE SETUP_SFLP2
824
825 !=========================================================================
826
827 SUBROUTINE GPPOPER(CDACT,KBL,PSP_SB,PSP_SG,PSP_RR,PSP_EP,PSP_X2,YDCOM)
828 ! Operations on prognostic surface fields
829 CHARACTER(LEN=*),INTENT(IN) :: CDACT
830 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBL
831 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SB(:,:,:)
832 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SG(:,:)
833 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_RR(:,:)
834 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_EP(:,:,:)
835 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_X2(:,:)
836 TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
837
838
839 REAL(KIND=JPRB) :: ZHOOK_HANDLE
840
841 !-------------------------------------------------------------------------
842
843 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPPOPER',0,ZHOOK_HANDLE)
844 IF(PRESENT(KBL)) THEN
845 CALL GPOPER_3(CDACT,SP_SB(:,:,:,KBL),YSP_SBD,YSP_SB%YSB,YDCOM)
846 CALL GPOPER_2(CDACT,SP_SG(:,:,KBL) ,YSP_SGD,YSP_SG%YSG,YDCOM)
847 CALL GPOPER_2(CDACT,SP_RR(:,:,KBL) ,YSP_RRD,YSP_RR%YRR,YDCOM)
848 CALL GPOPER_3(CDACT,SP_EP(:,:,:,KBL),YSP_EPD,YSP_EP%YEP,YDCOM)
849 CALL GPOPER_2(CDACT,SP_X2(:,:,KBL) ,YSP_X2D,YSP_X2%YX2,YDCOM)
850 ELSE
851 IF(PRESENT(PSP_SB)) CALL GPOPER_3(CDACT,PSP_SB(:,:,:),YSP_SBD,YSP_SB%YSB,YDCOM)
852 IF(PRESENT(PSP_SG)) CALL GPOPER_2(CDACT,PSP_SG(:,:) ,YSP_SGD,YSP_SG%YSG,YDCOM)
853 IF(PRESENT(PSP_RR)) CALL GPOPER_2(CDACT,PSP_RR(:,:) ,YSP_RRD,YSP_RR%YRR,YDCOM)
854 IF(PRESENT(PSP_EP)) CALL GPOPER_3(CDACT,PSP_EP(:,:,:),YSP_EPD,YSP_EP%YEP,YDCOM)
855 IF(PRESENT(PSP_X2)) CALL GPOPER_2(CDACT,PSP_X2(:,:) ,YSP_X2D,YSP_X2%YX2,YDCOM)
856 ENDIF
857 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPPOPER',1,ZHOOK_HANDLE)
858 END SUBROUTINE GPPOPER
859
860 !=========================================================================
861
862 SUBROUTINE GPOPER(CDACT,KBL,PSP_SB,PSP_SG,PSP_RR,PSD_VF,PSD_VV,YDCOM,PFIELD,PFIELD2)
863 !Operations on ALL surface groups
864 CHARACTER(LEN=*),INTENT(IN) :: CDACT
865 INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBL
866 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SB(:,:,:)
867 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SG(:,:)
868 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_RR(:,:)
869 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSD_VF(:,:)
870 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSD_VV(:,:)
871 TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
872 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD(:,:)
873 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD2(:,:)
874 REAL(KIND=JPRB) :: ZHOOK_HANDLE
875
876 !-------------------------------------------------------------------------
877
878 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER',0,ZHOOK_HANDLE)
879 IF(CDACT == 'PUTALLFLDS' .OR. CDACT == 'GETALLFLDS' .OR.&
880 & CDACT == 'TRAJSTORE' .OR. CDACT == 'TRAJSTORECST' .OR. &
881 & CDACT == 'SET0TOTRAJ' .OR. CDACT == 'GETTRAJ' ) THEN
882 IF(.NOT.PRESENT(PFIELD)) CALL ABOR1('SURFACE_FIELDS:GPOPER - PFIELD MISSING')
883 IF(SIZE(PFIELD,1) < NPROMA) CALL ABOR1('SURFACE_FIELDS:GPOPER - SIZE(PFIELD,1) < NPROMA)')
884 ENDIF
885 IF(CDACT == 'PUTALLFLDS' .OR. CDACT == 'GETALLFLDS') THEN
886 IF(SIZE(PFIELD,2) < NPROGSURFL) CALL ABOR1('SURFACE_FIELDS:GPOPER - SIZE(PFIELD,2) < NPROGSURFL)')
887 ENDIF
888 IF(CDACT == 'GETTRAJ') THEN
889 IF(.NOT.PRESENT(PFIELD2)) CALL ABOR1('SURFACE_FIELDS:GPOPER - PFIELD2 MISSING')
890 IF(SIZE(PFIELD2,1) < NPROMA) CALL ABOR1('SURFACE_FIELDS:GPOPER - SIZE(PFIELD2,1) < NPROMA)')
891 ENDIF
892 IF(PRESENT(YDCOM)) THEN
893 YDCOM%L_OK = .FALSE.
894 YDCOM%IPTRSURF = 0
895 YDCOM%ICOUNT = 0
896 ENDIF
897
898 NPTRSURF = 0
899 IF(PRESENT(KBL)) THEN
900 IF(YSP_SBD%NDIM > 0) THEN
901 CALL GPOPER_3(CDACT,SP_SB(:,:,:,KBL),YSP_SBD,YSP_SB%YSB,YDCOM,PFIELD,PFIELD2)
902 ENDIF
903 IF(YSP_SGD%NDIM > 0) THEN
904 CALL GPOPER_2(CDACT,SP_SG(:,:,KBL) ,YSP_SGD,YSP_SG%YSG,YDCOM,PFIELD,PFIELD2)
905 ENDIF
906 IF(YSP_RRD%NDIM > 0) THEN
907 CALL GPOPER_2(CDACT,SP_RR(:,:,KBL) ,YSP_RRD,YSP_RR%YRR,YDCOM,PFIELD,PFIELD2)
908 ENDIF
909 IF(YSP_EPD%NDIM > 0) THEN
910 CALL GPOPER_3(CDACT,SP_EP(:,:,:,KBL),YSP_EPD,YSP_EP%YEP,YDCOM,PFIELD,PFIELD2)
911 ENDIF
912 IF(YSP_X2D%NDIM > 0) THEN
913 CALL GPOPER_2(CDACT,SP_X2(:,:,KBL) ,YSP_X2D,YSP_X2%YX2,YDCOM,PFIELD,PFIELD2)
914 ENDIF
915 IF(YSD_VFD%NDIM > 0) THEN
916 CALL GPOPER_2(CDACT,SD_VF(:,:,KBL) ,YSD_VFD,YSD_VF%YVF,YDCOM,PFIELD,PFIELD2)
917 ENDIF
918 IF(YSD_VPD%NDIM > 0) THEN
919 CALL GPOPER_2(CDACT,SD_VP(:,:,KBL) ,YSD_VPD,YSD_VP%YVP,YDCOM,PFIELD,PFIELD2)
920 ENDIF
921 IF(YSD_VVD%NDIM > 0) THEN
922 CALL GPOPER_2(CDACT,SD_VV(:,:,KBL) ,YSD_VVD,YSD_VV%YVV,YDCOM,PFIELD,PFIELD2)
923 ENDIF
924 IF(YSD_VND%NDIM > 0) THEN
925 CALL GPOPER_2(CDACT,SD_VN(:,:,KBL) ,YSD_VND,YSD_VN%YVN,YDCOM,PFIELD,PFIELD2)
926 ENDIF
927 IF(YSD_VHD%NDIM > 0) THEN
928 CALL GPOPER_2(CDACT,SD_VH(:,:,KBL) ,YSD_VHD,YSD_VH%YVH,YDCOM,PFIELD,PFIELD2)
929 ENDIF
930 IF(YSD_VAD%NDIM > 0) THEN
931 CALL GPOPER_2(CDACT,SD_VA(:,:,KBL) ,YSD_VAD,YSD_VA%YVA,YDCOM,PFIELD,PFIELD2)
932 ENDIF
933 IF(YSD_VCD%NDIM > 0) THEN
934 CALL GPOPER_2(CDACT,SD_VC(:,:,KBL) ,YSD_VCD,YSD_VC%YVC,YDCOM,PFIELD,PFIELD2)
935 ENDIF
936 IF(YSD_VDD%NDIM > 0) THEN
937 CALL GPOPER_2(CDACT,SD_VD(:,:,KBL) ,YSD_VDD,YSD_VD%YVD,YDCOM,PFIELD,PFIELD2)
938 ENDIF
939 IF(YSD_WSD%NDIM > 0) THEN
940 CALL GPOPER_2(CDACT,SD_WS(:,:,KBL) ,YSD_WSD,YSD_WS%YWS,YDCOM,PFIELD,PFIELD2)
941 ENDIF
942 IF(YSD_XAD%NDIM > 0) THEN
943 CALL GPOPER_3(CDACT,SD_XA(:,:,:,KBL),YSD_XAD,YSD_XA%YXA,YDCOM,PFIELD,PFIELD2)
944 ENDIF
945 IF(YSD_X2D%NDIM > 0) THEN
946 CALL GPOPER_2(CDACT,SD_X2(:,:,KBL) ,YSD_X2D,YSD_X2%YX2,YDCOM,PFIELD,PFIELD2)
947 ENDIF
948 IF(YSD_VXD%NDIM > 0) THEN
949 CALL GPOPER_2(CDACT,SD_VX(:,:,KBL) ,YSD_VXD,YSD_VX%YVX,YDCOM,PFIELD,PFIELD2)
950 ENDIF
951 ELSE
952 IF(YSP_SBD%NDIM > 0) THEN
953 IF(PRESENT(PSP_SB)) &
954 & CALL GPOPER_3(CDACT,PSP_SB,YSP_SBD,YSP_SB%YSB,YDCOM,PFIELD,PFIELD2)
955 ENDIF
956 IF(YSP_SGD%NDIM > 0) THEN
957 IF(PRESENT(PSP_SG)) &
958 & CALL GPOPER_2(CDACT,PSP_SG,YSP_SGD,YSP_SG%YSG,YDCOM,PFIELD,PFIELD2)
959 ENDIF
960 IF(YSP_RRD%NDIM > 0) THEN
961 IF(PRESENT(PSP_RR)) &
962 & CALL GPOPER_2(CDACT,PSP_RR,YSP_RRD,YSP_RR%YRR,YDCOM,PFIELD,PFIELD2)
963 ENDIF
964 IF(YSD_VFD%NDIM > 0) THEN
965 IF(PRESENT(PSD_VF)) &
966 & CALL GPOPER_2(CDACT,PSD_VF,YSD_VFD,YSD_VF%YVF,YDCOM,PFIELD,PFIELD2)
967 ENDIF
968 IF(YSD_VVD%NDIM > 0) THEN
969 IF(PRESENT(PSD_VV)) &
970 & CALL GPOPER_2(CDACT,PSD_VV,YSD_VVD,YSD_VV%YVV,YDCOM,PFIELD,PFIELD2)
971 ENDIF
972 ENDIF
973 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER',1,ZHOOK_HANDLE)
974 END SUBROUTINE GPOPER
975
976 !=========================================================================
977
978 SUBROUTINE GPOPER_2(CDACT,PFLD,YDSC,YD,YDCOM,PFIELD,PFIELD2)
979 ! Operations on 2-D surface groups
980 CHARACTER(LEN=*),INTENT(IN) :: CDACT
981 REAL(KIND=JPRB),INTENT(INOUT) :: PFLD(:,:)
982 TYPE(TYPE_SURF_GEN),INTENT(IN) :: YDSC
983 TYPE(TYPE_SURF_MTL_2D),INTENT(IN) :: YD(:)
984 TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
985 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD(:,:)
986 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD2(:,:)
987
988 INTEGER(KIND=JPIM) :: J,IPTR,IPTR2
989 REAL(KIND=JPRB) :: ZZPHY
990 REAL(KIND=JPRB) :: ZHOOK_HANDLE
991
992 !-------------------------------------------------------------------------
993
994 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_2',0,ZHOOK_HANDLE)
995 IF(CDACT == 'SET9TO0') THEN
996 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
997 DO J=1,YDSC%NUMFLDS
998 PFLD(:,YD(J)%MP9) = PFLD(:,YD(J)%MP0)
999 ENDDO
1000 ELSEIF(CDACT == 'SET1TO0') THEN
1001 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1002 DO J=1,YDSC%NUMFLDS
1003 PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP0)
1004 ENDDO
1005 ELSEIF(CDACT == 'SET1TO9') THEN
1006 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1007 DO J=1,YDSC%NUMFLDS
1008 PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP9)
1009 ENDDO
1010 ELSEIF(CDACT == 'SET1TO9AD') THEN
1011 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1012 DO J=1,YDSC%NUMFLDS
1013 PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP9)+PFLD(:,YD(J)%MP1)
1014 PFLD(:,YD(J)%MP1) = 0.0_JPRB
1015 ENDDO
1016 ELSEIF(CDACT == 'SET0TO1') THEN
1017 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1018 DO J=1,YDSC%NUMFLDS
1019 PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP1)
1020 ENDDO
1021 ELSEIF(CDACT == 'SET0TO1AD') THEN
1022 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1023 DO J=1,YDSC%NUMFLDS
1024 PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP1)+PFLD(:,YD(J)%MP0)
1025 PFLD(:,YD(J)%MP0) = 0.0_JPRB
1026 ENDDO
1027 ELSEIF(CDACT == 'SET9TO1') THEN
1028 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1029 DO J=1,YDSC%NUMFLDS
1030 PFLD(:,YD(J)%MP9) = PFLD(:,YD(J)%MP1)
1031 ENDDO
1032 ELSEIF(CDACT == 'PHTFILT') THEN
1033 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1034 ZZPHY=1.0_JPRB-REPSP1
1035 DO J=1,YDSC%NUMFLDS
1036 PFLD(:,YD(J)%MP9) = REPSP1*PFLD(:,YD(J)%MP1)+ZZPHY*PFLD(:,YD(J)%MP0)
1037 PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP1)
1038 ENDDO
1039 ELSEIF(CDACT == 'PHTFILTAD') THEN
1040 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1041 ZZPHY=1.0_JPRB-REPSP1
1042 DO J=1,YDSC%NUMFLDS
1043 PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP1)+PFLD(:,YD(J)%MP0)
1044 PFLD(:,YD(J)%MP0) = 0.0_JPRB
1045 PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP1)+REPSP1*PFLD(:,YD(J)%MP9)
1046 PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP0)+ZZPHY *PFLD(:,YD(J)%MP9)
1047 PFLD(:,YD(J)%MP9) = 0.0_JPRB
1048 ENDDO
1049 ELSEIF(CDACT == 'SET0TOVAL') THEN
1050 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1051 DO J=1,YDSC%NUMFLDS
1052 PFLD(:,YD(J)%MP0) = YDCOM%VALUE
1053 ENDDO
1054 ELSEIF(CDACT == 'SET9TOVAL') THEN
1055 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1056 DO J=1,YDSC%NUMFLDS
1057 PFLD(:,YD(J)%MP9) = YDCOM%VALUE
1058 ENDDO
1059 ELSEIF(CDACT == 'SET1TOVAL') THEN
1060 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1061 DO J=1,YDSC%NUMFLDS
1062 PFLD(:,YD(J)%MP1) = YDCOM%VALUE
1063 ENDDO
1064 ELSEIF(CDACT == 'SETALLTOVAL') THEN
1065 DO J=1,YDSC%NDIM
1066 PFLD(:,J) = YDCOM%VALUE
1067 ENDDO
1068 ELSEIF(CDACT == 'SETDEFAULT') THEN
1069 DO J=1,YDSC%NUMFLDS
1070 IF(YD(J)%NREQIN == -1) THEN
1071 PFLD(:,YD(J)%MP) = YD(J)%REFVALI
1072 ENDIF
1073 ENDDO
1074 ELSEIF(CDACT == 'TRAJSTORE') THEN
1075 IF(YDSC%NDIM5 > 0 ) THEN
1076 IPTR = YDSC%NOFFTRAJ
1077 DO J=1,YDSC%NUMFLDS
1078 IF(YD(J)%ITRAJ == 1) THEN
1079 IPTR = IPTR+1
1080 PFIELD(:,IPTR) = PFLD(:,YD(J)%MP)
1081 ENDIF
1082 ENDDO
1083 ENDIF
1084 ELSEIF(CDACT == 'TRAJSTORECST') THEN
1085 IF(YDSC%NDIM5 > 0 ) THEN
1086 IPTR2 = YDSC%NOFFTRAJ_CST
1087 DO J=1,YDSC%NUMFLDS
1088 IF(YD(J)%ITRAJ == 2) THEN
1089 IPTR2 = IPTR2+1
1090 PFIELD(:,IPTR2) = PFLD(:,YD(J)%MP)
1091 ENDIF
1092 ENDDO
1093 ENDIF
1094 ELSEIF(CDACT == 'SET0TOTRAJ') THEN
1095 IF(YDSC%NDIM5 > 0 ) THEN
1096 IPTR = YDSC%NOFFTRAJ
1097 DO J=1,YDSC%NUMFLDS
1098 IF(YD(J)%ITRAJ == 1) THEN
1099 IPTR = IPTR+1
1100 PFLD(:,YD(J)%MP) = PFIELD(:,IPTR)
1101 ENDIF
1102 ENDDO
1103 ENDIF
1104 ELSEIF(CDACT == 'GETTRAJ') THEN
1105 IF(YDSC%NDIM5 > 0 ) THEN
1106 IPTR = YDSC%NOFFTRAJ
1107 IPTR2 = YDSC%NOFFTRAJ_CST
1108 DO J=1,YDSC%NUMFLDS
1109 IF(YD(J)%ITRAJ == 1) THEN
1110 IPTR = IPTR+1
1111 PFLD(:,YD(J)%MP5) = PFIELD(:,IPTR)
1112 ELSEIF(YD(J)%ITRAJ == 2) THEN
1113 IPTR2 = IPTR2+1
1114 PFLD(:,YD(J)%MP5) = PFIELD2(:,IPTR2)
1115 ENDIF
1116 ENDDO
1117 ENDIF
1118 ELSEIF(CDACT == 'GETALLFLDS') THEN
1119 DO J=1,YDSC%NDIM
1120 NPTRSURF = NPTRSURF+1
1121 PFIELD(:,NPTRSURF) = PFLD(:,J)
1122 ENDDO
1123 ELSEIF(CDACT == 'PUTALLFLDS') THEN
1124 DO J=1,YDSC%NDIM
1125 NPTRSURF = NPTRSURF+1
1126 PFLD(:,J) = PFIELD(:,NPTRSURF)
1127 ENDDO
1128 ELSEIF(CDACT == 'GETGRIBPOS') THEN
1129 DO J=1,YDSC%NUMFLDS
1130 YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1131 IF(YD(J)%IGRBCODE == YDCOM%IGRBCODE) THEN
1132 YDCOM%IFLDNUM = YDCOM%IPTRSURF
1133 YDCOM%L_OK = .TRUE.
1134 ENDIF
1135 ENDDO
1136 ELSEIF(CDACT == 'GETFIELD') THEN
1137 DO J=1,YDSC%NUMFLDS
1138 YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1139 IF(YDCOM%IPTRSURF == YDCOM%IFLDNUM) THEN
1140 PFIELD(:,1) = PFLD(:,J)
1141 YDCOM%L_OK = .TRUE.
1142 ENDIF
1143 ENDDO
1144 ELSEIF(CDACT == 'GRIBIN') THEN
1145 DO J=1,YDSC%NUMFLDS
1146 YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1147 IF(YD(J)%NREQIN == 1) THEN
1148 YDCOM%ICOUNT = YDCOM%ICOUNT+1
1149 YDCOM%ICODES(YDCOM%ICOUNT) = YD(J)%IGRBCODE
1150 ENDIF
1151 ENDDO
1152 ELSE
1153 WRITE(NULOUT,*) 'SURFACE_FIELD:GPPOPER UNKNOWN ACTION - ',CDACT
1154 CALL ABOR1('SURFACE_FIELD:GPPOPER - UNKNOWN ACTION')
1155 ENDIF
1156 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_2',1,ZHOOK_HANDLE)
1157 END SUBROUTINE GPOPER_2
1158
1159 !=========================================================================
1160
1161 SUBROUTINE GPOPER_3(CDACT,PFLD,YDSC,YD,YDCOM,PFIELD,PFIELD2)
1162 ! Operations on 3-D surface groups
1163 CHARACTER(LEN=*),INTENT(IN) :: CDACT
1164 REAL(KIND=JPRB),INTENT(INOUT) :: PFLD(:,:,:)
1165 TYPE(TYPE_SURF_GEN),INTENT(IN) :: YDSC
1166 TYPE(TYPE_SURF_MTL_3D),INTENT(IN) :: YD(:)
1167 TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
1168 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD(:,:)
1169 REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD2(:,:)
1170
1171 INTEGER(KIND=JPIM) :: J,JLEV,IPTR,IPTR2
1172 REAL(KIND=JPRB) :: ZZPHY
1173 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1174
1175 !-------------------------------------------------------------------------
1176
1177 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_3',0,ZHOOK_HANDLE)
1178 IF(CDACT == 'SET9TO0') THEN
1179 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1180 DO J=1,YDSC%NUMFLDS
1181 PFLD(:,:,YD(J)%MP9) = PFLD(:,:,YD(J)%MP0)
1182 ENDDO
1183 ELSEIF(CDACT == 'SET1TO0') THEN
1184 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1185 DO J=1,YDSC%NUMFLDS
1186 PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP0)
1187 ENDDO
1188 ELSEIF(CDACT == 'SET1TO9') THEN
1189 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1190 DO J=1,YDSC%NUMFLDS
1191 PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP9)
1192 ENDDO
1193 ELSEIF(CDACT == 'SET1TO9AD') THEN
1194 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1195 DO J=1,YDSC%NUMFLDS
1196 PFLD(:,:,YD(J)%MP9) = PFLD(:,:,YD(J)%MP9)+PFLD(:,:,YD(J)%MP1)
1197 PFLD(:,:,YD(J)%MP1) = 0.0_JPRB
1198 ENDDO
1199 ELSEIF(CDACT == 'SET0TO1') THEN
1200 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1201 DO J=1,YDSC%NUMFLDS
1202 PFLD(:,:,YD(J)%MP0) = PFLD(:,:,YD(J)%MP1)
1203 ENDDO
1204 ELSEIF(CDACT == 'SET0TO1AD') THEN
1205 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1206 DO J=1,YDSC%NUMFLDS
1207 PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP1)+PFLD(:,:,YD(J)%MP0)
1208 PFLD(:,:,YD(J)%MP0) = 0.0_JPRB
1209 ENDDO
1210 ELSEIF(CDACT == 'SET9TO1') THEN
1211 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1212 DO J=1,YDSC%NUMFLDS
1213 PFLD(:,:,YD(J)%MP9) = PFLD(:,:,YD(J)%MP1)
1214 ENDDO
1215 ELSEIF(CDACT == 'PHTFILT') THEN
1216 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1217 ZZPHY=1.0_JPRB-REPSP1
1218 DO J=1,YDSC%NUMFLDS
1219 PFLD(:,:,YD(J)%MP9) = REPSP1*PFLD(:,:,YD(J)%MP1)+ZZPHY*PFLD(:,:,YD(J)%MP0)
1220 PFLD(:,:,YD(J)%MP0) = PFLD(:,:,YD(J)%MP1)
1221 ENDDO
1222 ELSEIF(CDACT == 'PHTFILTAD') THEN
1223 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1224 ZZPHY=1.0_JPRB-REPSP1
1225 DO J=1,YDSC%NUMFLDS
1226 PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP1)+PFLD(:,:,YD(J)%MP0)
1227 PFLD(:,:,YD(J)%MP0) = 0.0_JPRB
1228 PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP1)+REPSP1*PFLD(:,:,YD(J)%MP9)
1229 PFLD(:,:,YD(J)%MP0) = PFLD(:,:,YD(J)%MP0)+ZZPHY *PFLD(:,:,YD(J)%MP9)
1230 PFLD(:,:,YD(J)%MP9) = 0.0_JPRB
1231 ENDDO
1232 ELSEIF(CDACT == 'SET0TOVAL') THEN
1233 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1234 DO J=1,YDSC%NUMFLDS
1235 PFLD(:,:,YD(J)%MP0) = YDCOM%VALUE
1236 ENDDO
1237 ELSEIF(CDACT == 'SET9TOVAL') THEN
1238 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1239 DO J=1,YDSC%NUMFLDS
1240 PFLD(:,:,YD(J)%MP9) = YDCOM%VALUE
1241 ENDDO
1242 ELSEIF(CDACT == 'SET1TOVAL') THEN
1243 IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1244 DO J=1,YDSC%NUMFLDS
1245 PFLD(:,:,YD(J)%MP1) = YDCOM%VALUE
1246 ENDDO
1247 ELSEIF(CDACT == 'SETALLTOVAL') THEN
1248 DO J=1,YDSC%NDIM
1249 PFLD(:,:,J) = YDCOM%VALUE
1250 ENDDO
1251 ELSEIF(CDACT == 'SETDEFAULT') THEN
1252 DO J=1,YDSC%NUMFLDS
1253 DO JLEV=1,YDSC%NLEVS
1254 IF(YD(J)%NREQIN(JLEV) == -1) THEN
1255 PFLD(:,JLEV,YD(J)%MP) = YD(J)%REFVALI(JLEV)
1256 ENDIF
1257 ENDDO
1258 ENDDO
1259 ELSEIF(CDACT == 'TRAJSTORE') THEN
1260 IF(YDSC%NDIM5 > 0 ) THEN
1261 IPTR = YDSC%NOFFTRAJ
1262 DO J=1,YDSC%NUMFLDS
1263 IF(YD(J)%ITRAJ == 1) THEN
1264 DO JLEV=1,YDSC%NLEVS
1265 IPTR = IPTR+1
1266 PFIELD(:,IPTR) = PFLD(:,JLEV,YD(J)%MP)
1267 ENDDO
1268 ENDIF
1269 ENDDO
1270 ENDIF
1271 ELSEIF(CDACT == 'TRAJSTORECST') THEN
1272 IF(YDSC%NDIM5 > 0 ) THEN
1273 IPTR2 = YDSC%NOFFTRAJ_CST
1274 DO J=1,YDSC%NUMFLDS
1275 IF(YD(J)%ITRAJ == 2) THEN
1276 DO JLEV=1,YDSC%NLEVS
1277 IPTR2 = IPTR2+1
1278 PFIELD(:,IPTR2) = PFLD(:,JLEV,YD(J)%MP)
1279 ENDDO
1280 ENDIF
1281 ENDDO
1282 ENDIF
1283 ELSEIF(CDACT == 'SET0TOTRAJ') THEN
1284 IF(YDSC%NDIM5 > 0 ) THEN
1285 IPTR = YDSC%NOFFTRAJ
1286 DO J=1,YDSC%NUMFLDS
1287 IF(YD(J)%ITRAJ == 1) THEN
1288 DO JLEV=1,YDSC%NLEVS
1289 IPTR = IPTR+1
1290 PFLD(:,JLEV,YD(J)%MP) = PFIELD(:,IPTR)
1291 ENDDO
1292 ENDIF
1293 ENDDO
1294 ENDIF
1295 ELSEIF(CDACT == 'GETTRAJ') THEN
1296 IF(YDSC%NDIM5 > 0 ) THEN
1297 IPTR = YDSC%NOFFTRAJ
1298 IPTR2 = YDSC%NOFFTRAJ_CST
1299 DO J=1,YDSC%NUMFLDS
1300 IF(YD(J)%ITRAJ == 1) THEN
1301 DO JLEV=1,YDSC%NLEVS
1302 IPTR = IPTR+1
1303 PFLD(:,JLEV,YD(J)%MP5) = PFIELD(:,IPTR)
1304 ENDDO
1305 ELSEIF(YD(J)%ITRAJ == 2) THEN
1306 DO JLEV=1,YDSC%NLEVS
1307 IPTR2 = IPTR2+1
1308 PFLD(:,JLEV,YD(J)%MP5) = PFIELD2(:,IPTR2)
1309 ENDDO
1310 ENDIF
1311 ENDDO
1312 ENDIF
1313 ELSEIF(CDACT == 'GETALLFLDS') THEN
1314 DO J=1,YDSC%NDIM
1315 DO JLEV=1,YDSC%NLEVS
1316 NPTRSURF = NPTRSURF+1
1317 PFIELD(:,NPTRSURF) = PFLD(:,JLEV,J)
1318 ENDDO
1319 ENDDO
1320 ELSEIF(CDACT == 'PUTALLFLDS') THEN
1321 DO J=1,YDSC%NDIM
1322 DO JLEV=1,YDSC%NLEVS
1323 NPTRSURF = NPTRSURF+1
1324 PFLD(:,JLEV,J) = PFIELD(:,NPTRSURF)
1325 ENDDO
1326 ENDDO
1327 ELSEIF(CDACT == 'GETGRIBPOS') THEN
1328 DO J=1,YDSC%NUMFLDS
1329 DO JLEV=1,YDSC%NLEVS
1330 YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1331 IF(YD(J)%IGRBCODE(JLEV) == YDCOM%IGRBCODE) THEN
1332 YDCOM%IFLDNUM = YDCOM%IPTRSURF
1333 YDCOM%L_OK = .TRUE.
1334 ENDIF
1335 ENDDO
1336 ENDDO
1337 ELSEIF(CDACT == 'GETFIELD') THEN
1338 DO J=1,YDSC%NUMFLDS
1339 DO JLEV=1,YDSC%NLEVS
1340 YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1341 IF(YDCOM%IPTRSURF == YDCOM%IFLDNUM) THEN
1342 PFIELD(:,1) = PFLD(:,JLEV,J)
1343 YDCOM%L_OK = .TRUE.
1344 ENDIF
1345 ENDDO
1346 ENDDO
1347 ELSEIF(CDACT == 'GRIBIN') THEN
1348 DO J=1,YDSC%NUMFLDS
1349 DO JLEV=1,YDSC%NLEVS
1350 YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1351 IF(YD(J)%NREQIN(JLEV) == 1) THEN
1352 YDCOM%ICOUNT = YDCOM%ICOUNT+1
1353 YDCOM%ICODES(YDCOM%ICOUNT) = YD(J)%IGRBCODE(JLEV)
1354 ENDIF
1355 ENDDO
1356 ENDDO
1357 ELSE
1358 WRITE(NULOUT,*) 'SURFACE_FIELD:GPPOPER UNKNOWN ACTION - ',CDACT
1359 CALL ABOR1('SURFACE_FIELD:GPPOPER - UNKNOWN ACTION')
1360 ENDIF
1361 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_3',1,ZHOOK_HANDLE)
1362 END SUBROUTINE GPOPER_3
1363
1364 !=========================================================================
1365
1366 SUBROUTINE SURF_STORE
1367 ! Store all surface fields
1368 INTEGER(KIND=JPIM) :: JBL
1369 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1370
1371 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_STORE',0,ZHOOK_HANDLE)
1372 ALLOCATE(SURF_STORE_ARRAY(NPROMA,NDIMSURFL,NGPBLKS))
1373 DO JBL=1,NGPBLKS
1374 CALL GPOPER('GETALLFLDS',KBL=JBL,PFIELD=SURF_STORE_ARRAY(:,:,JBL))
1375 ENDDO
1376 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_STORE',1,ZHOOK_HANDLE)
1377 END SUBROUTINE SURF_STORE
1378
1379 !=========================================================================
1380
1381 SUBROUTINE SURF_RESTORE
1382 ! Restore all surface fields
1383 INTEGER(KIND=JPIM) :: JBL
1384 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1385
1386 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_RESTORE',0,ZHOOK_HANDLE)
1387 IF(.NOT. ALLOCATED(SURF_STORE_ARRAY)) &
1388 & CALL ABOR1('SURFACE_FIELDS:SURF_RESTORE - SURF_STORE NOT ALLOCATED')
1389 DO JBL=1,NGPBLKS
1390 CALL GPOPER('PUTALLFLDS',KBL=JBL,PFIELD=SURF_STORE_ARRAY(:,:,JBL))
1391 ENDDO
1392 DEALLOCATE(SURF_STORE_ARRAY)
1393 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_RESTORE',1,ZHOOK_HANDLE)
1394
1395 END SUBROUTINE SURF_RESTORE
1396
1397 !=========================================================================
1398
1399 SUBROUTINE ALLO_SURF
1400 ! Allocate surface field arrays
1401 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1402
1403 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:ALLO_SURF',0,ZHOOK_HANDLE)
1404 ALLOCATE(SP_SB(NPROMA,YSP_SBD%NLEVS,YSP_SBD%NDIM,NGPBLKS))
1405 ALLOCATE(SP_SG(NPROMA,YSP_SGD%NDIM,NGPBLKS))
1406 ALLOCATE(SP_RR(NPROMA,YSP_RRD%NDIM,NGPBLKS))
1407 ALLOCATE(SP_EP(NPROMA,YSP_EPD%NLEVS,YSP_EPD%NDIM,NGPBLKS))
1408 ALLOCATE(SP_X2(NPROMA,YSP_X2D%NDIM,NGPBLKS))
1409 ALLOCATE(SP_CI(NPROMA,YSP_CID%NDIM,NGPBLKS))
1410 ALLOCATE(SD_VF(NPROMA,YSD_VFD%NDIM,NGPBLKS))
1411 ALLOCATE(SD_VP(NPROMA,YSD_VPD%NDIM,NGPBLKS))
1412 ALLOCATE(SD_VV(NPROMA,YSD_VVD%NDIM,NGPBLKS))
1413 ALLOCATE(SD_VN(NPROMA,YSD_VND%NDIM,NGPBLKS))
1414 ALLOCATE(SD_VH(NPROMA,YSD_VHD%NDIM,NGPBLKS))
1415 ALLOCATE(SD_VA(NPROMA,YSD_VAD%NDIM,NGPBLKS))
1416 ALLOCATE(SD_VC(NPROMA,YSD_VCD%NDIM,NGPBLKS))
1417 ALLOCATE(SD_VD(NPROMA,YSD_VDD%NDIM,NGPBLKS))
1418 ALLOCATE(SD_WS(NPROMA,YSD_WSD%NDIM,NGPBLKS))
1419 ALLOCATE(SD_XA(NPROMA,YSD_XAD%NLEVS,YSD_XAD%NDIM,NGPBLKS))
1420 ALLOCATE(SD_X2(NPROMA,YSD_X2D%NDIM,NGPBLKS))
1421 ALLOCATE(SD_VX(NPROMA,YSD_VXD%NDIM,NGPBLKS))
1422
1423 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:ALLO_SURF',1,ZHOOK_HANDLE)
1424 END SUBROUTINE ALLO_SURF
1425
1426 !=========================================================================
1427
1428 SUBROUTINE DEALLO_SURF
1429 ! Deallocate surface field arrays
1430 REAL(KIND=JPRB) :: ZHOOK_HANDLE
1431
1432 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:DEALLO_SURF',0,ZHOOK_HANDLE)
1433 IF(ALLOCATED(SP_SB)) DEALLOCATE(SP_SB)
1434 IF(ALLOCATED(SP_SG)) DEALLOCATE(SP_SG)
1435 IF(ALLOCATED(SP_RR)) DEALLOCATE(SP_RR)
1436 IF(ALLOCATED(SP_EP)) DEALLOCATE(SP_EP)
1437 IF(ALLOCATED(SP_X2)) DEALLOCATE(SP_X2)
1438 IF(ALLOCATED(SP_CI)) DEALLOCATE(SP_CI)
1439 IF(ALLOCATED(SD_VF)) DEALLOCATE(SD_VF)
1440 IF(ALLOCATED(SD_VP)) DEALLOCATE(SD_VP)
1441 IF(ALLOCATED(SD_VV)) DEALLOCATE(SD_VV)
1442 IF(ALLOCATED(SD_VN)) DEALLOCATE(SD_VN)
1443 IF(ALLOCATED(SD_VH)) DEALLOCATE(SD_VH)
1444 IF(ALLOCATED(SD_VA)) DEALLOCATE(SD_VA)
1445 IF(ALLOCATED(SD_VC)) DEALLOCATE(SD_VC)
1446 IF(ALLOCATED(SD_VD)) DEALLOCATE(SD_VD)
1447 IF(ALLOCATED(SD_WS)) DEALLOCATE(SD_WS)
1448 IF(ALLOCATED(SD_XA)) DEALLOCATE(SD_XA)
1449 IF(ALLOCATED(SD_X2)) DEALLOCATE(SD_X2)
1450 IF(ALLOCATED(SD_VX)) DEALLOCATE(SD_VX)
1451 IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:DEALLO_SURF',1,ZHOOK_HANDLE)
1452 END SUBROUTINE DEALLO_SURF
1453
1454 !=========================================================================
1455
1456 END MODULE SURFACE_FIELDS
1457