source: LMDZ5/branches/IPSLCM5A2.1/libf/phylmd/rrtm/surface_fields.F90 @ 3152

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

Modifications pour OpenMP

OpenMP modifications
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 54.1 KB
Line 
1MODULE 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
45USE PARKIND1  ,ONLY : JPIM     ,JPRB
46USE YOMDIM    ,ONLY : NPROMA, NGPBLKS, NUNDEFLD
47USE YOMLUN    ,ONLY : NULOUT, NULERR
48USE YOMCT0    ,ONLY : LTWOTL
49USE YOMDYN   , ONLY : REPSP1
50USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
51IMPLICIT NONE
52SAVE
53
54!#include "abor1.intfb.h"
55!     -------------------------------------------------------------------------
56
57INTEGER(KIND=JPIM), PARAMETER :: JPMAXSFLDS=100 ! Max number of fields in individual group
58INTEGER(KIND=JPIM), PARAMETER :: JPMAXSTRAJ=100 ! Dimension of NSTRAJGRIB
59INTEGER(KIND=JPIM) :: NSURF=0              ! Number of surf var.
60INTEGER(KIND=JPIM) :: NSURFL=0             ! Number of surf flds (fields*levels)
61INTEGER(KIND=JPIM) :: NDIMSURF=0           ! Total of surf var (includes timelevels etc)
62INTEGER(KIND=JPIM) :: NDIMSURFL=0          ! Total dimension of all surface variables
63INTEGER(KIND=JPIM) :: NPROGSURF=0          ! Number of prognostic surf var.
64INTEGER(KIND=JPIM) :: NPROGSURFL=0         ! Number of prognostic surf flds (fields*levels)
65INTEGER(KIND=JPIM) :: NOFFTRAJ             ! Offset in surf trajectory
66INTEGER(KIND=JPIM) :: NOFFTRAJ_CST         ! Offset in "constant" surf trajectory
67INTEGER(KIND=JPIM) :: NPTRSURF             ! Used by routine GPOPER
68INTEGER(KIND=JPIM) :: NSTRAJGRIB(JPMAXSTRAJ) ! Used in trajectory setup
69
70REAL(KIND=JPRB),ALLOCATABLE   :: SURF_STORE_ARRAY(:,:,:) ! Backup array for surf (see routineSURF_STORE )
71! General type defintions
72
73! 2D surface field structure
74TYPE TYPE_SURF_MTL_2D
75INTEGER(KIND=JPIM) :: MP                   ! Basic field pointer
76INTEGER(KIND=JPIM) :: MP0                  ! Field pointer timelevel  0 (prognostic fields)
77INTEGER(KIND=JPIM) :: MP9                  ! Field pointer timelevel -1 (prognostic fields)
78INTEGER(KIND=JPIM) :: MP1                  ! Field pointer timelevel +1 (prognostic fields)
79INTEGER(KIND=JPIM) :: MP5                  ! Field pointer trajectory
80INTEGER(KIND=JPIM) :: IGRBCODE             ! GRIB parameter code (default: -999)
81CHARACTER(LEN=16)  :: CNAME                ! ARPEGE field name   (default: all spaces)
82REAL(KIND=JPRB)    :: REFVALI              ! Default value       (default: 0.0)
83INTEGER(KIND=JPIM) :: NREQIN               ! -1 - initial value from default (default)
84                                           ! +1 - initial value from reading file
85                                           !  0 - no initial value
86INTEGER(KIND=JPIM) :: ITRAJ                !  0 not in trajectory (default)
87                                           !  1 in trajectory
88                                           !  2 in "constant" trajectory
89END TYPE TYPE_SURF_MTL_2D
90
91! 3D surface field structure
92TYPE TYPE_SURF_MTL_3D
93INTEGER(KIND=JPIM) :: MP   ! Basic field pointer
94INTEGER(KIND=JPIM) :: MP0  ! Field pointer timelevel  0 (prognostic fields)
95INTEGER(KIND=JPIM) :: MP9  ! Field pointer timelevel -1 (prognostic fields)
96INTEGER(KIND=JPIM) :: MP1  ! Field pointer timelevel +1 (prognostic fields)
97INTEGER(KIND=JPIM) :: MP5  ! Field pointer trajectory
98INTEGER(KIND=JPIM),POINTER :: IGRBCODE(:)  ! GRIB parameter code (default: -999)
99CHARACTER(LEN=16) ,POINTER :: CNAME(:)     ! ARPEGE field name   (default: all spaces)
100REAL(KIND=JPRB)   ,POINTER :: REFVALI(:)   ! Default value       (default: 0.0)
101INTEGER(KIND=JPIM),POINTER :: NREQIN(:)    ! -1 - initial value from default (default)
102                                           ! +1 - initial value from reading file
103                                           !  0 - no initial value
104INTEGER(KIND=JPIM) :: ITRAJ                !  0 not in trajectory (default)
105                                           !  1 in trajectory
106                                           !  2 in "constant" trajectory
107END TYPE TYPE_SURF_MTL_3D
108
109! Descriptor pertaining to group
110TYPE TYPE_SURF_GEN
111INTEGER(KIND=JPIM) :: NUMFLDS         ! Number of field in group
112INTEGER(KIND=JPIM) :: NDIM            ! Field dimenion
113INTEGER(KIND=JPIM) :: NLEVS           ! Number of levels (for multi level groups)
114INTEGER(KIND=JPIM) :: IPTR            ! Internal use
115INTEGER(KIND=JPIM) :: IPTR5           ! Internal use
116INTEGER(KIND=JPIM) :: NDIM5           ! Dimension of trajectory array
117INTEGER(KIND=JPIM) :: NOFFTRAJ        ! Internal use
118INTEGER(KIND=JPIM) :: NOFFTRAJ_CST    ! Internal use
119CHARACTER(LEN=16)  :: CGRPNAME        ! Name of group (for prints)
120LOGICAL            :: L3D             ! TRUE if multi-level field (3-D)
121LOGICAL            :: LMTL            ! TRUE if prognostic field (multi time level)
122END TYPE TYPE_SURF_GEN
123
124! Type descriptor for derived type for communicating with GPOPER (see below)
125TYPE TYPE_SFL_COMM
126INTEGER(KIND=JPIM) :: IGRBCODE
127LOGICAL            :: L_OK
128CHARACTER(LEN=16)  :: CNAME
129INTEGER(KIND=JPIM) :: IFLDNUM
130REAL(KIND=JPRB)    :: VALUE
131INTEGER(KIND=JPIM) :: IPTRSURF
132INTEGER(KIND=JPIM) :: ICODES(JPMAXSFLDS)
133INTEGER(KIND=JPIM) :: ICOUNT
134END 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):
140TYPE TYPE_SFL_SOILB
141TYPE(TYPE_SURF_MTL_3D),POINTER :: YT    ! temperature
142TYPE(TYPE_SURF_MTL_3D),POINTER :: YQ    ! liquid water content
143TYPE(TYPE_SURF_MTL_3D),POINTER :: YTL   ! ice water content (for MF)
144TYPE(TYPE_SURF_MTL_3D),POINTER :: YSB(:)
145END TYPE TYPE_SFL_SOILB
146
147! * Group SG=SNOWG: surface snow prognostic quantities:
148TYPE TYPE_SFL_SNOWG
149TYPE(TYPE_SURF_MTL_2D),POINTER :: YF    ! content of surface snow
150TYPE(TYPE_SURF_MTL_2D),POINTER :: YA    ! snow albedo
151TYPE(TYPE_SURF_MTL_2D),POINTER :: YR    ! snow density
152TYPE(TYPE_SURF_MTL_2D),POINTER :: YT    ! total albedo (diagnostic for MF for LVGSN)
153TYPE(TYPE_SURF_MTL_2D),POINTER :: YSG(:)
154END 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!).
172TYPE TYPE_SFL_RESVR
173TYPE(TYPE_SURF_MTL_2D),POINTER :: YT    ! skin temperature (Ts)
174TYPE(TYPE_SURF_MTL_2D),POINTER :: YW    ! skin water content (Wskin) at ECMWF
175                                        ! superficial reservoir water content (Ws) at MF
176TYPE(TYPE_SURF_MTL_2D),POINTER :: YFC   ! skin water content (Wl) at MF
177TYPE(TYPE_SURF_MTL_2D),POINTER :: YIC   ! superficial reservoir ice
178TYPE(TYPE_SURF_MTL_2D),POINTER :: YFP1  ! interpolated Ts for 2nd part of 927-FULLPOS
179TYPE(TYPE_SURF_MTL_2D),POINTER :: YRR(:)
180END TYPE TYPE_SFL_RESVR
181
182! * Group WS=WAVES: surface prognostic quantities over sea:
183TYPE TYPE_SFL_WAVES
184TYPE(TYPE_SURF_MTL_2D),POINTER :: YWS(:)
185TYPE(TYPE_SURF_MTL_2D),POINTER :: YCHAR ! Charnock constant
186END TYPE TYPE_SFL_WAVES
187
188! * Group EP=EXTRP: extra 3-d prognostic fields:
189TYPE TYPE_SFL_EXTRP
190TYPE(TYPE_SURF_MTL_3D),POINTER :: YEP(:)
191END TYPE TYPE_SFL_EXTRP
192
193! * Group X2=XTRP2: extra 2-d prognostic fields:
194!   (is used for precipitation fields in CANARI)
195TYPE TYPE_SFL_XTRP2
196TYPE(TYPE_SURF_MTL_2D),POINTER :: YX2(:)
197END TYPE TYPE_SFL_XTRP2
198
199! * Group CI=CANRI: 2-d prognostic fields for CANARI:
200TYPE TYPE_SFL_CANRI
201TYPE(TYPE_SURF_MTL_2D),POINTER :: YCI(:)
202END TYPE TYPE_SFL_CANRI
203
204! * Group VF=VARSF: climatological/geographical diagnostic fields:
205TYPE TYPE_SFL_VARSF
206TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0F    ! gravity * surface roughness length
207TYPE(TYPE_SURF_MTL_2D),POINTER :: YALBF   ! surface shortwave albedo
208TYPE(TYPE_SURF_MTL_2D),POINTER :: YEMISF  ! surface longwave emissivity
209TYPE(TYPE_SURF_MTL_2D),POINTER :: YGETRL  ! standard deviation of orography
210TYPE(TYPE_SURF_MTL_2D),POINTER :: YITM    ! land-sea mask
211TYPE(TYPE_SURF_MTL_2D),POINTER :: YVEG    ! vegetation cover
212TYPE(TYPE_SURF_MTL_2D),POINTER :: YVRLAN  ! anisotropy of the sub-grid scale orography
213TYPE(TYPE_SURF_MTL_2D),POINTER :: YVRLDI  ! angle of the direction of orography with the x axis
214TYPE(TYPE_SURF_MTL_2D),POINTER :: YSIG    ! characteristic orographic slope
215TYPE(TYPE_SURF_MTL_2D),POINTER :: YALBSF  ! soil shortwave albedo
216TYPE(TYPE_SURF_MTL_2D),POINTER :: YCONT   ! fraction of land
217TYPE(TYPE_SURF_MTL_2D),POINTER :: YSST    ! (open) sea surface temperature
218TYPE(TYPE_SURF_MTL_2D),POINTER :: YLZ0H   ! logarithm of roughness length for heat
219TYPE(TYPE_SURF_MTL_2D),POINTER :: YCVL    ! low vegetation cover
220TYPE(TYPE_SURF_MTL_2D),POINTER :: YCVH    ! high vegetation cover
221TYPE(TYPE_SURF_MTL_2D),POINTER :: YTVL    ! low vegetation type
222TYPE(TYPE_SURF_MTL_2D),POINTER :: YTVH    ! high vegetation type
223TYPE(TYPE_SURF_MTL_2D),POINTER :: YCI     ! sea ice fraction
224TYPE(TYPE_SURF_MTL_2D),POINTER :: YUCUR   ! U-component of the ocean current
225TYPE(TYPE_SURF_MTL_2D),POINTER :: YVCUR   ! V-component of the ocean current
226TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0RLF  ! gravity * vegetation roughness length
227TYPE(TYPE_SURF_MTL_2D),POINTER :: YCO2O   ! oceanic CO2 flux
228TYPE(TYPE_SURF_MTL_2D),POINTER :: YCO2B   ! biosphere CO2 flux
229TYPE(TYPE_SURF_MTL_2D),POINTER :: YCO2A   ! anthropogenic CO2 flux
230TYPE(TYPE_SURF_MTL_2D),POINTER :: YSDFOR  ! SD filtered orography
231TYPE(TYPE_SURF_MTL_2D),POINTER :: YALUVP  ! MODIS-derived parallel albedo for shortwave radiation
232TYPE(TYPE_SURF_MTL_2D),POINTER :: YALUVD  ! MODIS-derived diffuse albedo for shortwave radiation
233TYPE(TYPE_SURF_MTL_2D),POINTER :: YALNIP  ! MODIS-derived parallel albedo for longwave radiation
234TYPE(TYPE_SURF_MTL_2D),POINTER :: YALNID  ! MODIS-derived diffuse albedo for longwave radiation
235TYPE(TYPE_SURF_MTL_2D),POINTER :: YSF6    ! anthropogenic SF6 flux
236TYPE(TYPE_SURF_MTL_2D),POINTER :: YFP1    ! surface orography in the 2nd part of FULLPOS-927
237TYPE(TYPE_SURF_MTL_2D),POINTER :: YVF(:)
238END TYPE TYPE_SFL_VARSF
239
240! * Group VP=VCLIP: deep soil diagnostic fields:
241TYPE TYPE_SFL_VCLIP
242TYPE(TYPE_SURF_MTL_2D),POINTER :: YTPC    ! climatological deep layer temperature
243TYPE(TYPE_SURF_MTL_2D),POINTER :: YWPC    ! climatological deep layer moisture
244TYPE(TYPE_SURF_MTL_2D),POINTER :: YVP(:)
245END TYPE TYPE_SFL_VCLIP
246
247! * Group VV=VCLIV: vegetation diagnostic fields:
248TYPE TYPE_SFL_VCLIV
249TYPE(TYPE_SURF_MTL_2D),POINTER :: YARG    ! silt percentage within soil
250TYPE(TYPE_SURF_MTL_2D),POINTER :: YSAB    ! percentage of sand within the soil
251TYPE(TYPE_SURF_MTL_2D),POINTER :: YD2     ! soil depth
252TYPE(TYPE_SURF_MTL_2D),POINTER :: YIVEG   ! type of vegetation
253TYPE(TYPE_SURF_MTL_2D),POINTER :: YRSMIN  ! stomatal minimum resistance
254TYPE(TYPE_SURF_MTL_2D),POINTER :: YLAI    ! leaf area index
255TYPE(TYPE_SURF_MTL_2D),POINTER :: YHV     ! resistance to evapotranspiration
256TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0H    ! gravity * roughness length for heat
257TYPE(TYPE_SURF_MTL_2D),POINTER :: YALS    ! albedo of bare ground
258TYPE(TYPE_SURF_MTL_2D),POINTER :: YALV    ! albedo of vegetation
259TYPE(TYPE_SURF_MTL_2D),POINTER :: YVV(:)
260END TYPE TYPE_SFL_VCLIV
261
262! * Group VN=VCLIN: cloudiness diagnostic predictors:
263TYPE TYPE_SFL_VCLIN
264TYPE(TYPE_SURF_MTL_2D),POINTER :: YTOP    ! index of convective cloud top
265TYPE(TYPE_SURF_MTL_2D),POINTER :: YBAS    ! index of convective cloud base
266TYPE(TYPE_SURF_MTL_2D),POINTER :: YACPR   ! averaged convective precipitaion rate
267TYPE(TYPE_SURF_MTL_2D),POINTER :: YVN(:)
268END TYPE TYPE_SFL_VCLIN
269
270! * Group VH=VCLIH: convective cloud diagnostic fields:
271TYPE TYPE_SFL_VCLIH
272TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCCH   ! total convective cloudiness
273TYPE(TYPE_SURF_MTL_2D),POINTER :: YSCCH   ! convective cloud summit
274TYPE(TYPE_SURF_MTL_2D),POINTER :: YBCCH   ! convective cloud base
275TYPE(TYPE_SURF_MTL_2D),POINTER :: YPBLH   ! PBL height
276TYPE(TYPE_SURF_MTL_2D),POINTER :: YSPSH   ! variable for prognostic convection scheme (ALARO)
277TYPE(TYPE_SURF_MTL_2D),POINTER :: YVH(:)
278END TYPE TYPE_SFL_VCLIH
279
280! * Group VA=VCLIA: aerosol diagnostic fields:
281TYPE TYPE_SFL_VCLIA
282TYPE(TYPE_SURF_MTL_2D),POINTER :: YSEA    ! aerosol: sea
283TYPE(TYPE_SURF_MTL_2D),POINTER :: YLAN    ! aerosol: land
284TYPE(TYPE_SURF_MTL_2D),POINTER :: YSOO    ! aerosol: soot
285TYPE(TYPE_SURF_MTL_2D),POINTER :: YDES    ! aerosol: desert
286TYPE(TYPE_SURF_MTL_2D),POINTER :: YSUL    ! aerosol: sulfate
287TYPE(TYPE_SURF_MTL_2D),POINTER :: YVOL    ! aerosol: volcano
288TYPE(TYPE_SURF_MTL_2D),POINTER :: YNUD    ! aerosol: nudging
289TYPE(TYPE_SURF_MTL_2D),POINTER :: YVA(:)
290END TYPE TYPE_SFL_VCLIA
291
292! * Group VG=VCLIG: ice-coupler diagnostic fields:
293TYPE TYPE_SFL_VCLIG
294TYPE(TYPE_SURF_MTL_2D),POINTER :: YICFR   ! sea-ice fraction
295TYPE(TYPE_SURF_MTL_2D),POINTER :: YSOUP   ! upward solar flux over sea-ice
296TYPE(TYPE_SURF_MTL_2D),POINTER :: YIRUP   ! upward IR flux over sea-ice
297TYPE(TYPE_SURF_MTL_2D),POINTER :: YCHSS   ! sensible heat over sea-ice
298TYPE(TYPE_SURF_MTL_2D),POINTER :: YEVAP   ! evaporation over sea-ice
299TYPE(TYPE_SURF_MTL_2D),POINTER :: YTAUX   ! U-component of stress over sea-ice
300TYPE(TYPE_SURF_MTL_2D),POINTER :: YTAUY   ! V-component of stress over sea-ice
301TYPE(TYPE_SURF_MTL_2D),POINTER :: YVG(:)
302END TYPE TYPE_SFL_VCLIG
303
304! * Group VC=VO3ABC: A,B and C (Climatological ozone profiles) diagnostic fields:
305TYPE TYPE_SFL_VO3ABC
306TYPE(TYPE_SURF_MTL_2D),POINTER :: YA      ! A climatological ozone profile
307TYPE(TYPE_SURF_MTL_2D),POINTER :: YB      ! B climatological ozone profile
308TYPE(TYPE_SURF_MTL_2D),POINTER :: YC      ! C climatological ozone profile
309TYPE(TYPE_SURF_MTL_2D),POINTER :: YVC(:)
310END TYPE TYPE_SFL_VO3ABC
311
312! * Group VD=VDIAG: (ECMWF) diagnostic fields:
313TYPE TYPE_SFL_VDIAG
314TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSP   !Large scale precipitation
315TYPE(TYPE_SURF_MTL_2D),POINTER :: YCP    !Convective precipitation
316TYPE(TYPE_SURF_MTL_2D),POINTER :: YSF    !Snowfall
317TYPE(TYPE_SURF_MTL_2D),POINTER :: YBLD   !Boundary layer dissipation
318TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSHF  !Surface sensible heat flux
319TYPE(TYPE_SURF_MTL_2D),POINTER :: YSLHF  !Surface latent heat flux
320TYPE(TYPE_SURF_MTL_2D),POINTER :: YMSL   !Mean sea level pressure
321TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCC   !Total cloud cover
322TYPE(TYPE_SURF_MTL_2D),POINTER :: Y10U   !U-wind at 10 m
323TYPE(TYPE_SURF_MTL_2D),POINTER :: Y10V   !V-wind at 10 m
324TYPE(TYPE_SURF_MTL_2D),POINTER :: Y2T    !Temperature at 2 m
325TYPE(TYPE_SURF_MTL_2D),POINTER :: Y2D    !Dewpoint temperature at 2 m
326TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSR   !Surface solar radiation
327TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTR   !Surface thermal radiation
328TYPE(TYPE_SURF_MTL_2D),POINTER :: YTSR   !Top solar radiation
329TYPE(TYPE_SURF_MTL_2D),POINTER :: YTTR   !Top thermal radiation
330TYPE(TYPE_SURF_MTL_2D),POINTER :: YEWSS  !Instantaneous surface U-wind stress
331TYPE(TYPE_SURF_MTL_2D),POINTER :: YNSSS  !Instantaneous surface V-wind stress
332TYPE(TYPE_SURF_MTL_2D),POINTER :: YE     !Water evaporation
333TYPE(TYPE_SURF_MTL_2D),POINTER :: YCCC   !Convective cloud cover
334TYPE(TYPE_SURF_MTL_2D),POINTER :: YLCC   !Low cloud cover
335TYPE(TYPE_SURF_MTL_2D),POINTER :: YMCC   !Medium cloud cover
336TYPE(TYPE_SURF_MTL_2D),POINTER :: YHCC   !High cloud cover
337TYPE(TYPE_SURF_MTL_2D),POINTER :: YLGWS  !Zonal gravity wave stress
338TYPE(TYPE_SURF_MTL_2D),POINTER :: YMGWS  !Meridian gravity wave stress
339TYPE(TYPE_SURF_MTL_2D),POINTER :: YGWD   !Gravity wave dissipation
340TYPE(TYPE_SURF_MTL_2D),POINTER :: YMX2T  !Maximum temperature at 2 m
341TYPE(TYPE_SURF_MTL_2D),POINTER :: YMN2T  !Minimum temperature at 2 m
342TYPE(TYPE_SURF_MTL_2D),POINTER :: YRO    !Runoff
343TYPE(TYPE_SURF_MTL_2D),POINTER :: YALB   !(surface shortwave) albedo
344TYPE(TYPE_SURF_MTL_2D),POINTER :: YIEWSS !Instantaneous surface zonal component of stress
345TYPE(TYPE_SURF_MTL_2D),POINTER :: YINSSS !Instantaneous surface meridian component of stress
346TYPE(TYPE_SURF_MTL_2D),POINTER :: YISSHF !Instantaneous surface heat flux
347TYPE(TYPE_SURF_MTL_2D),POINTER :: YIE    !Instantaneous surface moisture flux
348TYPE(TYPE_SURF_MTL_2D),POINTER :: YCSF   !Convective snow fall
349TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSSF  !Large scale snowfall
350TYPE(TYPE_SURF_MTL_2D),POINTER :: YZ0F   !Gravity * surface roughness length
351TYPE(TYPE_SURF_MTL_2D),POINTER :: YLZ0H  !Logarithm of z0 times heat flux
352TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCW   !Total water content in a vertical column
353TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCWV  !Total water vapor content in a vertical column
354TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCLW  !Total liquid water content in a vertical column
355TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCIW  !Total ice water content in a vertical column
356TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSRD  !Downward surface solar radiation
357TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTRD  !Downward surface thermic radiation
358TYPE(TYPE_SURF_MTL_2D),POINTER :: YBLH   !Height of boundary layer
359TYPE(TYPE_SURF_MTL_2D),POINTER :: YSUND  !Sunshine duration
360TYPE(TYPE_SURF_MTL_2D),POINTER :: YSPAR  !Surface downward PARadiation
361TYPE(TYPE_SURF_MTL_2D),POINTER :: YSUVB  !Surface downward UV-B radiation
362TYPE(TYPE_SURF_MTL_2D),POINTER :: YCAPE  !Conv.avail.potential energy (CAPE)
363TYPE(TYPE_SURF_MTL_2D),POINTER :: YTSRC  !Top solar radiation clear sky
364TYPE(TYPE_SURF_MTL_2D),POINTER :: YTTRC  !Top thermal radiation clear sky
365TYPE(TYPE_SURF_MTL_2D),POINTER :: YSSRC  !Surface solar radiation clear sky
366TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTRC  !Surface thermal radiation clear sky
367TYPE(TYPE_SURF_MTL_2D),POINTER :: YES    !Evaporation of snow
368TYPE(TYPE_SURF_MTL_2D),POINTER :: YSMLT  !Snow melt
369TYPE(TYPE_SURF_MTL_2D),POINTER :: Y10FG  !Wind gust at 10 m (max since previous pp)
370TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSPF  !Large scale precipitation fraction
371TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCO3  !Total ozone content in a vertical column
372TYPE(TYPE_SURF_MTL_2D),POINTER :: YVIMD  !Vertically integrated mass divergence
373TYPE(TYPE_SURF_MTL_2D),POINTER :: YSPARC !Surface clear-sky parallel radiation
374TYPE(TYPE_SURF_MTL_2D),POINTER :: YSTINC !TOA (top of atmosph?) incident solar radiation
375TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCGHG(:)  !Total column greenhouse gases
376TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCGRG(:)  !Total column reactive gases
377TYPE(TYPE_SURF_MTL_2D),POINTER :: YTCTRAC(:) !Total column tracers
378TYPE(TYPE_SURF_MTL_2D),POINTER :: YVD(:)
379END TYPE TYPE_SFL_VDIAG
380
381! * Group VX=VCLIX: auxilary climatological diagnostic fields:
382TYPE TYPE_SFL_VCLIX
383TYPE(TYPE_SURF_MTL_2D),POINTER :: YORO    ! climatological surface geopotential
384TYPE(TYPE_SURF_MTL_2D),POINTER :: YTSC    ! climatological surface temperature
385TYPE(TYPE_SURF_MTL_2D),POINTER :: YPWS    ! climatological surface max. prop. moisture
386TYPE(TYPE_SURF_MTL_2D),POINTER :: YPWP    ! climatological deep soil max. prop. moisture
387TYPE(TYPE_SURF_MTL_2D),POINTER :: YSNO    ! climatological snow cover
388TYPE(TYPE_SURF_MTL_2D),POINTER :: YTPC    ! climatological deep soil temperature
389TYPE(TYPE_SURF_MTL_2D),POINTER :: YSAB    ! climatologic percentage of sand within the soil
390TYPE(TYPE_SURF_MTL_2D),POINTER :: YXD2    ! climatologic soil depth
391TYPE(TYPE_SURF_MTL_2D),POINTER :: YLSM    ! climatologic land sea mask
392TYPE(TYPE_SURF_MTL_2D),POINTER :: YIVEG   ! climatologic type of vegetation
393TYPE(TYPE_SURF_MTL_2D),POINTER :: YVX(:)
394END TYPE TYPE_SFL_VCLIX
395
396! * Group XA=VEXTRA: extra 3-d diagnostic fields:
397TYPE TYPE_SFL_VEXTRA
398TYPE(TYPE_SURF_MTL_3D),POINTER :: YXA(:)
399END TYPE TYPE_SFL_VEXTRA
400
401! * Group X2=VEXTR2: extra 2-d diagnostic fields:
402TYPE TYPE_SFL_VEXTR2
403TYPE(TYPE_SURF_MTL_2D),POINTER :: YX2(:)
404END TYPE TYPE_SFL_VEXTR2
405
406! End of type definitions
407
408! Data structures
409
410! Prognostic (multi time level) fields
411
412! Soilb
413REAL(KIND=JPRB),ALLOCATABLE :: SP_SB (:,:,:,:)
414TYPE(TYPE_SURF_GEN)    :: YSP_SBD
415TYPE(TYPE_SFL_SOILB)   :: YSP_SB
416
417! Snowg
418REAL(KIND=JPRB),ALLOCATABLE :: SP_SG (:,:,:)
419TYPE(TYPE_SURF_GEN)    :: YSP_SGD
420TYPE(TYPE_SFL_SNOWG)   :: YSP_SG
421
422! Resvr
423REAL(KIND=JPRB),ALLOCATABLE :: SP_RR (:,:,:)
424TYPE(TYPE_SURF_GEN)    :: YSP_RRD
425TYPE(TYPE_SFL_RESVR)   :: YSP_RR
426
427
428! Extrp
429REAL(KIND=JPRB),ALLOCATABLE :: SP_EP (:,:,:,:)
430TYPE(TYPE_SURF_GEN)    :: YSP_EPD
431TYPE(TYPE_SFL_EXTRP)   :: YSP_EP
432
433! Xtrp2
434REAL(KIND=JPRB),ALLOCATABLE :: SP_X2 (:,:,:)
435TYPE(TYPE_SURF_GEN)    :: YSP_X2D
436TYPE(TYPE_SFL_XTRP2)   :: YSP_X2
437
438! Canri
439REAL(KIND=JPRB),ALLOCATABLE :: SP_CI (:,:,:)
440TYPE(TYPE_SURF_GEN)    :: YSP_CID
441TYPE(TYPE_SFL_CANRI)   :: YSP_CI
442
443! One time level fields
444
445! Varsf
446REAL(KIND=JPRB),ALLOCATABLE :: SD_VF (:,:,:)
447TYPE(TYPE_SURF_GEN)    :: YSD_VFD
448TYPE(TYPE_SFL_VARSF)   :: YSD_VF
449
450! Vclip
451REAL(KIND=JPRB),ALLOCATABLE :: SD_VP (:,:,:)
452TYPE(TYPE_SURF_GEN)    :: YSD_VPD
453TYPE(TYPE_SFL_VCLIP)   :: YSD_VP
454
455! Vcliv
456REAL(KIND=JPRB),ALLOCATABLE :: SD_VV (:,:,:)
457TYPE(TYPE_SURF_GEN)    :: YSD_VVD
458TYPE(TYPE_SFL_VCLIV)   :: YSD_VV
459
460! Vclin
461REAL(KIND=JPRB),ALLOCATABLE :: SD_VN (:,:,:)
462TYPE(TYPE_SURF_GEN)    :: YSD_VND
463TYPE(TYPE_SFL_VCLIN)   :: YSD_VN
464
465! Vclih
466REAL(KIND=JPRB),ALLOCATABLE :: SD_VH (:,:,:)
467TYPE(TYPE_SURF_GEN)    :: YSD_VHD
468TYPE(TYPE_SFL_VCLIH)   :: YSD_VH
469
470! Vclia
471REAL(KIND=JPRB),ALLOCATABLE :: SD_VA (:,:,:)
472TYPE(TYPE_SURF_GEN)    :: YSD_VAD
473TYPE(TYPE_SFL_VCLIA)   :: YSD_VA
474
475! Vo3abc
476REAL(KIND=JPRB),ALLOCATABLE :: SD_VC (:,:,:)
477TYPE(TYPE_SURF_GEN)    :: YSD_VCD
478TYPE(TYPE_SFL_VO3ABC)  :: YSD_VC
479
480! Vdiag
481REAL(KIND=JPRB),ALLOCATABLE :: SD_VD (:,:,:)
482TYPE(TYPE_SURF_GEN)    :: YSD_VDD
483TYPE(TYPE_SFL_VDIAG)   :: YSD_VD
484
485! Waves
486REAL(KIND=JPRB),ALLOCATABLE :: SD_WS (:,:,:)
487TYPE(TYPE_SURF_GEN)    :: YSD_WSD
488TYPE(TYPE_SFL_WAVES)   :: YSD_WS
489
490! Vclix
491REAL(KIND=JPRB),ALLOCATABLE :: SD_VX (:,:,:)
492TYPE(TYPE_SURF_GEN)    :: YSD_VXD
493TYPE(TYPE_SFL_VCLIX)   :: YSD_VX
494
495! Vextra
496
497REAL(KIND=JPRB),ALLOCATABLE :: SD_XA (:,:,:,:)
498TYPE(TYPE_SURF_GEN)    :: YSD_XAD
499TYPE(TYPE_SFL_VEXTRA)  :: YSD_XA
500
501! Vextr2
502
503REAL(KIND=JPRB),ALLOCATABLE :: SD_X2 (:,:,:)
504TYPE(TYPE_SURF_GEN)    :: YSD_X2D
505TYPE(TYPE_SFL_VEXTR2)  :: YSD_X2
506
507!$OMP THREADPRIVATE(ndimsurf,ndimsurfl,nofftraj,nofftraj_cst,nprogsurf)
508!$OMP THREADPRIVATE(nprogsurfl,nptrsurf,nstrajgrib,nsurf,nsurfl,ysd_va,ysd_vad)
509!$OMP THREADPRIVATE(ysd_vc,ysd_vcd,ysd_vd,ysd_vdd,ysd_vf,ysd_vfd,ysd_vh,ysd_vhd)
510!$OMP THREADPRIVATE(ysd_vn,ysd_vnd,ysd_vp,ysd_vpd,ysd_vv,ysd_vvd,ysd_vx,ysd_vxd)
511!$OMP THREADPRIVATE(ysd_ws,ysd_wsd,ysd_x2,ysd_x2d,ysd_xa,ysd_xad,ysp_ci,ysp_cid)
512!$OMP THREADPRIVATE(ysp_ep,ysp_epd,ysp_rr,ysp_rrd,ysp_sb,ysp_sbd,ysp_sg,ysp_sgd)
513!$OMP THREADPRIVATE(ysp_x2,ysp_x2d)
514
515!$OMP THREADPRIVATE(sd_va,sd_vc,sd_vd,sd_vf,sd_vh,sd_vn,sd_vp,sd_vv,sd_vx,sd_ws)
516!$OMP THREADPRIVATE(sd_x2,sd_xa,sp_ci,sp_ep,sp_rr,sp_sb,sp_sg,sp_x2,surf_store_array)
517
518
519!-------------------------------------------------------------------------
520
521CONTAINS
522
523!=========================================================================
524
525SUBROUTINE INI_SFLP3(YDSC,YD,KFLDS,KLEVS,LDMTL,CDGRPNAME)
526! Initialize 3-D surface field group
527TYPE(TYPE_SURF_GEN),INTENT(INOUT)    :: YDSC
528TYPE(TYPE_SURF_MTL_3D),INTENT(INOUT) :: YD(:)
529INTEGER(KIND=JPIM),INTENT(IN)        :: KFLDS
530INTEGER(KIND=JPIM),INTENT(IN)        :: KLEVS
531LOGICAL,INTENT(IN)                   :: LDMTL
532CHARACTER(LEN=*),INTENT(IN)          :: CDGRPNAME
533
534INTEGER(KIND=JPIM) :: JFLD, IMAXF
535REAL(KIND=JPRB) :: ZHOOK_HANDLE
536
537!-------------------------------------------------------------------------
538
539IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP3',0,ZHOOK_HANDLE)
540
541IMAXF = SIZE(YD)
542YDSC%NUMFLDS = KFLDS
543YDSC%NLEVS = KLEVS
544YDSC%IPTR  = 1
545YDSC%LMTL  = LDMTL
546YDSC%CGRPNAME = CDGRPNAME
547YDSC%NDIM5 = 0
548YDSC%NOFFTRAJ = NOFFTRAJ
549YDSC%NOFFTRAJ_CST = NOFFTRAJ_CST
550
551NSURF = NSURF+YDSC%NUMFLDS
552NSURFL = NSURFL+YDSC%NUMFLDS*YDSC%NLEVS
553IF(LDMTL) THEN
554  NPROGSURF = NPROGSURF+YDSC%NUMFLDS
555  NPROGSURFL = NPROGSURFL+YDSC%NUMFLDS*YDSC%NLEVS
556ENDIF
557
558IF(LDMTL) THEN
559  IF (LTWOTL) THEN
560    YDSC%NDIM = 2*YDSC%NUMFLDS
561  ELSE
562    YDSC%NDIM = 3*YDSC%NUMFLDS
563  ENDIF
564ELSE
565  YDSC%NDIM = YDSC%NUMFLDS
566ENDIF 
567NDIMSURF = NDIMSURF + YDSC%NDIM   
568NDIMSURFL = NDIMSURFL + YDSC%NDIM*YDSC%NLEVS
569   
570DO 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
596ENDDO
597
598DO 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
605ENDDO
606
607WRITE(NULOUT,*) 'INITIALIZING 3-D SURFACE FIELD GROUP ', YDSC%CGRPNAME
608WRITE(NULOUT,*) 'NUMFLDS=',YDSC%NUMFLDS,' NLEVS=',YDSC%NLEVS,' LMTL=',YDSC%LMTL
609
610IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP3',1,ZHOOK_HANDLE)
611END SUBROUTINE INI_SFLP3
612
613!=========================================================================
614
615SUBROUTINE SETUP_SFLP3(YDSC,YD,KGRIB,CDNAME,PDEFAULT,KTRAJ,KREQIN)
616! Setup 3-D surface field
617TYPE(TYPE_SURF_GEN),INTENT(INOUT)      :: YDSC
618TYPE(TYPE_SURF_MTL_3D),INTENT(INOUT)   :: YD
619INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB(:)
620CHARACTER(LEN=16) ,OPTIONAL,INTENT(IN) :: CDNAME(:)
621REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN) :: PDEFAULT(:)
622INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTRAJ
623INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREQIN(:)
624
625INTEGER(KIND=JPIM) :: IPTR,JLEV
626REAL(KIND=JPRB) :: ZHOOK_HANDLE
627
628!-------------------------------------------------------------------------
629
630IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP3',0,ZHOOK_HANDLE)
631IPTR = YDSC%IPTR
632IF(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')
636ENDIF
637IF(PRESENT(KGRIB)) THEN
638  YD%IGRBCODE(:) = KGRIB(:)
639ENDIF
640IF(PRESENT(KREQIN)) THEN
641  YD%NREQIN(:) = KREQIN(:)
642ENDIF
643IF(PRESENT(CDNAME)) THEN
644  YD%CNAME(:)    = CDNAME(:)
645ENDIF
646IF(PRESENT(PDEFAULT)) THEN
647  YD%REFVALI(:) = PDEFAULT
648ENDIF
649IF(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
663ENDIF
664DO 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
674ENDDO
675YDSC%IPTR = YDSC%IPTR+1
676 
677IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP3',1,ZHOOK_HANDLE)
678END SUBROUTINE SETUP_SFLP3
679
680!=========================================================================
681
682SUBROUTINE INI_SFLP2(YDSC,YD,KFLDS,LDMTL,CDGRPNAME)
683! Initialize 2-D surface field group
684TYPE(TYPE_SURF_GEN),INTENT(INOUT)    :: YDSC
685TYPE(TYPE_SURF_MTL_2D),INTENT(INOUT) :: YD(:)
686INTEGER(KIND=JPIM),INTENT(IN)        :: KFLDS
687LOGICAL,INTENT(IN)                   :: LDMTL
688CHARACTER(LEN=*),INTENT(IN)          :: CDGRPNAME
689
690INTEGER(KIND=JPIM) :: JFLD, IMAXF
691REAL(KIND=JPRB) :: ZHOOK_HANDLE
692
693!-------------------------------------------------------------------------
694
695IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP2',0,ZHOOK_HANDLE)
696
697IMAXF = SIZE(YD)
698YDSC%NUMFLDS = KFLDS
699YDSC%NLEVS = -1
700YDSC%IPTR  = 1
701YDSC%LMTL  = LDMTL
702YDSC%CGRPNAME = CDGRPNAME
703YDSC%NDIM5 = 0
704YDSC%NOFFTRAJ = NOFFTRAJ
705YDSC%NOFFTRAJ_CST = NOFFTRAJ_CST
706
707NSURF = NSURF+YDSC%NUMFLDS
708NSURFL = NSURFL+YDSC%NUMFLDS
709IF(LDMTL) THEN
710  NPROGSURF = NPROGSURF+YDSC%NUMFLDS
711  NPROGSURFL = NPROGSURFL+YDSC%NUMFLDS
712ENDIF
713
714IF(LDMTL) THEN
715  IF (LTWOTL) THEN
716    YDSC%NDIM = 2*YDSC%NUMFLDS
717  ELSE
718    YDSC%NDIM = 3*YDSC%NUMFLDS
719  ENDIF
720ELSE
721  YDSC%NDIM = YDSC%NUMFLDS
722ENDIF 
723NDIMSURF = NDIMSURF + YDSC%NDIM   
724NDIMSURFL = NDIMSURFL + YDSC%NDIM   
725DO 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
747ENDDO
748 
749DO 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
756ENDDO
757
758WRITE(NULOUT,*) 'INITIALIZING 2-D SURFACE FIELD GROUP ', YDSC%CGRPNAME
759WRITE(NULOUT,*) 'NUMFLDS=',YDSC%NUMFLDS,' LMTL=',YDSC%LMTL
760
761IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:INI_SFLP2',1,ZHOOK_HANDLE)
762END SUBROUTINE INI_SFLP2
763
764!=========================================================================
765
766SUBROUTINE SETUP_SFLP2(YDSC,YD,KGRIB,CDNAME,PDEFAULT,KTRAJ,KREQIN)
767! Setup 2-D surface field
768TYPE(TYPE_SURF_GEN),INTENT(INOUT)      :: YDSC
769TYPE(TYPE_SURF_MTL_2D),INTENT(INOUT)   :: YD
770INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KGRIB
771CHARACTER(LEN=16) ,OPTIONAL,INTENT(IN) :: CDNAME
772REAL(KIND=JPRB)   ,OPTIONAL,INTENT(IN) :: PDEFAULT
773INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KTRAJ
774INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KREQIN
775
776INTEGER(KIND=JPIM) :: IPTR
777REAL(KIND=JPRB) :: ZHOOK_HANDLE
778
779!-------------------------------------------------------------------------
780
781IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP2',0,ZHOOK_HANDLE)
782IPTR = YDSC%IPTR
783IF(IPTR > YDSC%NUMFLDS) THEN
784  WRITE(NULERR,*) 'SURFACE FIELDS UNDER-DIMENSINED - GROUP ',YDSC%CGRPNAME,YDSC%NUMFLDS,KGRIB,CDNAME
785  CALL ABOR1('IPTR > YDSC%NUMFLDS')
786ENDIF
787IF(PRESENT(KGRIB)) THEN
788  YD%IGRBCODE = KGRIB
789ENDIF
790IF(PRESENT(KREQIN)) THEN
791  YD%NREQIN = KREQIN
792ENDIF
793IF(PRESENT(CDNAME)) THEN
794  YD%CNAME    = CDNAME
795ENDIF
796IF(PRESENT(PDEFAULT)) THEN
797  YD%REFVALI = PDEFAULT
798ENDIF
799IF(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
811ENDIF
812IF(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
816ELSE
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
819ENDIF
820 
821YDSC%IPTR = YDSC%IPTR+1
822IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SETUP_SFLP2',1,ZHOOK_HANDLE)
823END SUBROUTINE SETUP_SFLP2
824
825!=========================================================================
826
827SUBROUTINE GPPOPER(CDACT,KBL,PSP_SB,PSP_SG,PSP_RR,PSP_EP,PSP_X2,YDCOM)
828! Operations on prognostic surface fields
829CHARACTER(LEN=*),INTENT(IN)            :: CDACT
830INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBL
831REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SB(:,:,:)
832REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SG(:,:)
833REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_RR(:,:)
834REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_EP(:,:,:)
835REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_X2(:,:)
836TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT)   :: YDCOM
837
838
839REAL(KIND=JPRB) :: ZHOOK_HANDLE
840
841!-------------------------------------------------------------------------
842
843IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPPOPER',0,ZHOOK_HANDLE)
844IF(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)
850ELSE
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)
856ENDIF
857IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPPOPER',1,ZHOOK_HANDLE)
858END SUBROUTINE GPPOPER
859
860!=========================================================================
861
862SUBROUTINE GPOPER(CDACT,KBL,PSP_SB,PSP_SG,PSP_RR,PSD_VF,PSD_VV,YDCOM,PFIELD,PFIELD2)
863!Operations on ALL surface groups
864CHARACTER(LEN=*),INTENT(IN)            :: CDACT
865INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN) :: KBL
866REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SB(:,:,:)
867REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_SG(:,:)
868REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSP_RR(:,:)
869REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSD_VF(:,:)
870REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PSD_VV(:,:)
871TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT)   :: YDCOM
872REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD(:,:)
873REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT) :: PFIELD2(:,:)
874REAL(KIND=JPRB) :: ZHOOK_HANDLE
875
876!-------------------------------------------------------------------------
877
878IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER',0,ZHOOK_HANDLE)
879IF(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)')
884ENDIF
885IF(CDACT == 'PUTALLFLDS' .OR. CDACT == 'GETALLFLDS') THEN
886  IF(SIZE(PFIELD,2) < NPROGSURFL) CALL ABOR1('SURFACE_FIELDS:GPOPER - SIZE(PFIELD,2) < NPROGSURFL)')
887ENDIF
888IF(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)')
891ENDIF
892IF(PRESENT(YDCOM)) THEN
893  YDCOM%L_OK = .FALSE.
894  YDCOM%IPTRSURF = 0
895  YDCOM%ICOUNT = 0
896ENDIF
897
898NPTRSURF = 0
899IF(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
951ELSE
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
972ENDIF
973IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER',1,ZHOOK_HANDLE)
974END SUBROUTINE GPOPER
975
976!=========================================================================
977
978SUBROUTINE GPOPER_2(CDACT,PFLD,YDSC,YD,YDCOM,PFIELD,PFIELD2)
979! Operations on 2-D surface groups
980CHARACTER(LEN=*),INTENT(IN)                :: CDACT
981REAL(KIND=JPRB),INTENT(INOUT)              :: PFLD(:,:)
982TYPE(TYPE_SURF_GEN),INTENT(IN)             :: YDSC
983TYPE(TYPE_SURF_MTL_2D),INTENT(IN)          :: YD(:)
984TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
985REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT)     :: PFIELD(:,:)
986REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT)     :: PFIELD2(:,:)
987
988INTEGER(KIND=JPIM) :: J,IPTR,IPTR2
989REAL(KIND=JPRB) :: ZZPHY
990REAL(KIND=JPRB) :: ZHOOK_HANDLE
991
992!-------------------------------------------------------------------------
993
994IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_2',0,ZHOOK_HANDLE)
995IF(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
1000ELSEIF(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
1005ELSEIF(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
1010ELSEIF(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
1016ELSEIF(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
1021ELSEIF(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
1027ELSEIF(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
1032ELSEIF(CDACT == 'PHTFILT') THEN
1033  IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_2 : FIELD NOT MULTI-TIME LEVEL')
1034  ZZPHY=1.0_JPRB-REPSP1
1035  DO J=1,YDSC%NUMFLDS
1036    PFLD(:,YD(J)%MP9) = REPSP1*PFLD(:,YD(J)%MP1)+ZZPHY*PFLD(:,YD(J)%MP0)
1037    PFLD(:,YD(J)%MP0) = PFLD(:,YD(J)%MP1)
1038  ENDDO
1039ELSEIF(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
1049ELSEIF(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
1054ELSEIF(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
1059ELSEIF(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
1064ELSEIF(CDACT == 'SETALLTOVAL') THEN
1065  DO J=1,YDSC%NDIM
1066    PFLD(:,J) = YDCOM%VALUE
1067  ENDDO
1068ELSEIF(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
1074ELSEIF(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
1084ELSEIF(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
1094ELSEIF(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
1104ELSEIF(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
1118ELSEIF(CDACT == 'GETALLFLDS') THEN
1119  DO J=1,YDSC%NDIM
1120    NPTRSURF = NPTRSURF+1
1121    PFIELD(:,NPTRSURF) = PFLD(:,J)
1122  ENDDO
1123ELSEIF(CDACT == 'PUTALLFLDS') THEN
1124  DO J=1,YDSC%NDIM
1125    NPTRSURF = NPTRSURF+1
1126    PFLD(:,J) = PFIELD(:,NPTRSURF)
1127  ENDDO
1128ELSEIF(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
1136ELSEIF(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
1144ELSEIF(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
1152ELSE
1153  WRITE(NULOUT,*) 'SURFACE_FIELD:GPPOPER UNKNOWN ACTION - ',CDACT
1154  CALL ABOR1('SURFACE_FIELD:GPPOPER - UNKNOWN ACTION')
1155ENDIF
1156IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_2',1,ZHOOK_HANDLE)
1157END SUBROUTINE GPOPER_2
1158
1159!=========================================================================
1160
1161SUBROUTINE GPOPER_3(CDACT,PFLD,YDSC,YD,YDCOM,PFIELD,PFIELD2)
1162! Operations on 3-D surface groups
1163CHARACTER(LEN=*),INTENT(IN)                :: CDACT
1164REAL(KIND=JPRB),INTENT(INOUT)              :: PFLD(:,:,:)
1165TYPE(TYPE_SURF_GEN),INTENT(IN)             :: YDSC
1166TYPE(TYPE_SURF_MTL_3D),INTENT(IN)          :: YD(:)
1167TYPE(TYPE_SFL_COMM),OPTIONAL,INTENT(INOUT) :: YDCOM
1168REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT)     :: PFIELD(:,:)
1169REAL(KIND=JPRB),OPTIONAL,INTENT(INOUT)     :: PFIELD2(:,:)
1170
1171INTEGER(KIND=JPIM) :: J,JLEV,IPTR,IPTR2
1172REAL(KIND=JPRB) :: ZZPHY
1173REAL(KIND=JPRB) :: ZHOOK_HANDLE
1174
1175!-------------------------------------------------------------------------
1176
1177IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_3',0,ZHOOK_HANDLE)
1178IF(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
1183ELSEIF(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
1188ELSEIF(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
1193ELSEIF(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
1199ELSEIF(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
1204ELSEIF(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
1210ELSEIF(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
1215ELSEIF(CDACT == 'PHTFILT') THEN
1216  IF( .NOT. YDSC%LMTL) CALL ABOR1('SURFACE_FIELDS:GPOPER_3 : FIELD NOT MULTI-TIME LEVEL')
1217  ZZPHY=1.0_JPRB-REPSP1
1218  DO J=1,YDSC%NUMFLDS
1219    PFLD(:,:,YD(J)%MP9) = REPSP1*PFLD(:,:,YD(J)%MP1)+ZZPHY*PFLD(:,:,YD(J)%MP0)
1220    PFLD(:,:,YD(J)%MP0) = PFLD(:,:,YD(J)%MP1)
1221  ENDDO
1222ELSEIF(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
1232ELSEIF(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
1237ELSEIF(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
1242ELSEIF(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
1247ELSEIF(CDACT == 'SETALLTOVAL') THEN
1248  DO J=1,YDSC%NDIM
1249    PFLD(:,:,J) = YDCOM%VALUE
1250  ENDDO
1251ELSEIF(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
1259ELSEIF(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
1271ELSEIF(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
1283ELSEIF(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
1295ELSEIF(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
1313ELSEIF(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
1320ELSEIF(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
1327ELSEIF(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
1337ELSEIF(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
1347ELSEIF(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
1357ELSE
1358  WRITE(NULOUT,*) 'SURFACE_FIELD:GPPOPER UNKNOWN ACTION - ',CDACT
1359  CALL ABOR1('SURFACE_FIELD:GPPOPER - UNKNOWN ACTION')
1360ENDIF
1361IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:GPOPER_3',1,ZHOOK_HANDLE)
1362END SUBROUTINE GPOPER_3
1363
1364!=========================================================================
1365
1366SUBROUTINE SURF_STORE
1367! Store all surface fields
1368INTEGER(KIND=JPIM) :: JBL
1369REAL(KIND=JPRB) :: ZHOOK_HANDLE
1370
1371IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_STORE',0,ZHOOK_HANDLE)
1372ALLOCATE(SURF_STORE_ARRAY(NPROMA,NDIMSURFL,NGPBLKS))
1373DO JBL=1,NGPBLKS
1374  CALL GPOPER('GETALLFLDS',KBL=JBL,PFIELD=SURF_STORE_ARRAY(:,:,JBL))
1375ENDDO
1376IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_STORE',1,ZHOOK_HANDLE)
1377END SUBROUTINE SURF_STORE
1378
1379!=========================================================================
1380
1381SUBROUTINE SURF_RESTORE
1382! Restore all surface fields
1383INTEGER(KIND=JPIM) :: JBL
1384REAL(KIND=JPRB) :: ZHOOK_HANDLE
1385
1386IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_RESTORE',0,ZHOOK_HANDLE)
1387IF(.NOT. ALLOCATED(SURF_STORE_ARRAY)) &
1388 & CALL ABOR1('SURFACE_FIELDS:SURF_RESTORE - SURF_STORE NOT ALLOCATED')
1389DO JBL=1,NGPBLKS
1390  CALL GPOPER('PUTALLFLDS',KBL=JBL,PFIELD=SURF_STORE_ARRAY(:,:,JBL))
1391ENDDO
1392DEALLOCATE(SURF_STORE_ARRAY)
1393IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:SURF_RESTORE',1,ZHOOK_HANDLE)
1394
1395END SUBROUTINE SURF_RESTORE
1396
1397!=========================================================================
1398
1399SUBROUTINE ALLO_SURF
1400! Allocate surface field arrays
1401REAL(KIND=JPRB) :: ZHOOK_HANDLE
1402
1403IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:ALLO_SURF',0,ZHOOK_HANDLE)
1404ALLOCATE(SP_SB(NPROMA,YSP_SBD%NLEVS,YSP_SBD%NDIM,NGPBLKS))
1405ALLOCATE(SP_SG(NPROMA,YSP_SGD%NDIM,NGPBLKS))
1406ALLOCATE(SP_RR(NPROMA,YSP_RRD%NDIM,NGPBLKS))
1407ALLOCATE(SP_EP(NPROMA,YSP_EPD%NLEVS,YSP_EPD%NDIM,NGPBLKS))
1408ALLOCATE(SP_X2(NPROMA,YSP_X2D%NDIM,NGPBLKS))
1409ALLOCATE(SP_CI(NPROMA,YSP_CID%NDIM,NGPBLKS))
1410ALLOCATE(SD_VF(NPROMA,YSD_VFD%NDIM,NGPBLKS))
1411ALLOCATE(SD_VP(NPROMA,YSD_VPD%NDIM,NGPBLKS))
1412ALLOCATE(SD_VV(NPROMA,YSD_VVD%NDIM,NGPBLKS))
1413ALLOCATE(SD_VN(NPROMA,YSD_VND%NDIM,NGPBLKS))
1414ALLOCATE(SD_VH(NPROMA,YSD_VHD%NDIM,NGPBLKS))
1415ALLOCATE(SD_VA(NPROMA,YSD_VAD%NDIM,NGPBLKS))
1416ALLOCATE(SD_VC(NPROMA,YSD_VCD%NDIM,NGPBLKS))
1417ALLOCATE(SD_VD(NPROMA,YSD_VDD%NDIM,NGPBLKS))
1418ALLOCATE(SD_WS(NPROMA,YSD_WSD%NDIM,NGPBLKS))
1419ALLOCATE(SD_XA(NPROMA,YSD_XAD%NLEVS,YSD_XAD%NDIM,NGPBLKS))
1420ALLOCATE(SD_X2(NPROMA,YSD_X2D%NDIM,NGPBLKS))
1421ALLOCATE(SD_VX(NPROMA,YSD_VXD%NDIM,NGPBLKS))
1422
1423IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:ALLO_SURF',1,ZHOOK_HANDLE)
1424END SUBROUTINE ALLO_SURF
1425
1426!=========================================================================
1427
1428SUBROUTINE DEALLO_SURF
1429! Deallocate surface field arrays
1430REAL(KIND=JPRB) :: ZHOOK_HANDLE
1431
1432IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:DEALLO_SURF',0,ZHOOK_HANDLE)
1433IF(ALLOCATED(SP_SB)) DEALLOCATE(SP_SB)
1434IF(ALLOCATED(SP_SG)) DEALLOCATE(SP_SG)
1435IF(ALLOCATED(SP_RR)) DEALLOCATE(SP_RR)
1436IF(ALLOCATED(SP_EP)) DEALLOCATE(SP_EP)
1437IF(ALLOCATED(SP_X2)) DEALLOCATE(SP_X2)
1438IF(ALLOCATED(SP_CI)) DEALLOCATE(SP_CI)
1439IF(ALLOCATED(SD_VF)) DEALLOCATE(SD_VF)
1440IF(ALLOCATED(SD_VP)) DEALLOCATE(SD_VP)
1441IF(ALLOCATED(SD_VV)) DEALLOCATE(SD_VV)
1442IF(ALLOCATED(SD_VN)) DEALLOCATE(SD_VN)
1443IF(ALLOCATED(SD_VH)) DEALLOCATE(SD_VH)
1444IF(ALLOCATED(SD_VA)) DEALLOCATE(SD_VA)
1445IF(ALLOCATED(SD_VC)) DEALLOCATE(SD_VC)
1446IF(ALLOCATED(SD_VD)) DEALLOCATE(SD_VD)
1447IF(ALLOCATED(SD_WS)) DEALLOCATE(SD_WS)
1448IF(ALLOCATED(SD_XA)) DEALLOCATE(SD_XA)
1449IF(ALLOCATED(SD_X2)) DEALLOCATE(SD_X2)
1450IF(ALLOCATED(SD_VX)) DEALLOCATE(SD_VX)
1451IF (LHOOK) CALL DR_HOOK('SURFACE_FIELDS:DEALLO_SURF',1,ZHOOK_HANDLE)
1452END SUBROUTINE DEALLO_SURF
1453
1454!=========================================================================
1455
1456END MODULE SURFACE_FIELDS
Note: See TracBrowser for help on using the repository browser.