| Line |
Branch |
Exec |
Source |
| 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 |
| 1457 |
|
|
|