Ignore:
Timestamp:
Apr 4, 2014, 2:51:02 PM (11 years ago)
Author:
Laurent Fairhead
Message:

Nouvelle version qui inclut les effets des aérosols et propose les mêmes diagnostics des effets
directs et indirects que l'ancienne version du rayonnement.
OB

New RRTM version that includes the effects of aerosols and outputs the same direct and indirect effects
diagnostics as the old version
OB

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/radlwsw_m.F90

    • Property svn:keywords set to Author Date Id Revi
    r1991 r2003  
     1!
     2! $Id$
     3!
    14module radlwsw_m
    25
    … …  
    1316   flag_aerosol_strat,&
    1417   tau_aero, piz_aero, cg_aero,&
     18   tau_aero_rrtm, piz_aero_rrtm, cg_aero_rrtm,& ! rajoute par OB pour RRTM
    1519   cldtaupi, new_aod, &
    1620   qsat, flwc, fiwc, &
    … …  
    177181  REAL,    INTENT(in)  :: piz_aero(KLON,KLEV,9,2)                        ! aerosol optical properties (see aeropt.F)
    178182  REAL,    INTENT(in)  :: cg_aero(KLON,KLEV,9,2)                         ! aerosol optical properties (see aeropt.F)
     183!--OB
     184  REAL,    INTENT(in)  :: tau_aero_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
     185  REAL,    INTENT(in)  :: piz_aero_rrtm(KLON,KLEV,2,NSW)                 ! aerosol optical properties RRTM
     186  REAL,    INTENT(in)  :: cg_aero_rrtm(KLON,KLEV,2,NSW)                  ! aerosol optical properties RRTM
     187!--OB fin
    179188  REAL,    INTENT(in)  :: cldtaupi(KLON,KLEV)                            ! cloud optical thickness for pre-industrial aerosol concentrations
    180189  LOGICAL, INTENT(in)  :: new_aod                                        ! flag pour retrouver les resultats exacts de l'AR4 dans le cas ou l'on ne travaille qu'avec les sulfates
    … …  
    273282      REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted)
    274283      REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted)
     284!--OB
     285      REAL(KIND=8) ref_liq_pi_i(klon,klev) ! cloud droplet radius pre-industrial from newmicro (inverted)
     286      REAL(KIND=8) ref_ice_pi_i(klon,klev) ! ice crystal radius pre-industrial from newmicro (inverted)
     287!--end OB
    275288      REAL(KIND=8) paprs_i(klon,klev+1)
    276289      REAL(KIND=8) pplay_i(klon,klev)
    … …  
    297310      REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
    298311      REAL(KIND=8) ZFLUCDWN_i(klon,klev+1),ZFLUCUP_i(klon,klev+1)
    299       REAL(KIND=8) PPIZA_DST(klon,klev,NSW)
    300       REAL(KIND=8) PCGA_DST(klon,klev,NSW)
    301       REAL(KIND=8) PTAUREL_DST(klon,klev,NSW)
     312      REAL(KIND=8) PPIZA_TOT(klon,klev,NSW)
     313      REAL(KIND=8) PCGA_TOT(klon,klev,NSW)
     314      REAL(KIND=8) PTAU_TOT(klon,klev,NSW)
     315      REAL(KIND=8) PPIZA_NAT(klon,klev,NSW)
     316      REAL(KIND=8) PCGA_NAT(klon,klev,NSW)
     317      REAL(KIND=8) PTAU_NAT(klon,klev,NSW)
    302318      REAL(KIND=8) PSFSWDIR(klon,NSW)
    303319      REAL(KIND=8) PSFSWDIF(klon,NSW)
    … …  
    319335!      REAL(KIND=8) SUN_FRACT(2)
    320336  real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
    321 !--OB
    322       REAL tau(6), alt, zdz, zrho
    323       character (len=20) :: modname='radlwsw'
    324       character (len=80) :: abort_message
     337  CHARACTER (LEN=80) :: abort_message
     338  CHARACTER (LEN=80) :: modname='radlwsw_m'
    325339
    326340  call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
    … …  
    621635      ENDDO
    622636      ENDDO
    623 !     
    624 !--OB Valeurs de tau(NSW) calculees par O.Boucher (MPL 20130417)
    625 !-- voir aod_2bands.F90, aod_4bands.F90, aod_6bands.F90 dans BENCH48x36x19
    626       SELECT CASE (NSW)
    627       CASE (2)
    628        tau(1)=0.22017828
    629        tau(2)=0.110565394
    630       CASE (4)
    631        tau(1)=0.22017743
    632        tau(2)=0.12738435
    633        tau(3)=0.07157799
    634        tau(4)=0.03301198
    635       CASE (6)
    636        tau(1)=0.49999997
    637        tau(2)=0.28593913
    638        tau(3)=0.20057647
    639        tau(4)=0.12738435
    640        tau(5)=0.07157799
    641        tau(6)=0.03301198
    642       END SELECT
    643 !     tau1=0.2099  ! anciennes valeurs de Nicolas Huneeus (20130326)
    644 !     tau2=0.1022
    645 !     tau(1)=1.0e-15
    646 !     tau(2)=1.0e-15
    647 !     tau(3)=1.0e-15
    648 !     tau(4)=1.0e-15
    649 !     tau(5)=1.0e-15
    650 !     tau(6)=1.0e-15
    651       print *,'Radlwsw: NSW tau= ',NSW,tau(:)
    652       DO i = 1, kdlon
    653       alt=0.0
     637!
     638!--OB
     639!--aerosol TOT  - anthropogenic+natural
     640!--aerosol NAT  - natural only
     641!
     642      DO i = 1, kdlon
    654643      DO k = 1, kflev
    655       zrho=pplay(i,k)/t(i,k)/RD
    656       zdz=(paprs(i,k)-paprs(i,k+1))/zrho/RG
    657644      DO kk=1, NSW
    658       PTAUREL_DST(i,kflev+1-k,kk)=(tau(kk)/2000.0)*max(0.0,min(zdz,2000.0-alt))
    659       PTAUREL_DST(i,kflev+1-k,kk)=MAX(PTAUREL_DST(i,kflev+1-k,kk), 1e-15)
    660       ENDDO
    661       alt=alt+zdz
    662       ENDDO
    663       ENDDO
    664 
    665 !
    666       DO k = 1, kflev
    667       DO i = 1, kdlon
    668       DO kk = 1, NSW
    669 !     PPIZA_DST(i,k,kk)=1.0   
    670       PPIZA_DST(i,k,kk)=0.8   
    671       PCGA_DST(i,k,kk)=0.7
    672       ENDDO
    673       ENDDO
    674       ENDDO
     645!
     646      PTAU_TOT(i,kflev+1-k,kk)=tau_aero_rrtm(i,k,2,kk)
     647      PPIZA_TOT(i,kflev+1-k,kk)=piz_aero_rrtm(i,k,2,kk)
     648      PCGA_TOT(i,kflev+1-k,kk)=cg_aero_rrtm(i,k,2,kk)
     649!
     650      PTAU_NAT(i,kflev+1-k,kk)=tau_aero_rrtm(i,k,1,kk)
     651      PPIZA_NAT(i,kflev+1-k,kk)=piz_aero_rrtm(i,k,1,kk)
     652      PCGA_NAT(i,kflev+1-k,kk)=cg_aero_rrtm(i,k,1,kk)
     653!
     654      ENDDO
     655      ENDDO
     656      ENDDO
     657!-end OB
     658!
    675659!     
    676660      DO i = 1, kdlon
    … …  
    707691            ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k)
    708692            ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k)
     693!-OB
     694            ref_liq_pi_i(1:klon,k) =ref_liq_pi(1:klon,klev+1-k)
     695            ref_ice_pi_i(1:klon,k) =ref_ice_pi(1:klon,klev+1-k)
    709696         enddo
    710697         do k=1,kflev
    … …  
    762749
    763750! Nouvel appel a RECMWF (celui du cy32t0)
    764          CALL RECMWF (ist , iend, klon , ktdia  , klev   , kmode ,&
     751         CALL RECMWF_AERO (ist , iend, klon , ktdia  , klev   , kmode ,&
    765752         PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2   , cldfra_i,&
    766753         POZON_i  , PAER_i  , PDP_i   , PEMIS   , rmu0   ,&
    767754          q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
    768755         ref_liq_i, ref_ice_i, &
     756         ref_liq_pi_i, ref_ice_pi_i, &   ! rajoute par OB pour diagnostiquer effet indirect
    769757         ZEMTD_i  , ZEMTU_i , ZTRSO_i ,&
    770758         ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,&
    771759         ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,&
    772760         PSFSWDIR , PSFSWDIF, PFSDNN  , PFSDNV  ,&
    773          PPIZA_DST, PCGA_DST,PTAUREL_DST,ZFLUX_i  , ZFLUC_i ,&
    774          ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i)
     761         PPIZA_TOT, PCGA_TOT,PTAU_TOT,&
     762         PPIZA_NAT, PCGA_NAT,PTAU_NAT,           &  ! rajoute par OB pour diagnostiquer effet direct
     763         ZFLUX_i  , ZFLUC_i ,&
     764         ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i,&
     765         ZTOPSWADAERO,ZSOLSWADAERO,&  ! rajoute par OB pour diagnostics
     766         ZTOPSWAD0AERO,ZSOLSWAD0AERO,&
     767         ZTOPSWAIAERO,ZSOLSWAIAERO, &
     768         ZTOPSWCF_AERO,ZSOLSWCF_AERO, &
     769         ok_ade, ok_aie, flag_aerosol,flag_aerosol_strat) ! flags aerosols
    775770           
    776771         print *,'RADLWSW: apres RECMWF'
    … …  
    791786        CALL writefield_phy('pfsdnn',PFSDNN,1)
    792787        CALL writefield_phy('pfsdnv',PFSDNV,1)
    793         CALL writefield_phy('ppiza_dst',PPIZA_DST,klev)
    794         CALL writefield_phy('pcga_dst',PCGA_DST,klev)
    795         CALL writefield_phy('ptaurel_dst',PTAUREL_DST,klev)
     788        CALL writefield_phy('ppiza_dst',PPIZA_TOT,klev)
     789        CALL writefield_phy('pcga_dst',PCGA_TOT,klev)
     790        CALL writefield_phy('ptaurel_dst',PTAU_TOT,klev)
    796791        CALL writefield_phy('zflux_i',ZFLUX_i,klev+1)
    797792        CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1)
    … …  
    813808!  ZSWFC        (KPROMA,2)       ; CLEAR-SKY SHORTWAVE FLUXES
    814809!  ZSWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY SHORTWAVE FLUXES
    815 !  PPIZA_DST    (KPROMA,KLEV,NSW); Single scattering albedo of dust
    816 !  PCGA_DST     (KPROMA,KLEV,NSW); Assymetry factor for dust
    817 !  PTAUREL_DST  (KPROMA,KLEV,NSW); Optical depth of dust relative to at 550nm
     810!  PPIZA_TOT    (KPROMA,KLEV,NSW); Single scattering albedo of total aerosols
     811!  PCGA_TOT     (KPROMA,KLEV,NSW); Assymetry factor for total aerosols
     812!  PTAU_TOT     (KPROMA,KLEV,NSW); Optical depth of total aerosols
     813!  PPIZA_NAT    (KPROMA,KLEV,NSW); Single scattering albedo of natural aerosols
     814!  PCGA_NAT     (KPROMA,KLEV,NSW); Assymetry factor for natural aerosols
     815!  PTAU_NAT     (KPROMA,KLEV,NSW); Optical depth of natiral aerosols
    818816!  PSFSWDIR     (KPROMA,NSW)     ;
    819817!  PSFSWDIF     (KPROMA,NSW)     ;
    … …  
    854852         ENDDO
    855853      ENDDO
     854
     855!--ajout OB
     856      ZTOPSWADAERO(:) =ZTOPSWADAERO(:) *fract(:)
     857      ZSOLSWADAERO(:) =ZSOLSWADAERO(:) *fract(:)
     858      ZTOPSWAD0AERO(:)=ZTOPSWAD0AERO(:)*fract(:)
     859      ZSOLSWAD0AERO(:)=ZSOLSWAD0AERO(:)*fract(:)
     860      ZTOPSWAIAERO(:) =ZTOPSWAIAERO(:) *fract(:)
     861      ZSOLSWAIAERO(:) =ZSOLSWAIAERO(:) *fract(:)
     862      ZTOPSWCF_AERO(:,1)=ZTOPSWCF_AERO(:,1)*fract(:)
     863      ZTOPSWCF_AERO(:,2)=ZTOPSWCF_AERO(:,2)*fract(:)
     864      ZTOPSWCF_AERO(:,3)=ZTOPSWCF_AERO(:,3)*fract(:)
     865      ZSOLSWCF_AERO(:,1)=ZSOLSWCF_AERO(:,1)*fract(:)
     866      ZSOLSWCF_AERO(:,2)=ZSOLSWCF_AERO(:,2)*fract(:)
     867      ZSOLSWCF_AERO(:,3)=ZSOLSWCF_AERO(:,3)*fract(:)
    856868
    857869!     print*,'SW_RRTM ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
Note: See TracChangeset for help on using the changeset viewer.