! $Id: radlwsw_inca.F90 163 2010-02-22 15:41:45Z acosce $ !! ========================================================================= !! INCA - INteraction with Chemistry and Aerosols !! !! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE) !! Unite mixte CEA-CNRS-UVSQ !! !! Contributors to this INCA subroutine: !! !! Celine Deandreis, LSCE !! !! Anne Cozic, LSCE, anne.cozic@cea.fr !! !! This software is a computer program whose purpose is to simulate the !! atmospheric gas phase and aerosol composition. The model is designed to be !! used within a transport model or a general circulation model. This version !! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts !! for emissions, transport (resolved and sub-grid scale), photochemical !! transformations, and scavenging (dry deposition and washout) of chemical !! species and aerosols interactively in the GCM. Several versions of the INCA !! model are currently used depending on the envisaged applications with the !! chemistry-climate model. !! !! This software is governed by the CeCILL license under French law and !! abiding by the rules of distribution of free software. You can use, !! modify and/ or redistribute the software under the terms of the CeCILL !! license as circulated by CEA, CNRS and INRIA at the following URL !! "http://www.cecill.info". !! !! As a counterpart to the access to the source code and rights to copy, !! modify and redistribute granted by the license, users are provided only !! with a limited warranty and the software's author, the holder of the !! economic rights, and the successive licensors have only limited !! liability. !! !! In this respect, the user's attention is drawn to the risks associated !! with loading, using, modifying and/or developing or reproducing the !! software by the user in light of its specific status of free software, !! that may mean that it is complicated to manipulate, and that also !! therefore means that it is reserved for developers and experienced !! professionals having in-depth computer knowledge. Users are therefore !! encouraged to load and test the software's suitability as regards their !! requirements in conditions enabling the security of their systems and/or !! data to be ensured and, more generally, to use and operate it in the !! same conditions as regards security. !! !! The fact that you are presently reading this means that you have had !! knowledge of the CeCILL license and that you accept its terms. !! ========================================================================= #include SUBROUTINE radlwsw_inca(chemistry_couple, kdlon,kflev,dist, rmu0, fract, & solaire,paprs, pplay,tsol,albedo, alblw, t,q,size_wo, wo,& cldfra, cldemi, cldtaupd,& heat,heat0,cool,cool0,albpla,& topsw,toplw,solsw,sollw,& sollwdown,& topsw0,toplw0,solsw0,sollw0,& lwdn0, lwdn, lwup0, lwup,& swdn0, swdn, swup0, swup,& ok_ade, ok_aie,& tau_inca, piz_inca, cg_inca,& topswad_inca, solswad_inca,& topswad0_inca, solswad0_inca,& topsw_inca, topsw0_inca,& solsw_inca, solsw0_inca,& cldtaupi, topswai_inca, solswai_inca) USE INCA_DIM USE PRINT_INCA USE AEROSOL_DIAG USE CHEM_MODS, ONLY : o3_inca IMPLICIT NONE !====================================================================== ! Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719 ! Objet: interface entre le modele et les rayonnements ! Arguments: ! dist-----input-R- distance astronomique terre-soleil ! rmu0-----input-R- cosinus de l'angle zenithal ! fract----input-R- duree d'ensoleillement normalisee ! co2_ppm--input-R- concentration du gaz carbonique (en ppm) ! solaire--input-R- constante solaire (W/m**2) ! paprs----input-R- pression a inter-couche (Pa) ! pplay----input-R- pression au milieu de couche (Pa) ! tsol-----input-R- temperature du sol (en K) ! albedo---input-R- albedo du sol (entre 0 et 1) ! t--------input-R- temperature (K) ! q--------input-R- vapeur d'eau (en kg/kg) ! wo-------input-R- contenu en ozone (en kilo-Dobsons 21/10/2016) correction MPL 100505 ! cldfra---input-R- fraction nuageuse (entre 0 et 1) ! cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value) ! cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1) ! ok_ade---input-L- apply the Aerosol Direct Effect or not? ! ok_aie---input-L- apply the Aerosol Indirect Effect or not? ! tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F) ! cldtaupi-input-R- epaisseur optique des nuages dans le visible ! calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller ! droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd ! it is needed for the diagnostics of the aerosol indirect radiative forcing ! ! heat-----output-R- echauffement atmospherique (visible) (K/jour) ! cool-----output-R- refroidissement dans l'IR (K/jour) ! albpla---output-R- albedo planetaire (entre 0 et 1) ! topsw----output-R- flux solaire net au sommet de l'atm. ! toplw----output-R- ray. IR montant au sommet de l'atmosphere ! solsw----output-R- flux solaire net a la surface ! sollw----output-R- ray. IR montant a la surface ! solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir) ! topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir) ! solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind) ! topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind) ! ! ATTENTION: swai and swad have to be interpreted in the following manner: ! --------- ! ok_ade=F & ok_aie=F -both are zero ! ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad ! indirect is zero ! ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai ! direct is zero ! ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai ! aerosol direct forcing is F_{AD} = topswai-topswad ! !====================================================================== ! ==================================================================== ! Adapte au modele de chimie INCA par Celine Deandreis -- 2007 ! 1 = ZERO ! 2 = AER total ! 3 = NAT ! 4 = BC ! 5 = SO4 ! 6 = POM ! 7 = DUST ! 8 = SS ! 9 = FNO3 ! 10 = DNO3 ! 11 = SNO3 ! ! ==================================================================== #include "YOETHF_I.h" #include "YOMCST_I.h" EXTERNAL lw_LMDAR4, sw_LMDAR4 LOGICAL, INTENT(in) :: chemistry_couple INTEGER, INTENT(in) :: kdlon,kflev REAL, INTENT(in) :: solaire REAL, INTENT(in) :: dist REAL, INTENT(in) :: rmu0(PLON), fract(PLON) REAL,INTENT(in) :: paprs(PLON,PLEV+1), pplay(PLON,PLEV) REAL,INTENT(in) ::albedo(PLON), alblw(PLON), tsol(PLON) REAL,INTENT(in) :: t(PLON,PLEV), q(PLON,PLEV) INTEGER, INTENT(in) :: size_wo REAL, INTENT(in):: wo(PLON,PLEV,size_wo) ! column-density of ozone in a layer, in kilo-Dobsons ! "wo(:, :, 1)" is for the average day-night field, ! "wo(:, :, 2)" is for daylight time. LOGICAL, INTENT(in) :: ok_ade, ok_aie ! switches whether to use aerosol direct (indirect) effects or not REAL, INTENT(in) :: cldfra(PLON,PLEV), cldemi(PLON,PLEV), cldtaupd(PLON,PLEV) REAL, INTENT(in) :: tau_inca(PLON,PLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) REAL, INTENT(in) :: piz_inca(PLON,PLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) REAL, INTENT(in) :: cg_inca(PLON,PLEV,naero_grp,2) ! aerosol optical properties (see aeropt.F) REAL, INTENT(in) :: cldtaupi(PLON,PLEV) ! cloud optical thickness for pre-industrial aerosol concentrations REAL, INTENT(out):: heat(PLON,PLEV), cool(PLON,PLEV) REAL, INTENT(out):: heat0(PLON,PLEV), cool0(PLON,PLEV) REAL, INTENT(out) :: topsw(PLON), toplw(PLON) REAL, INTENT(out) :: solsw(PLON), sollw(PLON), albpla(PLON) REAL, INTENT(out) :: topsw0(PLON), toplw0(PLON), solsw0(PLON), sollw0(PLON) REAL, INTENT(out) :: sollwdown(PLON) REAL, INTENT(out) :: swdn(PLON,kflev+1),swdn0(PLON,kflev+1) REAL, INTENT(out) :: swup(PLON,kflev+1),swup0(PLON,kflev+1) REAL, INTENT(out) :: lwdn(PLON,kflev+1),lwdn0(PLON,kflev+1) REAL, INTENT(out) :: lwup(PLON,kflev+1),lwup0(PLON,kflev+1) REAL, INTENT(out) :: topswad_inca(PLON), solswad_inca(PLON) ! output: aerosol direct forcing at TOA and surface REAL, INTENT(out) :: topswad0_inca(PLON), solswad0_inca(PLON) ! output: aerosol direct forcing at TOA and surface REAL, INTENT(out) :: topswai_inca(PLON), solswai_inca(PLON) ! output: aerosol indirect forcing atTOA and surface REAL*8, INTENT(out) :: topsw_inca(kdlon,naero_grp), topsw0_inca(kdlon,naero_grp) REAL*8, INTENT(out) :: solsw_inca(kdlon,naero_grp), solsw0_inca(kdlon,naero_grp) #ifdef AER REAL*8 ZFSUP(KDLON,KFLEV+1) REAL*8 ZFSDN(KDLON,KFLEV+1) REAL*8 ZFSUP0(KDLON,KFLEV+1) REAL*8 ZFSDN0(KDLON,KFLEV+1) REAL*8 ZFLUP(KDLON,KFLEV+1) REAL*8 ZFLDN(KDLON,KFLEV+1) REAL*8 ZFLUP0(KDLON,KFLEV+1) REAL*8 ZFLDN0(KDLON,KFLEV+1) REAL*8 zx_alpha1, zx_alpha2 INTEGER k, kk, i, j, iof, nb_gr REAL*8 PSCT REAL*8 PALBD(kdlon,2), PALBP(kdlon,2) REAL*8 PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon) REAL*8 PPSOL(kdlon), PDP(kdlon,PLEV) REAL*8 PTL(kdlon,kflev+1), PPMB(kdlon,kflev+1) REAL*8 PTAVE(kdlon,kflev) REAL*8 PWV(kdlon,kflev), PQS(kdlon,kflev) REAL*8 POZON(kdlon,kflev, size(wo,3))! mass fraction of ozone ! "POZON(:, :, 1)" is for the average day-night field, ! "POZON(:, :, 2)" is for daylight time. REAL*8 PAER(kdlon,kflev,5) REAL*8 PCLDLD(kdlon,kflev) REAL*8 PCLDLU(kdlon,kflev) REAL*8 PCLDSW(kdlon,kflev) REAL*8 PTAU(kdlon,2,kflev) REAL*8 POMEGA(kdlon,2,kflev) REAL*8 PCG(kdlon,2,kflev) REAL*8 zfract(kdlon), zrmu0(kdlon), zdist REAL*8 zheat(kdlon,kflev), zcool(kdlon,kflev) REAL*8 zheat0(kdlon,kflev), zcool0(kdlon,kflev) REAL*8 ztopsw(kdlon), ztoplw(kdlon) REAL*8 zsolsw(kdlon), zsollw(kdlon), zalbpla(kdlon) REAL*8 zsollwdown(kdlon) REAL*8 ztopsw0(kdlon), ztoplw0(kdlon) REAL*8 zsolsw0(kdlon), zsollw0(kdlon) REAL*8 zznormcp REAL*8 tauinca(kdlon,kflev,naero_grp,2) ! aer opt properties REAL*8 pizinca(kdlon,kflev,naero_grp,2) REAL*8 cginca(kdlon,kflev,naero_grp,2) REAL*8 PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use REAL*8 POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo REAL*8 ztopswadinca(kdlon), zsolswadinca(kdlon) ! Aerosol direct forcing at TOAand surface REAL*8 ztopswad0inca(kdlon), zsolswad0inca(kdlon) ! Aerosol direct forcing at TOAand surface REAL*8 ztopswaiinca(kdlon), zsolswaiinca(kdlon) ! dito, indirect REAL*8 ztopsw_inca(kdlon,naero_grp), ztopsw0_inca(kdlon,naero_grp) REAL*8 zsolsw_inca(kdlon,naero_grp), zsolsw0_inca(kdlon,naero_grp) REAL*8 ZCLEAR(KDLON) real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 ! initialisation tauinca(:,:,:,:)=0. pizinca(:,:,:,:)=0. cginca(:,:,:,:)=0. ! !------------------------------------------- nb_gr = PLON / kdlon IF (nb_gr*kdlon .NE. PLON) THEN WRITE(lunout,*) "kdlon mauvais:", PLON, kdlon, nb_gr CALL abort ENDIF IF (kflev .NE. PLEV) THEN WRITE(lunout,*) "kflev differe de PLEV, kflev, PLEV" CALL abort ENDIF !------------------------------------------- DO k = 1, PLEV DO i = 1, PLON heat(i,k)=0. cool(i,k)=0. heat0(i,k)=0. cool0(i,k)=0. ENDDO ENDDO ! zdist = dist ! PSCT = solaire/zdist/zdist DO j = 1, nb_gr iof = kdlon*(j-1) DO i = 1, kdlon zfract(i) = fract(iof+i) zrmu0(i) = rmu0(iof+i) PALBD(i,1) = albedo(iof+i) PALBD(i,2) = alblw(iof+i) PALBP(i,1) = albedo(iof+i) PALBP(i,2) = alblw(iof+i) PEMIS(i) = 1.0 PVIEW(i) = 1.66 PPSOL(i) = paprs(iof+i,1) zx_alpha1 = (paprs(iof+i,1)-pplay(iof+i,2))/(pplay(iof+i,1)-pplay(iof+i,2)) zx_alpha2 = 1.0 - zx_alpha1 PTL(i,1) = t(iof+i,1) * zx_alpha1 + t(iof+i,2) * zx_alpha2 PTL(i,PLEV+1) = t(iof+i,PLEV) PDT0(i) = tsol(iof+i) - PTL(i,1) ENDDO DO k = 2, kflev DO i = 1, kdlon PTL(i,k) = (t(iof+i,k)+t(iof+i,k-1))*0.5 ENDDO ENDDO DO k = 1, kflev DO i = 1, kdlon PDP(i,k) = paprs(iof+i,k)-paprs(iof+i,k+1) PTAVE(i,k) = t(iof+i,k) PWV(i,k) = MAX (q(iof+i,k), 1.0e-12) PQS(i,k) = PWV(i,k) ! Confert from column density of ozone in a cell, in kDU, to a mass fraction POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 & / (paprs(iof+i, k) - paprs(iof+i, k+1)) !Old version : 21/10/2016 - correction d'une modification d'unite datant de 06/2009 dans lmdz ! wo: cm.atm (epaisseur en cm dans la situation standard) ! POZON: kg/kg ! POZON(i,k) = MAX(wo(iof+i,k),1.0e-12)*RG/46.6968 & ! /(paprs(iof+i,k)-paprs(iof+i,k+1))& ! *(paprs(iof+i,1)/101325.0) PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k) PCLDSW(i,k) = cldfra(iof+i,k) PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k)) POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k)) PCG(i,1,k) = 0.865 PCG(i,2,k) = 0.910 !- ! Introduced for aerosol indirect forcings. ! The following values use the cloud optical thickness calculated from ! present-day aerosol concentrations whereas the quantities without the ! "A" at the end are for pre-industial (natural-only) aerosol concentrations ! PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k)) POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k)) ENDDO ENDDO if (chemistry_couple) then POZON(:,:,1) = o3_inca(:,:) endif ! DO k = 1, kflev+1 DO i = 1, kdlon PPMB(i,k) = paprs(iof+i,k)/100.0 ENDDO ENDDO ! DO kk = 1, 5 DO k = 1, kflev DO i = 1, kdlon PAER(i,k,kk) = 1.0E-15 ENDDO ENDDO ENDDO DO k = 1, kflev DO i = 1, kdlon tauinca(i,k,:,1)=tau_inca(iof+i,k,:,1) pizinca(i,k,:,1)=piz_inca(iof+i,k,:,1) cginca(i,k,:,1) =cg_inca(iof+i,k,:,1) tauinca(i,k,:,2)=tau_inca(iof+i,k,:,2) pizinca(i,k,:,2)=piz_inca(iof+i,k,:,2) cginca(i,k,:,2) =cg_inca(iof+i,k,:,2) ENDDO ENDDO ! !====================================================================== CALL LW_LMDAR4(& PPMB, PDP,& PPSOL,PDT0,PEMIS,& PTL, PTAVE, PWV, POZON(:, :, 1), PAER,& PCLDLD,PCLDLU,& PVIEW,& zcool, zcool0,& ztoplw,zsollw,ztoplw0,zsollw0,& zsollwdown,& ZFLUP, ZFLDN, ZFLUP0,ZFLDN0) CALL SW_INCA(kdlon,kflev,PSCT, zrmu0, zfract,& PPMB, PDP,& PPSOL, PALBD, PALBP,& PTAVE, PWV, PQS, POZON(:, :, size(wo, 3)), PAER,& PCLDSW, PTAU, POMEGA, PCG,& zheat, zheat0,& zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,& ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,& tauinca, pizinca, cginca, &! aerosol optical properties PTAUA, POMEGAA,& ztopswadinca,zsolswadinca,& ztopswad0inca,zsolswad0inca,& ztopswaiinca,zsolswaiinca, & ! diagnosed aerosol forcing ztopsw_inca,ztopsw0_inca,& zsolsw_inca,zsolsw0_inca,& ok_ade, ok_aie,ZCLEAR) ! apply aerosol effects or not? DO i=1, kdlon cldfract(i)=1-ZCLEAR(i) END DO !====================================================================== DO i = 1, kdlon topsw(iof+i) = ztopsw(i) toplw(iof+i) = ztoplw(i) solsw(iof+i) = zsolsw(i) sollw(iof+i) = zsollw(i) sollwdown(iof+i) = zsollwdown(i) DO k = 1, kflev+1 lwdn0 ( iof+i,k) = ZFLDN0 ( i,k) lwdn ( iof+i,k) = ZFLDN ( i,k) lwup0 ( iof+i,k) = ZFLUP0 ( i,k) lwup ( iof+i,k) = ZFLUP ( i,k) ENDDO topsw0(iof+i) = ztopsw0(i) toplw0(iof+i) = ztoplw0(i) solsw0(iof+i) = zsolsw0(i) sollw0(iof+i) = zsollw0(i) albpla(iof+i) = zalbpla(i) DO k = 1, kflev+1 swdn0 ( iof+i,k) = ZFSDN0 ( i,k) swdn ( iof+i,k) = ZFSDN ( i,k) swup0 ( iof+i,k) = ZFSUP0 ( i,k) swup ( iof+i,k) = ZFSUP ( i,k) ENDDO ENDDO !-transform the aerosol forcings, if they have ! to be calculated IF (ok_ade) THEN DO i = 1, kdlon ! topsw_inca(iof+i,:) = ztopsw_inca(iof+i,:) ! topsw0_inca(iof+i,:) = ztopsw0_inca(iof+i,:) ! solsw_inca(iof+i,:) = zsolsw_inca(iof+i,:) ! solsw0_inca(iof+i,:) = zsolsw0_inca(iof+i,:) ! le calcul de topsw_inca et cie a ete modifie en 2013 suite ! a des modifications du code cote lmdz. Ce diagnostique ! ne comporte plus que les flux net pour ant et nat (defini ! sur 1 et 2) - verif en 2015 Yves et Anne ! nat topsw_inca(iof+i,1) = ztopsw_inca(i,3)-ztopsw_inca(i,1) ! ant topsw_inca(iof+i,2) = ztopsw_inca(i,2)-ztopsw_inca(i,3) ! nat topsw0_inca(iof+i,1) = ztopsw0_inca(i,3)-ztopsw0_inca(i,1) ! ant topsw0_inca(iof+i,2) = ztopsw0_inca(i,2)-ztopsw0_inca(i,3) ! nat solsw_inca(iof+i,1) = zsolsw_inca(i,3)-zsolsw_inca(i,1) ! ant solsw_inca(iof+i,2) = zsolsw_inca(i,2)-zsolsw_inca(i,3) ! nat solsw0_inca(iof+i,1) = zsolsw0_inca(i,3)-zsolsw0_inca(i,1) ! ant solsw0_inca(iof+i,2) = zsolsw0_inca(i,2)-zsolsw0_inca(i,3) !RAFF AD=direct antro topswad_inca(iof+i) = ztopsw_inca(i,2)-ztopsw_inca(i,3) solswad_inca(iof+i) = zsolsw_inca(i,2)-zsolsw_inca(i,3) topswad0_inca(iof+i) = ztopsw0_inca(i,2)-ztopsw0_inca(i,3) solswad0_inca(iof+i) = zsolsw0_inca(i,2)-zsolsw0_inca(i,3) ENDDO ELSE DO i = 1, kdlon topswad_inca(iof+i) = 0.0 solswad_inca(iof+i) = 0.0 topswad0_inca(iof+i) = 0.0 solswad0_inca(iof+i) = 0.0 topsw_inca(iof+i,:) = 0. topsw0_inca(iof+i,:) =0. solsw_inca(iof+i,:) = 0. solsw0_inca(iof+i,:) = 0. ENDDO ENDIF IF (ok_aie) THEN DO i = 1, kdlon ! topswai_inca(iof+i) = ztopswaiinca(i) ! solswai_inca(iof+i) = zsolswaiinca(i) topswai_inca(iof+i) = ztopsw_inca(i,2)-ztopswaiinca(i) solswai_inca(iof+i) = zsolsw_inca(i,2)- zsolswaiinca(i) ENDDO ELSE DO i = 1, kdlon topswai_inca(iof+i) = 0.0 solswai_inca(iof+i) = 0.0 ENDDO ENDIF DO k = 1, kflev DO i = 1, kdlon ! scale factor to take into account the difference between ! dry air and watter vapour scpecifi! heat capacity zznormcp=1.0+RVTMP2*PWV(i,k) heat(iof+i,k) = zheat(i,k)/zznormcp cool(iof+i,k) = zcool(i,k)/zznormcp heat0(iof+i,k) = zheat0(i,k)/zznormcp cool0(iof+i,k) = zcool0(i,k)/zznormcp ENDDO ENDDO ! ENDDO swtoaas_ad(:) = topswad_inca(:) swtoacs_ad(:) = topswad0_inca(:) if (ok_aie) then DO i = 1, kdlon swtoaas_ai(iof+i) = ztopswaiinca(i) swsrfas_ai(iof+i) = zsolswaiinca(i) enddo else swtoaas_ai(:) = 0.0 swsrfas_ai(:) = 0.0 endif if (ok_ade) then swtoaas(:,:) = ztopsw_inca(:,:) swtoacs(:,:) = ztopsw0_inca(:,:) swsrfas(:,:) = zsolsw_inca(:,:) swsrfcs(:,:) = zsolsw0_inca(:,:) else swtoaas(:,:) = 0.0 swtoacs(:,:) = 0.0 swsrfas(:,:) = 0.0 swsrfcs(:,:) = 0.0 endif swsrfas_ad(:) = solswad_inca(:) swsrfcs_ad(:) = solswad0_inca(:) cld_tau(:,:) = cldtaupd(:,:) cld_taupi(:,:)= cldtaupi(:,:) cld_emi(:,:) = cldemi(:,:) tops(:) = topsw(:) tops0(:) = topsw0(:) topl(:) = toplw(:) topl0(:) = toplw0(:) !RAF dforctoaas(:,1)=swtoaas(:,2)-swtoaas(:,3) dforctoacs(:,1)=swtoacs(:,2)-swtoacs(:,3) dforcsrfas(:,1)=swsrfas(:,2)-swsrfas(:,3) dforcsrfcs(:,1)=swsrfcs(:,2)-swsrfcs(:,3) do i=2,naero_grp dforctoaas(:,i)=swtoaas(:,i)-swtoaas(:,1) dforctoacs(:,i)=swtoacs(:,i)-swtoacs(:,1) dforcsrfas(:,i)=swsrfas(:,i)-swsrfas(:,1) dforcsrfcs(:,i)=swsrfcs(:,i)-swsrfcs(:,1) end do IF (ok_aie) THEN iforctoaas(:)=swtoaas_ai(:)-swtoaas(:,2) iforcsrfas(:)=swsrfas_ai(:)-swsrfas(:,2) ELSE iforctoaas(:)=0. iforcsrfas(:)=0. ENDIF !RAFF Cloud forcing+ impact of aerosols on cloud forcing cforctoa_0(:) = topsw_inca(:,1)-topsw0_inca(:,1) cforcsrf_0(:) = solsw_inca(:,1)-solsw0_inca(:,1) dcforctoa_nat(:) = dforctoaas(:,3)-dforctoacs(:,3) dcforcsrf_nat(:) = dforcsrfas(:,3)-dforcsrfcs(:,3) dcforctoa_antr(:) = dforctoaas(:,1)-dforctoacs(:,1) dcforcsrf_antr(:) = dforcsrfas(:,1)-dforcsrfcs(:,1) !RAFF2 Forcing in cloudy regions DO i = 1, PLON if (cldfract(i).gt.0.) then cRFtoa_nat(i)=(dforctoaas(i,3)-ZCLEAR(i)*dforctoacs(i,3))/cldfract(i) cRFsrf_nat(i)=(dforcsrfas(i,3)-ZCLEAR(i)*dforcsrfcs(i,3))/cldfract(i) cRFtoa_antr(i)=(dforctoaas(i,1)-ZCLEAR(i)*dforctoacs(i,1))/cldfract(i) cRFsrf_antr(i)=(dforcsrfas(i,1)-ZCLEAR(i)*dforcsrfcs(i,1))/cldfract(i) else cRFtoa_nat(i)=0. cRFsrf_nat(i)=0. cRFtoa_antr(i)=0. cRFsrf_antr(i)=0. end if END DO #endif ENDSUBROUTINE radlwsw_inca #ifdef AER SUBROUTINE SW_INCA(kdlon,kflev,PSCT, PRMU0, PFRAC, & PPMB, PDP, & PPSOL, PALBD, PALBP,& PTAVE, PWV, PQS, POZON, PAER,& PCLDSW, PTAU, POMEGA, PCG,& PHEAT, PHEAT0,& PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,& ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,& tauinca, pizinca, cginca,& PTAUA, POMEGAA,& PTOPSWADINCA,PSOLSWADINCA,& PTOPSWAD0INCA,PSOLSWAD0INCA,& PTOPSWAIINCA,PSOLSWAIINCA,& PTOPSWINCA,PTOPSW0INCA,& PSOLSWINCA,PSOLSW0INCA,& ok_ade, ok_aie,ZCLEAR) USE PRINT_INCA USE PARAM_CHEM USE AEROSOL_DIAG IMPLICIT NONE #include "YOMCST_I.h" ! ! ------------------------------------------------------------------ ! ! PURPOSE. ! -------- ! ! THIS ROUTINE COMPUTES THE SHORTWAVE RADIATION FLUXES IN TWO ! SPECTRAL INTERVALS FOLLOWING FOUQUART AND BONNEL (1980). ! ! METHOD. ! ------- ! ! 1. COMPUTES ABSORBER AMOUNTS (SWU) ! 2. COMPUTES FLUXES IN 1ST SPECTRAL INTERVAL (SW1S) ! 3. COMPUTES FLUXES IN 2ND SPECTRAL INTERVAL (SW2S) ! ! REFERENCE. ! ---------- ! ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980) ! ! AUTHOR. ! ------- ! JEAN-JACQUES MORCRETTE *ECMWF* ! ! MODIFICATIONS. ! -------------- ! ORIGINAL : 89-07-14 ! 95-01-01 J.-J. MORCRETTE Direct/Diffuse Albedo ! 03-11-27 J. QUAAS Introduce aerosol forcings (based on BOUCHER) ! ------------------------------------------------------------------ ! !* ARGUMENTS: ! REAL*8 PSCT ! constante solaire (valeur conseillee: 1370) INTEGER, INTENT(in) :: kdlon,kflev REAL*8 PPSOL(KDLON) ! SURFACE PRESSURE (PA) REAL*8 PDP(KDLON,KFLEV) ! LAYER THICKNESS (PA) REAL*8 PPMB(KDLON,KFLEV+1) ! HALF-LEVEL PRESSURE (MB) REAL*8 PRMU0(KDLON) ! COSINE OF ZENITHAL ANGLE REAL*8 PFRAC(KDLON) ! fraction de la journee REAL*8 PTAVE(KDLON,KFLEV) ! LAYER TEMPERATURE (K) REAL*8 PWV(KDLON,KFLEV) ! SPECIFI! HUMIDITY (KG/KG) REAL*8 PQS(KDLON,KFLEV) ! SATURATED WATER VAPOUR (KG/KG) REAL*8 POZON(KDLON,KFLEV) ! OZONE CONCENTRATION (KG/KG) REAL*8 PAER(KDLON,KFLEV,5) ! AEROSOLS' OPTICAL THICKNESS REAL*8 PALBD(KDLON,2) ! albedo du sol (lumiere diffuse) REAL*8 PALBP(KDLON,2) ! albedo du sol (lumiere parallele) REAL*8 PCLDSW(KDLON,KFLEV) ! CLOUD FRACTION REAL*8 PTAU(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS REAL*8 PCG(KDLON,2,KFLEV) ! ASYMETRY FACTOR REAL*8 POMEGA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO REAL*8 PHEAT(KDLON,KFLEV) ! SHORTWAVE HEATING (K/DAY) REAL*8 PHEAT0(KDLON,KFLEV)! SHORTWAVE HEATING (K/DAY) clear-sky REAL*8 PALBPLA(KDLON) ! PLANETARY ALBEDO REAL*8 PTOPSW(KDLON) ! SHORTWAVE FLUX AT T.O.A. REAL*8 PSOLSW(KDLON) ! SHORTWAVE FLUX AT SURFACE REAL*8 PTOPSW0(KDLON) ! SHORTWAVE FLUX AT T.O.A. (CLEAR-SKY) REAL*8 PSOLSW0(KDLON) ! SHORTWAVE FLUX AT SURFACE (CLEAR-SKY) ! !* LOCAL VARIABLES: ! REAL*8 ZOZ(KDLON,KFLEV) REAL*8 ZAKI(KDLON,2) REAL*8 ZCLD(KDLON,KFLEV) REAL*8 ZCLEAR(KDLON) REAL*8 ZDSIG(KDLON,KFLEV) REAL*8 ZFACT(KDLON) REAL*8 ZFD(KDLON,KFLEV+1) REAL*8 ZFDOWN(KDLON,KFLEV+1) REAL*8 ZFU(KDLON,KFLEV+1) REAL*8 ZFUP(KDLON,KFLEV+1) REAL*8 ZRMU(KDLON) REAL*8 ZSEC(KDLON) REAL*8 ZUD(KDLON,5,KFLEV+1) REAL*8 ZCLDSW0(KDLON,KFLEV) REAL*8 ZFSUP(KDLON,KFLEV+1) REAL*8 ZFSDN(KDLON,KFLEV+1) REAL*8 ZFSUP0(KDLON,KFLEV+1) REAL*8 ZFSDN0(KDLON,KFLEV+1) INTEGER inu, jl, jk, i, k, kpl1 INTEGER swpas ! Every swpas steps, sw is calculated PARAMETER(swpas=1) INTEGER itapsw LOGICAL appel1er DATA itapsw /0/ DATA appel1er /.TRUE./ SAVE itapsw,appel1er !$OMP THREADPRIVATE(appel1er) !$OMP THREADPRIVATE(itapsw) !jq-Introduced for aerosol forcings REAL*8 flag_aer LOGICAL ok_ade, ok_aie ! use aerosol forcings or not? REAL*8 tauinca(kdlon,kflev,naero_grp,2) ! aerosol optical properties REAL*8 pizinca(kdlon,kflev,naero_grp,2) ! (see aeropt.F) REAL*8 cginca(kdlon,kflev,naero_grp,2) ! -"- REAL*8 PTAUA(KDLON,2,KFLEV) ! CLOUD OPTICAL THICKNESS (pre-industrial value) REAL*8 POMEGAA(KDLON,2,KFLEV) ! SINGLE SCATTERING ALBEDO REAL*8 PTOPSWADINCA(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR) REAL*8 PSOLSWADINCA(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR) REAL*8 PTOPSWAD0INCA(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR) REAL*8 PSOLSWAD0INCA(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR) REAL*8 PTOPSWAIINCA(KDLON) ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND) REAL*8 PSOLSWAIINCA(KDLON) ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND) REAL*8 PTOPSWINCA(KDLON,naero_grp) REAL*8 PTOPSW0INCA(KDLON,naero_grp) REAL*8 PSOLSWINCA(KDLON,naero_grp) REAL*8 PSOLSW0INCA(KDLON,naero_grp) !jq - Fluxes including aerosol effects REAL*8,ALLOCATABLE,SAVE :: ZFSUPAD_INCA(:,:) !$OMP THREADPRIVATE(ZFSUPAD_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSDNAD_INCA(:,:) !$OMP THREADPRIVATE(ZFSDNAD_INCA) !jq - Fluxes including aerosol effects REAL*8,ALLOCATABLE,SAVE :: ZFSUPAD0_INCA(:,:) !$OMP THREADPRIVATE(ZFSUPAD0_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSDNAD0_INCA(:,:) !$OMP THREADPRIVATE(ZFSDNAD0_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSUPAI_INCA(:,:) !$OMP THREADPRIVATE(ZFSUPAI_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSDNAI_INCA(:,:) !$OMP THREADPRIVATE(ZFSDNAI_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSUP_INCA(:,:,:) !$OMP THREADPRIVATE(ZFSUP_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSDN_INCA(:,:,:) !$OMP THREADPRIVATE(ZFSDN_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSUP0_INCA(:,:,:) !$OMP THREADPRIVATE(ZFSUP0_INCA) REAL*8,ALLOCATABLE,SAVE :: ZFSDN0_INCA(:,:,:) !$OMP THREADPRIVATE(ZFSDN0_INCA) !!HEAT REAL*8,ALLOCATABLE,SAVE :: ZFSUP_HEAT(:,:) !$OMP THREADPRIVATE(ZFSUP_HEAT) REAL*8,ALLOCATABLE,SAVE :: ZFSDN_HEAT(:,:) !$OMP THREADPRIVATE(ZFSDN_HEAT) REAL*8,ALLOCATABLE,SAVE :: ZFSUP0_HEAT(:,:) !$OMP THREADPRIVATE(ZFSUP0_HEAT) REAL*8,ALLOCATABLE,SAVE :: ZFSDN0_HEAT(:,:) !$OMP THREADPRIVATE(ZFSDN0_HEAT) INTEGER ispec LOGICAL initialized !rv SAVE flag_aer !$OMP THREADPRIVATE(flag_aer) DATA initialized/.FALSE./ SAVE initialized !$OMP THREADPRIVATE(initialized) IF(.NOT.initialized) THEN flag_aer=0. initialized=.TRUE. ALLOCATE(ZFSUPAD_INCA(KDLON,KFLEV+1)) ALLOCATE(ZFSDNAD_INCA(KDLON,KFLEV+1)) ALLOCATE(ZFSUPAD0_INCA(KDLON,KFLEV+1)) ALLOCATE(ZFSDNAD0_INCA(KDLON,KFLEV+1)) ALLOCATE(ZFSUPAI_INCA(KDLON,KFLEV+1)) ALLOCATE(ZFSDNAI_INCA(KDLON,KFLEV+1)) ALLOCATE(ZFSUP_INCA (KDLON,KFLEV+1,naero_grp)) ALLOCATE(ZFSDN_INCA (KDLON,KFLEV+1,naero_grp)) ALLOCATE(ZFSUP0_INCA(KDLON,KFLEV+1,naero_grp)) ALLOCATE(ZFSDN0_INCA(KDLON,KFLEV+1,naero_grp)) ALLOCATE(ZFSUP_HEAT(KDLON,KFLEV+1)) ALLOCATE(ZFSDN_HEAT(KDLON,KFLEV+1)) ALLOCATE(ZFSUP0_HEAT(KDLON,KFLEV+1)) ALLOCATE(ZFSDN0_HEAT(KDLON,KFLEV+1)) ZFSUPAD_INCA(:,:)=0. ZFSDNAD_INCA(:,:)=0. ZFSUPAD0_INCA(:,:)=0. ZFSDNAD0_INCA(:,:)=0. ZFSUPAI_INCA(:,:)=0. ZFSDNAI_INCA(:,:)=0. ZFSUP_INCA (:,:,:)=0. ZFSDN_INCA (:,:,:)=0. ZFSUP0_INCA(:,:,:)=0. ZFSDN0_INCA(:,:,:)=0. ZFSUP_HEAT(:,:)=0. ZFSDN_HEAT(:,:)=0. ZFSUP0_HEAT(:,:)=0. ZFSDN0_HEAT(:,:)=0. ENDIF IF (appel1er) THEN WRITE(lunout,*) 'SW calling frequency : ', swpas WRITE(lunout,*) " In general, it should be 1" appel1er = .FALSE. ENDIF ! ------------------------------------------------------------------ IF (MOD(itapsw,swpas).EQ.0) THEN DO JK = 1 , KFLEV DO JL = 1, KDLON ZCLDSW0(JL,JK) = 0.0 ZOZ(JL,JK) = POZON(JL,JK)*46.6968/RG & *PDP(JL,JK)*(101325.0/PPSOL(JL)) ENDDO ENDDO ! clear-sky: flag_aer=0.0 CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,& PRMU0,PFRAC,PTAVE,PWV,& ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) INU = 1 CALL SW1S_LMDAR4(INU,PAER, flag_aer, & tauinca(:,:,1,:), pizinca(:,:,1,:), cginca(:,:,1,:),& PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& ZFD, ZFU) INU = 2 CALL SW2S_LMDAR4(INU, PAER, flag_aer, & tauinca(:,:,1,:), pizinca(:,:,1,:), cginca(:,:,1,:),& ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& PWV, PQS,& ZFDOWN, ZFUP) DO JK = 1 , KFLEV+1 DO JL = 1, KDLON ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) ZFSUP0_INCA(JL,JK,1) = ZFSUP0(JL,JK) ZFSDN0_INCA(JL,JK,1) = ZFSDN0(JL,JK) ENDDO ENDDO ! cloudy-sky: flag_aer=0.0 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,& PRMU0,PFRAC,PTAVE,PWV,& ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) INU = 1 CALL SW1S_LMDAR4(INU, PAER, flag_aer, & tauinca(:,:,1,:), pizinca(:,:,1,:), cginca(:,:,1,:),& PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& ZFD, ZFU) INU = 2 CALL SW2S_LMDAR4(INU, PAER, flag_aer, & tauinca(:,:,1,:), pizinca(:,:,1,:), cginca(:,:,1,:),& ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& PWV, PQS,& ZFDOWN, ZFUP) DO JK = 1 , KFLEV+1 DO JL = 1, KDLON ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) ZFSUP_INCA(JL,JK,1) = ZFSUP(JL,JK) ZFSDN_INCA(JL,JK,1) = ZFSDN(JL,JK) ENDDO ENDDO IF (ok_ade) THEN ! clear sky (Anne 03/07/2007) ! CAS AER (2) flag_aer=1.0 CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,& PRMU0,PFRAC,PTAVE,PWV,& ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) INU = 1 CALL SW1S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,2,:), pizinca(:,:,2,:), cginca(:,:,2,:),& PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& ZFD, ZFU) INU = 2 CALL SW2S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,2,:), pizinca(:,:,2,:), cginca(:,:,2,:),& ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& PWV, PQS,& ZFDOWN, ZFUP) DO JK = 1 , KFLEV+1 DO JL = 1, KDLON ZFSUPAD0_INCA(JL,JK) = ZFSUP0(JL,JK) ZFSDNAD0_INCA(JL,JK) = ZFSDN0(JL,JK) ZFSUP0(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) ZFSDN0(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) ZFSUP0_INCA(JL,JK,2) = ZFSUP0(JL,JK) ZFSDN0_INCA(JL,JK,2) = ZFSDN0(JL,JK) ENDDO ENDDO ! cloudy-sky + aerosol dir OB ! Anne AER flag_aer=1.0 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,& PRMU0,PFRAC,PTAVE,PWV,& ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) INU = 1 CALL SW1S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,2,:), pizinca(:,:,2,:), cginca(:,:,2,:),& PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& ZFD, ZFU) INU = 2 CALL SW2S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,2,:), pizinca(:,:,2,:), cginca(:,:,2,:),& ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& PWV, PQS,& ZFDOWN, ZFUP) DO JK = 1 , KFLEV+1 DO JL = 1, KDLON ZFSUPAD_INCA(JL,JK) = ZFSUP(JL,JK) ZFSDNAD_INCA(JL,JK) = ZFSDN(JL,JK) ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) ZFSUP_INCA(JL,JK,2) = ZFSUP(JL,JK) ZFSDN_INCA(JL,JK,2) = ZFSDN(JL,JK) ENDDO ENDDO !CAS NAT BC SO4 POM DUSS CNO3 FNO3 do ispec=3,naero_grp ! clear sky flag_aer=1.0 CALL SWU_LMDAR4(PSCT,ZCLDSW0,PPMB,PPSOL,& PRMU0,PFRAC,PTAVE,PWV,& ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) INU = 1 CALL SW1S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,ispec,:), pizinca(:,:,ispec,:), cginca(:,:,ispec,:),& PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& ZFD, ZFU) INU = 2 CALL SW2S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,ispec,:), pizinca(:,:,ispec,:), cginca(:,:,ispec,:),& ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& PWV, PQS,& ZFDOWN, ZFUP) DO JK = 1 , KFLEV+1 DO JL = 1, KDLON ZFSUP0_INCA(JL,JK,ispec) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) ZFSDN0_INCA(JL,JK,ispec) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) ENDDO ENDDO ! cloudy-sky flag_aer=1.0 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,& PRMU0,PFRAC,PTAVE,PWV,& ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) INU = 1 CALL SW1S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,ispec,:), pizinca(:,:,ispec,:), cginca(:,:,ispec,:),& PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& ZFD, ZFU) INU = 2 CALL SW2S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,ispec,:), pizinca(:,:,ispec,:), cginca(:,:,ispec,:),& ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,& PWV, PQS,& ZFDOWN, ZFUP) DO JK = 1 , KFLEV+1 DO JL = 1, KDLON ZFSUP_INCA(JL,JK,ispec) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) ZFSDN_INCA(JL,JK,ispec) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) ENDDO ENDDO end do !ispec ENDIF ! ok_ade IF (ok_aie) THEN !jq cloudy-sky + aerosol direct + aerosol indirect flag_aer=1.0 CALL SWU_LMDAR4(PSCT,PCLDSW,PPMB,PPSOL,& PRMU0,PFRAC,PTAVE,PWV,& ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD) INU = 1 CALL SW1S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,2,:), pizinca(:,:,2,:), cginca(:,:,2,:),& PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,& ZFD, ZFU) INU = 2 CALL SW2S_LMDAR4(INU, PAER, flag_aer,& tauinca(:,:,2,:), pizinca(:,:,2,:), cginca(:,:,2,:),& ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,& ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,& PWV, PQS,& ZFDOWN, ZFUP) DO JK = 1 , KFLEV+1 DO JL = 1, KDLON ! attention dans zfsupai et zfdnai on stocke la valeur issue de l'effet direct ZFSUPAI_INCA(JL,JK) = ZFSUP(JL,JK) ZFSDNAI_INCA(JL,JK) = ZFSDN(JL,JK) ZFSUP(JL,JK) = (ZFUP(JL,JK) + ZFU(JL,JK)) * ZFACT(JL) ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL) ZFSUP_INCA(JL,JK,2) = ZFSUP(JL,JK) ZFSDN_INCA(JL,JK,2) = ZFSDN(JL,JK) ENDDO ENDDO ENDIF ! ok_aie itapsw = 0 ENDIF itapsw = itapsw + 1 ! HEAT COMPUTATION DO i = 1, KDLON DO k = 1, KFLEV+1 if (feedb .eq. 0) then ZFSUP_HEAT(i,k)=ZFSUP_INCA(i,k,1) ZFSDN_HEAT(i,k)=ZFSDN_INCA(i,k,1) ZFSUP0_HEAT(i,k)=ZFSUP0_INCA(i,k,1) ZFSDN0_HEAT(i,k)=ZFSDN0_INCA(i,k,1) elseif (feedb .eq. 1) then IF ((ok_aie) .and. (ok_ade)) THEN ! ZFSUP_HEAT(i,k)=ZFSUPAI_INCA(i,k) ! ZFSDN_HEAT(i,k)=ZFSDNAI_INCA(i,k) ! correction par rapport au code sw_aeroAR4 ! il faut prendre la valeur issues de ok_aie ! et non pas ok_ade ZFSUP_HEAT(i,k)=ZFSUP_INCA(i,k,2) ZFSDN_HEAT(i,k)=ZFSDN_INCA(i,k,2) ZFSUP0_HEAT(i,k)=ZFSUP0_INCA(i,k,2) ZFSDN0_HEAT(i,k)=ZFSDN0_INCA(i,k,2) ENDIF IF ((.not. ok_aie) .and. (ok_ade)) THEN ZFSUP_HEAT(i,k)=ZFSUP_INCA(i,k,2) ZFSDN_HEAT(i,k)=ZFSDN_INCA(i,k,2) ZFSUP0_HEAT(i,k)=ZFSUP0_INCA(i,k,2) ZFSDN0_HEAT(i,k)=ZFSDN0_INCA(i,k,2) ENDIF IF ((.not. ok_aie) .and. (.not. ok_ade)) THEN ZFSUP_HEAT(i,k)=ZFSUP_INCA(i,k,1) ZFSDN_HEAT(i,k)=ZFSDN_INCA(i,k,1) ZFSUP0_HEAT(i,k)=ZFSUP0_INCA(i,k,1) ZFSDN0_HEAT(i,k)=ZFSDN0_INCA(i,k,1) ENDIF IF ((ok_aie) .and. (.not. ok_ade)) THEN ! ZFSUP_HEAT(i,k)=ZFSUPAI_INCA(i,k) ! ZFSDN_HEAT(i,k)=ZFSDNAI_INCA(i,k) ! correction par rapport au code sw_aeroAR4 ! il faut prendre la valeur issues de ok_aie ! et non pas ok_ade ZFSUP_HEAT(i,k)=ZFSUP_INCA(i,k,2) ZFSDN_HEAT(i,k)=ZFSDN_INCA(i,k,2) ZFSUP0_HEAT(i,k)=ZFSUP0_INCA(i,k,1) ZFSDN0_HEAT(i,k)=ZFSDN0_INCA(i,k,1) END IF endif !feedb END DO END DO !raf: var _HEAT DO k = 1, KFLEV kpl1 = k+1 DO i = 1, KDLON PHEAT(i,k) = -(ZFSUP_HEAT(i,kpl1)-ZFSUP_HEAT(i,k)) & -(ZFSDN_HEAT(i,k)-ZFSDN_HEAT(i,kpl1)) PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k) PHEAT0(i,k) = -(ZFSUP0_HEAT(i,kpl1)-ZFSUP0_HEAT(i,k)) & -(ZFSDN0_HEAT(i,k)-ZFSDN0_HEAT(i,kpl1)) PHEAT0(i,k) = PHEAT0(i,k) * RDAY*RG/RCPD / PDP(i,k) ENDDO ENDDO DO i = 1, KDLON PALBPLA(i) = ZFSUP(i,KFLEV+1)/(ZFSDN(i,KFLEV+1)+1.0e-20) ! clear sky PSOLSW0(i) = ZFSDN0_HEAT(i,1) - ZFSUP0_HEAT(i,1) PTOPSW0(i) = ZFSDN0_HEAT(i,KFLEV+1) - ZFSUP0_HEAT(i,KFLEV+1) PSOLSW(i) = ZFSDN_HEAT(i,1) - ZFSUP_HEAT(i,1) PTOPSW(i) = ZFSDN_HEAT(i,KFLEV+1) - ZFSUP_HEAT(i,KFLEV+1) PSOLSW0INCA(i,:) = ZFSDN0_INCA(i,1,:) - ZFSUP0_INCA(i,1,:) PTOPSW0INCA(i,:) = & ZFSDN0_INCA(i,KFLEV+1,:) - ZFSUP0_INCA(i,KFLEV+1,:) PSOLSWINCA(i,:) = ZFSDN_INCA(i,1,:) - ZFSUP_INCA(i,1,:) PTOPSWINCA(i,:) = & ZFSDN_INCA(i,KFLEV+1,:) - ZFSUP_INCA(i,KFLEV+1,:) PSOLSWADINCA(i) = ZFSDNAD_INCA(i,1) - ZFSUPAD_INCA(i,1) PTOPSWADINCA(i) = & ZFSDNAD_INCA(i,KFLEV+1) - ZFSUPAD_INCA(i,KFLEV+1) PSOLSWAD0INCA(i) = ZFSDNAD0_INCA(i,1) - ZFSUPAD0_INCA(i,1) PTOPSWAD0INCA(i) = & ZFSDNAD0_INCA(i,KFLEV+1) - ZFSUPAD0_INCA(i,KFLEV+1) PSOLSWAIINCA(i) = ZFSDNAI_INCA(i,1) - ZFSUPAI_INCA(i,1) PTOPSWAIINCA(i) = & ZFSDNAI_INCA(i,KFLEV+1) - ZFSUPAI_INCA(i,KFLEV+1) ENDDO END SUBROUTINE SW_INCA #endif