Ignore:
Timestamp:
Jun 11, 2014, 3:46:46 PM (10 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r1997:2055 into testing branch

Location:
LMDZ5/branches/testing
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/libf/phylmd/radlwsw_m.F90

    • Property svn:keywords set to Author Date Id Revi
    r1999 r2056  
     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, &
    … …  
    6064!    &    RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF, RLINLI
    6165      USE YOERDU   , ONLY : NUAER  ,NTRAER ,REPLOG ,REPSC  ,REPSCW ,DIFF
    62       USE YOETHF   , ONLY : RTICE
     66!      USE YOETHF   , ONLY : RTICE
    6367      USE YOERRTWN , ONLY : DELWAVE   ,TOTPLNK     
    6468      USE YOMPHY3  , ONLY : RII0
    … …  
    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.