Context Navigation

surface_fields.F90 @ 5423

Last change on this file since 5423 was 2056, checked in by Laurent Fairhead, 11 years ago
Merged trunk changes r1997:2055 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: 54.1 KB

Rev	Line
[1989]	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
[2056]	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
[1989]	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