Context Navigation

surface_fields.F90 @ 3040

Last change on this file since 3040 was 2010, checked in by Laurent Fairhead, 11 years ago

Modifications pour OpenMP

OpenMP modifications

Property copyright set to
Name of program: LMDZ
Creation date: 1984
Version: LMDZ5
License: CeCILL version 2
Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
See the license file in the root directory

File size: 54.1 KB

Line
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) = REPSP1PFLD(:,YD(J)%MP1)+ZZPHYPFLD(:,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) = REPSP1PFLD(:,:,YD(J)%MP1)+ZZPHYPFLD(:,:,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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format