Index: trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90 =================================================================== --- trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90 (revision 2625) +++ trunk/LMDZ.GENERIC/libf/phystd/callcorrk.F90 (revision 2631) @@ -198,5 +198,7 @@ REAL*8 albedo_temp(L_NSPECTV) ! For equivalent albedo calculation. REAL*8 surface_stellar_flux ! Stellar flux reaching the surface. Useful for equivalent albedo calculation. - + + ! local variable + integer ok ! status (returned by NetCDF functions) !=============================================================== @@ -208,17 +210,77 @@ ! test on allocated necessary because of CLFvarying (two calls to callcorrk in physiq) - if(.not.allocated(QXVAER)) allocate(QXVAER(L_LEVELS,L_NSPECTV,naerkind)) - if(.not.allocated(QSVAER)) allocate(QSVAER(L_LEVELS,L_NSPECTV,naerkind)) - if(.not.allocated(GVAER)) allocate(GVAER(L_LEVELS,L_NSPECTV,naerkind)) - if(.not.allocated(QXIAER)) allocate(QXIAER(L_LEVELS,L_NSPECTI,naerkind)) - if(.not.allocated(QSIAER)) allocate(QSIAER(L_LEVELS,L_NSPECTI,naerkind)) - if(.not.allocated(GIAER)) allocate(GIAER(L_LEVELS,L_NSPECTI,naerkind)) + if(.not.allocated(QXVAER)) then + allocate(QXVAER(L_LEVELS,L_NSPECTV,naerkind), stat=ok) + if (ok /= 0) then + write(*,*) "memory allocation failed for QXVAER!" + call abort_physic(subname,'allocation failurei for QXVAER',1) + endif + endif + if(.not.allocated(QSVAER)) then + allocate(QSVAER(L_LEVELS,L_NSPECTV,naerkind), stat=ok) + if (ok /= 0) then + write(*,*) "memory allocation failed for QSVAER!" + call abort_physic(subname,'allocation failure for QSVAER',1) + endif + endif + if(.not.allocated(GVAER)) then + allocate(GVAER(L_LEVELS,L_NSPECTV,naerkind), stat=ok) + if (ok /= 0) then + write(*,*) "memory allocation failed for GVAER!" + call abort_physic(subname,'allocation failure for GVAER',1) + endif + endif + if(.not.allocated(QXIAER)) then + allocate(QXIAER(L_LEVELS,L_NSPECTI,naerkind), stat=ok) + if (ok /= 0) then + write(*,*) "memory allocation failed for QXIAER!" + call abort_physic(subname,'allocation failure for QXIAER',1) + endif + endif + if(.not.allocated(QSIAER)) then + allocate(QSIAER(L_LEVELS,L_NSPECTI,naerkind), stat=ok) + if (ok /= 0) then + write(*,*) "memory allocation failed for QSIAER!" + call abort_physic(subname,'allocation failure for QSIAER',1) + endif + endif + if(.not.allocated(GIAER)) then + allocate(GIAER(L_LEVELS,L_NSPECTI,naerkind), stat=ok) + if (ok /= 0) then + write(*,*) "memory allocation failed for GIAER!" + call abort_physic(subname,'allocation failure for GIAER',1) + endif + endif !!! ALLOCATED instances are necessary because of CLFvarying (strategy to call callcorrk twice in physiq...) - IF(.not.ALLOCATED(QREFvis3d)) ALLOCATE(QREFvis3d(ngrid,nlayer,naerkind)) - IF(.not.ALLOCATED(QREFir3d)) ALLOCATE(QREFir3d(ngrid,nlayer,naerkind)) + IF(.not.ALLOCATED(QREFvis3d))THEN + ALLOCATE(QREFvis3d(ngrid,nlayer,naerkind), stat=ok) + IF (ok/=0) THEN + write(*,*) "memory allocation failed for QREFvis3d!" + call abort_physic(subname,'allocation failure for QREFvis3d',1) + ENDIF + ENDIF + IF(.not.ALLOCATED(QREFir3d)) THEN + ALLOCATE(QREFir3d(ngrid,nlayer,naerkind), stat=ok) + IF (ok/=0) THEN + write(*,*) "memory allocation failed for QREFir3d!" + call abort_physic(subname,'allocation failure for QREFir3d',1) + ENDIF + ENDIF ! Effective radius and variance of the aerosols - IF(.not.ALLOCATED(reffrad)) allocate(reffrad(ngrid,nlayer,naerkind)) - IF(.not.ALLOCATED(nueffrad)) allocate(nueffrad(ngrid,nlayer,naerkind)) + IF(.not.ALLOCATED(reffrad)) THEN + allocate(reffrad(ngrid,nlayer,naerkind), stat=ok) + IF (ok/=0) THEN + write(*,*) "memory allocation failed for reffrad!" + call abort_physic(subname,'allocation failure for reffrad',1) + ENDIF + ENDIF + IF(.not.ALLOCATED(nueffrad)) THEN + allocate(nueffrad(ngrid,nlayer,naerkind), stat=ok) + IF (ok/=0) THEN + write(*,*) "memory allocation failed for nueffrad!" + call abort_physic(subname,'allocation failure for nueffrad',1) + ENDIF + ENDIF #ifndef MESOSCALE @@ -254,15 +316,81 @@ ! now that L_NGAUSS has been initialized (by sugas_corrk) ! allocate related arrays - if(.not.allocated(dtaui)) ALLOCATE(dtaui(L_NLAYRAD,L_NSPECTI,L_NGAUSS)) - if(.not.allocated(dtauv)) ALLOCATE(dtauv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)) - if(.not.allocated(cosbv)) ALLOCATE(cosbv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)) - if(.not.allocated(cosbi)) ALLOCATE(cosbi(L_NLAYRAD,L_NSPECTI,L_NGAUSS)) - if(.not.allocated(wbari)) ALLOCATE(wbari(L_NLAYRAD,L_NSPECTI,L_NGAUSS)) - if(.not.allocated(wbarv)) ALLOCATE(wbarv(L_NLAYRAD,L_NSPECTV,L_NGAUSS)) - if(.not.allocated(tauv)) ALLOCATE(tauv(L_NLEVRAD,L_NSPECTV,L_NGAUSS)) - if(.not.allocated(taucumv)) ALLOCATE(taucumv(L_LEVELS,L_NSPECTV,L_NGAUSS)) - if(.not.allocated(taucumi)) ALLOCATE(taucumi(L_LEVELS,L_NSPECTI,L_NGAUSS)) - if(.not.allocated(taugsurf)) ALLOCATE(taugsurf(L_NSPECTV,L_NGAUSS-1)) - if(.not.allocated(taugsurfi)) ALLOCATE(taugsurfi(L_NSPECTI,L_NGAUSS-1)) + if(.not.allocated(dtaui)) then + ALLOCATE(dtaui(L_NLAYRAD,L_NSPECTI,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for dtaui!" + call abort_physic(subname,'allocation failure for dtaui',1) + endif + endif + if(.not.allocated(dtauv)) then + ALLOCATE(dtauv(L_NLAYRAD,L_NSPECTV,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for dtauv!" + call abort_physic(subname,'allocation failure for dtauv',1) + endif + endif + if(.not.allocated(cosbv)) then + ALLOCATE(cosbv(L_NLAYRAD,L_NSPECTV,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for cosbv!" + call abort_physic(subname,'allocation failure for cobsv',1) + endif + endif + if(.not.allocated(cosbi)) then + ALLOCATE(cosbi(L_NLAYRAD,L_NSPECTI,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for cosbi!" + call abort_physic(subname,'allocation failure for cobsi',1) + endif + endif + if(.not.allocated(wbari)) then + ALLOCATE(wbari(L_NLAYRAD,L_NSPECTI,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for wbari!" + call abort_physic(subname,'allocation failure for wbari',1) + endif + endif + if(.not.allocated(wbarv)) then + ALLOCATE(wbarv(L_NLAYRAD,L_NSPECTV,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for wbarv!" + call abort_physic(subname,'allocation failure for wbarv',1) + endif + endif + if(.not.allocated(tauv)) then + ALLOCATE(tauv(L_NLEVRAD,L_NSPECTV,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for tauv!" + call abort_physic(subname,'allocation failure for tauv',1) + endif + endif + if(.not.allocated(taucumv)) then + ALLOCATE(taucumv(L_LEVELS,L_NSPECTV,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for taucumv!" + call abort_physic(subname,'allocation failure for taucumv',1) + endif + endif + if(.not.allocated(taucumi)) then + ALLOCATE(taucumi(L_LEVELS,L_NSPECTI,L_NGAUSS), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for taucumi!" + call abort_physic(subname,'allocation failure for taucumi',1) + endif + endif + if(.not.allocated(taugsurf)) then + ALLOCATE(taugsurf(L_NSPECTV,L_NGAUSS-1), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for taugsurf!" + call abort_physic(subname,'allocation failure for taugsurf',1) + endif + endif + if(.not.allocated(taugsurfi)) then + ALLOCATE(taugsurfi(L_NSPECTI,L_NGAUSS-1), stat=ok) + if (ok/=0) then + write(*,*) "memory allocation failed for taugsurfi!" + call abort_physic(subname,'allocation failure for taugsurfi',1) + endif + endif if((igcm_h2o_vap.eq.0) .and. varactive)then