Ignore:
Timestamp:
Apr 16, 2004, 5:43:38 PM (20 years ago)
Author:
lmdzadmin
Message:

Inclusion des modifications de O. Boucher et de J. Quaas pour le calcul des
premiers effets directs et indirects dus aux aerosols
LF

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ.3.3/branches/rel-LF/libf/phylmd/radlwsw.F

    r503 r517  
    1 cIM   SUBROUTINE radlwsw(dist, rmu0, fract, co2_ppm, solaire,
    21      SUBROUTINE radlwsw(dist, rmu0, fract,
    32     .                  paprs, pplay,tsol,albedo, alblw, t,q,wo,
    4      .                  cldfra, cldemi, cldtau,
     3     .                  cldfra, cldemi, cldtaupd,
    54     .                  heat,heat0,cool,cool0,radsol,albpla,
    65     .                  topsw,toplw,solsw,sollw,
    76     .                  sollwdown,
    8 cIM  .                  sollwdown, sollwdownclr,
    9 cIM  .                  toplwdown, toplwdownclr,
    107     .                  topsw0,toplw0,solsw0,sollw0,
    11 cIM BEG
    128     .                  lwdn0, lwdn, lwup0, lwup,
    13 cIM END
    14      .                  swdn0, swdn, swup0, swup    )
     9     .                  swdn0, swdn, swup0, swup,
     10     .                  ok_ade, ok_aie,
     11     .                  tau_ae, piz_ae, cg_ae,
     12     .                  topswad, solswad,
     13     .                  cldtaupi, topswai, solswai)
     14c     
    1515      IMPLICIT none
    1616c======================================================================
    … …  
    3131c wo-------input-R- contenu en ozone (en cm.atm)
    3232c cldfra---input-R- fraction nuageuse (entre 0 et 1)
    33 c cldtau---input-R- epaisseur optique des nuages dans le visible
     33c cldtaupd---input-R- epaisseur optique des nuages dans le visible (present-day value)
    3434c cldemi---input-R- emissivite des nuages dans l'IR (entre 0 et 1)
     35c ok_ade---input-L- apply the Aerosol Direct Effect or not?
     36c ok_aie---input-L- apply the Aerosol Indirect Effect or not?
     37c tau_ae, piz_ae, cg_ae-input-R- aerosol optical properties (calculated in aeropt.F)
     38c cldtaupi-input-R- epaisseur optique des nuages dans le visible
     39c                   calculated for pre-industrial (pi) aerosol concentrations, i.e. with smaller
     40c                   droplet concentration, thus larger droplets, thus generally cdltaupi cldtaupd
     41c                   it is needed for the diagnostics of the aerosol indirect radiative forcing     
    3542c
    3643c heat-----output-R- echauffement atmospherique (visible) (K/jour)
    … …  
    4249c solsw----output-R- flux solaire net a la surface
    4350c sollw----output-R- ray. IR montant a la surface
     51c solswad---output-R- ray. solaire net absorbe a la surface (aerosol dir)
     52c topswad---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol dir)
     53c solswai---output-R- ray. solaire net absorbe a la surface (aerosol ind)
     54c topswai---output-R- ray. solaire absorbe au sommet de l'atm. (aerosol ind)
     55c
     56c ATTENTION: swai and swad have to be interpreted in the following manner:
     57c ---------
     58c ok_ade=F & ok_aie=F -both are zero
     59c ok_ade=T & ok_aie=F -aerosol direct forcing is F_{AD} = topsw-topswad
     60c                        indirect is zero
     61c ok_ade=F & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
     62c                        direct is zero
     63c ok_ade=T & ok_aie=T -aerosol indirect forcing is F_{AI} = topsw-topswai
     64c                        aerosol direct forcing is F_{AD} = topswai-topswad
     65c
     66     
    4467c======================================================================
    4568#include "dimensions.h"
    … …  
    5679      real albedo(klon), alblw(klon), tsol(klon)
    5780      real t(klon,klev), q(klon,klev), wo(klon,klev)
    58       real cldfra(klon,klev), cldemi(klon,klev), cldtau(klon,klev)
     81      real cldfra(klon,klev), cldemi(klon,klev), cldtaupd(klon,klev)
    5982      real heat(klon,klev), cool(klon,klev)
    6083      real heat0(klon,klev), cool0(klon,klev)
    … …  
    123146      REAL lwup(klon,kflev+1),lwup0(klon,kflev+1)
    124147cIM END
    125 c---------------------------------------------------------------
     148c-OB
     149cjq the following quantities are needed for the aerosol radiative forcings
     150
     151      real topswad(klon), solswad(klon) ! output: aerosol direct forcing at TOA and surface
     152      real topswai(klon), solswai(klon) ! output: aerosol indirect forcing atTOA and surface
     153      real tau_ae(klon,klev,2), piz_ae(klon,klev,2), cg_ae(klon,klev,2) ! aerosol optical properties (see aeropt.F)
     154      real cldtaupi(klon,klev)  ! cloud optical thickness for pre-industrial aerosol concentrations
     155                                ! (i.e., with a smaller droplet concentrationand thus larger droplet radii)
     156      logical ok_ade, ok_aie    ! switches whether to use aerosol direct (indirect) effects or not
     157      real*8 tauae(kdlon,kflev,2) ! aer opt properties
     158      real*8 pizae(kdlon,kflev,2)
     159      real*8 cgae(kdlon,kflev,2)
     160      REAL*8 PTAUA(kdlon,2,kflev) ! present-day value of cloud opt thickness (PTAU is pre-industrial value), local use
     161      REAL*8 POMEGAA(kdlon,2,kflev) ! dito for single scatt albedo
     162      REAL*8 ztopswad(kdlon), zsolswad(kdlon) ! Aerosol direct forcing at TOAand surface
     163      REAL*8 ztopswai(kdlon), zsolswai(kdlon) ! dito, indirect
     164cjq-end
     165     
     166c
     167c-------------------------------------------
    126168      nb_gr = klon / kdlon
    127169      IF (nb_gr*kdlon .NE. klon) THEN
    … …  
    202244         PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
    203245         PCLDSW(i,k) = cldfra(iof+i,k)
    204          PTAU(i,1,k) = MAX(cldtau(iof+i,k), 1.0e-05)! 1e-12 serait instable
    205          PTAU(i,2,k) = MAX(cldtau(iof+i,k), 1.0e-05)! pour 32-bit machines
     246         PTAU(i,1,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! 1e-12 serait instable
     247         PTAU(i,2,k) = MAX(cldtaupi(iof+i,k), 1.0e-05)! pour 32-bit machines
    206248         POMEGA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAU(i,1,k))
    207249         POMEGA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAU(i,2,k))
    208250         PCG(i,1,k) = 0.865
    209251         PCG(i,2,k) = 0.910
     252c-OB
     253cjq Introduced for aerosol indirect forcings.
     254cjq The following values use the cloud optical thickness calculated from
     255cjq present-day aerosol concentrations whereas the quantities without the
     256cjq "A" at the end are for pre-industial (natural-only) aerosol concentrations
     257cjq
     258         PTAUA(i,1,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! 1e-12 serait instable
     259         PTAUA(i,2,k) = MAX(cldtaupd(iof+i,k), 1.0e-05)! pour 32-bit machines
     260         POMEGAA(i,1,k) = 0.9999 - 5.0e-04 * EXP(-0.5 * PTAUA(i,1,k))
     261         POMEGAA(i,2,k) = 0.9988 - 2.5e-03 * EXP(-0.05 * PTAUA(i,2,k))
     262cjq-end
    210263      ENDDO
    211264      ENDDO
    … …  
    222275         PAER(i,k,kk) = 1.0E-15
    223276      ENDDO
     277      ENDDO
     278      ENDDO
     279c-OB
     280      DO k = 1, kflev
     281      DO i = 1, kdlon
     282        tauae(i,k,1)=tau_ae(iof+i,k,1)
     283        pizae(i,k,1)=piz_ae(iof+i,k,1)
     284        cgae(i,k,1) =cg_ae(iof+i,k,1)
     285        tauae(i,k,2)=tau_ae(iof+i,k,2)
     286        pizae(i,k,2)=piz_ae(iof+i,k,2)
     287        cgae(i,k,2) =cg_ae(iof+i,k,2)
    224288      ENDDO
    225289      ENDDO
    … …  
    247311     S        zheat, zheat0,
    248312     S        zalbpla,ztopsw,zsolsw,ztopsw0,zsolsw0,
    249      S        ZFSUP,ZFSDN,ZFSUP0,ZFSDN0)
     313     S        ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,
     314     S        tauae, pizae, cgae, ! aerosol optical properties
     315     s        PTAUA, POMEGAA,
     316     s        ztopswad,zsolswad,ztopswai,zsolswai, ! diagnosed aerosol forcing
     317     J        ok_ade, ok_aie) ! apply aerosol effects or not?
     318
    250319c======================================================================
    251320      DO i = 1, kdlon
    … …  
    292361c        swup  ( iof+i,2)   = ZFSUP  ( i,kflev + 1 )
    293362      ENDDO
     363cjq-transform the aerosol forcings, if they have
     364cjq to be calculated
     365      IF (ok_ade) THEN
     366      DO i = 1, kdlon
     367         topswad(iof+i) = ztopswad(i)
     368         solswad(iof+i) = zsolswad(i)
     369      ENDDO
     370      ELSE
     371      DO i = 1, kdlon
     372         topswad(iof+i) = 0.0
     373         solswad(iof+i) = 0.0
     374      ENDDO
     375      ENDIF
     376      IF (ok_aie) THEN
     377      DO i = 1, kdlon
     378         topswai(iof+i) = ztopswai(i)
     379         solswai(iof+i) = zsolswai(i)
     380      ENDDO
     381      ELSE
     382      DO i = 1, kdlon
     383         topswai(iof+i) = 0.0
     384         solswai(iof+i) = 0.0
     385      ENDDO
     386      ENDIF
     387cjq-end
    294388      DO k = 1, kflev
    295389c      DO i = 1, kdlon
    … …  
    321415     S              PHEAT, PHEAT0,
    322416     S              PALBPLA,PTOPSW,PSOLSW,PTOPSW0,PSOLSW0,
    323      S              ZFSUP,ZFSDN,ZFSUP0,ZFSDN0)
     417     S              ZFSUP,ZFSDN,ZFSUP0,ZFSDN0,
     418     S              tauae, pizae, cgae,
     419     s              PTAUA, POMEGAA,
     420     S              PTOPSWAD,PSOLSWAD,PTOPSWAI,PSOLSWAI,
     421     J              ok_ade, ok_aie )
     422     
    324423      IMPLICIT none
    325424
    … …  
    358457C        ORIGINAL : 89-07-14
    359458C        95-01-01   J.-J. MORCRETTE  Direct/Diffuse Albedo
     459c        03-11-27   J. QUAAS Introduce aerosol forcings (based on BOUCHER)
    360460C     ------------------------------------------------------------------
    361461C
    … …  
    426526      DATA itapsw /0/
    427527      DATA appel1er /.TRUE./
     528cjq-Introduced for aerosol forcings
     529      real*8 flag_aer
     530      logical ok_ade, ok_aie    ! use aerosol forcings or not?
     531      real*8 tauae(kdlon,kflev,2)  ! aerosol optical properties
     532      real*8 pizae(kdlon,kflev,2)  ! (see aeropt.F)
     533      real*8 cgae(kdlon,kflev,2)   ! -"-
     534      REAL*8 PTAUA(KDLON,2,KFLEV)    ! CLOUD OPTICAL THICKNESS (pre-industrial value)
     535      REAL*8 POMEGAA(KDLON,2,KFLEV)  ! SINGLE SCATTERING ALBEDO
     536      REAL*8 PTOPSWAD(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL DIR)
     537      REAL*8 PSOLSWAD(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL DIR)
     538      REAL*8 PTOPSWAI(KDLON)     ! SHORTWAVE FLUX AT T.O.A.(+AEROSOL IND)
     539      REAL*8 PSOLSWAI(KDLON)     ! SHORTWAVE FLUX AT SURFACE(+AEROSOL IND)
     540cjq - Fluxes including aerosol effects
     541      REAL*8 ZFSUPAD(KDLON,KFLEV+1)
     542      REAL*8 ZFSDNAD(KDLON,KFLEV+1)
     543      REAL*8 ZFSUPAI(KDLON,KFLEV+1)
     544      REAL*8 ZFSDNAI(KDLON,KFLEV+1)
     545      SAVE ZFSUPAD, ZFSDNAD, ZFSUPAI, ZFSDNAI ! aerosol fluxes
     546cjq-end
     547     
    428548c
    429549      IF (appel1er) THEN
    … …  
    451571      INU = 1
    452572      CALL SW1S(INU,
    453      S     PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
     573     S     PAER, flag_aer, tauae, pizae, cgae,
     574     S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
    454575     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
    455576     S     ZFD, ZFU)
    456577      INU = 2
    457578      CALL SW2S(INU,
    458      S     PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
     579     S     PAER, flag_aer, tauae, pizae, cgae,
     580     S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, ZCLDSW0,
    459581     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
    460582     S     PWV, PQS,
    … …  
    466588      ENDDO
    467589      ENDDO
    468 c cloudy-sky:
    469 cIM ctes ds clesphys.h   CALL SWU(PSCT,RCO2,PCLDSW,PPMB,PPSOL,
     590     
     591      flag_aer=0.0
    470592      CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,
    471593     S         PRMU0,PFRAC,PTAVE,PWV,
    … …  
    473595      INU = 1
    474596      CALL SW1S(INU,
    475      S     PAER, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
     597     S     PAER, flag_aer, tauae, pizae, cgae,
     598     S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
    476599     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
    477600     S     ZFD, ZFU)
    478601      INU = 2
    479602      CALL SW2S(INU,
    480      S     PAER, ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
     603     S     PAER, flag_aer, tauae, pizae, cgae,
     604     S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
    481605     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
    482606     S     PWV, PQS,
    483607     S    ZFDOWN, ZFUP)
     608
     609c cloudy-sky:
     610     
    484611      DO JK = 1 , KFLEV+1
    485612      DO JL = 1, KDLON
    … …  
    488615      ENDDO
    489616      ENDDO
     617     
     618c     
     619      IF (ok_ade) THEN
    490620c
     621c cloudy-sky + aerosol dir OB
     622      flag_aer=1.0
     623      CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,
     624     S         PRMU0,PFRAC,PTAVE,PWV,
     625     S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
     626      INU = 1
     627      CALL SW1S(INU,
     628     S     PAER, flag_aer, tauae, pizae, cgae,
     629     S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
     630     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
     631     S     ZFD, ZFU)
     632      INU = 2
     633      CALL SW2S(INU,
     634     S     PAER, flag_aer, tauae, pizae, cgae,
     635     S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
     636     S     ZDSIG, POMEGA, ZOZ, ZRMU, ZSEC, PTAU, ZUD,
     637     S     PWV, PQS,
     638     S    ZFDOWN, ZFUP)
     639      DO JK = 1 , KFLEV+1
     640      DO JL = 1, KDLON
     641         ZFSUPAD(JL,JK) = ZFSUP(JL,JK)
     642         ZFSDNAD(JL,JK) = ZFSDN(JL,JK)
     643         ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
     644         ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
     645      ENDDO
     646      ENDDO
     647     
     648      ENDIF ! ok_ade
     649     
     650      IF (ok_aie) THEN
     651         
     652cjq   cloudy-sky + aerosol direct + aerosol indirect
     653      flag_aer=1.0
     654      CALL SWU(PSCT,PCLDSW,PPMB,PPSOL,
     655     S         PRMU0,PFRAC,PTAVE,PWV,
     656     S         ZAKI,ZCLD,ZCLEAR,ZDSIG,ZFACT,ZRMU,ZSEC,ZUD)
     657      INU = 1
     658      CALL SW1S(INU,
     659     S     PAER, flag_aer, tauae, pizae, cgae,
     660     S     PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
     661     S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,
     662     S     ZFD, ZFU)
     663      INU = 2
     664      CALL SW2S(INU,
     665     S     PAER, flag_aer, tauae, pizae, cgae,
     666     S     ZAKI, PALBD, PALBP, PCG, ZCLD, ZCLEAR, PCLDSW,
     667     S     ZDSIG, POMEGAA, ZOZ, ZRMU, ZSEC, PTAUA, ZUD,
     668     S     PWV, PQS,
     669     S    ZFDOWN, ZFUP)
     670      DO JK = 1 , KFLEV+1
     671      DO JL = 1, KDLON
     672         ZFSUPAI(JL,JK) = ZFSUP(JL,JK)
     673         ZFSDNAI(JL,JK) = ZFSDN(JL,JK)         
     674         ZFSUP(JL,JK) = (ZFUP(JL,JK)   + ZFU(JL,JK)) * ZFACT(JL)
     675         ZFSDN(JL,JK) = (ZFDOWN(JL,JK) + ZFD(JL,JK)) * ZFACT(JL)
     676      ENDDO
     677      ENDDO
     678      ENDIF ! ok_aie     
     679cjq -end
     680     
    491681      itapsw = 0
    492682      ENDIF
    … …  
    512702         PSOLSW0(i) = ZFSDN0(i,1) - ZFSUP0(i,1)
    513703         PTOPSW0(i) = ZFSDN0(i,KFLEV+1) - ZFSUP0(i,KFLEV+1)
     704c-OB
     705         PSOLSWAD(i) = ZFSDNAD(i,1) - ZFSUPAD(i,1)
     706         PTOPSWAD(i) = ZFSDNAD(i,KFLEV+1) - ZFSUPAD(i,KFLEV+1)
     707c
     708         PSOLSWAI(i) = ZFSDNAI(i,1) - ZFSUPAI(i,1)
     709         PTOPSWAI(i) = ZFSDNAI(i,KFLEV+1) - ZFSUPAI(i,KFLEV+1)
     710c-fin
    514711      ENDDO
    515712C
    … …  
    707904      END
    708905      SUBROUTINE SW1S ( KNU
    709      S  ,  PAER  , PALBD , PALBP, PCG  , PCLD , PCLEAR, PCLDSW
     906     S  ,  PAER  , flag_aer, tauae, pizae, cgae
     907     S  ,  PALBD , PALBP, PCG  , PCLD , PCLEAR, PCLDSW
    710908     S  ,  PDSIG , POMEGA, POZ  , PRMU , PSEC , PTAU  , PUD 
    711909     S  ,  PFD   , PFU)
    … …  
    748946C
    749947      INTEGER KNU
     948c-OB
     949      real*8 flag_aer
     950      real*8 tauae(kdlon,kflev,2)
     951      real*8 pizae(kdlon,kflev,2)
     952      real*8 cgae(kdlon,kflev,2)
    750953      REAL*8 PAER(KDLON,KFLEV,5)
    751954      REAL*8 PALBD(KDLON,2)
    … …  
    8391042C
    8401043      CALL SWCLR ( KNU
    841      S  , PAER   , PALBP , PDSIG , ZRAYL, PSEC
     1044     S  , PAER   , flag_aer, tauae, pizae, cgae
     1045     S  , PALBP  , PDSIG , ZRAYL, PSEC
    8421046     S  , ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
    8431047     S  , ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
    … …  
    9391143      END
    9401144      SUBROUTINE SW2S ( KNU
    941      S  ,  PAER  ,PAKI, PALBD, PALBP, PCG   , PCLD, PCLEAR, PCLDSW
     1145     S  ,  PAER  , flag_aer, tauae, pizae, cgae
     1146     S  ,  PAKI, PALBD, PALBP, PCG   , PCLD, PCLEAR, PCLDSW
    9421147     S  ,  PDSIG ,POMEGA,POZ , PRMU , PSEC  , PTAU
    9431148     S  ,  PUD   ,PWV , PQS
    … …  
    9861191C
    9871192      INTEGER KNU
     1193c-OB
     1194      real*8 flag_aer
     1195      real*8 tauae(kdlon,kflev,2)
     1196      real*8 pizae(kdlon,kflev,2)
     1197      real*8 cgae(kdlon,kflev,2)
    9881198      REAL*8 PAER(KDLON,KFLEV,5)
    9891199      REAL*8 PAKI(KDLON,2)
    … …  
    11071317C
    11081318      CALL SWCLR ( KNU
    1109      S  , PAER   , PALBP , PDSIG , ZRAYL, PSEC
     1319     S  , PAER   , flag_aer, tauae, pizae, cgae
     1320     S  , PALBP  , PDSIG , ZRAYL, PSEC
    11101321     S  , ZCGAZ  , ZPIZAZ, ZRAY1 , ZRAY2, ZREFZ, ZRJ0
    11111322     S  , ZRK0   , ZRMU0 , ZTAUAZ, ZTRA1, ZTRA2)
    … …  
    14791690      END
    14801691      SUBROUTINE SWCLR  ( KNU
    1481      S  , PAER  , PALBP , PDSIG , PRAYL , PSEC
     1692     S  , PAER  , flag_aer, tauae, pizae, cgae
     1693     S  , PALBP , PDSIG , PRAYL , PSEC
    14821694     S  , PCGAZ , PPIZAZ, PRAY1 , PRAY2 , PREFZ , PRJ 
    14831695     S  , PRK   , PRMU0 , PTAUAZ, PTRA1 , PTRA2                   )
    … …  
    15121724C
    15131725      INTEGER KNU
     1726c-OB
     1727      real*8 flag_aer
     1728      real*8 tauae(kdlon,kflev,2)
     1729      real*8 pizae(kdlon,kflev,2)
     1730      real*8 cgae(kdlon,kflev,2)
    15141731      REAL*8 PAER(KDLON,KFLEV,5)
    15151732      REAL*8 PALBP(KDLON,2)
    … …  
    15761793C
    15771794      DO 108 JK = 1 , KFLEV
    1578       DO 104 JL = 1, KDLON
    1579       PCGAZ(JL,JK) = 0.
    1580       PPIZAZ(JL,JK) =  0.
    1581       PTAUAZ(JL,JK) = 0.
    1582  104  CONTINUE
    1583       DO 106 JAE=1,5
     1795c-OB
     1796c      DO 104 JL = 1, KDLON
     1797c      PCGAZ(JL,JK) = 0.
     1798c      PPIZAZ(JL,JK) =  0.
     1799c      PTAUAZ(JL,JK) = 0.
     1800c 104  CONTINUE
     1801c-OB
     1802c      DO 106 JAE=1,5
     1803c      DO 105 JL = 1, KDLON
     1804c      PTAUAZ(JL,JK)=PTAUAZ(JL,JK)
     1805c     S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)
     1806c      PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)
     1807c     S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)
     1808c      PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)
     1809c     S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
     1810c 105  CONTINUE
     1811c 106  CONTINUE
     1812c-OB
    15841813      DO 105 JL = 1, KDLON
    1585       PTAUAZ(JL,JK)=PTAUAZ(JL,JK)
    1586      S        +PAER(JL,JK,JAE)*TAUA(KNU,JAE)
    1587       PPIZAZ(JL,JK)=PPIZAZ(JL,JK)+PAER(JL,JK,JAE)
    1588      S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)
    1589       PCGAZ(JL,JK) =  PCGAZ(JL,JK) +PAER(JL,JK,JAE)
    1590      S        * TAUA(KNU,JAE)*RPIZA(KNU,JAE)*RCGA(KNU,JAE)
     1814      PTAUAZ(JL,JK)=flag_aer * tauae(JL,JK,KNU)
     1815      PPIZAZ(JL,JK)=flag_aer * pizae(JL,JK,KNU)
     1816      PCGAZ (JL,JK)=flag_aer * cgae(JL,JK,KNU)
    15911817 105  CONTINUE
    1592  106  CONTINUE
    1593 C
     1818C
     1819      IF (flag_aer.GT.0) THEN
     1820c-OB
    15941821      DO 107 JL = 1, KDLON
    1595       IF (KAER.NE.0) THEN
    1596          PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
    1597          PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
     1822c         PCGAZ(JL,JK)=PCGAZ(JL,JK)/PPIZAZ(JL,JK)
     1823c         PPIZAZ(JL,JK)=PPIZAZ(JL,JK)/PTAUAZ(JL,JK)
    15981824         ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
    15991825         ZRATIO = ZTRAY / (ZTRAY + PTAUAZ(JL,JK))
    … …  
    16041830         PPIZAZ(JL,JK) =ZRATIO+(1.-ZRATIO)*PPIZAZ(JL,JK)*(1.-ZFF)
    16051831     S                       / (1. - PPIZAZ(JL,JK) * ZFF)
     1832 107  CONTINUE
    16061833      ELSE
     1834      DO JL = 1, KDLON
    16071835         ZTRAY = PRAYL(JL) * PDSIG(JL,JK)
    16081836         PTAUAZ(JL,JK) = ZTRAY
    16091837         PCGAZ(JL,JK) = 0.
    16101838         PPIZAZ(JL,JK) = 1.-REPSCT
    1611       END IF
    1612  107  CONTINUE
     1839      END DO
     1840      END IF   ! check flag_aer
     1841c     107  CONTINUE
    16131842c      PRINT 9107,JK,((PAER(JL,JK,JAE),JAE=1,5)
    16141843c     $ ,PTAUAZ(JL,JK),PPIZAZ(JL,JK),PCGAZ(JL,JK),JL=1,KDLON)
Note: See TracChangeset for help on using the changeset viewer.