Context Navigation

surface_fields.F90 @ 1999

Last change on this file since 1999 was 1999, checked in by Laurent Fairhead, 10 years ago
Merged trunk changes r1920:1997 into testing branch
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: 53.5 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	!-------------------------------------------------------------------------
508
509	CONTAINS
510
511	!=========================================================================
512
513	SUBROUTINE INI_SFLP3(YDSC,YD,KFLDS,KLEVS,LDMTL,CDGRPNAME)
514	! Initialize 3-D surface field group
515	TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
516	TYPE(TYPE_SURF_MTL_3D),INTENT(INOUT) :: YD(:)
517	INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS
518	INTEGER(KIND=JPIM),INTENT(IN) :: KLEVS
519	LOGICAL,INTENT(IN) :: LDMTL
520	CHARACTER(LEN=*),INTENT(IN) :: CDGRPNAME
521
522	INTEGER(KIND=JPIM) :: JFLD, IMAXF
523	REAL(KIND=JPRB) :: ZHOOK_HANDLE
524
525	!-------------------------------------------------------------------------
526
527	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP3',0,ZHOOK_HANDLE)
528
529	IMAXF = SIZE(YD)
530	YDSC%NUMFLDS = KFLDS
531	YDSC%NLEVS = KLEVS
532	YDSC%IPTR = 1
533	YDSC%LMTL = LDMTL
534	YDSC%CGRPNAME = CDGRPNAME
535	YDSC%NDIM5 = 0
536	YDSC%NOFFTRAJ = NOFFTRAJ
537	YDSC%NOFFTRAJ_CST = NOFFTRAJ_CST
538
539	NSURF = NSURF+YDSC%NUMFLDS
540	NSURFL = NSURFL+YDSC%NUMFLDS*YDSC%NLEVS
541	IF(LDMTL) THEN
542	NPROGSURF = NPROGSURF+YDSC%NUMFLDS
543	NPROGSURFL = NPROGSURFL+YDSC%NUMFLDS*YDSC%NLEVS
544	ENDIF
545
546	IF(LDMTL) THEN
547	IF (LTWOTL) THEN
548	YDSC%NDIM = 2*YDSC%NUMFLDS
549	ELSE
550	YDSC%NDIM = 3*YDSC%NUMFLDS
551	ENDIF
552	ELSE
553	YDSC%NDIM = YDSC%NUMFLDS
554	ENDIF
555	NDIMSURF = NDIMSURF + YDSC%NDIM
556	NDIMSURFL = NDIMSURFL + YDSC%NDIM*YDSC%NLEVS
557
558	DO JFLD=1,KFLDS
559	ALLOCATE(YD(JFLD)%IGRBCODE(KLEVS))
560	ALLOCATE(YD(JFLD)%CNAME(KLEVS))
561	ALLOCATE(YD(JFLD)%REFVALI(KLEVS))
562	ALLOCATE(YD(JFLD)%NREQIN(KLEVS))
563	YD(JFLD)%IGRBCODE(:) = -999
564	YD(JFLD)%CNAME(:) = ''
565	YD(JFLD)%REFVALI(:) = 0.0_JPRB
566	YD(JFLD)%NREQIN(:) = -1
567	YD(JFLD)%MP = JFLD
568	IF (YDSC%LMTL) THEN
569	YD(JFLD)%MP0 = YD(JFLD)%MP
570	IF(LTWOTL) THEN
571	YD(JFLD)%MP9 = YD(JFLD)%MP0
572	YD(JFLD)%MP1 = YD(JFLD)%MP0+YDSC%NUMFLDS
573	ELSE
574	YD(JFLD)%MP9 = YD(JFLD)%MP0+YDSC%NUMFLDS
575	YD(JFLD)%MP1 = YD(JFLD)%MP0+2*YDSC%NUMFLDS
576	ENDIF
577	ELSE
578	YD(JFLD)%MP0 = NUNDEFLD
579	YD(JFLD)%MP9 = NUNDEFLD
580	YD(JFLD)%MP1 = NUNDEFLD
581	ENDIF
582	YD(JFLD)%MP5 = NUNDEFLD
583	YD(JFLD)%ITRAJ = 0
584	ENDDO
585
586	DO JFLD=KFLDS+1,IMAXF
587	YD(JFLD)%MP = NUNDEFLD
588	YD(JFLD)%MP0 = NUNDEFLD
589	YD(JFLD)%MP9 = NUNDEFLD
590	YD(JFLD)%MP1 = NUNDEFLD
591	YD(JFLD)%MP5 = NUNDEFLD
592	YD(JFLD)%ITRAJ = 0
593	ENDDO
594
595	WRITE(NULOUT,*) 'INITIALIZING 3-D SURFACE FIELD GROUP ', YDSC%CGRPNAME
596	WRITE(NULOUT,*) 'NUMFLDS=',YDSC%NUMFLDS,' NLEVS=',YDSC%NLEVS,' LMTL=',YDSC%LMTL
597
598	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP3',1,ZHOOK_HANDLE)
599	END SUBROUTINE INI_SFLP3
600
601	!=========================================================================
602
603	SUBROUTINE SETUP_SFLP3(YDSC,YD,KGRIB,CDNAME,PDEFAULT,KTRAJ,KREQIN)
604	! Setup 3-D surface field
605	TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
606	TYPE(TYPE_SURF_MTL_3D),INTENT(INOUT) :: YD
607	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB(:)
608	CHARACTER(LEN=16) ,OPTIONAL,INTENT(IN) :: CDNAME(:)
609	REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PDEFAULT(:)
610	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTRAJ
611	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREQIN(:)
612
613	INTEGER(KIND=JPIM) :: IPTR,JLEV
614	REAL(KIND=JPRB) :: ZHOOK_HANDLE
615
616	!-------------------------------------------------------------------------
617
618	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP3',0,ZHOOK_HANDLE)
619	IPTR = YDSC%IPTR
620	IF(IPTR > YDSC%NUMFLDS) THEN
621	WRITE(NULERR,*) 'SURFACE FIELDS UNDER-DIMENSINED - GROUP ',&
622	& YDSC%CGRPNAME,YDSC%NUMFLDS,KGRIB(1),CDNAME(1)
623	CALL ABOR1('IPTR > YDSC%NUMFLDS')
624	ENDIF
625	IF(PRESENT(KGRIB)) THEN
626	YD%IGRBCODE(:) = KGRIB(:)
627	ENDIF
628	IF(PRESENT(KREQIN)) THEN
629	YD%NREQIN(:) = KREQIN(:)
630	ENDIF
631	IF(PRESENT(CDNAME)) THEN
632	YD%CNAME(:) = CDNAME(:)
633	ENDIF
634	IF(PRESENT(PDEFAULT)) THEN
635	YD%REFVALI(:) = PDEFAULT
636	ENDIF
637	IF(PRESENT(KTRAJ)) THEN
638	IF(KTRAJ == 1) THEN
639	DO JLEV=1,YDSC%NLEVS
640	NSTRAJGRIB(NOFFTRAJ+JLEV) = YD%IGRBCODE(JLEV)
641	ENDDO
642	NOFFTRAJ = NOFFTRAJ+YDSC%NLEVS
643	ELSEIF(KTRAJ == 2) THEN
644	NOFFTRAJ_CST = NOFFTRAJ_CST+YDSC%NLEVS
645	ELSEIF(KTRAJ /= 0) THEN
646	CALL ABOR1('SURFACE_FIELDS:SETUP_SFLP3 - UNKNOWN KTRAJ')
647	ENDIF
648	YD%ITRAJ = KTRAJ
649	YDSC%NDIM5 = YDSC%NDIM5+1
650	YD%MP5 = YDSC%NDIM5
651	ENDIF
652	DO JLEV=1,YDSC%NLEVS
653	IF(YDSC%LMTL) THEN
654	WRITE(NULOUT,'(1X,A,2I4,1X,A,6I4)') &
655	& YDSC%CGRPNAME(1:6),YDSC%IPTR,JLEV,YD%CNAME(JLEV),YD%IGRBCODE(JLEV),&
656	& YD%MP0,YD%MP9,YD%MP1,YD%ITRAJ,YD%NREQIN(JLEV)
657	ELSE
658	WRITE(NULOUT,'(1X,A,2I4,1X,A,4I4)') &
659	& YDSC%CGRPNAME(1:6),YDSC%IPTR,JLEV,YD%CNAME(JLEV),YD%IGRBCODE(JLEV),&
660	& YD%MP,YD%ITRAJ,YD%NREQIN(JLEV)
661	ENDIF
662	ENDDO
663	YDSC%IPTR = YDSC%IPTR+1
664
665	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP3',1,ZHOOK_HANDLE)
666	END SUBROUTINE SETUP_SFLP3
667
668	!=========================================================================
669
670	SUBROUTINE INI_SFLP2(YDSC,YD,KFLDS,LDMTL,CDGRPNAME)
671	! Initialize 2-D surface field group
672	TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
673	TYPE(TYPE_SURF_MTL_2D),INTENT(INOUT) :: YD(:)
674	INTEGER(KIND=JPIM),INTENT(IN) :: KFLDS
675	LOGICAL,INTENT(IN) :: LDMTL
676	CHARACTER(LEN=*),INTENT(IN) :: CDGRPNAME
677
678	INTEGER(KIND=JPIM) :: JFLD, IMAXF
679	REAL(KIND=JPRB) :: ZHOOK_HANDLE
680
681	!-------------------------------------------------------------------------
682
683	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP2',0,ZHOOK_HANDLE)
684
685	IMAXF = SIZE(YD)
686	YDSC%NUMFLDS = KFLDS
687	YDSC%NLEVS = -1
688	YDSC%IPTR = 1
689	YDSC%LMTL = LDMTL
690	YDSC%CGRPNAME = CDGRPNAME
691	YDSC%NDIM5 = 0
692	YDSC%NOFFTRAJ = NOFFTRAJ
693	YDSC%NOFFTRAJ_CST = NOFFTRAJ_CST
694
695	NSURF = NSURF+YDSC%NUMFLDS
696	NSURFL = NSURFL+YDSC%NUMFLDS
697	IF(LDMTL) THEN
698	NPROGSURF = NPROGSURF+YDSC%NUMFLDS
699	NPROGSURFL = NPROGSURFL+YDSC%NUMFLDS
700	ENDIF
701
702	IF(LDMTL) THEN
703	IF (LTWOTL) THEN
704	YDSC%NDIM = 2*YDSC%NUMFLDS
705	ELSE
706	YDSC%NDIM = 3*YDSC%NUMFLDS
707	ENDIF
708	ELSE
709	YDSC%NDIM = YDSC%NUMFLDS
710	ENDIF
711	NDIMSURF = NDIMSURF + YDSC%NDIM
712	NDIMSURFL = NDIMSURFL + YDSC%NDIM
713	DO JFLD=1,KFLDS
714	YD(JFLD)%IGRBCODE = -999
715	YD(JFLD)%CNAME = ''
716	YD(JFLD)%REFVALI = 0.0_JPRB
717	YD(JFLD)%NREQIN = -1
718	YD(JFLD)%MP = JFLD
719	IF (YDSC%LMTL) THEN
720	YD(JFLD)%MP0 = YD(JFLD)%MP
721	IF(LTWOTL) THEN
722	YD(JFLD)%MP9 = YD(JFLD)%MP0
723	YD(JFLD)%MP1 = YD(JFLD)%MP0+YDSC%NUMFLDS
724	ELSE
725	YD(JFLD)%MP9 = YD(JFLD)%MP0+YDSC%NUMFLDS
726	YD(JFLD)%MP1 = YD(JFLD)%MP0+2*YDSC%NUMFLDS
727	ENDIF
728	ELSE
729	YD(JFLD)%MP0 = NUNDEFLD
730	YD(JFLD)%MP9 = NUNDEFLD
731	YD(JFLD)%MP1 = NUNDEFLD
732	ENDIF
733	YD(JFLD)%MP5 = NUNDEFLD
734	YD(JFLD)%ITRAJ = 0
735	ENDDO
736
737	DO JFLD=KFLDS+1,IMAXF
738	YD(JFLD)%MP = NUNDEFLD
739	YD(JFLD)%MP0 = NUNDEFLD
740	YD(JFLD)%MP9 = NUNDEFLD
741	YD(JFLD)%MP1 = NUNDEFLD
742	YD(JFLD)%MP5 = NUNDEFLD
743	YD(JFLD)%ITRAJ = 0
744	ENDDO
745
746	WRITE(NULOUT,*) 'INITIALIZING 2-D SURFACE FIELD GROUP ', YDSC%CGRPNAME
747	WRITE(NULOUT,*) 'NUMFLDS=',YDSC%NUMFLDS,' LMTL=',YDSC%LMTL
748
749	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP2',1,ZHOOK_HANDLE)
750	END SUBROUTINE INI_SFLP2
751
752	!=========================================================================
753
754	SUBROUTINE SETUP_SFLP2(YDSC,YD,KGRIB,CDNAME,PDEFAULT,KTRAJ,KREQIN)
755	! Setup 2-D surface field
756	TYPE(TYPE_SURF_GEN),INTENT(INOUT) :: YDSC
757	TYPE(TYPE_SURF_MTL_2D),INTENT(INOUT) :: YD
758	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB
759	CHARACTER(LEN=16) ,OPTIONAL,INTENT(IN) :: CDNAME
760	REAL(KIND=JPRB) ,OPTIONAL,INTENT(IN) :: PDEFAULT
761	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTRAJ
762	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREQIN
763
764	INTEGER(KIND=JPIM) :: IPTR
765	REAL(KIND=JPRB) :: ZHOOK_HANDLE
766
767	!-------------------------------------------------------------------------
768
769	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP2',0,ZHOOK_HANDLE)
770	IPTR = YDSC%IPTR
771	IF(IPTR > YDSC%NUMFLDS) THEN
772	WRITE(NULERR,*) 'SURFACE FIELDS UNDER-DIMENSINED - GROUP ',YDSC%CGRPNAME,YDSC%NUMFLDS,KGRIB,CDNAME
773	CALL ABOR1('IPTR > YDSC%NUMFLDS')
774	ENDIF
775	IF(PRESENT(KGRIB)) THEN
776	YD%IGRBCODE = KGRIB
777	ENDIF
778	IF(PRESENT(KREQIN)) THEN
779	YD%NREQIN = KREQIN
780	ENDIF
781	IF(PRESENT(CDNAME)) THEN
782	YD%CNAME = CDNAME
783	ENDIF
784	IF(PRESENT(PDEFAULT)) THEN
785	YD%REFVALI = PDEFAULT
786	ENDIF
787	IF(PRESENT(KTRAJ)) THEN
788	IF(KTRAJ == 1) THEN
789	NSTRAJGRIB(NOFFTRAJ+1) = YD%IGRBCODE
790	NOFFTRAJ = NOFFTRAJ+1
791	ELSEIF(KTRAJ == 2) THEN
792	NOFFTRAJ_CST = NOFFTRAJ_CST+1
793	ELSEIF(KTRAJ /= 0) THEN
794	CALL ABOR1('SURFACE_FIELDS:SETUP_SFLP2 - UNKNOWN KTRAJ')
795	ENDIF
796	YD%ITRAJ = KTRAJ
797	YDSC%NDIM5 = YDSC%NDIM5+1
798	YD%MP5 = YDSC%NDIM5
799	ENDIF
800	IF(YDSC%LMTL) THEN
801	WRITE(NULOUT,'(1X,A,I4,1X,A,6I4)') &
802	& YDSC%CGRPNAME(1:6),YDSC%IPTR,YD%CNAME,YD%IGRBCODE,&
803	& YD%MP0,YD%MP9,YD%MP1,YD%ITRAJ,YD%NREQIN
804	ELSE
805	WRITE(NULOUT,'(1X,A,I4,1X,A,4I4)') &
806	& YDSC%CGRPNAME(1:6),YDSC%IPTR,YD%CNAME,YD%IGRBCODE,YD%MP,YD%ITRAJ,YD%NREQIN
807	ENDIF
808
809	YDSC%IPTR = YDSC%IPTR+1
810	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP2',1,ZHOOK_HANDLE)
811	END SUBROUTINE SETUP_SFLP2
812
813	!=========================================================================
814
815	SUBROUTINE GPPOPER(CDACT,KBL,PSP_SB,PSP_SG,PSP_RR,PSP_EP,PSP_X2,YDCOM)
816	! Operations on prognostic surface fields
817	CHARACTER(LEN=*),INTENT(IN) :: CDACT
818	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBL
819	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SB(:,:,:)
820	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SG(:,:)
821	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_RR(:,:)
822	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_EP(:,:,:)
823	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_X2(:,:)
824	TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
825
826
827	REAL(KIND=JPRB) :: ZHOOK_HANDLE
828
829	!-------------------------------------------------------------------------
830
831	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPPOPER',0,ZHOOK_HANDLE)
832	IF(PRESENT(KBL)) THEN
833	CALL GPOPER_3(CDACT,SP_SB(:,:,:,KBL),YSP_SBD,YSP_SB%YSB,YDCOM)
834	CALL GPOPER_2(CDACT,SP_SG(:,:,KBL) ,YSP_SGD,YSP_SG%YSG,YDCOM)
835	CALL GPOPER_2(CDACT,SP_RR(:,:,KBL) ,YSP_RRD,YSP_RR%YRR,YDCOM)
836	CALL GPOPER_3(CDACT,SP_EP(:,:,:,KBL),YSP_EPD,YSP_EP%YEP,YDCOM)
837	CALL GPOPER_2(CDACT,SP_X2(:,:,KBL) ,YSP_X2D,YSP_X2%YX2,YDCOM)
838	ELSE
839	IF(PRESENT(PSP_SB)) CALL GPOPER_3(CDACT,PSP_SB(:,:,:),YSP_SBD,YSP_SB%YSB,YDCOM)
840	IF(PRESENT(PSP_SG)) CALL GPOPER_2(CDACT,PSP_SG(:,:) ,YSP_SGD,YSP_SG%YSG,YDCOM)
841	IF(PRESENT(PSP_RR)) CALL GPOPER_2(CDACT,PSP_RR(:,:) ,YSP_RRD,YSP_RR%YRR,YDCOM)
842	IF(PRESENT(PSP_EP)) CALL GPOPER_3(CDACT,PSP_EP(:,:,:),YSP_EPD,YSP_EP%YEP,YDCOM)
843	IF(PRESENT(PSP_X2)) CALL GPOPER_2(CDACT,PSP_X2(:,:) ,YSP_X2D,YSP_X2%YX2,YDCOM)
844	ENDIF
845	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPPOPER',1,ZHOOK_HANDLE)
846	END SUBROUTINE GPPOPER
847
848	!=========================================================================
849
850	SUBROUTINE GPOPER(CDACT,KBL,PSP_SB,PSP_SG,PSP_RR,PSD_VF,PSD_VV,YDCOM,PFIELD,PFIELD2)
851	!Operations on ALL surface groups
852	CHARACTER(LEN=*),INTENT(IN) :: CDACT
853	INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBL
854	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SB(:,:,:)
855	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SG(:,:)
856	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_RR(:,:)
857	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSD_VF(:,:)
858	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSD_VV(:,:)
859	TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
860	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD(:,:)
861	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD2(:,:)
862	REAL(KIND=JPRB) :: ZHOOK_HANDLE
863
864	!-------------------------------------------------------------------------
865
866	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER',0,ZHOOK_HANDLE)
867	IF(CDACT == 'PUTALLFLDS' .OR. CDACT == 'GETALLFLDS' .OR.&
868	& CDACT == 'TRAJSTORE' .OR. CDACT == 'TRAJSTORECST' .OR. &
869	& CDACT == 'SET0TOTRAJ' .OR. CDACT == 'GETTRAJ' ) THEN
870	IF(.NOT.PRESENT(PFIELD)) CALL ABOR1('SURFACE_FIELDS:GPOPER - PFIELD MISSING')
871	IF(SIZE(PFIELD,1) < NPROMA) CALL ABOR1('SURFACE_FIELDS:GPOPER - SIZE(PFIELD,1) < NPROMA)')
872	ENDIF
873	IF(CDACT == 'PUTALLFLDS' .OR. CDACT == 'GETALLFLDS') THEN
874	IF(SIZE(PFIELD,2) < NPROGSURFL) CALL ABOR1('SURFACE_FIELDS:GPOPER - SIZE(PFIELD,2) < NPROGSURFL)')
875	ENDIF
876	IF(CDACT == 'GETTRAJ') THEN
877	IF(.NOT.PRESENT(PFIELD2)) CALL ABOR1('SURFACE_FIELDS:GPOPER - PFIELD2 MISSING')
878	IF(SIZE(PFIELD2,1) < NPROMA) CALL ABOR1('SURFACE_FIELDS:GPOPER - SIZE(PFIELD2,1) < NPROMA)')
879	ENDIF
880	IF(PRESENT(YDCOM)) THEN
881	YDCOM%L_OK = .FALSE.
882	YDCOM%IPTRSURF = 0
883	YDCOM%ICOUNT = 0
884	ENDIF
885
886	NPTRSURF = 0
887	IF(PRESENT(KBL)) THEN
888	IF(YSP_SBD%NDIM > 0) THEN
889	CALL GPOPER_3(CDACT,SP_SB(:,:,:,KBL),YSP_SBD,YSP_SB%YSB,YDCOM,PFIELD,PFIELD2)
890	ENDIF
891	IF(YSP_SGD%NDIM > 0) THEN
892	CALL GPOPER_2(CDACT,SP_SG(:,:,KBL) ,YSP_SGD,YSP_SG%YSG,YDCOM,PFIELD,PFIELD2)
893	ENDIF
894	IF(YSP_RRD%NDIM > 0) THEN
895	CALL GPOPER_2(CDACT,SP_RR(:,:,KBL) ,YSP_RRD,YSP_RR%YRR,YDCOM,PFIELD,PFIELD2)
896	ENDIF
897	IF(YSP_EPD%NDIM > 0) THEN
898	CALL GPOPER_3(CDACT,SP_EP(:,:,:,KBL),YSP_EPD,YSP_EP%YEP,YDCOM,PFIELD,PFIELD2)
899	ENDIF
900	IF(YSP_X2D%NDIM > 0) THEN
901	CALL GPOPER_2(CDACT,SP_X2(:,:,KBL) ,YSP_X2D,YSP_X2%YX2,YDCOM,PFIELD,PFIELD2)
902	ENDIF
903	IF(YSD_VFD%NDIM > 0) THEN
904	CALL GPOPER_2(CDACT,SD_VF(:,:,KBL) ,YSD_VFD,YSD_VF%YVF,YDCOM,PFIELD,PFIELD2)
905	ENDIF
906	IF(YSD_VPD%NDIM > 0) THEN
907	CALL GPOPER_2(CDACT,SD_VP(:,:,KBL) ,YSD_VPD,YSD_VP%YVP,YDCOM,PFIELD,PFIELD2)
908	ENDIF
909	IF(YSD_VVD%NDIM > 0) THEN
910	CALL GPOPER_2(CDACT,SD_VV(:,:,KBL) ,YSD_VVD,YSD_VV%YVV,YDCOM,PFIELD,PFIELD2)
911	ENDIF
912	IF(YSD_VND%NDIM > 0) THEN
913	CALL GPOPER_2(CDACT,SD_VN(:,:,KBL) ,YSD_VND,YSD_VN%YVN,YDCOM,PFIELD,PFIELD2)
914	ENDIF
915	IF(YSD_VHD%NDIM > 0) THEN
916	CALL GPOPER_2(CDACT,SD_VH(:,:,KBL) ,YSD_VHD,YSD_VH%YVH,YDCOM,PFIELD,PFIELD2)
917	ENDIF
918	IF(YSD_VAD%NDIM > 0) THEN
919	CALL GPOPER_2(CDACT,SD_VA(:,:,KBL) ,YSD_VAD,YSD_VA%YVA,YDCOM,PFIELD,PFIELD2)
920	ENDIF
921	IF(YSD_VCD%NDIM > 0) THEN
922	CALL GPOPER_2(CDACT,SD_VC(:,:,KBL) ,YSD_VCD,YSD_VC%YVC,YDCOM,PFIELD,PFIELD2)
923	ENDIF
924	IF(YSD_VDD%NDIM > 0) THEN
925	CALL GPOPER_2(CDACT,SD_VD(:,:,KBL) ,YSD_VDD,YSD_VD%YVD,YDCOM,PFIELD,PFIELD2)
926	ENDIF
927	IF(YSD_WSD%NDIM > 0) THEN
928	CALL GPOPER_2(CDACT,SD_WS(:,:,KBL) ,YSD_WSD,YSD_WS%YWS,YDCOM,PFIELD,PFIELD2)
929	ENDIF
930	IF(YSD_XAD%NDIM > 0) THEN
931	CALL GPOPER_3(CDACT,SD_XA(:,:,:,KBL),YSD_XAD,YSD_XA%YXA,YDCOM,PFIELD,PFIELD2)
932	ENDIF
933	IF(YSD_X2D%NDIM > 0) THEN
934	CALL GPOPER_2(CDACT,SD_X2(:,:,KBL) ,YSD_X2D,YSD_X2%YX2,YDCOM,PFIELD,PFIELD2)
935	ENDIF
936	IF(YSD_VXD%NDIM > 0) THEN
937	CALL GPOPER_2(CDACT,SD_VX(:,:,KBL) ,YSD_VXD,YSD_VX%YVX,YDCOM,PFIELD,PFIELD2)
938	ENDIF
939	ELSE
940	IF(YSP_SBD%NDIM > 0) THEN
941	IF(PRESENT(PSP_SB)) &
942	& CALL GPOPER_3(CDACT,PSP_SB,YSP_SBD,YSP_SB%YSB,YDCOM,PFIELD,PFIELD2)
943	ENDIF
944	IF(YSP_SGD%NDIM > 0) THEN
945	IF(PRESENT(PSP_SG)) &
946	& CALL GPOPER_2(CDACT,PSP_SG,YSP_SGD,YSP_SG%YSG,YDCOM,PFIELD,PFIELD2)
947	ENDIF
948	IF(YSP_RRD%NDIM > 0) THEN
949	IF(PRESENT(PSP_RR)) &
950	& CALL GPOPER_2(CDACT,PSP_RR,YSP_RRD,YSP_RR%YRR,YDCOM,PFIELD,PFIELD2)
951	ENDIF
952	IF(YSD_VFD%NDIM > 0) THEN
953	IF(PRESENT(PSD_VF)) &
954	& CALL GPOPER_2(CDACT,PSD_VF,YSD_VFD,YSD_VF%YVF,YDCOM,PFIELD,PFIELD2)
955	ENDIF
956	IF(YSD_VVD%NDIM > 0) THEN
957	IF(PRESENT(PSD_VV)) &
958	& CALL GPOPER_2(CDACT,PSD_VV,YSD_VVD,YSD_VV%YVV,YDCOM,PFIELD,PFIELD2)
959	ENDIF
960	ENDIF
961	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER',1,ZHOOK_HANDLE)
962	END SUBROUTINE GPOPER
963
964	!=========================================================================
965
966	SUBROUTINE GPOPER_2(CDACT,PFLD,YDSC,YD,YDCOM,PFIELD,PFIELD2)
967	! Operations on 2-D surface groups
968	CHARACTER(LEN=*),INTENT(IN) :: CDACT
969	REAL(KIND=JPRB),INTENT(INOUT) :: PFLD(:,:)
970	TYPE(TYPE_SURF_GEN),INTENT(IN) :: YDSC
971	TYPE(TYPE_SURF_MTL_2D),INTENT(IN) :: YD(:)
972	TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
973	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD(:,:)
974	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD2(:,:)
975
976	INTEGER(KIND=JPIM) :: J,IPTR,IPTR2
977	REAL(KIND=JPRB) :: ZZPHY
978	REAL(KIND=JPRB) :: ZHOOK_HANDLE
979
980	!-------------------------------------------------------------------------
981
982	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_2',0,ZHOOK_HANDLE)
983	IF(CDACT == 'SET9TO0') THEN
984	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
985	DO J=1,YDSC%NUMFLDS
986	PFLD(:,YD(J)%MP9) = PFLD(:,YD(J)%MP0)
987	ENDDO
988	ELSEIF(CDACT == 'SET1TO0') THEN
989	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
990	DO J=1,YDSC%NUMFLDS
991	PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP0)
992	ENDDO
993	ELSEIF(CDACT == 'SET1TO9') THEN
994	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
995	DO J=1,YDSC%NUMFLDS
996	PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP9)
997	ENDDO
998	ELSEIF(CDACT == 'SET1TO9AD') THEN
999	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1000	DO J=1,YDSC%NUMFLDS
1001	PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP9)+PFLD(:,YD(J)%MP1)
1002	PFLD(:,YD(J)%MP1) = 0.0_JPRB
1003	ENDDO
1004	ELSEIF(CDACT == 'SET0TO1') THEN
1005	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1006	DO J=1,YDSC%NUMFLDS
1007	PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP1)
1008	ENDDO
1009	ELSEIF(CDACT == 'SET0TO1AD') THEN
1010	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1011	DO J=1,YDSC%NUMFLDS
1012	PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP1)+PFLD(:,YD(J)%MP0)
1013	PFLD(:,YD(J)%MP0) = 0.0_JPRB
1014	ENDDO
1015	ELSEIF(CDACT == 'SET9TO1') THEN
1016	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1017	DO J=1,YDSC%NUMFLDS
1018	PFLD(:,YD(J)%MP9) = PFLD(:,YD(J)%MP1)
1019	ENDDO
1020	ELSEIF(CDACT == 'PHTFILT') THEN
1021	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1022	ZZPHY=1.0_JPRB-REPSP1
1023	DO J=1,YDSC%NUMFLDS
1024	PFLD(:,YD(J)%MP9) = REPSP1PFLD(:,YD(J)%MP1)+ZZPHYPFLD(:,YD(J)%MP0)
1025	PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP1)
1026	ENDDO
1027	ELSEIF(CDACT == 'PHTFILTAD') THEN
1028	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1029	ZZPHY=1.0_JPRB-REPSP1
1030	DO J=1,YDSC%NUMFLDS
1031	PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP1)+PFLD(:,YD(J)%MP0)
1032	PFLD(:,YD(J)%MP0) = 0.0_JPRB
1033	PFLD(:,YD(J)%MP1) = PFLD(:,YD(J)%MP1)+REPSP1*PFLD(:,YD(J)%MP9)
1034	PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP0)+ZZPHY *PFLD(:,YD(J)%MP9)
1035	PFLD(:,YD(J)%MP9) = 0.0_JPRB
1036	ENDDO
1037	ELSEIF(CDACT == 'SET0TOVAL') THEN
1038	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1039	DO J=1,YDSC%NUMFLDS
1040	PFLD(:,YD(J)%MP0) = YDCOM%VALUE
1041	ENDDO
1042	ELSEIF(CDACT == 'SET9TOVAL') THEN
1043	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1044	DO J=1,YDSC%NUMFLDS
1045	PFLD(:,YD(J)%MP9) = YDCOM%VALUE
1046	ENDDO
1047	ELSEIF(CDACT == 'SET1TOVAL') THEN
1048	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1049	DO J=1,YDSC%NUMFLDS
1050	PFLD(:,YD(J)%MP1) = YDCOM%VALUE
1051	ENDDO
1052	ELSEIF(CDACT == 'SETALLTOVAL') THEN
1053	DO J=1,YDSC%NDIM
1054	PFLD(:,J) = YDCOM%VALUE
1055	ENDDO
1056	ELSEIF(CDACT == 'SETDEFAULT') THEN
1057	DO J=1,YDSC%NUMFLDS
1058	IF(YD(J)%NREQIN == -1) THEN
1059	PFLD(:,YD(J)%MP) = YD(J)%REFVALI
1060	ENDIF
1061	ENDDO
1062	ELSEIF(CDACT == 'TRAJSTORE') THEN
1063	IF(YDSC%NDIM5 > 0 ) THEN
1064	IPTR = YDSC%NOFFTRAJ
1065	DO J=1,YDSC%NUMFLDS
1066	IF(YD(J)%ITRAJ == 1) THEN
1067	IPTR = IPTR+1
1068	PFIELD(:,IPTR) = PFLD(:,YD(J)%MP)
1069	ENDIF
1070	ENDDO
1071	ENDIF
1072	ELSEIF(CDACT == 'TRAJSTORECST') THEN
1073	IF(YDSC%NDIM5 > 0 ) THEN
1074	IPTR2 = YDSC%NOFFTRAJ_CST
1075	DO J=1,YDSC%NUMFLDS
1076	IF(YD(J)%ITRAJ == 2) THEN
1077	IPTR2 = IPTR2+1
1078	PFIELD(:,IPTR2) = PFLD(:,YD(J)%MP)
1079	ENDIF
1080	ENDDO
1081	ENDIF
1082	ELSEIF(CDACT == 'SET0TOTRAJ') THEN
1083	IF(YDSC%NDIM5 > 0 ) THEN
1084	IPTR = YDSC%NOFFTRAJ
1085	DO J=1,YDSC%NUMFLDS
1086	IF(YD(J)%ITRAJ == 1) THEN
1087	IPTR = IPTR+1
1088	PFLD(:,YD(J)%MP) = PFIELD(:,IPTR)
1089	ENDIF
1090	ENDDO
1091	ENDIF
1092	ELSEIF(CDACT == 'GETTRAJ') THEN
1093	IF(YDSC%NDIM5 > 0 ) THEN
1094	IPTR = YDSC%NOFFTRAJ
1095	IPTR2 = YDSC%NOFFTRAJ_CST
1096	DO J=1,YDSC%NUMFLDS
1097	IF(YD(J)%ITRAJ == 1) THEN
1098	IPTR = IPTR+1
1099	PFLD(:,YD(J)%MP5) = PFIELD(:,IPTR)
1100	ELSEIF(YD(J)%ITRAJ == 2) THEN
1101	IPTR2 = IPTR2+1
1102	PFLD(:,YD(J)%MP5) = PFIELD2(:,IPTR2)
1103	ENDIF
1104	ENDDO
1105	ENDIF
1106	ELSEIF(CDACT == 'GETALLFLDS') THEN
1107	DO J=1,YDSC%NDIM
1108	NPTRSURF = NPTRSURF+1
1109	PFIELD(:,NPTRSURF) = PFLD(:,J)
1110	ENDDO
1111	ELSEIF(CDACT == 'PUTALLFLDS') THEN
1112	DO J=1,YDSC%NDIM
1113	NPTRSURF = NPTRSURF+1
1114	PFLD(:,J) = PFIELD(:,NPTRSURF)
1115	ENDDO
1116	ELSEIF(CDACT == 'GETGRIBPOS') THEN
1117	DO J=1,YDSC%NUMFLDS
1118	YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1119	IF(YD(J)%IGRBCODE == YDCOM%IGRBCODE) THEN
1120	YDCOM%IFLDNUM = YDCOM%IPTRSURF
1121	YDCOM%L_OK = .TRUE.
1122	ENDIF
1123	ENDDO
1124	ELSEIF(CDACT == 'GETFIELD') THEN
1125	DO J=1,YDSC%NUMFLDS
1126	YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1127	IF(YDCOM%IPTRSURF == YDCOM%IFLDNUM) THEN
1128	PFIELD(:,1) = PFLD(:,J)
1129	YDCOM%L_OK = .TRUE.
1130	ENDIF
1131	ENDDO
1132	ELSEIF(CDACT == 'GRIBIN') THEN
1133	DO J=1,YDSC%NUMFLDS
1134	YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1135	IF(YD(J)%NREQIN == 1) THEN
1136	YDCOM%ICOUNT = YDCOM%ICOUNT+1
1137	YDCOM%ICODES(YDCOM%ICOUNT) = YD(J)%IGRBCODE
1138	ENDIF
1139	ENDDO
1140	ELSE
1141	WRITE(NULOUT,*) 'SURFACE_FIELD:GPPOPER UNKNOWN ACTION - ',CDACT
1142	CALL ABOR1('SURFACE_FIELD:GPPOPER - UNKNOWN ACTION')
1143	ENDIF
1144	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_2',1,ZHOOK_HANDLE)
1145	END SUBROUTINE GPOPER_2
1146
1147	!=========================================================================
1148
1149	SUBROUTINE GPOPER_3(CDACT,PFLD,YDSC,YD,YDCOM,PFIELD,PFIELD2)
1150	! Operations on 3-D surface groups
1151	CHARACTER(LEN=*),INTENT(IN) :: CDACT
1152	REAL(KIND=JPRB),INTENT(INOUT) :: PFLD(:,:,:)
1153	TYPE(TYPE_SURF_GEN),INTENT(IN) :: YDSC
1154	TYPE(TYPE_SURF_MTL_3D),INTENT(IN) :: YD(:)
1155	TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
1156	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD(:,:)
1157	REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD2(:,:)
1158
1159	INTEGER(KIND=JPIM) :: J,JLEV,IPTR,IPTR2
1160	REAL(KIND=JPRB) :: ZZPHY
1161	REAL(KIND=JPRB) :: ZHOOK_HANDLE
1162
1163	!-------------------------------------------------------------------------
1164
1165	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_3',0,ZHOOK_HANDLE)
1166	IF(CDACT == 'SET9TO0') THEN
1167	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1168	DO J=1,YDSC%NUMFLDS
1169	PFLD(:,:,YD(J)%MP9) = PFLD(:,:,YD(J)%MP0)
1170	ENDDO
1171	ELSEIF(CDACT == 'SET1TO0') THEN
1172	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1173	DO J=1,YDSC%NUMFLDS
1174	PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP0)
1175	ENDDO
1176	ELSEIF(CDACT == 'SET1TO9') THEN
1177	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1178	DO J=1,YDSC%NUMFLDS
1179	PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP9)
1180	ENDDO
1181	ELSEIF(CDACT == 'SET1TO9AD') THEN
1182	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1183	DO J=1,YDSC%NUMFLDS
1184	PFLD(:,:,YD(J)%MP9) = PFLD(:,:,YD(J)%MP9)+PFLD(:,:,YD(J)%MP1)
1185	PFLD(:,:,YD(J)%MP1) = 0.0_JPRB
1186	ENDDO
1187	ELSEIF(CDACT == 'SET0TO1') THEN
1188	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1189	DO J=1,YDSC%NUMFLDS
1190	PFLD(:,:,YD(J)%MP0) = PFLD(:,:,YD(J)%MP1)
1191	ENDDO
1192	ELSEIF(CDACT == 'SET0TO1AD') THEN
1193	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1194	DO J=1,YDSC%NUMFLDS
1195	PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP1)+PFLD(:,:,YD(J)%MP0)
1196	PFLD(:,:,YD(J)%MP0) = 0.0_JPRB
1197	ENDDO
1198	ELSEIF(CDACT == 'SET9TO1') THEN
1199	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1200	DO J=1,YDSC%NUMFLDS
1201	PFLD(:,:,YD(J)%MP9) = PFLD(:,:,YD(J)%MP1)
1202	ENDDO
1203	ELSEIF(CDACT == 'PHTFILT') THEN
1204	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1205	ZZPHY=1.0_JPRB-REPSP1
1206	DO J=1,YDSC%NUMFLDS
1207	PFLD(:,:,YD(J)%MP9) = REPSP1PFLD(:,:,YD(J)%MP1)+ZZPHYPFLD(:,:,YD(J)%MP0)
1208	PFLD(:,:,YD(J)%MP0) = PFLD(:,:,YD(J)%MP1)
1209	ENDDO
1210	ELSEIF(CDACT == 'PHTFILTAD') THEN
1211	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1212	ZZPHY=1.0_JPRB-REPSP1
1213	DO J=1,YDSC%NUMFLDS
1214	PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP1)+PFLD(:,:,YD(J)%MP0)
1215	PFLD(:,:,YD(J)%MP0) = 0.0_JPRB
1216	PFLD(:,:,YD(J)%MP1) = PFLD(:,:,YD(J)%MP1)+REPSP1*PFLD(:,:,YD(J)%MP9)
1217	PFLD(:,:,YD(J)%MP0) = PFLD(:,:,YD(J)%MP0)+ZZPHY *PFLD(:,:,YD(J)%MP9)
1218	PFLD(:,:,YD(J)%MP9) = 0.0_JPRB
1219	ENDDO
1220	ELSEIF(CDACT == 'SET0TOVAL') THEN
1221	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1222	DO J=1,YDSC%NUMFLDS
1223	PFLD(:,:,YD(J)%MP0) = YDCOM%VALUE
1224	ENDDO
1225	ELSEIF(CDACT == 'SET9TOVAL') THEN
1226	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1227	DO J=1,YDSC%NUMFLDS
1228	PFLD(:,:,YD(J)%MP9) = YDCOM%VALUE
1229	ENDDO
1230	ELSEIF(CDACT == 'SET1TOVAL') THEN
1231	IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1232	DO J=1,YDSC%NUMFLDS
1233	PFLD(:,:,YD(J)%MP1) = YDCOM%VALUE
1234	ENDDO
1235	ELSEIF(CDACT == 'SETALLTOVAL') THEN
1236	DO J=1,YDSC%NDIM
1237	PFLD(:,:,J) = YDCOM%VALUE
1238	ENDDO
1239	ELSEIF(CDACT == 'SETDEFAULT') THEN
1240	DO J=1,YDSC%NUMFLDS
1241	DO JLEV=1,YDSC%NLEVS
1242	IF(YD(J)%NREQIN(JLEV) == -1) THEN
1243	PFLD(:,JLEV,YD(J)%MP) = YD(J)%REFVALI(JLEV)
1244	ENDIF
1245	ENDDO
1246	ENDDO
1247	ELSEIF(CDACT == 'TRAJSTORE') THEN
1248	IF(YDSC%NDIM5 > 0 ) THEN
1249	IPTR = YDSC%NOFFTRAJ
1250	DO J=1,YDSC%NUMFLDS
1251	IF(YD(J)%ITRAJ == 1) THEN
1252	DO JLEV=1,YDSC%NLEVS
1253	IPTR = IPTR+1
1254	PFIELD(:,IPTR) = PFLD(:,JLEV,YD(J)%MP)
1255	ENDDO
1256	ENDIF
1257	ENDDO
1258	ENDIF
1259	ELSEIF(CDACT == 'TRAJSTORECST') THEN
1260	IF(YDSC%NDIM5 > 0 ) THEN
1261	IPTR2 = YDSC%NOFFTRAJ_CST
1262	DO J=1,YDSC%NUMFLDS
1263	IF(YD(J)%ITRAJ == 2) THEN
1264	DO JLEV=1,YDSC%NLEVS
1265	IPTR2 = IPTR2+1
1266	PFIELD(:,IPTR2) = PFLD(:,JLEV,YD(J)%MP)
1267	ENDDO
1268	ENDIF
1269	ENDDO
1270	ENDIF
1271	ELSEIF(CDACT == 'SET0TOTRAJ') THEN
1272	IF(YDSC%NDIM5 > 0 ) THEN
1273	IPTR = YDSC%NOFFTRAJ
1274	DO J=1,YDSC%NUMFLDS
1275	IF(YD(J)%ITRAJ == 1) THEN
1276	DO JLEV=1,YDSC%NLEVS
1277	IPTR = IPTR+1
1278	PFLD(:,JLEV,YD(J)%MP) = PFIELD(:,IPTR)
1279	ENDDO
1280	ENDIF
1281	ENDDO
1282	ENDIF
1283	ELSEIF(CDACT == 'GETTRAJ') THEN
1284	IF(YDSC%NDIM5 > 0 ) THEN
1285	IPTR = YDSC%NOFFTRAJ
1286	IPTR2 = YDSC%NOFFTRAJ_CST
1287	DO J=1,YDSC%NUMFLDS
1288	IF(YD(J)%ITRAJ == 1) THEN
1289	DO JLEV=1,YDSC%NLEVS
1290	IPTR = IPTR+1
1291	PFLD(:,JLEV,YD(J)%MP5) = PFIELD(:,IPTR)
1292	ENDDO
1293	ELSEIF(YD(J)%ITRAJ == 2) THEN
1294	DO JLEV=1,YDSC%NLEVS
1295	IPTR2 = IPTR2+1
1296	PFLD(:,JLEV,YD(J)%MP5) = PFIELD2(:,IPTR2)
1297	ENDDO
1298	ENDIF
1299	ENDDO
1300	ENDIF
1301	ELSEIF(CDACT == 'GETALLFLDS') THEN
1302	DO J=1,YDSC%NDIM
1303	DO JLEV=1,YDSC%NLEVS
1304	NPTRSURF = NPTRSURF+1
1305	PFIELD(:,NPTRSURF) = PFLD(:,JLEV,J)
1306	ENDDO
1307	ENDDO
1308	ELSEIF(CDACT == 'PUTALLFLDS') THEN
1309	DO J=1,YDSC%NDIM
1310	DO JLEV=1,YDSC%NLEVS
1311	NPTRSURF = NPTRSURF+1
1312	PFLD(:,JLEV,J) = PFIELD(:,NPTRSURF)
1313	ENDDO
1314	ENDDO
1315	ELSEIF(CDACT == 'GETGRIBPOS') THEN
1316	DO J=1,YDSC%NUMFLDS
1317	DO JLEV=1,YDSC%NLEVS
1318	YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1319	IF(YD(J)%IGRBCODE(JLEV) == YDCOM%IGRBCODE) THEN
1320	YDCOM%IFLDNUM = YDCOM%IPTRSURF
1321	YDCOM%L_OK = .TRUE.
1322	ENDIF
1323	ENDDO
1324	ENDDO
1325	ELSEIF(CDACT == 'GETFIELD') THEN
1326	DO J=1,YDSC%NUMFLDS
1327	DO JLEV=1,YDSC%NLEVS
1328	YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1329	IF(YDCOM%IPTRSURF == YDCOM%IFLDNUM) THEN
1330	PFIELD(:,1) = PFLD(:,JLEV,J)
1331	YDCOM%L_OK = .TRUE.
1332	ENDIF
1333	ENDDO
1334	ENDDO
1335	ELSEIF(CDACT == 'GRIBIN') THEN
1336	DO J=1,YDSC%NUMFLDS
1337	DO JLEV=1,YDSC%NLEVS
1338	YDCOM%IPTRSURF = YDCOM%IPTRSURF+1
1339	IF(YD(J)%NREQIN(JLEV) == 1) THEN
1340	YDCOM%ICOUNT = YDCOM%ICOUNT+1
1341	YDCOM%ICODES(YDCOM%ICOUNT) = YD(J)%IGRBCODE(JLEV)
1342	ENDIF
1343	ENDDO
1344	ENDDO
1345	ELSE
1346	WRITE(NULOUT,*) 'SURFACE_FIELD:GPPOPER UNKNOWN ACTION - ',CDACT
1347	CALL ABOR1('SURFACE_FIELD:GPPOPER - UNKNOWN ACTION')
1348	ENDIF
1349	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_3',1,ZHOOK_HANDLE)
1350	END SUBROUTINE GPOPER_3
1351
1352	!=========================================================================
1353
1354	SUBROUTINE SURF_STORE
1355	! Store all surface fields
1356	INTEGER(KIND=JPIM) :: JBL
1357	REAL(KIND=JPRB) :: ZHOOK_HANDLE
1358
1359	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_STORE',0,ZHOOK_HANDLE)
1360	ALLOCATE(SURF_STORE_ARRAY(NPROMA,NDIMSURFL,NGPBLKS))
1361	DO JBL=1,NGPBLKS
1362	CALL GPOPER('GETALLFLDS',KBL=JBL,PFIELD=SURF_STORE_ARRAY(:,:,JBL))
1363	ENDDO
1364	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_STORE',1,ZHOOK_HANDLE)
1365	END SUBROUTINE SURF_STORE
1366
1367	!=========================================================================
1368
1369	SUBROUTINE SURF_RESTORE
1370	! Restore all surface fields
1371	INTEGER(KIND=JPIM) :: JBL
1372	REAL(KIND=JPRB) :: ZHOOK_HANDLE
1373
1374	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_RESTORE',0,ZHOOK_HANDLE)
1375	IF(.NOT. ALLOCATED(SURF_STORE_ARRAY)) &
1376	& CALL ABOR1('SURFACE_FIELDS:SURF_RESTORE - SURF_STORE NOT ALLOCATED')
1377	DO JBL=1,NGPBLKS
1378	CALL GPOPER('PUTALLFLDS',KBL=JBL,PFIELD=SURF_STORE_ARRAY(:,:,JBL))
1379	ENDDO
1380	DEALLOCATE(SURF_STORE_ARRAY)
1381	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_RESTORE',1,ZHOOK_HANDLE)
1382
1383	END SUBROUTINE SURF_RESTORE
1384
1385	!=========================================================================
1386
1387	SUBROUTINE ALLO_SURF
1388	! Allocate surface field arrays
1389	REAL(KIND=JPRB) :: ZHOOK_HANDLE
1390
1391	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:ALLO_SURF',0,ZHOOK_HANDLE)
1392	ALLOCATE(SP_SB(NPROMA,YSP_SBD%NLEVS,YSP_SBD%NDIM,NGPBLKS))
1393	ALLOCATE(SP_SG(NPROMA,YSP_SGD%NDIM,NGPBLKS))
1394	ALLOCATE(SP_RR(NPROMA,YSP_RRD%NDIM,NGPBLKS))
1395	ALLOCATE(SP_EP(NPROMA,YSP_EPD%NLEVS,YSP_EPD%NDIM,NGPBLKS))
1396	ALLOCATE(SP_X2(NPROMA,YSP_X2D%NDIM,NGPBLKS))
1397	ALLOCATE(SP_CI(NPROMA,YSP_CID%NDIM,NGPBLKS))
1398	ALLOCATE(SD_VF(NPROMA,YSD_VFD%NDIM,NGPBLKS))
1399	ALLOCATE(SD_VP(NPROMA,YSD_VPD%NDIM,NGPBLKS))
1400	ALLOCATE(SD_VV(NPROMA,YSD_VVD%NDIM,NGPBLKS))
1401	ALLOCATE(SD_VN(NPROMA,YSD_VND%NDIM,NGPBLKS))
1402	ALLOCATE(SD_VH(NPROMA,YSD_VHD%NDIM,NGPBLKS))
1403	ALLOCATE(SD_VA(NPROMA,YSD_VAD%NDIM,NGPBLKS))
1404	ALLOCATE(SD_VC(NPROMA,YSD_VCD%NDIM,NGPBLKS))
1405	ALLOCATE(SD_VD(NPROMA,YSD_VDD%NDIM,NGPBLKS))
1406	ALLOCATE(SD_WS(NPROMA,YSD_WSD%NDIM,NGPBLKS))
1407	ALLOCATE(SD_XA(NPROMA,YSD_XAD%NLEVS,YSD_XAD%NDIM,NGPBLKS))
1408	ALLOCATE(SD_X2(NPROMA,YSD_X2D%NDIM,NGPBLKS))
1409	ALLOCATE(SD_VX(NPROMA,YSD_VXD%NDIM,NGPBLKS))
1410
1411	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:ALLO_SURF',1,ZHOOK_HANDLE)
1412	END SUBROUTINE ALLO_SURF
1413
1414	!=========================================================================
1415
1416	SUBROUTINE DEALLO_SURF
1417	! Deallocate surface field arrays
1418	REAL(KIND=JPRB) :: ZHOOK_HANDLE
1419
1420	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:DEALLO_SURF',0,ZHOOK_HANDLE)
1421	IF(ALLOCATED(SP_SB)) DEALLOCATE(SP_SB)
1422	IF(ALLOCATED(SP_SG)) DEALLOCATE(SP_SG)
1423	IF(ALLOCATED(SP_RR)) DEALLOCATE(SP_RR)
1424	IF(ALLOCATED(SP_EP)) DEALLOCATE(SP_EP)
1425	IF(ALLOCATED(SP_X2)) DEALLOCATE(SP_X2)
1426	IF(ALLOCATED(SP_CI)) DEALLOCATE(SP_CI)
1427	IF(ALLOCATED(SD_VF)) DEALLOCATE(SD_VF)
1428	IF(ALLOCATED(SD_VP)) DEALLOCATE(SD_VP)
1429	IF(ALLOCATED(SD_VV)) DEALLOCATE(SD_VV)
1430	IF(ALLOCATED(SD_VN)) DEALLOCATE(SD_VN)
1431	IF(ALLOCATED(SD_VH)) DEALLOCATE(SD_VH)
1432	IF(ALLOCATED(SD_VA)) DEALLOCATE(SD_VA)
1433	IF(ALLOCATED(SD_VC)) DEALLOCATE(SD_VC)
1434	IF(ALLOCATED(SD_VD)) DEALLOCATE(SD_VD)
1435	IF(ALLOCATED(SD_WS)) DEALLOCATE(SD_WS)
1436	IF(ALLOCATED(SD_XA)) DEALLOCATE(SD_XA)
1437	IF(ALLOCATED(SD_X2)) DEALLOCATE(SD_X2)
1438	IF(ALLOCATED(SD_VX)) DEALLOCATE(SD_VX)
1439	IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:DEALLO_SURF',1,ZHOOK_HANDLE)
1440	END SUBROUTINE DEALLO_SURF
1441
1442	!=========================================================================
1443
1444	END MODULE SURFACE_FIELDS

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

Download in other formats:

Original Format