| Line |
Branch |
Exec |
Source |
| 1 |
|
|
MODULE GFL_SUBS |
| 2 |
|
|
|
| 3 |
|
|
! Purpose. |
| 4 |
|
|
! -------- |
| 5 |
|
|
|
| 6 |
|
|
! GFL_SUBS contains routines to do basic manipulatutions of GFL descriptors |
| 7 |
|
|
|
| 8 |
|
|
! Author. |
| 9 |
|
|
! ------- |
| 10 |
|
|
! Mats Hamrud(ECMWF) |
| 11 |
|
|
|
| 12 |
|
|
! Modifications. |
| 13 |
|
|
! -------------- |
| 14 |
|
|
! Original : 2003-03-01 |
| 15 |
|
|
! Modifications: |
| 16 |
|
|
! 03/07/09 C. Fischer - add Arome/Aladin attributes |
| 17 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
| 18 |
|
|
! M. Tudor 31-Oct-2003 physics tendencies |
| 19 |
|
|
! Y.Tremolet 03-Mar-2004 Protect *EACT_CLOUD_GFL for multiple calls |
| 20 |
|
|
! Y.Tremolet 12-Mar-2004 Save/falsify GFLC |
| 21 |
|
|
! J.Haseler 10-Oct-2005 Switch for I/O to trajectory structure |
| 22 |
|
|
! Y. Bouteloup 28-Jan-2005 Add YR (rain !) in DEACT_CLOUD_GFL |
| 23 |
|
|
! 20-Feb-2005 J. Vivoda 3TL PC Eulerian scheme, GWADV scheme for PC_FULL |
| 24 |
|
|
! Y. Bouteloup 25-Dec-2005 Add YS (snow !) in DEACT_CLOUD_GFL |
| 25 |
|
|
! A. Trojakova 29-June-2006 Add YCPF in DEACT_CLOUD_GFL |
| 26 |
|
|
!------------------------------------------------------------------------- |
| 27 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
| 28 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
| 29 |
|
|
|
| 30 |
|
|
USE YOMLUN , ONLY : NULOUT |
| 31 |
|
|
USE TYPE_GFLS ,ONLY : TYPE_GFL_COMP |
| 32 |
|
|
USE YOM_YGFL , ONLY : YGFL,JPGFL,YGFLC,YL,YI,YA,YR,YS,YCPF |
| 33 |
|
|
USE YOPHNC , ONLY : LENCLD2 |
| 34 |
|
|
USE YOMSLPHY ,ONLY : MSAVTEND_S |
| 35 |
|
|
USE YOMDIM , ONLY : NFLEVG ,NFLSUL |
| 36 |
|
|
|
| 37 |
|
|
IMPLICIT NONE |
| 38 |
|
|
SAVE |
| 39 |
|
|
|
| 40 |
|
|
PRIVATE |
| 41 |
|
|
!PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR,DEACT_CLOUD_GFL,REACT_CLOUD_GFL |
| 42 |
|
|
! MPL 10.12.08 |
| 43 |
|
|
PUBLIC DEFINE_GFL_COMP,PRINT_GFL,SET_GFL_ATTR |
| 44 |
|
|
|
| 45 |
|
|
! For internal use |
| 46 |
|
|
TYPE(TYPE_GFL_COMP),POINTER :: YLASTGFLC ! Pointer to last defined field |
| 47 |
|
|
TYPE(TYPE_GFL_COMP),POINTER :: YPTRC ! Temporary field pointer |
| 48 |
|
|
TYPE(TYPE_GFL_COMP) :: YL_SAVE ! For saving status of cloud fields |
| 49 |
|
|
TYPE(TYPE_GFL_COMP) :: YI_SAVE ! For saving status of cloud fields |
| 50 |
|
|
TYPE(TYPE_GFL_COMP) :: YA_SAVE ! For saving status of cloud fields |
| 51 |
|
|
TYPE(TYPE_GFL_COMP) :: YR_SAVE ! For saving status of cloud fields |
| 52 |
|
|
TYPE(TYPE_GFL_COMP) :: YS_SAVE ! For saving status of cloud fields |
| 53 |
|
|
TYPE(TYPE_GFL_COMP) :: YCPF_SAVE ! For saving status of cloud fields |
| 54 |
|
|
LOGICAL :: L_CLD_DEACT=.FALSE. |
| 55 |
|
|
|
| 56 |
|
|
!$OMP THREADPRIVATE(l_cld_deact,ya_save,ycpf_save,yi_save,yl_save,ylastgflc,yptrc,yr_save,ys_save) |
| 57 |
|
|
|
| 58 |
|
|
INTERFACE |
| 59 |
|
|
SUBROUTINE ABOR1(CDTEXT) |
| 60 |
|
|
CHARACTER(LEN=*) :: CDTEXT |
| 61 |
|
|
END SUBROUTINE ABOR1 |
| 62 |
|
|
END INTERFACE |
| 63 |
|
|
|
| 64 |
|
|
!------------------------------------------------------------------------- |
| 65 |
|
|
CONTAINS |
| 66 |
|
|
!------------------------------------------------------------------------- |
| 67 |
|
|
|
| 68 |
|
✗ |
SUBROUTINE DEFINE_GFL_COMP(YDGFLC,CDNAME,KGRIB,LDGP,KREQIN,PREFVALI, & |
| 69 |
|
|
& LDREQOUT,LDERS,LD5,LDT1,LDGPINGP,LDTRAJIO,LDTHERMACT,PR,PRCP) |
| 70 |
|
|
|
| 71 |
|
|
!**** *DEFINE_GFL_COMP* - Setup indivual GFL field |
| 72 |
|
|
|
| 73 |
|
|
! Purpose. |
| 74 |
|
|
! -------- |
| 75 |
|
|
! Basic allocation of GFL descriptor structure (on first call) |
| 76 |
|
|
! Setup basic attributes of individual GFL component |
| 77 |
|
|
|
| 78 |
|
|
! Explicit arguments : |
| 79 |
|
|
! -------------------- |
| 80 |
|
|
|
| 81 |
|
|
! YDGFLC - field handle |
| 82 |
|
|
! CDNAME - field ARPEGE name |
| 83 |
|
|
! KGRIB - GRIB code |
| 84 |
|
|
! LDGP - if TRUE gridpoint field |
| 85 |
|
|
! KREQIN - 1 if required in input, 0 if not, -1 if initialised with refernence value |
| 86 |
|
|
! PREFVALI - reference value for initialisation in case NREQIN==-1 |
| 87 |
|
|
! LDREQOUT- TRUE if requiered in output |
| 88 |
|
|
! LDERS - TRUE if derivatives required (only possible for spectral field) |
| 89 |
|
|
! LD5 - TRUE if field needs to be present in trajectory (T5) |
| 90 |
|
|
! LD1 - TRUE if field needs to be present in t+dt array (GFLT1) |
| 91 |
|
|
! LDTRAJIO- TRUE if field written to/from trajectory structure files |
| 92 |
|
|
|
| 93 |
|
|
! Author. |
| 94 |
|
|
! ------- |
| 95 |
|
|
! Mats Hamrud *ECMWF* |
| 96 |
|
|
|
| 97 |
|
|
! Modifications. |
| 98 |
|
|
! -------------- |
| 99 |
|
|
! Original : 2003-03-01 |
| 100 |
|
|
! Modifications: |
| 101 |
|
|
! 03/07/09 C. Fischer - add Arome/Aladin attributes |
| 102 |
|
|
!------------------------------------------------------------------------- |
| 103 |
|
|
|
| 104 |
|
|
TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC |
| 105 |
|
|
CHARACTER(LEN=16),INTENT(IN) :: CDNAME |
| 106 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KGRIB |
| 107 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KREQIN |
| 108 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALI |
| 109 |
|
|
LOGICAL,INTENT(IN):: LDREQOUT |
| 110 |
|
|
LOGICAL,INTENT(IN) :: LDGP |
| 111 |
|
|
LOGICAL,INTENT(IN) :: LDERS |
| 112 |
|
|
LOGICAL,INTENT(IN) :: LD5 |
| 113 |
|
|
LOGICAL,INTENT(IN) :: LDT1 |
| 114 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDGPINGP |
| 115 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDTRAJIO |
| 116 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDTHERMACT |
| 117 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PR |
| 118 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PRCP |
| 119 |
|
|
|
| 120 |
|
|
INTEGER(KIND=JPIM) :: JGFL, ICURFLDPT, ICURFLDPC |
| 121 |
|
|
LOGICAL,SAVE :: LLFIRSTCALL = .TRUE. |
| 122 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 123 |
|
|
!$OMP THREADPRIVATE(llfirstcall) |
| 124 |
|
|
|
| 125 |
|
|
|
| 126 |
|
|
!------------------------------------------------------------------------- |
| 127 |
|
|
|
| 128 |
|
|
! 1. Initialization of YGFL on first call to this routine |
| 129 |
|
|
! ---------------------------------------------------- |
| 130 |
|
|
|
| 131 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',0,ZHOOK_HANDLE) |
| 132 |
|
✗ |
IF(LLFIRSTCALL) THEN |
| 133 |
|
✗ |
YGFL%NUMFLDS = 0 |
| 134 |
|
✗ |
YGFL%NUMFLDS9 = 0 |
| 135 |
|
✗ |
YGFL%NUMFLDS1 = 0 |
| 136 |
|
✗ |
YGFL%NUMFLDS5 = 0 |
| 137 |
|
✗ |
YGFL%NUMFLDSPHY = 0 |
| 138 |
|
✗ |
YGFL%NUMFLDS_SPL = 0 |
| 139 |
|
✗ |
YGFL%NUMFLDS_SL1 = 0 |
| 140 |
|
✗ |
YGFL%NUMFLDSPT = 0 |
| 141 |
|
✗ |
YGFL%NUMFLDSPC = 0 |
| 142 |
|
✗ |
YGFL%NDIM = 0 |
| 143 |
|
✗ |
YGFL%NDIM0 = 0 |
| 144 |
|
✗ |
YGFL%NDIM9 = 0 |
| 145 |
|
✗ |
YGFL%NDIM1 = 0 |
| 146 |
|
✗ |
YGFL%NDIM5 = 0 |
| 147 |
|
✗ |
YGFL%NDIMSLP = 0 |
| 148 |
|
✗ |
YGFL%NDIM_SPL = 0 |
| 149 |
|
✗ |
YGFL%NDIMPT = 0 |
| 150 |
|
✗ |
YGFL%NDIMPC = 0 |
| 151 |
|
✗ |
YGFL%NDERS = 0 |
| 152 |
|
✗ |
YGFL%NUMSPFLDS = 0 |
| 153 |
|
✗ |
YGFL%NUMGPFLDS = 0 |
| 154 |
|
✗ |
YGFL%NUMSPFLDS1 = 0 |
| 155 |
|
✗ |
DO JGFL=1,JPGFL |
| 156 |
|
✗ |
CALL FALSIFY_GFLC(YGFLC(JGFL)) |
| 157 |
|
✗ |
YGFLC(JGFL)%MP = -HUGE(JPGFL) |
| 158 |
|
✗ |
YGFLC(JGFL)%MPL = -HUGE(JPGFL) |
| 159 |
|
✗ |
YGFLC(JGFL)%MPM = -HUGE(JPGFL) |
| 160 |
|
✗ |
YGFLC(JGFL)%MP9 = -HUGE(JPGFL) |
| 161 |
|
✗ |
YGFLC(JGFL)%MP9_PH = -HUGE(JPGFL) |
| 162 |
|
✗ |
YGFLC(JGFL)%MP1 = -HUGE(JPGFL) |
| 163 |
|
✗ |
YGFLC(JGFL)%MP5 = -HUGE(JPGFL) |
| 164 |
|
✗ |
YGFLC(JGFL)%MP5L = -HUGE(JPGFL) |
| 165 |
|
✗ |
YGFLC(JGFL)%MP5M = -HUGE(JPGFL) |
| 166 |
|
✗ |
YGFLC(JGFL)%MPSLP = -HUGE(JPGFL) |
| 167 |
|
✗ |
YGFLC(JGFL)%MPSP = -HUGE(JPGFL) |
| 168 |
|
✗ |
YGFLC(JGFL)%MP_SPL = -HUGE(JPGFL) |
| 169 |
|
✗ |
YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL) |
| 170 |
|
✗ |
YGFLC(JGFL)%MP_SLX = -HUGE(JPGFL) |
| 171 |
|
✗ |
YGFLC(JGFL)%MPPT = -HUGE(JPGFL) |
| 172 |
|
✗ |
YGFLC(JGFL)%MPPC = -HUGE(JPGFL) |
| 173 |
|
|
ENDDO |
| 174 |
|
✗ |
NULLIFY(YLASTGFLC) |
| 175 |
|
✗ |
LLFIRSTCALL = .FALSE. |
| 176 |
|
|
ENDIF |
| 177 |
|
|
|
| 178 |
|
|
!------------------------------------------------------------------------- |
| 179 |
|
|
|
| 180 |
|
|
! 2. Define GFL component |
| 181 |
|
|
! -------------------- |
| 182 |
|
|
|
| 183 |
|
|
! 2.1 Some checks |
| 184 |
|
✗ |
IF(LDGP) THEN |
| 185 |
|
✗ |
DO JGFL=1,YGFL%NUMFLDS |
| 186 |
|
✗ |
IF(.NOT. YGFLC(JGFL)%LGP) THEN |
| 187 |
|
|
! Grid-point fields should be defined before any spectral field |
| 188 |
|
✗ |
CALL ABOR1('YOMMFL:DEFINE_GFL_COMP:GRIDPOINT BEFORE SPECTRAL') |
| 189 |
|
|
ENDIF |
| 190 |
|
|
ENDDO |
| 191 |
|
|
ENDIF |
| 192 |
|
✗ |
IF(LDGP) THEN |
| 193 |
|
✗ |
IF(LDERS) THEN |
| 194 |
|
|
! Derivatives can only be defined for spectral fields |
| 195 |
|
✗ |
CALL ABOR1('YOMMFL:DEFINE_GFL_COMP:DERIVATIVES ONLY WITH SPECTRAL') |
| 196 |
|
|
ENDIF |
| 197 |
|
|
ENDIF |
| 198 |
|
✗ |
IF(YGFL%NUMFLDS == JPGFL) THEN |
| 199 |
|
✗ |
WRITE(NULOUT,*) ' MAXIMUM NUMBER OF FIELDS ALREADY DEFINED' |
| 200 |
|
✗ |
CALL ABOR1('YOMMFL: EXCEED NUMBER OF FIELDS') |
| 201 |
|
|
ENDIF |
| 202 |
|
|
|
| 203 |
|
|
! 2.2 Define field attributes |
| 204 |
|
|
|
| 205 |
|
|
ICURFLDPT = YGFL%NUMFLDS+1 |
| 206 |
|
|
ICURFLDPC = YGFL%NUMFLDS+1 |
| 207 |
|
|
|
| 208 |
|
✗ |
YDGFLC%LACTIVE = .TRUE. |
| 209 |
|
✗ |
YDGFLC%CNAME = CDNAME |
| 210 |
|
✗ |
YDGFLC%IGRBCODE = KGRIB |
| 211 |
|
✗ |
YDGFLC%NREQIN = KREQIN |
| 212 |
|
✗ |
IF (PRESENT(PREFVALI)) THEN |
| 213 |
|
✗ |
YDGFLC%REFVALI = PREFVALI |
| 214 |
|
|
ENDIF |
| 215 |
|
✗ |
YDGFLC%LREQOUT = LDREQOUT |
| 216 |
|
✗ |
YDGFLC%LGP = LDGP |
| 217 |
|
✗ |
YDGFLC%LSP= .NOT. YDGFLC%LGP |
| 218 |
|
✗ |
YDGFLC%LT5 = LD5 |
| 219 |
|
✗ |
YDGFLC%LT1 = LDT1 |
| 220 |
|
✗ |
YDGFLC%LCDERS = LDERS |
| 221 |
|
✗ |
IF(PRESENT(LDGPINGP)) YDGFLC%LGPINGP=LDGPINGP |
| 222 |
|
✗ |
IF(PRESENT(LDTRAJIO)) YDGFLC%LTRAJIO=LDTRAJIO |
| 223 |
|
✗ |
IF(PRESENT(LDTHERMACT)) YDGFLC%LTHERMACT=LDTHERMACT |
| 224 |
|
✗ |
IF(YDGFLC%LTHERMACT) THEN |
| 225 |
|
✗ |
IF(.NOT.PRESENT(PR)) & |
| 226 |
|
✗ |
&CALL ABOR1('GFL_SUBS:DEFINE_GFL_COMPONENT - PR MISSING') |
| 227 |
|
✗ |
IF(.NOT.PRESENT(PRCP)) & |
| 228 |
|
✗ |
&CALL ABOR1('GFL_SUBS:DEFINE_GFL_COMPONENT - PRCP MISSING') |
| 229 |
|
✗ |
YDGFLC%R = PR |
| 230 |
|
✗ |
YDGFLC%RCP = PRCP |
| 231 |
|
|
ENDIF |
| 232 |
|
|
|
| 233 |
|
|
! 2.3 Numbers of fields and dimensions |
| 234 |
|
✗ |
YGFL%NUMFLDS = YGFL%NUMFLDS+1 |
| 235 |
|
✗ |
IF (YDGFLC%LT5) YGFL%NUMFLDS5 = YGFL%NUMFLDS5+1 |
| 236 |
|
|
|
| 237 |
|
✗ |
IF(YDGFLC%LCDERS) THEN |
| 238 |
|
✗ |
YGFL%NDIM = YGFL%NDIM+3 |
| 239 |
|
✗ |
YGFL%NDIM0 = YGFL%NDIM0+3 |
| 240 |
|
✗ |
YGFL%NDERS = YGFL%NDERS+1 |
| 241 |
|
✗ |
IF (YDGFLC%LT5) YGFL%NDIM5 = YGFL%NDIM5+3 |
| 242 |
|
|
ELSE |
| 243 |
|
✗ |
YGFL%NDIM = YGFL%NDIM+1 |
| 244 |
|
✗ |
YGFL%NDIM0 = YGFL%NDIM0+1 |
| 245 |
|
✗ |
IF (YDGFLC%LT5) YGFL%NDIM5 = YGFL%NDIM5+1 |
| 246 |
|
|
ENDIF |
| 247 |
|
|
|
| 248 |
|
✗ |
IF(YDGFLC%LSP) THEN |
| 249 |
|
✗ |
YGFL%NUMSPFLDS =YGFL%NUMSPFLDS+1 |
| 250 |
|
|
ELSE |
| 251 |
|
✗ |
YGFL%NUMGPFLDS =YGFL%NUMGPFLDS+1 |
| 252 |
|
|
ENDIF |
| 253 |
|
|
|
| 254 |
|
✗ |
IF (YDGFLC%LT1) THEN |
| 255 |
|
✗ |
YGFL%NUMFLDS1 = YGFL%NUMFLDS1+1 |
| 256 |
|
✗ |
YGFL%NDIM1 = YGFL%NDIM1+1 |
| 257 |
|
✗ |
IF (YDGFLC%LSP) YGFL%NUMSPFLDS1 =YGFL%NUMSPFLDS1+1 |
| 258 |
|
|
ENDIF |
| 259 |
|
|
|
| 260 |
|
|
! 2.4 Define field "pointers" |
| 261 |
|
✗ |
YDGFLC%MP5 = -HUGE(JPGFL) |
| 262 |
|
✗ |
IF (YDGFLC%LGP) THEN |
| 263 |
|
✗ |
YDGFLC%MP = YGFL%NDIM0 |
| 264 |
|
✗ |
IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NDIM5 |
| 265 |
|
|
ELSE |
| 266 |
|
✗ |
YDGFLC%MP = YGFL%NUMFLDS |
| 267 |
|
✗ |
IF (YDGFLC%LT5) YDGFLC%MP5 = YGFL%NUMFLDS5 |
| 268 |
|
|
ENDIF |
| 269 |
|
✗ |
IF (YDGFLC%LCDERS) THEN |
| 270 |
|
✗ |
YDGFLC%MPM = YDGFLC%MP+YGFL%NDERS |
| 271 |
|
✗ |
YDGFLC%MPL = YDGFLC%MP+2*YGFL%NDERS |
| 272 |
|
✗ |
IF(YDGFLC%LT5) THEN |
| 273 |
|
✗ |
YDGFLC%MP5M = YDGFLC%MP5+YGFL%NDERS |
| 274 |
|
✗ |
YDGFLC%MP5L = YDGFLC%MP5+2*YGFL%NDERS |
| 275 |
|
|
ENDIF |
| 276 |
|
|
ELSE |
| 277 |
|
✗ |
YDGFLC%MPL = -HUGE(JPGFL) |
| 278 |
|
✗ |
YDGFLC%MPM = -HUGE(JPGFL) |
| 279 |
|
✗ |
YDGFLC%MP5L = -HUGE(JPGFL) |
| 280 |
|
✗ |
YDGFLC%MP5M = -HUGE(JPGFL) |
| 281 |
|
|
ENDIF |
| 282 |
|
|
|
| 283 |
|
✗ |
IF(YDGFLC%LSP) THEN |
| 284 |
|
✗ |
YDGFLC%MPSP = YGFL%NUMSPFLDS |
| 285 |
|
|
ELSE |
| 286 |
|
✗ |
YDGFLC%MPSP = -HUGE(JPGFL) |
| 287 |
|
|
ENDIF |
| 288 |
|
|
|
| 289 |
|
✗ |
IF (YDGFLC%LT1) THEN |
| 290 |
|
✗ |
YDGFLC%MP1 = YGFL%NUMFLDS1 |
| 291 |
|
|
ELSE |
| 292 |
|
✗ |
YDGFLC%MP1 = -HUGE(JPGFL) |
| 293 |
|
|
ENDIF |
| 294 |
|
|
|
| 295 |
|
|
! 2.6 Possibly reassign pointers (needed for multiple fields with derivatives) |
| 296 |
|
|
|
| 297 |
|
✗ |
IF(ASSOCIATED(YLASTGFLC)) THEN |
| 298 |
|
✗ |
YPTRC=>YLASTGFLC |
| 299 |
|
✗ |
DO |
| 300 |
|
✗ |
IF(.NOT.LDGP) THEN |
| 301 |
|
✗ |
IF(YPTRC%LCDERS) THEN |
| 302 |
|
✗ |
YPTRC%MPM = YPTRC%MPM+1 |
| 303 |
|
✗ |
IF(LDERS)THEN |
| 304 |
|
✗ |
YPTRC%MPL = YPTRC%MPL+2 |
| 305 |
|
|
ELSE |
| 306 |
|
✗ |
YPTRC%MPL = YPTRC%MPL+1 |
| 307 |
|
|
ENDIF |
| 308 |
|
|
ENDIF |
| 309 |
|
✗ |
WRITE(NULOUT,*)' DEFINE_GFL_COMP:CHECKING ',YPTRC%CNAME |
| 310 |
|
✗ |
WRITE(NULOUT,*)' REASSIGNED MPL=',YPTRC%MPL,' MPM=',YPTRC%MPM |
| 311 |
|
✗ |
IF (YDGFLC%LT5) THEN |
| 312 |
|
✗ |
IF(YPTRC%LT5) THEN |
| 313 |
|
✗ |
IF(YPTRC%LCDERS) THEN |
| 314 |
|
✗ |
YPTRC%MP5M = YPTRC%MP5M+1 |
| 315 |
|
✗ |
IF(LDERS)THEN |
| 316 |
|
✗ |
YPTRC%MP5L = YPTRC%MP5L+2 |
| 317 |
|
|
ELSE |
| 318 |
|
✗ |
YPTRC%MP5L = YPTRC%MP5L+1 |
| 319 |
|
|
ENDIF |
| 320 |
|
|
ENDIF |
| 321 |
|
✗ |
WRITE(NULOUT,*)' REASSIGNED MP5L=',YPTRC%MP5L,' MP5M=',YPTRC%MP5M |
| 322 |
|
|
ENDIF |
| 323 |
|
|
ENDIF |
| 324 |
|
|
|
| 325 |
|
|
ENDIF |
| 326 |
|
✗ |
IF(.NOT.ASSOCIATED(YPTRC%PREVIOUS)) EXIT |
| 327 |
|
✗ |
YPTRC=>YPTRC%PREVIOUS |
| 328 |
|
|
ENDDO |
| 329 |
|
|
ENDIF |
| 330 |
|
|
|
| 331 |
|
|
! 2.7 Point to last defined field |
| 332 |
|
✗ |
YDGFLC%PREVIOUS=>YLASTGFLC |
| 333 |
|
✗ |
YLASTGFLC => YDGFLC |
| 334 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEFINE_GFL_COMP',1,ZHOOK_HANDLE) |
| 335 |
|
|
|
| 336 |
|
|
! ------------------------------------------------------------------ |
| 337 |
|
✗ |
END SUBROUTINE DEFINE_GFL_COMP |
| 338 |
|
|
|
| 339 |
|
|
!========================================================================= |
| 340 |
|
|
|
| 341 |
|
✗ |
SUBROUTINE SET_GFL_ATTR(YDGFLC,LDADV,LDT9,LDPHY,LDPT,LDPC,LDADJUST0,& |
| 342 |
|
|
& LDADJUST1,KCOUPLING,PREFVALC,LDBIPER,CDSLINT) |
| 343 |
|
|
|
| 344 |
|
|
!**** *SET_GFL_ATTR* Add attributes to previously setup GFL components |
| 345 |
|
|
|
| 346 |
|
|
! Purpose. |
| 347 |
|
|
! -------- |
| 348 |
|
|
! Add further attributes to previously setup, by call to DEFINE_GFL_COMP, GFL components |
| 349 |
|
|
|
| 350 |
|
|
! Explicit arguments : |
| 351 |
|
|
! -------------------- |
| 352 |
|
|
! LDADV - TRUE if field to be advected |
| 353 |
|
|
! LDT9 - TRUE if field present in t-dt |
| 354 |
|
|
! LDPHY - TRUE if field updated by physics |
| 355 |
|
|
! LDPT - TRUE if field present in phy. tend. |
| 356 |
|
|
! LDPC - TRUE if field in predictor/corrector time stepping treatment (3TL) |
| 357 |
|
|
! LDADJUST0 - TRUE if field to be adjusted at t |
| 358 |
|
|
! LDADJUST1 - TRUE if field to be adjusted at t+dt |
| 359 |
|
|
! KCOUPLING - 1 if field to be coupled, 0 if not, -1 if coupled with REFVALC |
| 360 |
|
|
! REVALC - refernce value for coupling, used only in case NCOUPLING==-1 |
| 361 |
|
|
! LDBIPER - TRUE if field to be biperiodised |
| 362 |
|
|
! CDSLINT - S.L. interpolator |
| 363 |
|
|
|
| 364 |
|
|
! Author. |
| 365 |
|
|
! ------- |
| 366 |
|
|
! Mats Hamrud *ECMWF* |
| 367 |
|
|
|
| 368 |
|
|
! Modifications. |
| 369 |
|
|
! -------------- |
| 370 |
|
|
! Original : 2003-03-01 |
| 371 |
|
|
! Modifications: |
| 372 |
|
|
! 03/07/09 C. Fischer - add Arome/Aladin attributes |
| 373 |
|
|
! 2004-Nov F. Vana - update of CDSLINT |
| 374 |
|
|
!------------------------------------------------------------------------- |
| 375 |
|
|
|
| 376 |
|
|
TYPE(TYPE_GFL_COMP),TARGET,INTENT(INOUT) :: YDGFLC |
| 377 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDADV |
| 378 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDT9 |
| 379 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDPHY |
| 380 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDPT |
| 381 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDPC |
| 382 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST0 |
| 383 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDADJUST1 |
| 384 |
|
|
INTEGER(KIND=JPIM),INTENT(IN),OPTIONAL :: KCOUPLING |
| 385 |
|
|
REAL(KIND=JPRB),INTENT(IN),OPTIONAL :: PREFVALC |
| 386 |
|
|
LOGICAL,INTENT(IN),OPTIONAL :: LDBIPER |
| 387 |
|
|
CHARACTER(LEN=12),INTENT(IN),OPTIONAL :: CDSLINT |
| 388 |
|
|
|
| 389 |
|
|
INTEGER(KIND=JPIM) :: IGFLPTR |
| 390 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 391 |
|
|
|
| 392 |
|
|
!------------------------------------------------------------------------- |
| 393 |
|
|
|
| 394 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',0,ZHOOK_HANDLE) |
| 395 |
|
✗ |
IF(YDGFLC%MP < 1 .OR. YDGFLC%MP > YGFL%NUMFLDS) THEN |
| 396 |
|
✗ |
CALL ABOR1('SET_GFL_ATTR: GFL COMPONENT NOT SET UP') |
| 397 |
|
|
ELSE |
| 398 |
|
|
IGFLPTR=YDGFLC%MP |
| 399 |
|
|
ENDIF |
| 400 |
|
|
|
| 401 |
|
✗ |
IF(PRESENT(LDADV)) THEN |
| 402 |
|
✗ |
YDGFLC%LADV = LDADV |
| 403 |
|
|
ENDIF |
| 404 |
|
✗ |
IF(YDGFLC%LADV) THEN |
| 405 |
|
✗ |
IF(.NOT.YDGFLC%LT1) THEN |
| 406 |
|
✗ |
CALL ABOR1(' GFL field to be advected but LT1=false') |
| 407 |
|
|
ENDIF |
| 408 |
|
✗ |
YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1 |
| 409 |
|
✗ |
YDGFLC%MP_SL1 = YGFL%NUMFLDS_SL1 |
| 410 |
|
✗ |
YDGFLC%MP_SLX = (YGFL%NUMFLDS_SL1-1)*(NFLEVG+2*NFLSUL) |
| 411 |
|
|
ENDIF |
| 412 |
|
|
|
| 413 |
|
|
|
| 414 |
|
|
! Other timelevels etc. |
| 415 |
|
|
|
| 416 |
|
✗ |
IF(PRESENT(LDT9)) THEN |
| 417 |
|
✗ |
YDGFLC%LT9 = LDT9 |
| 418 |
|
|
ENDIF |
| 419 |
|
✗ |
IF(YDGFLC%LT9 .AND. YDGFLC%MP9 == -HUGE(JPGFL) ) THEN |
| 420 |
|
✗ |
YGFL%NUMFLDS9 = YGFL%NUMFLDS9+1 |
| 421 |
|
✗ |
YGFL%NDIM = YGFL%NDIM+1 |
| 422 |
|
✗ |
YGFL%NDIM9 = YGFL%NDIM9+1 |
| 423 |
|
✗ |
YDGFLC%MP9 = YGFL%NDIM0+YGFL%NUMFLDS9 |
| 424 |
|
✗ |
YDGFLC%MP9_PH = YDGFLC%MP9 |
| 425 |
|
|
ELSE |
| 426 |
|
✗ |
YDGFLC%MP9 = YDGFLC%MP |
| 427 |
|
✗ |
YDGFLC%MP9_PH = YDGFLC%MP9 |
| 428 |
|
✗ |
WRITE(NULOUT,*) 'WARNING YDGFLC%MP9 = YDGFLC%MP',YDGFLC%MP9,YDGFLC%MP |
| 429 |
|
|
ENDIF |
| 430 |
|
|
|
| 431 |
|
✗ |
IF(PRESENT(LDPHY)) THEN |
| 432 |
|
✗ |
YDGFLC%LPHY = LDPHY |
| 433 |
|
|
ENDIF |
| 434 |
|
✗ |
IF(YGFL%NUMFLDSPHY == 0)YGFL%NUMFLDSPHY=YGFL%NUMFLDSPHY-MSAVTEND_S |
| 435 |
|
✗ |
IF(YDGFLC%MPSLP == -HUGE(JPGFL)) THEN |
| 436 |
|
✗ |
IF(YDGFLC%LPHY) THEN |
| 437 |
|
✗ |
IF(.NOT.YDGFLC%LT1) THEN |
| 438 |
|
✗ |
CALL ABOR1(' GFL field to be modified by physics but LT1=false') |
| 439 |
|
|
ENDIF |
| 440 |
|
✗ |
YGFL%NUMFLDSPHY = YGFL%NUMFLDSPHY+1+MSAVTEND_S |
| 441 |
|
✗ |
YGFL%NDIMSLP = YGFL%NDIMSLP+1+MSAVTEND_S |
| 442 |
|
✗ |
YDGFLC%MPSLP = YGFL%NUMFLDSPHY |
| 443 |
|
|
ENDIF |
| 444 |
|
|
ENDIF |
| 445 |
|
|
|
| 446 |
|
✗ |
IF(PRESENT(LDPT)) THEN |
| 447 |
|
✗ |
YDGFLC%LPT = LDPT |
| 448 |
|
|
ENDIF |
| 449 |
|
✗ |
IF(YDGFLC%MPPT == -HUGE(JPGFL)) THEN |
| 450 |
|
✗ |
IF(YDGFLC%LPT) THEN |
| 451 |
|
✗ |
YGFL%NUMFLDSPT = YGFL%NUMFLDSPT+1 |
| 452 |
|
✗ |
YGFL%NDIMPT = YGFL%NDIMPT+1 |
| 453 |
|
✗ |
YDGFLC%MPPT = YGFL%NUMFLDSPT |
| 454 |
|
|
ENDIF |
| 455 |
|
|
ENDIF |
| 456 |
|
✗ |
IF(PRESENT(LDPC)) THEN |
| 457 |
|
✗ |
YDGFLC%LPC = LDPC |
| 458 |
|
|
ENDIF |
| 459 |
|
✗ |
IF(YDGFLC%MPPC == -HUGE(JPGFL)) THEN |
| 460 |
|
✗ |
IF(YDGFLC%LPC) THEN |
| 461 |
|
✗ |
YGFL%NUMFLDSPC = YGFL%NUMFLDSPC+1 |
| 462 |
|
✗ |
YGFL%NDIMPC = YGFL%NDIMPC+1 |
| 463 |
|
✗ |
YDGFLC%MPPC = YGFL%NUMFLDSPC |
| 464 |
|
|
ENDIF |
| 465 |
|
|
ENDIF |
| 466 |
|
|
|
| 467 |
|
|
|
| 468 |
|
|
! LAM attributes (do not involve extra dimensioning or pointers) |
| 469 |
|
|
|
| 470 |
|
✗ |
IF(PRESENT(LDADJUST0)) THEN |
| 471 |
|
✗ |
YDGFLC%LADJUST0 = LDADJUST0 |
| 472 |
|
|
ENDIF |
| 473 |
|
✗ |
IF(PRESENT(LDADJUST1)) THEN |
| 474 |
|
✗ |
YDGFLC%LADJUST1 = LDADJUST1 |
| 475 |
|
|
ENDIF |
| 476 |
|
✗ |
IF(PRESENT(KCOUPLING)) THEN |
| 477 |
|
✗ |
YDGFLC%NCOUPLING = KCOUPLING |
| 478 |
|
|
ENDIF |
| 479 |
|
✗ |
IF(PRESENT(PREFVALC)) THEN |
| 480 |
|
✗ |
YDGFLC%REFVALC = PREFVALC |
| 481 |
|
|
ENDIF |
| 482 |
|
✗ |
IF(PRESENT(LDBIPER)) THEN |
| 483 |
|
✗ |
YDGFLC%LBIPER = LDBIPER |
| 484 |
|
|
ENDIF |
| 485 |
|
|
|
| 486 |
|
✗ |
IF(PRESENT(CDSLINT)) THEN |
| 487 |
|
✗ |
YDGFLC%CSLINT=CDSLINT |
| 488 |
|
✗ |
IF(YDGFLC%MP_SPL == -HUGE(JPGFL)) THEN |
| 489 |
|
✗ |
IF(CDSLINT == 'LAITVSPCQM ') THEN |
| 490 |
|
✗ |
YGFL%NUMFLDS_SPL = YGFL%NUMFLDS_SPL+1 |
| 491 |
|
✗ |
YGFL%NDIM_SPL = YGFL%NDIM_SPL+1 |
| 492 |
|
✗ |
YDGFLC%MP_SPL = YGFL%NUMFLDS_SPL |
| 493 |
|
|
ENDIF |
| 494 |
|
|
ENDIF |
| 495 |
|
|
ENDIF |
| 496 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:SET_GFL_ATTR',1,ZHOOK_HANDLE) |
| 497 |
|
|
|
| 498 |
|
|
! ------------------------------------------------------------------- |
| 499 |
|
✗ |
END SUBROUTINE SET_GFL_ATTR |
| 500 |
|
|
|
| 501 |
|
|
!========================================================================= |
| 502 |
|
|
|
| 503 |
|
✗ |
SUBROUTINE PRINT_GFL |
| 504 |
|
|
|
| 505 |
|
|
!**** *PRINT_GFL* - Print GFL attributes |
| 506 |
|
|
|
| 507 |
|
|
! ------------------------------------------------------------------- |
| 508 |
|
|
|
| 509 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 510 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',0,ZHOOK_HANDLE) |
| 511 |
|
✗ |
WRITE(NULOUT,*) ' ---- GFL COMPONENT ATTRIBUTES ----' |
| 512 |
|
✗ |
IF(ASSOCIATED(YLASTGFLC)) THEN |
| 513 |
|
✗ |
YPTRC=>YLASTGFLC |
| 514 |
|
✗ |
DO |
| 515 |
|
✗ |
WRITE(NULOUT,*) ' GFL COMPONENT DEFINED - NAME=',& |
| 516 |
|
✗ |
& YPTRC%CNAME,' GRIBCODE=', YPTRC%IGRBCODE |
| 517 |
|
✗ |
WRITE(NULOUT,*)' LGP=',YPTRC%LGP,' NREQIN=',YPTRC%NREQIN, & |
| 518 |
|
✗ |
& ' LREQOUT=',YPTRC%LREQOUT,' REFVALI=',YPTRC%REFVALI, & |
| 519 |
|
✗ |
& ' LCDERS=', YPTRC%LCDERS,' LADV=',YPTRC%LADV, & |
| 520 |
|
✗ |
& ' LPHY=',YPTRC%LPHY,' LPT=',YPTRC%LPT,' LPC=',YPTRC%LPC |
| 521 |
|
✗ |
WRITE(NULOUT,*)' LADJUST0=',YPTRC%LADJUST0,' LADJUST1=',YPTRC%LADJUST1,& |
| 522 |
|
✗ |
& ' NCOUPLING=',YPTRC%NCOUPLING,' REFVALC=',YPTRC%REFVALC,& |
| 523 |
|
✗ |
& ' LBIPER=',YPTRC%LBIPER |
| 524 |
|
✗ |
WRITE(NULOUT,*)' LTRAJIO=',YPTRC%LTRAJIO,' LGPINGP=',YPTRC%LGPINGP |
| 525 |
|
✗ |
WRITE(NULOUT,*)' CSLINT=',YPTRC%CSLINT |
| 526 |
|
✗ |
WRITE(NULOUT,*)'LTHERMACT=',YPTRC%LTHERMACT,& |
| 527 |
|
✗ |
& ' R=',YPTRC%R,' RCP=',YPTRC%RCP |
| 528 |
|
✗ |
WRITE(NULOUT,*)' MP=',YPTRC%MP,' MPL=',YPTRC%MPL,& |
| 529 |
|
✗ |
& ' MPM=',YPTRC%MPM,' MP9=',YPTRC%MP9,' MP1=',YPTRC%MP1,& |
| 530 |
|
✗ |
& ' MP5=',YPTRC%MP5,' MP5L=',YPTRC%MP5L,' MP5M=',YPTRC%MP5M, & |
| 531 |
|
✗ |
& ' MPSLP=',YPTRC%MPSLP,' MPSP=',YPTRC%MPSP,& |
| 532 |
|
✗ |
& ' MPPT=',YPTRC%MPPT, ' MPPC=',YPTRC%MPPC |
| 533 |
|
✗ |
IF(.NOT.ASSOCIATED(YPTRC%PREVIOUS)) EXIT |
| 534 |
|
✗ |
YPTRC=>YPTRC%PREVIOUS |
| 535 |
|
|
ENDDO |
| 536 |
|
|
ENDIF |
| 537 |
|
|
|
| 538 |
|
✗ |
WRITE(NULOUT,*) ' ---- YGFL ATTRIBUTES ----' |
| 539 |
|
✗ |
WRITE(NULOUT,*) ' YGFL%NUMFLDS=',YGFL%NUMFLDS,& |
| 540 |
|
✗ |
& ' YGFL%NUMSPFLDS=',YGFL%NUMSPFLDS,' YGFL%NUMGPFLDS=',YGFL%NUMGPFLDS,& |
| 541 |
|
✗ |
& ' YGFL%NDERS=',YGFL%NDERS,' YGFL%NUMFLDSPT=',YGFL%NUMFLDSPT,& |
| 542 |
|
✗ |
& ' YGFL%NUMFLDSPC=',YGFL%NUMFLDSPC |
| 543 |
|
✗ |
WRITE(NULOUT,*) ' YGFL%NUMFLDS_SL1=',YGFL%NUMFLDS_SL1 |
| 544 |
|
✗ |
WRITE(NULOUT,*) ' YGFL%NDIM=',YGFL%NDIM,' YGFL%NDIM0=',YGFL%NDIM0,& |
| 545 |
|
✗ |
& ' YGFL%NDIM9=',YGFL%NDIM9,' YGFL%NDIM1=',YGFL%NDIM1,& |
| 546 |
|
✗ |
& ' YGFL%NDIM5=',YGFL%NDIM5,' YGFL%NDIMSLP=',YGFL%NDIMSLP,& |
| 547 |
|
✗ |
& ' YGFL%NDIMPT=',YGFL%NDIMPT,' YGFL%NDIMPC=',YGFL%NDIMPC |
| 548 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%CNAMES=',YGFL%CNAMES(1:YGFL%NUMFLDS) |
| 549 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%IGRBCODE=',YGFL%IGRBCODE(1:YGFL%NUMFLDS) |
| 550 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%NREQIN=',YGFL%NREQIN(1:YGFL%NUMFLDS) |
| 551 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%REFVALI=',YGFL%REFVALI(1:YGFL%NUMFLDS) |
| 552 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LREQOUT=',YGFL%LREQOUT(1:YGFL%NUMFLDS) |
| 553 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LADV=',YGFL%LADV(1:YGFL%NUMFLDS) |
| 554 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%CSLINT=',YGFL%CSLINT(1:YGFL%NUMFLDS) |
| 555 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP=',YGFL%MP(1:YGFL%NUMFLDS) |
| 556 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LSP=',YGFL%LSP(1:YGFL%NUMFLDS) |
| 557 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPSP=',YGFL%MPSP(1:YGFL%NUMFLDS) |
| 558 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LCDERS=',YGFL%LCDERS(1:YGFL%NUMFLDS) |
| 559 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LTRAJIO=',YGFL%LTRAJIO(1:YGFL%NUMFLDS) |
| 560 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPL=',YGFL%MPL(1:YGFL%NUMFLDS) |
| 561 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPM=',YGFL%MPM(1:YGFL%NUMFLDS) |
| 562 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LT9=',YGFL%LT9(1:YGFL%NUMFLDS) |
| 563 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP9=',YGFL%MP9(1:YGFL%NUMFLDS) |
| 564 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LT1=',YGFL%LT1(1:YGFL%NUMFLDS) |
| 565 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP1=',YGFL%MP1(1:YGFL%NUMFLDS) |
| 566 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LT5=',YGFL%LT5(1:YGFL%NUMFLDS) |
| 567 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP5=',YGFL%MP5(1:YGFL%NUMFLDS) |
| 568 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP5L=',YGFL%MP5L(1:YGFL%NUMFLDS) |
| 569 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MP5M=',YGFL%MP5M(1:YGFL%NUMFLDS) |
| 570 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LPHY=',YGFL%LPHY(1:YGFL%NUMFLDS) |
| 571 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPSLP=',YGFL%MPSLP(1:YGFL%NUMFLDS) |
| 572 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LPT=',YGFL%LPT(1:YGFL%NUMFLDS) |
| 573 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPPT=',YGFL%MPPT(1:YGFL%NUMFLDS) |
| 574 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LPC=',YGFL%LPC(1:YGFL%NUMFLDS) |
| 575 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%MPPC=',YGFL%MPPC(1:YGFL%NUMFLDS) |
| 576 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LADJUST0=',YGFL%LADJUST0(1:YGFL%NUMFLDS) |
| 577 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LADJUST1=',YGFL%LADJUST1(1:YGFL%NUMFLDS) |
| 578 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%NCOUPLING=',YGFL%NCOUPLING(1:YGFL%NUMFLDS) |
| 579 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%REFVALC=',YGFL%REFVALC(1:YGFL%NUMFLDS) |
| 580 |
|
|
!!$WRITE(NULOUT,*) ' YGFL%LBIPER=',YGFL%LBIPER(1:YGFL%NUMFLDS) |
| 581 |
|
✗ |
WRITE(NULOUT,*) ' --------------------------------------------' |
| 582 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:PRINT_GFL',1,ZHOOK_HANDLE) |
| 583 |
|
✗ |
END SUBROUTINE PRINT_GFL |
| 584 |
|
|
|
| 585 |
|
|
!========================================================================= |
| 586 |
|
|
|
| 587 |
|
|
!SUBROUTINE DEACT_CLOUD_GFL ! commente par MPL 10.12.08 (et REACT_CLOUD_GFL) |
| 588 |
|
|
! |
| 589 |
|
|
!**** *DEACT_CLOUD_GFL* Deactivate prognostic cloud variables |
| 590 |
|
|
! |
| 591 |
|
|
! ------------------------------------------------------------------ |
| 592 |
|
|
! |
| 593 |
|
|
!INTEGER(KIND=JPIM) :: JGFL |
| 594 |
|
|
!REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 595 |
|
|
! |
| 596 |
|
|
!#include "suslb.intfb.h" |
| 597 |
|
|
! |
| 598 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEACT_CLOUD_GFL',0,ZHOOK_HANDLE) |
| 599 |
|
|
! |
| 600 |
|
|
!IF (.NOT.L_CLD_DEACT .AND. & |
| 601 |
|
|
! & (YL%LACTIVE .OR. YI%LACTIVE .OR. & |
| 602 |
|
|
! & YR%LACTIVE .OR. YS%LACTIVE .OR. YA%LACTIVE .OR. YCPF%LACTIVE ) ) THEN |
| 603 |
|
|
! CALL COPY_GFLC_GFLC(YL_SAVE,YL) |
| 604 |
|
|
! CALL COPY_GFLC_GFLC(YI_SAVE,YI) |
| 605 |
|
|
! CALL COPY_GFLC_GFLC(YR_SAVE,YR) |
| 606 |
|
|
! CALL COPY_GFLC_GFLC(YS_SAVE,YS) |
| 607 |
|
|
! CALL COPY_GFLC_GFLC(YA_SAVE,YA) |
| 608 |
|
|
! CALL COPY_GFLC_GFLC(YCPF_SAVE,YCPF) |
| 609 |
|
|
! |
| 610 |
|
|
! IF( .NOT. LENCLD2) THEN |
| 611 |
|
|
! IF (YL%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
| 612 |
|
|
! IF (YI%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
| 613 |
|
|
! IF (YR%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
| 614 |
|
|
! IF (YS%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
| 615 |
|
|
! IF (YA%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
| 616 |
|
|
! IF (YCPF%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS-1 |
| 617 |
|
|
! |
| 618 |
|
|
! IF (YL%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
| 619 |
|
|
! IF (YI%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
| 620 |
|
|
! IF (YR%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
| 621 |
|
|
! IF (YS%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
| 622 |
|
|
! IF (YA%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
| 623 |
|
|
! IF (YCPF%LT5) YGFL%NUMFLDS5=YGFL%NUMFLDS5-1 |
| 624 |
|
|
! |
| 625 |
|
|
! CALL FALSIFY_GFLC(YL) |
| 626 |
|
|
! CALL FALSIFY_GFLC(YI) |
| 627 |
|
|
! CALL FALSIFY_GFLC(YR) |
| 628 |
|
|
! CALL FALSIFY_GFLC(YS) |
| 629 |
|
|
! CALL FALSIFY_GFLC(YA) |
| 630 |
|
|
! CALL FALSIFY_GFLC(YCPF) |
| 631 |
|
|
! ELSE |
| 632 |
|
|
! CALL NOADVECT_GFLC(YL) |
| 633 |
|
|
! CALL NOADVECT_GFLC(YI) |
| 634 |
|
|
! CALL NOADVECT_GFLC(YR) |
| 635 |
|
|
! CALL NOADVECT_GFLC(YS) |
| 636 |
|
|
! CALL NOADVECT_GFLC(YA) |
| 637 |
|
|
! CALL NOADVECT_GFLC(YCPF) |
| 638 |
|
|
! ENDIF |
| 639 |
|
|
! YGFL%NUMFLDS_SL1 = 0 |
| 640 |
|
|
! DO JGFL=1,YGFL%NUMFLDS |
| 641 |
|
|
! YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL) |
| 642 |
|
|
! IF(YGFLC(JGFL)%LADV) THEN |
| 643 |
|
|
! YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1 |
| 644 |
|
|
! YGFLC(JGFL)%MP_SL1 = YGFL%NUMFLDS_SL1 |
| 645 |
|
|
! YGFLC(JGFL)%MP_SLX = (YGFLC(JGFL)%MP_SL1-1)*(NFLEVG+2*NFLSUL) |
| 646 |
|
|
! ENDIF |
| 647 |
|
|
! ENDDO |
| 648 |
|
|
! CALL SUSLB |
| 649 |
|
|
! |
| 650 |
|
|
! L_CLD_DEACT=.TRUE. |
| 651 |
|
|
! WRITE(NULOUT,*)' CLOUD FIELDS DE-ACTIVATAD, YGFL%NUMGPFLDS=', & |
| 652 |
|
|
! & YGFL%NUMGPFLDS,' YGFL%NUMFLDS_SL1=', YGFL%NUMFLDS_SL1 |
| 653 |
|
|
!ENDIF |
| 654 |
|
|
! |
| 655 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:DEACT_CLOUD_GFL',1,ZHOOK_HANDLE) |
| 656 |
|
|
! |
| 657 |
|
|
!END SUBROUTINE DEACT_CLOUD_GFL |
| 658 |
|
|
! |
| 659 |
|
|
!!========================================================================= |
| 660 |
|
|
! |
| 661 |
|
|
!SUBROUTINE REACT_CLOUD_GFL |
| 662 |
|
|
!!**** *REACT_CLOUD_GFL* Reactivate prognostic cloud variables |
| 663 |
|
|
! |
| 664 |
|
|
!INTEGER(KIND=JPIM) :: JGFL |
| 665 |
|
|
!REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 666 |
|
|
!LOGICAL :: LLGPI,LLGPL,LLGPA |
| 667 |
|
|
!#include "suslb.intfb.h" |
| 668 |
|
|
!! ------------------------------------------------------------------ |
| 669 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:REACT_CLOUD_GFL',0,ZHOOK_HANDLE) |
| 670 |
|
|
! |
| 671 |
|
|
!IF (L_CLD_DEACT) THEN |
| 672 |
|
|
! LLGPL = YL%LGP |
| 673 |
|
|
! LLGPI = YI%LGP |
| 674 |
|
|
! LLGPA = YA%LGP |
| 675 |
|
|
! |
| 676 |
|
|
! CALL COPY_GFLC_GFLC(YL,YL_SAVE) |
| 677 |
|
|
! CALL COPY_GFLC_GFLC(YI,YI_SAVE) |
| 678 |
|
|
! CALL COPY_GFLC_GFLC(YA,YA_SAVE) |
| 679 |
|
|
! |
| 680 |
|
|
! IF (.NOT. LLGPL .AND. YL%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1 |
| 681 |
|
|
! IF (.NOT. LLGPI .AND. YI%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1 |
| 682 |
|
|
! IF (.NOT. LLGPA .AND. YA%LGP) YGFL%NUMGPFLDS=YGFL%NUMGPFLDS+1 |
| 683 |
|
|
! |
| 684 |
|
|
! YGFL%NUMFLDS_SL1 = 0 |
| 685 |
|
|
! DO JGFL=1,YGFL%NUMFLDS |
| 686 |
|
|
! YGFLC(JGFL)%MP_SL1 = -HUGE(JPGFL) |
| 687 |
|
|
! IF(YGFLC(JGFL)%LADV) THEN |
| 688 |
|
|
! YGFL%NUMFLDS_SL1 = YGFL%NUMFLDS_SL1+1 |
| 689 |
|
|
! YGFLC(JGFL)%MP_SL1 = YGFL%NUMFLDS_SL1 |
| 690 |
|
|
! YGFLC(JGFL)%MP_SLX = (YGFLC(JGFL)%MP_SL1-1)*(NFLEVG+2*NFLSUL) |
| 691 |
|
|
! ENDIF |
| 692 |
|
|
! ENDDO |
| 693 |
|
|
! CALL SUSLB |
| 694 |
|
|
! |
| 695 |
|
|
! L_CLD_DEACT=.FALSE. |
| 696 |
|
|
! WRITE(NULOUT,*)' CLOUD FIELDS RE-ACTIVATAD, YGFL%NUMGPFLDS=', & |
| 697 |
|
|
! & YGFL%NUMGPFLDS,' YGFL%NUMFLDS_SL1=', YGFL%NUMFLDS_SL1 |
| 698 |
|
|
!ENDIF |
| 699 |
|
|
! |
| 700 |
|
|
!IF (LHOOK) CALL DR_HOOK('GFL_SUBS:REACT_CLOUD_GFL',1,ZHOOK_HANDLE) |
| 701 |
|
|
! |
| 702 |
|
|
!! ------------------------------------------------------------------ |
| 703 |
|
|
!END SUBROUTINE REACT_CLOUD_GFL |
| 704 |
|
|
|
| 705 |
|
|
!========================================================================= |
| 706 |
|
|
|
| 707 |
|
✗ |
SUBROUTINE FALSIFY_GFLC(YDGFLC) |
| 708 |
|
|
|
| 709 |
|
|
! Purpose. |
| 710 |
|
|
! -------- |
| 711 |
|
|
! Set field descriptors to false. |
| 712 |
|
|
|
| 713 |
|
|
! Author. |
| 714 |
|
|
! ------- |
| 715 |
|
|
! Y. Tremolet |
| 716 |
|
|
|
| 717 |
|
|
! Modifications. |
| 718 |
|
|
! -------------- |
| 719 |
|
|
! Original : 2004-03-12 |
| 720 |
|
|
!------------------------------------------------------------------------- |
| 721 |
|
|
|
| 722 |
|
|
TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC |
| 723 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 724 |
|
|
|
| 725 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',0,ZHOOK_HANDLE) |
| 726 |
|
✗ |
YDGFLC%CNAME = '' |
| 727 |
|
✗ |
YDGFLC%IGRBCODE = -HUGE(JPGFL) |
| 728 |
|
✗ |
YDGFLC%LADV = .FALSE. |
| 729 |
|
✗ |
YDGFLC%NREQIN = 0 |
| 730 |
|
✗ |
YDGFLC%REFVALI = 0.0_JPRB |
| 731 |
|
✗ |
YDGFLC%LREQOUT = .FALSE. |
| 732 |
|
✗ |
YDGFLC%LGPINGP = .TRUE. |
| 733 |
|
✗ |
YDGFLC%LTRAJIO = .FALSE. |
| 734 |
|
✗ |
YDGFLC%LGP = .FALSE. |
| 735 |
|
✗ |
YDGFLC%LSP = .FALSE. |
| 736 |
|
✗ |
YDGFLC%LCDERS = .FALSE. |
| 737 |
|
✗ |
YDGFLC%LACTIVE = .FALSE. |
| 738 |
|
✗ |
YDGFLC%LTHERMACT = .FALSE. |
| 739 |
|
✗ |
YDGFLC%LT9 = .FALSE. |
| 740 |
|
✗ |
YDGFLC%LT1 = .FALSE. |
| 741 |
|
✗ |
YDGFLC%LT5 = .FALSE. |
| 742 |
|
✗ |
YDGFLC%LPHY = .FALSE. |
| 743 |
|
✗ |
YDGFLC%LPT = .FALSE. |
| 744 |
|
✗ |
YDGFLC%LPC = .FALSE. |
| 745 |
|
✗ |
YDGFLC%LADJUST0 = .FALSE. |
| 746 |
|
✗ |
YDGFLC%LADJUST1 = .FALSE. |
| 747 |
|
✗ |
YDGFLC%NCOUPLING = 0 |
| 748 |
|
✗ |
YDGFLC%REFVALC = 0.0_JPRB |
| 749 |
|
✗ |
YDGFLC%LBIPER = .FALSE. |
| 750 |
|
✗ |
YDGFLC%CSLINT = '' |
| 751 |
|
✗ |
YDGFLC%R = 0.0_JPRB |
| 752 |
|
✗ |
YDGFLC%RCP = 0.0_JPRB |
| 753 |
|
|
!yt YDGFLC%MP = -HUGE(JPGFL) |
| 754 |
|
|
!yt YDGFLC%MPL = -HUGE(JPGFL) |
| 755 |
|
|
!yt YDGFLC%MPM = -HUGE(JPGFL) |
| 756 |
|
|
!yt YDGFLC%MP9 = -HUGE(JPGFL) |
| 757 |
|
|
!yt YDGFLC%MP1 = -HUGE(JPGFL) |
| 758 |
|
|
!yt YDGFLC%MP5 = -HUGE(JPGFL) |
| 759 |
|
|
!yt YDGFLC%MP5L = -HUGE(JPGFL) |
| 760 |
|
|
!yt YDGFLC%MP5M = -HUGE(JPGFL) |
| 761 |
|
|
!yt YDGFLC%MPSLP = -HUGE(JPGFL) |
| 762 |
|
|
!yt YDGFLC%MPSP = -HUGE(JPGFL) |
| 763 |
|
|
!yt YDGFLC%MP_SPL = -HUGE(JPGFL) |
| 764 |
|
|
!yt;-) YDGFLC%MPPT = -HUGE(JPGFL) |
| 765 |
|
|
!yt;-) YDGFLC%MPPC = -HUGE(JPGFL) |
| 766 |
|
|
!yt NULLIFY(YDGFLC%PREVIOUS) |
| 767 |
|
✗ |
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:FALSIFY_GFLC',1,ZHOOK_HANDLE) |
| 768 |
|
|
|
| 769 |
|
✗ |
END SUBROUTINE FALSIFY_GFLC |
| 770 |
|
|
!========================================================================= |
| 771 |
|
|
|
| 772 |
|
|
SUBROUTINE NOADVECT_GFLC(YDGFLC) |
| 773 |
|
|
|
| 774 |
|
|
! Purpose. |
| 775 |
|
|
! -------- |
| 776 |
|
|
! Switch off advection ect. |
| 777 |
|
|
|
| 778 |
|
|
! Author. |
| 779 |
|
|
! ------- |
| 780 |
|
|
! Y. Tremolet |
| 781 |
|
|
|
| 782 |
|
|
! Modifications. |
| 783 |
|
|
! -------------- |
| 784 |
|
|
! Original : 2004-03-12 |
| 785 |
|
|
!------------------------------------------------------------------------- |
| 786 |
|
|
|
| 787 |
|
|
TYPE(TYPE_GFL_COMP),INTENT(INOUT) :: YDGFLC |
| 788 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 789 |
|
|
|
| 790 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',0,ZHOOK_HANDLE) |
| 791 |
|
|
YDGFLC%LADV = .FALSE. |
| 792 |
|
|
YDGFLC%LCDERS = .FALSE. |
| 793 |
|
|
YDGFLC%LT1 = .FALSE. |
| 794 |
|
|
YDGFLC%LT5 = .FALSE. |
| 795 |
|
|
YDGFLC%LPHY = .FALSE. |
| 796 |
|
|
YDGFLC%LPT = .FALSE. |
| 797 |
|
|
YDGFLC%LADJUST0 = .FALSE. |
| 798 |
|
|
YDGFLC%LADJUST1 = .FALSE. |
| 799 |
|
|
YDGFLC%LBIPER = .FALSE. |
| 800 |
|
|
YDGFLC%CSLINT = '' |
| 801 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:NOADVECT_GFLC',1,ZHOOK_HANDLE) |
| 802 |
|
|
|
| 803 |
|
|
END SUBROUTINE NOADVECT_GFLC |
| 804 |
|
|
|
| 805 |
|
|
!========================================================================= |
| 806 |
|
|
|
| 807 |
|
|
SUBROUTINE COPY_GFLC_GFLC(YDGFLC1,YDGFLC2) |
| 808 |
|
|
|
| 809 |
|
|
! Purpose. |
| 810 |
|
|
! -------- |
| 811 |
|
|
! Copy field descriptors. |
| 812 |
|
|
|
| 813 |
|
|
! Author. |
| 814 |
|
|
! ------- |
| 815 |
|
|
! Y. Tremolet |
| 816 |
|
|
|
| 817 |
|
|
! Modifications. |
| 818 |
|
|
! -------------- |
| 819 |
|
|
! Original : 2004-03-12 |
| 820 |
|
|
!------------------------------------------------------------------------- |
| 821 |
|
|
|
| 822 |
|
|
TYPE (TYPE_GFL_COMP), INTENT(INOUT) :: YDGFLC1 |
| 823 |
|
|
TYPE (TYPE_GFL_COMP), INTENT(IN) :: YDGFLC2 |
| 824 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
| 825 |
|
|
|
| 826 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',0,ZHOOK_HANDLE) |
| 827 |
|
|
YDGFLC1%CNAME = YDGFLC2%CNAME |
| 828 |
|
|
YDGFLC1%IGRBCODE = YDGFLC2%IGRBCODE |
| 829 |
|
|
YDGFLC1%LADV = YDGFLC2%LADV |
| 830 |
|
|
YDGFLC1%NREQIN = YDGFLC2%NREQIN |
| 831 |
|
|
YDGFLC1%REFVALI = YDGFLC2%REFVALI |
| 832 |
|
|
YDGFLC1%LREQOUT = YDGFLC2%LREQOUT |
| 833 |
|
|
YDGFLC1%LGPINGP = YDGFLC2%LGPINGP |
| 834 |
|
|
YDGFLC1%LTRAJIO = YDGFLC2%LTRAJIO |
| 835 |
|
|
YDGFLC1%LGP = YDGFLC2%LGP |
| 836 |
|
|
YDGFLC1%LSP = YDGFLC2%LSP |
| 837 |
|
|
YDGFLC1%LPT = YDGFLC2%LPT |
| 838 |
|
|
YDGFLC1%LPC = YDGFLC2%LPC |
| 839 |
|
|
YDGFLC1%LCDERS = YDGFLC2%LCDERS |
| 840 |
|
|
YDGFLC1%LACTIVE = YDGFLC2%LACTIVE |
| 841 |
|
|
YDGFLC1%LTHERMACT = YDGFLC2%LTHERMACT |
| 842 |
|
|
YDGFLC1%LT9 = YDGFLC2%LT9 |
| 843 |
|
|
YDGFLC1%LT1 = YDGFLC2%LT1 |
| 844 |
|
|
YDGFLC1%LT5 = YDGFLC2%LT5 |
| 845 |
|
|
YDGFLC1%LPHY = YDGFLC2%LPHY |
| 846 |
|
|
YDGFLC1%LADJUST0 = YDGFLC2%LADJUST0 |
| 847 |
|
|
YDGFLC1%LADJUST1 = YDGFLC2%LADJUST1 |
| 848 |
|
|
YDGFLC1%NCOUPLING = YDGFLC2%NCOUPLING |
| 849 |
|
|
YDGFLC1%REFVALC = YDGFLC2%REFVALC |
| 850 |
|
|
YDGFLC1%LBIPER = YDGFLC2%LBIPER |
| 851 |
|
|
YDGFLC1%CSLINT = YDGFLC2%CSLINT |
| 852 |
|
|
YDGFLC1%R = YDGFLC2%R |
| 853 |
|
|
YDGFLC1%RCP = YDGFLC2%RCP |
| 854 |
|
|
YDGFLC1%MP = YDGFLC2%MP |
| 855 |
|
|
YDGFLC1%MPL = YDGFLC2%MPL |
| 856 |
|
|
YDGFLC1%MPM = YDGFLC2%MPM |
| 857 |
|
|
YDGFLC1%MP9 = YDGFLC2%MP9 |
| 858 |
|
|
YDGFLC1%MP1 = YDGFLC2%MP1 |
| 859 |
|
|
YDGFLC1%MP5 = YDGFLC2%MP5 |
| 860 |
|
|
YDGFLC1%MP5L = YDGFLC2%MP5L |
| 861 |
|
|
YDGFLC1%MP5M = YDGFLC2%MP5M |
| 862 |
|
|
YDGFLC1%MPSLP = YDGFLC2%MPSLP |
| 863 |
|
|
YDGFLC1%MP_SPL = YDGFLC2%MP_SPL |
| 864 |
|
|
YDGFLC1%MP_SL1 = YDGFLC2%MP_SL1 |
| 865 |
|
|
YDGFLC1%MPSP = YDGFLC2%MPSP |
| 866 |
|
|
YDGFLC1%MPPT = YDGFLC2%MPPT |
| 867 |
|
|
YDGFLC1%MPPC = YDGFLC2%MPPC |
| 868 |
|
|
!yt YDGFLC1%PREVIOUS => YDGFLC2%PREVIOUS |
| 869 |
|
|
IF (LHOOK) CALL DR_HOOK('GFL_SUBS:COPY_GFLC_GFLC',1,ZHOOK_HANDLE) |
| 870 |
|
|
|
| 871 |
|
|
END SUBROUTINE COPY_GFLC_GFLC |
| 872 |
|
|
|
| 873 |
|
|
!========================================================================= |
| 874 |
|
|
|
| 875 |
|
|
END MODULE GFL_SUBS |
| 876 |
|
|
|