Changeset 2631
- Timestamp:
- Mar 1, 2022, 11:46:41 PM (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90
r2543 r2631 198 198 REAL*8 albedo_temp(L_NSPECTV) ! For equivalent albedo calculation. 199 199 REAL*8 surface_stellar_flux ! Stellar flux reaching the surface. Useful for equivalent albedo calculation. 200 200 201 ! local variable 202 integer ok ! status (returned by NetCDF functions) 201 203 202 204 !=============================================================== … … 208 210 209 211 ! test on allocated necessary because of CLFvarying (two calls to callcorrk in physiq) 210 if(.not.allocated(QXVAER)) allocate(QXVAER(L_LEVELS,L_NSPECTV,naerkind)) 211 if(.not.allocated(QSVAER)) allocate(QSVAER(L_LEVELS,L_NSPECTV,naerkind)) 212 if(.not.allocated(GVAER)) allocate(GVAER(L_LEVELS,L_NSPECTV,naerkind)) 213 if(.not.allocated(QXIAER)) allocate(QXIAER(L_LEVELS,L_NSPECTI,naerkind)) 214 if(.not.allocated(QSIAER)) allocate(QSIAER(L_LEVELS,L_NSPECTI,naerkind)) 215 if(.not.allocated(GIAER)) allocate(GIAER(L_LEVELS,L_NSPECTI,naerkind)) 212 if(.not.allocated(QXVAER)) then 213 allocate(QXVAER(L_LEVELS,L_NSPECTV,naerkind), stat=ok) 214 if (ok /= 0) then 215 write(*,*) "memory allocation failed for QXVAER!" 216 call abort_physic(subname,'allocation failurei for QXVAER',1) 217 endif 218 endif 219 if(.not.allocated(QSVAER)) then 220 allocate(QSVAER(L_LEVELS,L_NSPECTV,naerkind), stat=ok) 221 if (ok /= 0) then 222 write(*,*) "memory allocation failed for QSVAER!" 223 call abort_physic(subname,'allocation failure for QSVAER',1) 224 endif 225 endif 226 if(.not.allocated(GVAER)) then 227 allocate(GVAER(L_LEVELS,L_NSPECTV,naerkind), stat=ok) 228 if (ok /= 0) then 229 write(*,*) "memory allocation failed for GVAER!" 230 call abort_physic(subname,'allocation failure for GVAER',1) 231 endif 232 endif 233 if(.not.allocated(QXIAER)) then 234 allocate(QXIAER(L_LEVELS,L_NSPECTI,naerkind), stat=ok) 235 if (ok /= 0) then 236 write(*,*) "memory allocation failed for QXIAER!" 237 call abort_physic(subname,'allocation failure for QXIAER',1) 238 endif 239 endif 240 if(.not.allocated(QSIAER)) then 241 allocate(QSIAER(L_LEVELS,L_NSPECTI,naerkind), stat=ok) 242 if (ok /= 0) then 243 write(*,*) "memory allocation failed for QSIAER!" 244 call abort_physic(subname,'allocation failure for QSIAER',1) 245 endif 246 endif 247 if(.not.allocated(GIAER)) then 248 allocate(GIAER(L_LEVELS,L_NSPECTI,naerkind), stat=ok) 249 if (ok /= 0) then 250 write(*,*) "memory allocation failed for GIAER!" 251 call abort_physic(subname,'allocation failure for GIAER',1) 252 endif 253 endif 216 254 217 255 !!! ALLOCATED instances are necessary because of CLFvarying (strategy to call callcorrk twice in physiq...) 218 IF(.not.ALLOCATED(QREFvis3d)) ALLOCATE(QREFvis3d(ngrid,nlayer,naerkind)) 219 IF(.not.ALLOCATED(QREFir3d)) ALLOCATE(QREFir3d(ngrid,nlayer,naerkind)) 256 IF(.not.ALLOCATED(QREFvis3d))THEN 257 ALLOCATE(QREFvis3d(ngrid,nlayer,naerkind), stat=ok) 258 IF (ok/=0) THEN 259 write(*,*) "memory allocation failed for QREFvis3d!" 260 call abort_physic(subname,'allocation failure for QREFvis3d',1) 261 ENDIF 262 ENDIF 263 IF(.not.ALLOCATED(QREFir3d)) THEN 264 ALLOCATE(QREFir3d(ngrid,nlayer,naerkind), stat=ok) 265 IF (ok/=0) THEN 266 write(*,*) "memory allocation failed for QREFir3d!" 267 call abort_physic(subname,'allocation failure for QREFir3d',1) 268 ENDIF 269 ENDIF 220 270 ! Effective radius and variance of the aerosols 221 IF(.not.ALLOCATED(reffrad)) allocate(reffrad(ngrid,nlayer,naerkind)) 222 IF(.not.ALLOCATED(nueffrad)) allocate(nueffrad(ngrid,nlayer,naerkind)) 271 IF(.not.ALLOCATED(reffrad)) THEN 272 allocate(reffrad(ngrid,nlayer,naerkind), stat=ok) 273 IF (ok/=0) THEN 274 write(*,*) "memory allocation failed for reffrad!" 275 call abort_physic(subname,'allocation failure for reffrad',1) 276 ENDIF 277 ENDIF 278 IF(.not.ALLOCATED(nueffrad)) THEN 279 allocate(nueffrad(ngrid,nlayer,naerkind), stat=ok) 280 IF (ok/=0) THEN 281 write(*,*) "memory allocation failed for nueffrad!" 282 call abort_physic(subname,'allocation failure for nueffrad',1) 283 ENDIF 284 ENDIF 223 285 224 286 #ifndef MESOSCALE … … 254 316 ! now that L_NGAUSS has been initialized (by sugas_corrk) 255 317 ! allocate related arrays 256 if(.not.allocated(dtaui)) ALLOCATE(dtaui(L_NLAYRAD,L_NSPECTI,L_NGAUSS)) 257 if(.not.allocated(dtauv)) ALLOCATE(dtauv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)) 258 if(.not.allocated(cosbv)) ALLOCATE(cosbv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)) 259 if(.not.allocated(cosbi)) ALLOCATE(cosbi(L_NLAYRAD,L_NSPECTI,L_NGAUSS)) 260 if(.not.allocated(wbari)) ALLOCATE(wbari(L_NLAYRAD,L_NSPECTI,L_NGAUSS)) 261 if(.not.allocated(wbarv)) ALLOCATE(wbarv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)) 262 if(.not.allocated(tauv)) ALLOCATE(tauv(L_NLEVRAD,L_NSPECTV,L_NGAUSS)) 263 if(.not.allocated(taucumv)) ALLOCATE(taucumv(L_LEVELS,L_NSPECTV,L_NGAUSS)) 264 if(.not.allocated(taucumi)) ALLOCATE(taucumi(L_LEVELS,L_NSPECTI,L_NGAUSS)) 265 if(.not.allocated(taugsurf)) ALLOCATE(taugsurf(L_NSPECTV,L_NGAUSS-1)) 266 if(.not.allocated(taugsurfi)) ALLOCATE(taugsurfi(L_NSPECTI,L_NGAUSS-1)) 318 if(.not.allocated(dtaui)) then 319 ALLOCATE(dtaui(L_NLAYRAD,L_NSPECTI,L_NGAUSS), stat=ok) 320 if (ok/=0) then 321 write(*,*) "memory allocation failed for dtaui!" 322 call abort_physic(subname,'allocation failure for dtaui',1) 323 endif 324 endif 325 if(.not.allocated(dtauv)) then 326 ALLOCATE(dtauv(L_NLAYRAD,L_NSPECTV,L_NGAUSS), stat=ok) 327 if (ok/=0) then 328 write(*,*) "memory allocation failed for dtauv!" 329 call abort_physic(subname,'allocation failure for dtauv',1) 330 endif 331 endif 332 if(.not.allocated(cosbv)) then 333 ALLOCATE(cosbv(L_NLAYRAD,L_NSPECTV,L_NGAUSS), stat=ok) 334 if (ok/=0) then 335 write(*,*) "memory allocation failed for cosbv!" 336 call abort_physic(subname,'allocation failure for cobsv',1) 337 endif 338 endif 339 if(.not.allocated(cosbi)) then 340 ALLOCATE(cosbi(L_NLAYRAD,L_NSPECTI,L_NGAUSS), stat=ok) 341 if (ok/=0) then 342 write(*,*) "memory allocation failed for cosbi!" 343 call abort_physic(subname,'allocation failure for cobsi',1) 344 endif 345 endif 346 if(.not.allocated(wbari)) then 347 ALLOCATE(wbari(L_NLAYRAD,L_NSPECTI,L_NGAUSS), stat=ok) 348 if (ok/=0) then 349 write(*,*) "memory allocation failed for wbari!" 350 call abort_physic(subname,'allocation failure for wbari',1) 351 endif 352 endif 353 if(.not.allocated(wbarv)) then 354 ALLOCATE(wbarv(L_NLAYRAD,L_NSPECTV,L_NGAUSS), stat=ok) 355 if (ok/=0) then 356 write(*,*) "memory allocation failed for wbarv!" 357 call abort_physic(subname,'allocation failure for wbarv',1) 358 endif 359 endif 360 if(.not.allocated(tauv)) then 361 ALLOCATE(tauv(L_NLEVRAD,L_NSPECTV,L_NGAUSS), stat=ok) 362 if (ok/=0) then 363 write(*,*) "memory allocation failed for tauv!" 364 call abort_physic(subname,'allocation failure for tauv',1) 365 endif 366 endif 367 if(.not.allocated(taucumv)) then 368 ALLOCATE(taucumv(L_LEVELS,L_NSPECTV,L_NGAUSS), stat=ok) 369 if (ok/=0) then 370 write(*,*) "memory allocation failed for taucumv!" 371 call abort_physic(subname,'allocation failure for taucumv',1) 372 endif 373 endif 374 if(.not.allocated(taucumi)) then 375 ALLOCATE(taucumi(L_LEVELS,L_NSPECTI,L_NGAUSS), stat=ok) 376 if (ok/=0) then 377 write(*,*) "memory allocation failed for taucumi!" 378 call abort_physic(subname,'allocation failure for taucumi',1) 379 endif 380 endif 381 if(.not.allocated(taugsurf)) then 382 ALLOCATE(taugsurf(L_NSPECTV,L_NGAUSS-1), stat=ok) 383 if (ok/=0) then 384 write(*,*) "memory allocation failed for taugsurf!" 385 call abort_physic(subname,'allocation failure for taugsurf',1) 386 endif 387 endif 388 if(.not.allocated(taugsurfi)) then 389 ALLOCATE(taugsurfi(L_NSPECTI,L_NGAUSS-1), stat=ok) 390 if (ok/=0) then 391 write(*,*) "memory allocation failed for taugsurfi!" 392 call abort_physic(subname,'allocation failure for taugsurfi',1) 393 endif 394 endif 267 395 268 396 if((igcm_h2o_vap.eq.0) .and. varactive)then
Note: See TracChangeset
for help on using the changeset viewer.