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