Changeset 1989


Ignore:
Timestamp:
Mar 3, 2014, 10:57:40 AM (11 years ago)
Author:
Laurent Fairhead
Message:

Inclusion du code RRTM

Adding RRTM code

MPL

Location:
LMDZ5/trunk/libf/phylmd
Files:
601 added
9 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/clesphys.h

    r1961 r1989  
    7373       REAL freq_COSP
    7474       LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
    75        INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo
     75       INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo,NSW
    7676       LOGICAL :: ok_strato
    7777       LOGICAL :: ok_hines, ok_gwd_rando
    … …  
    113113     &     , ok_lic_melt,           aer_type                            &
    114114     &     , iflag_rrtm, ok_strato,ok_hines                             &
    115      &     , iflag_ice_thermo, ok_gwd_rando
     115     &     , iflag_ice_thermo, ok_gwd_rando, NSW
    116116     
    117117       save /clesphys/

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

    r1938 r1989  
    101101    integer,SAVE        :: iflag_radia_omp
    102102    integer,SAVE        :: iflag_rrtm_omp
     103    integer,SAVE        :: NSW_omp
    103104    integer,SAVE        :: iflag_cldcon_omp, ip_ebil_phy_omp
    104105    integer,SAVE        :: iflag_ratqs_omp
    … …  
    831832    iflag_rrtm_omp = 0
    832833    call getin('iflag_rrtm',iflag_rrtm_omp)
     834
     835    !
     836    !Config Key  = NSW
     837    !Config Desc = 
     838    !Config Def  = 0
     839    !Config Help =
     840    !
     841    NSW_omp = 2
     842    call getin('NSW',NSW_omp)
    833843
    834844    !
    … …  
    17971807    iflag_radia = iflag_radia_omp
    17981808    iflag_rrtm = iflag_rrtm_omp
     1809    NSW = NSW_omp
    17991810    iflag_cldcon = iflag_cldcon_omp
    18001811    iflag_ratqs = iflag_ratqs_omp
    … …  
    19451956    write(lunout,*)' iflag_radia = ', iflag_radia
    19461957    write(lunout,*)' iflag_rrtm = ', iflag_rrtm
     1958    write(lunout,*)' NSW = ', NSW
    19471959    write(lunout,*)' iflag_ratqs = ', iflag_ratqs
    19481960    write(lunout,*)' seuil_inversion = ', seuil_inversion

  • LMDZ5/trunk/libf/phylmd/iniradia.F

    r1907 r1989  
    2121!         CALL suphel     ! initialiser constantes et parametres phys.
    2222!     print*,'Physiq: apres suphel '
    23 !        CALL SUINIT(klon,klev)
    24 !     print*,'iniradia: apres suinit '
     23#if CPP_RRTM
     24      CALL SUINIT(klon,klev)
     25      print*,'iniradia: apres suinit '
    2526! calcul des niveaux de pression de reference au bord des couches pour
    2627! l'intialisation des aerosols. Momentannement, on passe un point de
    2728! grille du profil de pression.
    28 !        CALL SURAYOLMD(pres(klev+1))  ! initialiser le rayonnement RRTM
    29 !     print*,'iniradia: apres surayolmd '
     29      CALL SURAYOLMD(pres(klev+1))  ! initialiser le rayonnement RRTM
     30      print*,'iniradia: apres surayolmd '
     31#endif
    3032
    3133      RETURN

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

    r1932 r1989  
    99                     bcast_mpi_i,bcast_mpi_i1,bcast_mpi_i2,bcast_mpi_i3,bcast_mpi_i4, &
    1010                     bcast_mpi_r,bcast_mpi_r1,bcast_mpi_r2,bcast_mpi_r3,bcast_mpi_r4, &
    11                      bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
     11                     bcast_mpi_l,bcast_mpi_l1,bcast_mpi_l2,bcast_mpi_l3,bcast_mpi_l4
    1212  END INTERFACE
    1313
    … …  
    1515    MODULE PROCEDURE scatter_mpi_i,scatter_mpi_i1,scatter_mpi_i2,scatter_mpi_i3, &
    1616                     scatter_mpi_r,scatter_mpi_r1,scatter_mpi_r2,scatter_mpi_r3, &
    17                      scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
     17                     scatter_mpi_l,scatter_mpi_l1,scatter_mpi_l2,scatter_mpi_l3
    1818  END INTERFACE
    1919
    … …  
    2222    MODULE PROCEDURE gather_mpi_i,gather_mpi_i1,gather_mpi_i2,gather_mpi_i3, &
    2323                     gather_mpi_r,gather_mpi_r1,gather_mpi_r2,gather_mpi_r3, &
    24                      gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3 
     24                     gather_mpi_l,gather_mpi_l1,gather_mpi_l2,gather_mpi_l3 
    2525  END INTERFACE
    2626 
    … …  
    2828    MODULE PROCEDURE scatter2D_mpi_i,scatter2D_mpi_i1,scatter2D_mpi_i2,scatter2D_mpi_i3, &
    2929                     scatter2D_mpi_r,scatter2D_mpi_r1,scatter2D_mpi_r2,scatter2D_mpi_r3, &
    30                      scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
     30                     scatter2D_mpi_l,scatter2D_mpi_l1,scatter2D_mpi_l2,scatter2D_mpi_l3
    3131  END INTERFACE
    3232
    … …  
    3434    MODULE PROCEDURE gather2D_mpi_i,gather2D_mpi_i1,gather2D_mpi_i2,gather2D_mpi_i3, &
    3535                     gather2D_mpi_r,gather2D_mpi_r1,gather2D_mpi_r2,gather2D_mpi_r3, &
    36                      gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
     36                     gather2D_mpi_l,gather2D_mpi_l1,gather2D_mpi_l2,gather2D_mpi_l3
    3737  END INTERFACE
    3838 
    … …  
    4545    MODULE PROCEDURE grid1dTo2d_mpi_i,grid1dTo2d_mpi_i1,grid1dTo2d_mpi_i2,grid1dTo2d_mpi_i3, &
    4646                     grid1dTo2d_mpi_r,grid1dTo2d_mpi_r1,grid1dTo2d_mpi_r2,grid1dTo2d_mpi_r3, &
    47                      grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
     47                     grid1dTo2d_mpi_l,grid1dTo2d_mpi_l1,grid1dTo2d_mpi_l2,grid1dTo2d_mpi_l3
    4848 END INTERFACE
    4949
    … …  
    5151    MODULE PROCEDURE grid2dTo1d_mpi_i,grid2dTo1d_mpi_i1,grid2dTo1d_mpi_i2,grid2dTo1d_mpi_i3, &
    5252                     grid2dTo1d_mpi_r,grid2dTo1d_mpi_r1,grid2dTo1d_mpi_r2,grid2dTo1d_mpi_r3, &
    53                      grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
     53                     grid2dTo1d_mpi_l,grid2dTo1d_mpi_l1,grid2dTo1d_mpi_l2,grid2dTo1d_mpi_l3
    5454 END INTERFACE
    5555   
    … …  
    14931493        displs(rank)=Index-1
    14941494        counts(rank)=nb*dimsize
    1495         Index=Index+nb*dimsize
     1495        Index=Index+nb*dimsize
    14961496      ENDDO
    14971497     
    … …  
    15031503#endif
    15041504
    1505                          
     1505                         
    15061506    IF (is_mpi_root) THEN
    15071507      Index=1
    … …  
    15101510        DO i=1,dimsize
    15111511          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
    1512           Index=Index+nb
     1512          Index=Index+nb
    15131513        ENDDO
    15141514      ENDDO
    … …  
    15421542        displs(rank)=Index-1
    15431543        counts(rank)=nb*dimsize
    1544         Index=Index+nb*dimsize
     1544        Index=Index+nb*dimsize
    15451545      ENDDO
    15461546    ENDIF
    … …  
    15551555                      MPI_REAL_LMDZ,mpi_root_x, COMM_LMDZ_PHY,ierr)
    15561556#endif
    1557                          
     1557                         
    15581558    IF (is_mpi_root) THEN
    15591559      Index=1
    … …  
    15621562        DO i=1,dimsize
    15631563          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
    1564           Index=Index+nb
     1564          Index=Index+nb
    15651565        ENDDO
    15661566      ENDDO
    … …  
    15991599        displs(rank)=Index-1
    16001600        counts(rank)=nb*dimsize
    1601         Index=Index+nb*dimsize
     1601        Index=Index+nb*dimsize
    16021602      ENDDO
    16031603    ENDIF
    … …  
    16081608                      MPI_LOGICAL,mpi_root_x, COMM_LMDZ_PHY,ierr)
    16091609#endif
    1610                          
     1610                         
    16111611    IF (is_mpi_root) THEN
    16121612      Index=1
    … …  
    16151615        DO i=1,dimsize
    16161616          VarOut(klon_mpi_para_begin(rank):klon_mpi_para_end(rank),i)=VarTmp(Index:Index+nb-1)
    1617           Index=Index+nb
     1617          Index=Index+nb
    16181618        ENDDO
    16191619      ENDDO
    … …  
    17071707        DO ij=1,nbp_lon
    17081708         VarOut(ij,i)=VarIn(1,i)
    1709         ENDDO
     1709        ENDDO
    17101710      ENDDO
    17111711    ENDIF
    … …  
    17151715        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
    17161716         VarOut(ij,i)=VarIn(klon_mpi,i)
    1717         ENDDO
     1717        ENDDO
    17181718      ENDDO
    17191719    ENDIF
    … …  
    17511751        DO ij=1,nbp_lon
    17521752         VarOut(ij,i)=VarIn(1,i)
    1753         ENDDO
     1753        ENDDO
    17541754      ENDDO
    17551755    ENDIF
    … …  
    17591759        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
    17601760         VarOut(ij,i)=VarIn(klon_mpi,i)
    1761         ENDDO
     1761        ENDDO
    17621762      ENDDO
    17631763    ENDIF
    … …  
    17961796        DO ij=1,nbp_lon
    17971797         VarOut(ij,i)=VarIn(1,i)
    1798         ENDDO
     1798        ENDDO
    17991799      ENDDO
    18001800    ENDIF
    … …  
    18041804        DO ij=nbp_lon*(jj_nb-1)+1,nbp_lon*jj_nb
    18051805         VarOut(ij,i)=VarIn(klon_mpi,i)
    1806         ENDDO
     1806        ENDDO
    18071807      ENDDO
    18081808    ENDIF

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

    r1932 r1989  
    2525                     bcast_omp_i,bcast_omp_i1,bcast_omp_i2,bcast_omp_i3,bcast_omp_i4, &
    2626                     bcast_omp_r,bcast_omp_r1,bcast_omp_r2,bcast_omp_r3,bcast_omp_r4, &
    27                      bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
     27                     bcast_omp_l,bcast_omp_l1,bcast_omp_l2,bcast_omp_l3,bcast_omp_l4
    2828  END INTERFACE
    2929
    … …  
    3131    MODULE PROCEDURE scatter_omp_i,scatter_omp_i1,scatter_omp_i2,scatter_omp_i3, &
    3232                     scatter_omp_r,scatter_omp_r1,scatter_omp_r2,scatter_omp_r3, &
    33                      scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
     33                     scatter_omp_l,scatter_omp_l1,scatter_omp_l2,scatter_omp_l3
    3434  END INTERFACE
    3535
    … …  
    3838    MODULE PROCEDURE gather_omp_i,gather_omp_i1,gather_omp_i2,gather_omp_i3, &
    3939                     gather_omp_r,gather_omp_r1,gather_omp_r2,gather_omp_r3, &
    40                      gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3 
     40                     gather_omp_l,gather_omp_l1,gather_omp_l2,gather_omp_l3 
    4141  END INTERFACE
    4242 

  • LMDZ5/trunk/libf/phylmd/newmicro.F

    r1907 r1989  
    99     .                  xflwp, xfiwp, xflwc, xfiwc,
    1010     .                  mass_solu_aero, mass_solu_aero_pi,
    11      .                  pcldtaupi, re, fl, reliq, reice)
     11     .                  pcldtaupi, re, fl,
     12     .                  reliq, reice, reliq_pi, reice_pi)
    1213c
    1314      USE dimphy
    … …  
    143144      REAL dh(klon, klev)     !--dz pour la couche
    144145      REAL zfice(klon, klev)
    145       REAL rad_chaud(klon, klev) !--rayon pour les nuages chauds
     146      REAL rad_chaud(klon, klev)    !--rayon pour les nuages chauds
     147      REAL rad_chaud_pi(klon, klev) !--rayon pour les nuages chauds pre-industriels
    146148      REAL zflwp_var, zfiwp_var
    147149      REAL d_rei_dt
    … …  
    149151! Abderrahmane oct 2009
    150152      Real reliq(klon, klev), reice(klon, klev)
     153      Real reliq_pi(klon, klev), reice_pi(klon, klev)
    151154
    152155!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    176179      reliq=0.
    177180      reice=0.
     181      reliq_pi=0.
     182      reice_pi=0.
    178183c
    179184      DO k = 1, klev
    … …  
    222227c
    223228c--pre-industrial case
    224                 radius =
     229                rad_chaud_pi(i,k) =
    225230     &               1.1*((pqlwp(i,k)*pplay(i,k)/(RD * T(i,k))) 
    226231     &               /(4./3.*RPI*1000.*cdnc_pi(i,k)))**(1./3.)
    227                 radius = MAX(radius*1.e6, 5.)
     232                rad_chaud_pi(i,k) = MAX(rad_chaud_pi(i,k)*1.e6, 5.)
    228233c
    229234c--pre-industrial case
    … …  
    247252c for ice clouds, Ebert & Curry (1992)]
    248253c                 
    249                 if (zflwp_var.eq.0.) radius = 1.
    250254                if (zfiwp_var.eq.0. .or. rei.le.0.) rei = 1.
    251                 pcldtaupi(i,k) = 3.0/2.0 * zflwp_var / radius
     255                pcldtaupi(i,k) = 3.0/2.0 * zflwp_var / rad_chaud_pi(i,k)
    252256     &                 + zfiwp_var * (3.448e-03  + 2.431/rei)
    253257c
    … …  
    264268           DO i = 1, klon
    265269               rad_chaud(i,k) = rad_chau2
     270               rad_chaud_pi(i,k) = rad_chau2
    266271           ENDDO           
    267272         ENDDO
    … …  
    269274           DO i = 1, klon
    270275               rad_chaud(i,k) = rad_chau1
     276               rad_chaud_pi(i,k) = rad_chau1
    271277           ENDDO           
    272278         ENDDO
    … …  
    349355             ENDIF
    350356c
    351              reliq(i,k)=rel
    352357             reice(i,k)=rei
    353358c
    … …  
    364369            DO i = 1, klon
    365370               pcldtaupi(i,k)=pcltau(i,k)
     371               reice_pi(i,k)=reice(i,k)
    366372            ENDDO
    367373         ENDDO               
    368374      ENDIF
     375c
     376      DO k = 1, klev
     377         DO i = 1, klon
     378            reliq(i,k)   =rad_chaud(i,k)
     379            reliq_pi(i,k)=rad_chaud_pi(i,k)
     380            reice_pi(i,k)=reice(i,k)
     381         ENDDO
     382      ENDDO               
    369383C     
    370384C     COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS

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

    r1943 r1989  
    9393      REAL, SAVE, ALLOCATABLE :: topswcf_aero(:,:),  solswcf_aero(:,:)  ! diag
    9494      !$OMP THREADPRIVATE(topswcf_aero,solswcf_aero)
     95! Special RRTM
     96      REAL, SAVE, ALLOCATABLE :: ZLWFT0_i(:,:),  ZSWFT0_i(:,:)      ! diag
     97      !$OMP THREADPRIVATE(ZLWFT0_i,ZSWFT0_i)
     98      REAL, SAVE, ALLOCATABLE :: ZFLDN0(:,:),  ZFLUP0(:,:)      ! diag
     99      !$OMP THREADPRIVATE(ZFLDN0,ZFLUP0)
     100      REAL, SAVE, ALLOCATABLE :: ZFSDN0(:,:),  ZFSUP0(:,:)      ! diag
     101      !$OMP THREADPRIVATE(ZFSDN0,ZFSUP0)
     102!
    95103      REAL, SAVE, ALLOCATABLE :: tausum_aero(:,:,:)
    96104      !$OMP THREADPRIVATE(tausum_aero)
    … …  
    243251      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: ref_liq, ref_ice, theta, zphi
    244252!$OMP THREADPRIVATE(ref_liq, ref_ice, theta, zphi)
     253      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: ref_liq_pi, ref_ice_pi
     254!$OMP THREADPRIVATE(ref_liq_pi, ref_ice_pi)
    245255      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: wake_omg, zx_rh
    246256!$OMP THREADPRIVATE(wake_omg, zx_rh)
    … …  
    313323      allocate(d_u_lif(klon,klev),d_v_lif(klon,klev))
    314324      allocate(d_ts(klon,nbsrf), d_tr(klon,klev,nbtr))
     325! Special RRTM
     326      allocate(ZLWFT0_i(klon,klev+1),ZSWFT0_i(klon,klev+1),ZFLDN0(klon,klev+1))
     327      allocate(ZFLUP0(klon,klev+1),ZFSDN0(klon,klev+1),ZFSUP0(klon,klev+1))
     328!
    315329      allocate(topswad_aero(klon), solswad_aero(klon))
    316330      allocate(topswai_aero(klon), solswai_aero(klon))
    … …  
    400414      ALLOCATE(fl(klon, klev), re(klon, klev), flwc(klon, klev))
    401415      ALLOCATE(ref_liq(klon, klev), ref_ice(klon, klev), theta(klon, klev))
     416      ALLOCATE(ref_liq_pi(klon, klev), ref_ice_pi(klon, klev))
    402417      ALLOCATE(zphi(klon, klev), wake_omg(klon, klev), zx_rh(klon, klev))
    403418      ALLOCATE(pmfd(klon, klev), pmfu(klon, klev))
    … …  
    550565      DEALLOCATE(fl, re, flwc)
    551566      DEALLOCATE(ref_liq, ref_ice, theta)
     567      DEALLOCATE(ref_liq_pi, ref_ice_pi)
    552568      DEALLOCATE(zphi, wake_omg, zx_rh)
    553569      DEALLOCATE(pmfd, pmfu)

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

    r1973 r1989  
    640640  save ok_newmicro
    641641  !$OMP THREADPRIVATE(ok_newmicro)
     642  !real ref_liq_pi(klon,klev), ref_ice_pi(klon,klev)
    642643  save fact_cldcon,facttemps
    643644  !$OMP THREADPRIVATE(fact_cldcon,facttemps)
    … …  
    29002901          flwp, fiwp, flwc, fiwc, &
    29012902          mass_solu_aero, mass_solu_aero_pi, &
    2902           cldtaupi, re, fl, ref_liq, ref_ice)
     2903          cldtaupi, re, fl, ref_liq, ref_ice, &
     2904          ref_liq_pi, ref_ice_pi)
    29032905  else
    29042906     CALL nuage (paprs, pplay, &
    … …  
    30373039             cldtaupirad,new_aod, &
    30383040             zqsat, flwc, fiwc, &
     3041             ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    30393042             heat,heat0,cool,cool0,radsol,albpla, &
    30403043             topsw,toplw,solsw,sollw, &
    … …  
    30483051             topsw_aero, topsw0_aero, &
    30493052             solsw_aero, solsw0_aero, &
    3050              topswcf_aero, solswcf_aero)
     3053             topswcf_aero, solswcf_aero, &
     3054             ZLWFT0_i, ZFLDN0, ZFLUP0, &
     3055             ZSWFT0_i, ZFSDN0, ZFSUP0)
    30513056
    30523057        !
    … …  
    30803085                   cldtaupi,new_aod, &
    30813086                   zqsat, flwc, fiwc, &
     3087                   ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    30823088                   heatp,heat0p,coolp,cool0p,radsolp,albplap, &
    30833089                   topswp,toplwp,solswp,sollwp, &
    … …  
    30913097                   topsw_aerop, topsw0_aerop, &
    30923098                   solsw_aerop, solsw0_aerop, &
    3093                    topswcf_aerop, solswcf_aerop)
     3099                   topswcf_aerop, solswcf_aerop, &
     3100                   ZLWFT0_i, ZFLDN0, ZFLUP0, &
     3101                   ZSWFT0_i, ZFSDN0, ZFSUP0)
    30943102           endif
    30953103        endif

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

    r1931 r1989  
    1515   cldtaupi, new_aod, &
    1616   qsat, flwc, fiwc, &
     17   ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    1718   heat,heat0,cool,cool0,radsol,albpla,&
    1819   topsw,toplw,solsw,sollw,&
    … …  
    2627   topsw_aero, topsw0_aero,&
    2728   solsw_aero, solsw0_aero, &
    28    topswcf_aero, solswcf_aero)
     29   topswcf_aero, solswcf_aero,&
     30   ZLWFT0_i, ZFLDN0, ZFLUP0,&
     31   ZSWFT0_i, ZFSDN0, ZFSUP0)
    2932
    3033
    … …  
    3336  USE assert_m, ONLY : assert
    3437  USE infotrac, ONLY : type_trac
     38  USE write_field_phy
    3539#ifdef REPROBUS
    3640  USE CHEM_REP, ONLY : solaireTIME, ok_SUNTIME, ndimozon
     41#endif
     42#ifdef CPP_RRTM
     43!    modules necessaires au rayonnement
     44!    -----------------------------------------
     45!     USE YOMCST   , ONLY : RG       ,RD       ,RTT      ,RPI
     46!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LINHOM   , LCCNL,LCCNO,
     47!     USE YOERAD   , ONLY : NSW      ,LRRTM    ,LCCNL    ,LCCNO ,&
     48! NSW mis dans .def MPL 20140211
     49      USE YOERAD   , ONLY : LRRTM    ,LCCNL    ,LCCNO ,&
     50          NRADIP   , NRADLP , NICEOPT, NLIQOPT ,RCCNLND  , RCCNSEA
     51      USE YOELW    , ONLY : NSIL     ,NTRA     ,NUA      ,TSTAND   ,XP
     52      USE YOESW    , ONLY : RYFWCA   ,RYFWCB   ,RYFWCC   ,RYFWCD,&   
     53          RYFWCE   ,RYFWCF   ,REBCUA   ,REBCUB   ,REBCUC,&   
     54          REBCUD   ,REBCUE   ,REBCUF   ,REBCUI   ,REBCUJ,& 
     55          REBCUG   ,REBCUH   ,RHSAVI   ,RFULIO   ,RFLAA0,& 
     56          RFLAA1   ,RFLBB0   ,RFLBB1   ,RFLBB2   ,RFLBB3,& 
     57          RFLCC0   ,RFLCC1   ,RFLCC2   ,RFLCC3   ,RFLDD0,& 
     58          RFLDD1   ,RFLDD2   ,RFLDD3   ,RFUETA   ,RASWCA,&
     59          RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF
     60!    &    RASWCB   ,RASWCC   ,RASWCD   ,RASWCE   ,RASWCF, RLINLI
     61      USE YOERDU   , ONLY : NUAER  ,NTRAER ,REPLOG ,REPSC  ,REPSCW ,DIFF
     62      USE YOETHF   , ONLY : RTICE
     63      USE YOERRTWN , ONLY : DELWAVE   ,TOTPLNK     
     64      USE YOMPHY3  , ONLY : RII0
    3765#endif
    3866
    … …  
    88116  !                        aerosol direct forcing is F_{AD} = topswai-topswad
    89117  !
     118  ! --------- RRTM: output RECMWFL
     119  ! ZEMTD (KPROMA,KLEV+1)         ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
     120  ! ZEMTU (KPROMA,KLEV+1)         ; TOTAL UPWARD   LONGWAVE EMISSIVITY
     121  ! ZTRSO (KPROMA,KLEV+1)         ; TOTAL SHORTWAVE TRANSMISSIVITY
     122  ! ZTH   (KPROMA,KLEV+1)         ; HALF LEVEL TEMPERATURE
     123  ! ZCTRSO(KPROMA,2)              ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
     124  ! ZCEMTR(KPROMA,2)              ; CLEAR-SKY NET LONGWAVE EMISSIVITY
     125  ! ZTRSOD(KPROMA)                ; TOTAL-SKY SURFACE SW TRANSMISSITY
     126  ! ZLWFC (KPROMA,2)              ; CLEAR-SKY LONGWAVE FLUXES
     127  ! ZLWFT (KPROMA,KLEV+1)         ; TOTAL-SKY LONGWAVE FLUXES
     128  ! ZLWFT0(KPROMA,KLEV+1)         ; CLEAR-SKY LONGWAVE FLUXES      ! added by MPL 090109
     129  ! ZSWFC (KPROMA,2)              ; CLEAR-SKY SHORTWAVE FLUXES
     130  ! ZSWFT (KPROMA,KLEV+1)         ; TOTAL-SKY SHORTWAVE FLUXES
     131  ! ZSWFT0(KPROMA,KLEV+1)         ; CLEAR-SKY SHORTWAVE FLUXES     ! added by MPL 090109
     132  ! ZFLUX (KLON,2,KLEV+1)         ; TOTAL LW FLUXES  1=up, 2=DWN   ! added by MPL 080411
     133  ! ZFLUC (KLON,2,KLEV+1)         ; CLEAR SKY LW FLUXES            ! added by MPL 080411
     134  ! ZFSDWN(klon,KLEV+1)           ; TOTAL SW  DWN FLUXES           ! added by MPL 080411
     135  ! ZFCDWN(klon,KLEV+1)           ; CLEAR SKY SW  DWN FLUXES       ! added by MPL 080411
     136  ! ZFSUP (klon,KLEV+1)           ; TOTAL SW  UP  FLUXES           ! added by MPL 080411
     137  ! ZFCUP (klon,KLEV+1)           ; CLEAR SKY SW  UP  FLUXES       ! added by MPL 080411
    90138 
    91139  !======================================================================
    … …  
    122170
    123171  LOGICAL, INTENT(in)  :: ok_ade, ok_aie                                 ! switches whether to use aerosol direct (indirect) effects or not
     172  LOGICAL              :: lldebug
    124173  INTEGER, INTENT(in)  :: flag_aerosol                                   ! takes value 0 (no aerosol) or 1 to 6 (aerosols)
    125174  LOGICAL, INTENT(in)  :: flag_aerosol_strat                             ! use stratospheric aerosols
    … …  
    133182  REAL,    INTENT(in)  :: flwc(klon,klev) ! Variable pour iflag_rrtm=1
    134183  REAL,    INTENT(in)  :: fiwc(klon,klev) ! Variable pour iflag_rrtm=1
     184  REAL,    INTENT(in)  :: ref_liq(klon,klev) ! cloud droplet radius present-day from newmicro
     185  REAL,    INTENT(in)  :: ref_ice(klon,klev) ! ice crystal radius   present-day from newmicro
     186  REAL,    INTENT(in)  :: ref_liq_pi(klon,klev) ! cloud droplet radius pre-industrial from newmicro
     187  REAL,    INTENT(in)  :: ref_ice_pi(klon,klev) ! ice crystal radius   pre-industrial from newmicro
    135188
    136189! Output arguments
    … …  
    155208  REAL, DIMENSION(kdlon,3), INTENT(out) :: topswcf_aero
    156209  REAL, DIMENSION(kdlon,3), INTENT(out) :: solswcf_aero
     210  REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZSWFT0_i
     211  REAL, DIMENSION(kdlon,kflev+1), INTENT(out) :: ZLWFT0_i
    157212
    158213! Local variables
    … …  
    167222  REAL(KIND=8) zx_alpha1, zx_alpha2
    168223  INTEGER k, kk, i, j, iof, nb_gr
     224  INTEGER ist,iend,ktdia,kmode
    169225  REAL(KIND=8) PSCT
    170226  REAL(KIND=8) PALBD(kdlon,2), PALBP(kdlon,2)
     227!  MPL 06.01.09: pour RRTM, creation de PALBD_NEW et PALBP_NEW
     228! avec NSW en deuxieme dimension       
     229  REAL(KIND=8) PALBD_NEW(kdlon,NSW), PALBP_NEW(kdlon,NSW)
    171230  REAL(KIND=8) PEMIS(kdlon), PDT0(kdlon), PVIEW(kdlon)
    172231  REAL(KIND=8) PPSOL(kdlon), PDP(kdlon,KLEV)
    … …  
    178237  ! "POZON(:, :, 1)" is for the average day-night field,
    179238  ! "POZON(:, :, 2)" is for daylight time.
    180 
    181   REAL(KIND=8) PAER(kdlon,kflev,5)
     239!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6 
     240  REAL(KIND=8) PAER(kdlon,kflev,6)
    182241  REAL(KIND=8) PCLDLD(kdlon,kflev)
    183242  REAL(KIND=8) PCLDLU(kdlon,kflev)
    … …  
    206265  REAL(KIND=8) zsolsw_aero(kdlon,9), zsolsw0_aero(kdlon,9)
    207266  REAL(KIND=8) ztopswcf_aero(kdlon,3), zsolswcf_aero(kdlon,3)     
     267! real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 deje declare dans physiq.F MPL 20130618
     268!MPL input supplementaires pour RECMWFL
     269! flwc, fiwc = Liquid Water Content & Ice Water Content (kg/kg)
     270      REAL(KIND=8) GEMU(klon)
     271!MPL input RECMWFL:
     272! Tableaux aux niveaux inverses pour respecter convention Arpege
     273      REAL(KIND=8) ref_liq_i(klon,klev) ! cloud droplet radius present-day from newmicro (inverted)
     274      REAL(KIND=8) ref_ice_i(klon,klev) ! ice crystal radius present-day from newmicro (inverted)
     275      REAL(KIND=8) paprs_i(klon,klev+1)
     276      REAL(KIND=8) pplay_i(klon,klev)
     277      REAL(KIND=8) cldfra_i(klon,klev)
     278      REAL(KIND=8) POZON_i(kdlon,kflev, size(wo, 3)) ! mass fraction of ozone
     279  ! "POZON(:, :, 1)" is for the average day-night field,
     280  ! "POZON(:, :, 2)" is for daylight time.
     281!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6     
     282      REAL(KIND=8) PAER_i(kdlon,kflev,6)
     283      REAL(KIND=8) PDP_i(klon,klev)
     284      REAL(KIND=8) t_i(klon,klev),q_i(klon,klev),qsat_i(klon,klev)
     285      REAL(KIND=8) flwc_i(klon,klev),fiwc_i(klon,klev)
     286!MPL output RECMWFL:
     287      REAL(KIND=8) ZEMTD (klon,klev+1),ZEMTD_i (klon,klev+1)       
     288      REAL(KIND=8) ZEMTU (klon,klev+1),ZEMTU_i (klon,klev+1)     
     289      REAL(KIND=8) ZTRSO (klon,klev+1),ZTRSO_i (klon,klev+1)   
     290      REAL(KIND=8) ZTH   (klon,klev+1),ZTH_i   (klon,klev+1)   
     291      REAL(KIND=8) ZCTRSO(klon,2)       
     292      REAL(KIND=8) ZCEMTR(klon,2)     
     293      REAL(KIND=8) ZTRSOD(klon)       
     294      REAL(KIND=8) ZLWFC (klon,2)     
     295      REAL(KIND=8) ZLWFT (klon,klev+1),ZLWFT_i (klon,klev+1)   
     296      REAL(KIND=8) ZSWFC (klon,2)     
     297      REAL(KIND=8) ZSWFT (klon,klev+1),ZSWFT_i (klon,klev+1)
     298      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)
     302      REAL(KIND=8) PSFSWDIR(klon,NSW)
     303      REAL(KIND=8) PSFSWDIF(klon,NSW)
     304      REAL(KIND=8) PFSDNN(klon)
     305      REAL(KIND=8) PFSDNV(klon)
     306!MPL On ne redefinit pas les tableaux ZFLUX,ZFLUC,
     307!MPL ZFSDWN,ZFCDWN,ZFSUP,ZFCUP car ils existent deja
     308!MPL sous les noms de ZFLDN,ZFLDN0,ZFLUP,ZFLUP0,
     309!MPL ZFSDN,ZFSDN0,ZFSUP,ZFSUP0
     310      REAL(KIND=8) ZFLUX_i (klon,2,klev+1)
     311      REAL(KIND=8) ZFLUC_i (klon,2,klev+1)
     312      REAL(KIND=8) ZFSDWN_i (klon,klev+1)
     313      REAL(KIND=8) ZFCDWN_i (klon,klev+1)
     314      REAL(KIND=8) ZFSUP_i (klon,klev+1)
     315      REAL(KIND=8) ZFCUP_i (klon,klev+1)
     316! 3 lignes suivantes a activer pour CCMVAL (MPL 20100412)
     317!      REAL(KIND=8) RSUN(3,2)
     318!      REAL(KIND=8) SUN(3)
     319!      REAL(KIND=8) SUN_FRACT(2)
    208320  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
    209325
    210326  call assert(size(wo, 1) == klon, size(wo, 2) == klev, "radlwsw wo")
    211327  ! initialisation
     328  ist=1
     329  iend=klon
     330  ktdia=1
     331  kmode=ist
    212332  tauaero(:,:,:,:)=0.
    213333  pizaero(:,:,:,:)=0.
    214334  cgaero(:,:,:,:)=0.
     335  lldebug=.FALSE.
    215336 
    216337  !
    … …  
    250371    DO i = 1, kdlon
    251372      zfract(i) = fract(iof+i)
     373!     zfract(i) = 1.     !!!!!!  essai MPL 19052010
    252374      zrmu0(i) = rmu0(iof+i)
    253375      PALBD(i,1) = alb1(iof+i)
    254376      PALBD(i,2) = alb2(iof+i)
     377!
     378         PALBD_NEW(i,1) = alb1(iof+i)   !!!!! A REVOIR (MPL) PALBD_NEW en fonction bdes SW
     379         do kk=2,NSW
     380           PALBD_NEW(i,kk) = alb2(iof+i)
     381         enddo
    255382      PALBP(i,1) = alb1(iof+i)
    256383      PALBP(i,2) = alb2(iof+i)
    257       PEMIS(i) = 1.0
     384!
     385         PALBP_NEW(i,1) = alb1(iof+i)     !!!!! A REVOIR (MPL) PALBP_NEW en fonction bdes SW
     386         do kk=2,NSW
     387           PALBP_NEW(i,kk) = alb2(iof+i)
     388         enddo
     389      PEMIS(i) = 1.0    !!!!! A REVOIR (MPL)
    258390      PVIEW(i) = 1.66
    259391      PPSOL(i) = paprs(iof+i,1)
    … …  
    277409        POZON(i,k, :) = wo(iof+i, k, :) * RG * dobson_u * 1e3 &
    278410             / (paprs(iof+i, k) - paprs(iof+i, k+1))
     411!       A activer pour CCMVAL on prend l'ozone impose (MPL 07042010)
     412!       POZON(i,k,:) = wo(i,k,:) 
     413!       print *,'RADLWSW: POZON',k, POZON(i,k,1)
    279414        PCLDLD(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
    280415        PCLDLU(i,k) = cldfra(iof+i,k)*cldemi(iof+i,k)
    … …  
    313448    ENDDO
    314449    !
    315     DO kk = 1, 5
     450!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6
     451    DO kk = 1, 6
    316452      DO k = 1, kflev
    317453        DO i = 1, kdlon
    318           PAER(i,k,kk) = 1.0E-15
     454          PAER(i,k,kk) = 1.0E-15   !!!!! A REVOIR (MPL)
    319455        ENDDO
    320456      ENDDO
    … …  
    334470!===== iflag_rrtm ================================================
    335471!     
    336     IF (iflag_rrtm == 0) THEN
     472    IF (iflag_rrtm == 0) THEN       !!!! remettre 0 juste pour tester l'ancien rayt via rrtm
     473!--- Mise a zero des tableaux output du rayonnement LW-AR4 ----------             
     474      DO k = 1, kflev+1
     475      DO i = 1, kdlon
     476!     print *,'RADLWSW: boucle mise a zero i k',i,k
     477      ZFLUP(i,k)=0.
     478      ZFLDN(i,k)=0.
     479      ZFLUP0(i,k)=0.
     480      ZFLDN0(i,k)=0.
     481      ZLWFT0_i(i,k)=0.
     482      ZFLUCUP_i(i,k)=0.
     483      ZFLUCDWN_i(i,k)=0.
     484      ENDDO
     485      ENDDO
     486      DO k = 1, kflev
     487      DO i = 1, kdlon
     488      zcool(i,k)=0.
     489      zcool0(i,k)=0.
     490      ENDDO
     491      ENDDO
     492      DO i = 1, kdlon
     493      ztoplw(i)=0.
     494      zsollw(i)=0.
     495      ztoplw0(i)=0.
     496      zsollw0(i)=0.
     497      zsollwdown(i)=0.
     498      ENDDO
    337499       ! Old radiation scheme, used for AR4 runs
    338500       ! average day-night ozone for longwave
    … …  
    347509            zsollwdown,&
    348510            ZFLUP, ZFLDN, ZFLUP0,ZFLDN0)
    349 
     511!----- Mise a zero des tableaux output du rayonnement SW-AR4
     512      DO k = 1, kflev+1
     513      DO i = 1, kdlon
     514      ZFSUP(i,k)=0.
     515      ZFSDN(i,k)=0.
     516      ZFSUP0(i,k)=0.
     517      ZFSDN0(i,k)=0.
     518      ZSWFT0_i(i,k)=0.
     519      ZFCUP_i(i,k)=0.
     520      ZFCDWN_i(i,k)=0.
     521      ENDDO
     522      ENDDO
     523      DO k = 1, kflev
     524      DO i = 1, kdlon
     525      zheat(i,k)=0.
     526      zheat0(i,k)=0.
     527      ENDDO
     528      ENDDO
     529      DO i = 1, kdlon
     530      zalbpla(i)=0.
     531      ztopsw(i)=0.
     532      zsolsw(i)=0.
     533      ztopsw0(i)=0.
     534      zsolsw0(i)=0.
     535      ztopswadaero(i)=0.
     536      zsolswadaero(i)=0.
     537      ztopswaiaero(i)=0.
     538      zsolswaiaero(i)=0.
     539      ENDDO
     540!     print *,'Avant SW_LMDAR4: PSCT zrmu0 zfract',PSCT, zrmu0, zfract
    350541       ! daylight ozone, if we have it, for short wave
    351542       IF (.NOT. new_aod) THEN
    … …  
    385576       ENDIF
    386577
     578             
     579          DO i=1,kdlon
     580          DO k=1,kflev+1
     581         ZSWFT0_i(1:klon,k) = ZFSDN0(1:klon,k)-ZFSUP0(1:klon,k)
     582         ZLWFT0_i(1:klon,k)=-ZFLDN0(1:klon,k)-ZFLUP0(1:klon,k)
     583!        print *,'iof i k klon klev=',iof,i,k,klon,klev
     584         lwdn0 ( iof+i,k)   = ZFLDN0 ( i,k)
     585         lwdn  ( iof+i,k)   = ZFLDN  ( i,k)
     586         lwup0 ( iof+i,k)   = ZFLUP0 ( i,k)
     587         lwup  ( iof+i,k)   = ZFLUP  ( i,k)
     588         swdn0 ( iof+i,k)   = ZFSDN0 ( i,k)
     589         swdn  ( iof+i,k)   = ZFSDN  ( i,k)
     590         swup0 ( iof+i,k)   = ZFSUP0 ( i,k)
     591         swup  ( iof+i,k)   = ZFSUP  ( i,k)
     592          ENDDO 
     593          ENDDO 
     594!          print*,'SW_AR4 ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
     595!          print*,'SW_AR4 swdn0  1 , klev:',swdn0(1:klon,1),swdn0(1:klon,klev)
     596!          print*,'SW_AR4 ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
     597!          print*,'SW_AR4 swup0  1 , klev:',swup0(1:klon,1),swup0(1:klon,klev)
     598!          print*,'SW_AR4 ZFSDN  1 , klev:',ZFSDN(1:klon,1) ,ZFSDN(1:klon,klev)
     599!          print*,'SW_AR4 ZFSUP  1 , klev:',ZFSUP(1:klon,1) ,ZFSUP(1:klon,klev)
    387600    ELSE 
     601#ifdef CPP_RRTM
     602!      if (prt_level.gt.10)write(lunout,*)'CPP_RRTM=.T.'
    388603!===== iflag_rrtm=1, on passe dans SW via RECMWFL ===============
    389        WRITE(lunout,*) "Option iflag_rrtm=T ne fonctionne pas encore !!!"
    390        CALL abort_gcm('radlwsw','iflag_rrtm=T not valid',1)
    391 
     604
     605      DO k = 1, kflev+1
     606      DO i = 1, kdlon
     607      ZEMTD_i(i,k)=0.
     608      ZEMTU_i(i,k)=0.
     609      ZTRSO_i(i,k)=0.
     610      ZTH_i(i,k)=0.
     611      ZLWFT_i(i,k)=0.
     612      ZSWFT_i(i,k)=0.
     613      ZFLUX_i(i,1,k)=0.
     614      ZFLUX_i(i,2,k)=0.
     615      ZFLUC_i(i,1,k)=0.
     616      ZFLUC_i(i,2,k)=0.
     617      ZFSDWN_i(i,k)=0.
     618      ZFCDWN_i(i,k)=0.
     619      ZFSUP_i(i,k)=0.
     620      ZFCUP_i(i,k)=0.
     621      ENDDO
     622      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
     654      DO k = 1, kflev
     655      zrho=pplay(i,k)/t(i,k)/RD
     656      zdz=(paprs(i,k)-paprs(i,k+1))/zrho/RG
     657      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
     675!     
     676      DO i = 1, kdlon
     677      ZCTRSO(i,1)=0.
     678      ZCTRSO(i,2)=0.
     679      ZCEMTR(i,1)=0.
     680      ZCEMTR(i,2)=0.
     681      ZTRSOD(i)=0.
     682      ZLWFC(i,1)=0.
     683      ZLWFC(i,2)=0.
     684      ZSWFC(i,1)=0.
     685      ZSWFC(i,2)=0.
     686      PFSDNN(i)=0.
     687      PFSDNV(i)=0.
     688      DO kk = 1, NSW
     689      PSFSWDIR(i,kk)=0.
     690      PSFSWDIF(i,kk)=0.
     691      ENDDO
     692      ENDDO
     693!----- Fin des mises a zero des tableaux output de RECMWF -------------------             
     694!        GEMU(1:klon)=sin(rlatd(1:klon))
     695! On met les donnees dans l'ordre des niveaux arpege
     696         paprs_i(:,1)=paprs(:,klev+1)
     697         do k=1,klev
     698            paprs_i(1:klon,k+1) =paprs(1:klon,klev+1-k)
     699            pplay_i(1:klon,k)   =pplay(1:klon,klev+1-k)
     700            cldfra_i(1:klon,k)  =cldfra(1:klon,klev+1-k)
     701            PDP_i(1:klon,k)     =PDP(1:klon,klev+1-k)
     702            t_i(1:klon,k)       =t(1:klon,klev+1-k)
     703            q_i(1:klon,k)       =q(1:klon,klev+1-k)
     704            qsat_i(1:klon,k)    =qsat(1:klon,klev+1-k)
     705            flwc_i(1:klon,k)    =flwc(1:klon,klev+1-k)
     706            fiwc_i(1:klon,k)    =fiwc(1:klon,klev+1-k)
     707            ref_liq_i(1:klon,k) =ref_liq(1:klon,klev+1-k)
     708            ref_ice_i(1:klon,k) =ref_ice(1:klon,klev+1-k)
     709         enddo
     710         do k=1,kflev
     711           POZON_i(1:klon,k,:)=POZON(1:klon,kflev+1-k,:)
     712!!!            POZON_i(1:klon,k)=POZON(1:klon,k)            !!! on laisse 1=sol et klev=top
     713!          print *,'Juste avant RECMWFL: k tsol temp',k,tsol,t(1,k)
     714!!!!!!! Modif MPL 6.01.09 avec RRTM, on passe de 5 a 6     
     715            do i=1,6
     716            PAER_i(1:klon,k,i)=PAER(1:klon,kflev+1-k,i)
     717            enddo
     718         enddo
     719!       print *,'RADLWSW: avant RECMWFL, RI0,rmu0=',solaire,rmu0
     720
     721!  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     722! La version ARPEGE1D utilise differentes valeurs de la constante
     723! solaire suivant le rayonnement utilise.
     724! A controler ...
     725! SOLAR FLUX AT THE TOP (/YOMPHY3/)
     726! introduce season correction
     727!--------------------------------------
     728! RII0 = RIP0
     729! IF(LRAYFM)
     730! RII0 = RIP0M   ! =rip0m if Morcrette non-each time step call.
     731! IF(LRAYFM15)
     732! RII0 = RIP0M15 ! =rip0m if Morcrette non-each time step call.
     733         RII0=solaire/zdist/zdist
     734        print*,'+++ radlwsw: solaire ,RII0',solaire,RII0
     735!  %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     736! Ancien appel a RECMWF (celui du cy25)
     737!        CALL RECMWF (ist , iend, klon , ktdia , klev   , kmode ,
     738!    s   PALBD    , PALBP   , paprs_i , pplay_i , RCO2   , cldfra_i,
     739!    s   POZON_i  , PAER_i  , PDP_i   , PEMIS   , GEMU   , rmu0,
     740!    s    q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,
     741!    s   ZEMTD_i  , ZEMTU_i , ZTRSO_i ,
     742!    s   ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,
     743!    s   ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,
     744!    s   ZFLUX_i  , ZFLUC_i , ZFSDWN_i, ZFSUP_i , ZFCDWN_i,ZFCUP_i)
     745!    s   'RECMWF ')
     746!
     747      if(lldebug) then
     748        CALL writefield_phy('paprs_i',paprs_i,klev+1)
     749        CALL writefield_phy('pplay_i',pplay_i,klev)
     750        CALL writefield_phy('cldfra_i',cldfra_i,klev)
     751        CALL writefield_phy('pozon_i',POZON_i,klev)
     752        CALL writefield_phy('paer_i',PAER_i,klev)
     753        CALL writefield_phy('pdp_i',PDP_i,klev)
     754        CALL writefield_phy('q_i',q_i,klev)
     755        CALL writefield_phy('qsat_i',qsat_i,klev)
     756        CALL writefield_phy('fiwc_i',fiwc_i,klev)
     757        CALL writefield_phy('flwc_i',flwc_i,klev)
     758        CALL writefield_phy('t_i',t_i,klev)
     759        CALL writefield_phy('palbd_new',PALBD_NEW,NSW)
     760        CALL writefield_phy('palbp_new',PALBP_NEW,NSW)
     761      endif
     762
     763! Nouvel appel a RECMWF (celui du cy32t0)
     764         CALL RECMWF (ist , iend, klon , ktdia  , klev   , kmode ,&
     765         PALBD_NEW,PALBP_NEW, paprs_i , pplay_i , RCO2   , cldfra_i,&
     766         POZON_i  , PAER_i  , PDP_i   , PEMIS   , rmu0   ,&
     767          q_i     , qsat_i  , fiwc_i  , flwc_i  , zmasq  , t_i  ,tsol,&
     768         ref_liq_i, ref_ice_i, &
     769         ZEMTD_i  , ZEMTU_i , ZTRSO_i ,&
     770         ZTH_i    , ZCTRSO  , ZCEMTR  , ZTRSOD  ,&
     771         ZLWFC    , ZLWFT_i , ZSWFC   , ZSWFT_i ,&
     772         PSFSWDIR , PSFSWDIF, PFSDNN  , PFSDNV  ,&
     773         PPIZA_DST, PCGA_DST,PTAUREL_DST,ZFLUX_i  , ZFLUC_i ,&
     774         ZFSDWN_i , ZFSUP_i , ZFCDWN_i, ZFCUP_i)
     775           
     776         print *,'RADLWSW: apres RECMWF'
     777      if(lldebug) then
     778        CALL writefield_phy('zemtd_i',ZEMTD_i,klev+1)
     779        CALL writefield_phy('zemtu_i',ZEMTU_i,klev+1)
     780        CALL writefield_phy('ztrso_i',ZTRSO_i,klev+1)
     781        CALL writefield_phy('zth_i',ZTH_i,klev+1)
     782        CALL writefield_phy('zctrso',ZCTRSO,2)
     783        CALL writefield_phy('zcemtr',ZCEMTR,2)
     784        CALL writefield_phy('ztrsod',ZTRSOD,1)
     785        CALL writefield_phy('zlwfc',ZLWFC,2)
     786        CALL writefield_phy('zlwft_i',ZLWFT_i,klev+1)
     787        CALL writefield_phy('zswfc',ZSWFC,2)
     788        CALL writefield_phy('zswft_i',ZSWFT_i,klev+1)
     789        CALL writefield_phy('psfswdir',PSFSWDIR,6)
     790        CALL writefield_phy('psfswdif',PSFSWDIF,6)
     791        CALL writefield_phy('pfsdnn',PFSDNN,1)
     792        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)
     796        CALL writefield_phy('zflux_i',ZFLUX_i,klev+1)
     797        CALL writefield_phy('zfluc_i',ZFLUC_i,klev+1)
     798        CALL writefield_phy('zfsdwn_i',ZFSDWN_i,klev+1)
     799        CALL writefield_phy('zfsup_i',ZFSUP_i,klev+1)
     800        CALL writefield_phy('zfcdwn_i',ZFCDWN_i,klev+1)
     801        CALL writefield_phy('zfcup_i',ZFCUP_i,klev+1)
     802      endif
     803! --------- output RECMWFL
     804!  ZEMTD        (KPROMA,KLEV+1)  ; TOTAL DOWNWARD LONGWAVE EMISSIVITY
     805!  ZEMTU        (KPROMA,KLEV+1)  ; TOTAL UPWARD   LONGWAVE EMISSIVITY
     806!  ZTRSO        (KPROMA,KLEV+1)  ; TOTAL SHORTWAVE TRANSMISSIVITY
     807!  ZTH          (KPROMA,KLEV+1)  ; HALF LEVEL TEMPERATURE
     808!  ZCTRSO       (KPROMA,2)       ; CLEAR-SKY SHORTWAVE TRANSMISSIVITY
     809!  ZCEMTR       (KPROMA,2)       ; CLEAR-SKY NET LONGWAVE EMISSIVITY
     810!  ZTRSOD       (KPROMA)         ; TOTAL-SKY SURFACE SW TRANSMISSITY
     811!  ZLWFC        (KPROMA,2)       ; CLEAR-SKY LONGWAVE FLUXES
     812!  ZLWFT        (KPROMA,KLEV+1)  ; TOTAL-SKY LONGWAVE FLUXES
     813!  ZSWFC        (KPROMA,2)       ; CLEAR-SKY SHORTWAVE FLUXES
     814!  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
     818!  PSFSWDIR     (KPROMA,NSW)     ;
     819!  PSFSWDIF     (KPROMA,NSW)     ;
     820!  PFSDNN       (KPROMA)         ;
     821!  PFSDNV       (KPROMA)         ;
     822! ---------
     823! ---------
     824! On retablit l'ordre des niveaux lmd pour les tableaux de sortie
     825! D autre part, on multiplie les resultats SW par fract pour etre coherent
     826! avec l ancien rayonnement AR4. Si nuit, fract=0 donc pas de
     827! rayonnement SW. (MPL 260609)
     828      DO k=0,klev
     829         DO i=1,klon
     830         ZEMTD(i,k+1)  = ZEMTD_i(i,k+1)
     831         ZEMTU(i,k+1)  = ZEMTU_i(i,k+1)
     832         ZTRSO(i,k+1)  = ZTRSO_i(i,k+1)
     833         ZTH(i,k+1)    = ZTH_i(i,k+1)
     834!        ZLWFT(i,k+1)  = ZLWFT_i(i,klev+1-k)
     835!        ZSWFT(i,k+1)  = ZSWFT_i(i,klev+1-k)
     836         ZFLUP(i,k+1)  = ZFLUX_i(i,1,k+1)
     837         ZFLDN(i,k+1)  = ZFLUX_i(i,2,k+1)
     838         ZFLUP0(i,k+1) = ZFLUC_i(i,1,k+1)
     839         ZFLDN0(i,k+1) = ZFLUC_i(i,2,k+1)
     840         ZFSDN(i,k+1)  = ZFSDWN_i(i,k+1)*fract(i)
     841         ZFSDN0(i,k+1) = ZFCDWN_i(i,k+1)*fract(i)
     842         ZFSUP (i,k+1) = ZFSUP_i(i,k+1)*fract(i)
     843         ZFSUP0(i,k+1) = ZFCUP_i(i,k+1)*fract(i)
     844!   Nouveau calcul car visiblement ZSWFT et ZSWFC sont nuls dans RRTM cy32
     845!   en sortie de radlsw.F90 - MPL 7.01.09
     846         ZSWFT(i,k+1)  = (ZFSDWN_i(i,k+1)-ZFSUP_i(i,k+1))*fract(i)
     847         ZSWFT0_i(i,k+1) = (ZFCDWN_i(i,k+1)-ZFCUP_i(i,k+1))*fract(i)
     848!        WRITE(*,'("FSDN FSUP FCDN FCUP: ",4E12.5)') ZFSDWN_i(i,k+1),&
     849!        ZFSUP_i(i,k+1),ZFCDWN_i(i,k+1),ZFCUP_i(i,k+1)
     850         ZLWFT(i,k+1) =-ZFLUX_i(i,2,k+1)-ZFLUX_i(i,1,k+1)
     851         ZLWFT0_i(i,k+1)=-ZFLUC_i(i,2,k+1)-ZFLUC_i(i,1,k+1)
     852!        print *,'FLUX2 FLUX1 FLUC2 FLUC1',ZFLUX_i(i,2,k+1),&
     853!    & ZFLUX_i(i,1,k+1),ZFLUC_i(i,2,k+1),ZFLUC_i(i,1,k+1)
     854         ENDDO
     855      ENDDO
     856
     857!     print*,'SW_RRTM ZFSDN0 1 , klev:',ZFSDN0(1:klon,1),ZFSDN0(1:klon,klev)
     858!     print*,'SW_RRTM ZFSUP0 1 , klev:',ZFSUP0(1:klon,1),ZFSUP0(1:klon,klev)
     859!     print*,'SW_RRTM ZFSDN  1 , klev:',ZFSDN(1:klon,1),ZFSDN(1:klon,klev)
     860!     print*,'SW_RRTM ZFSUP  1 , klev:',ZFSUP(1:klon,1),ZFSUP(1:klon,klev)     
     861!     print*,'OK1'
     862! ---------
     863! ---------
     864! On renseigne les champs LMDz, pour avoir la meme chose qu'en sortie de
     865! LW_LMDAR4 et SW_LMDAR4
     866      DO i = 1, kdlon
     867         zsolsw(i)    = ZSWFT(i,1)
     868         zsolsw0(i)   = ZSWFT0_i(i,1)
     869!        zsolsw0(i)   = ZFSDN0(i,1)     -ZFSUP0(i,1)
     870         ztopsw(i)    = ZSWFT(i,klev+1)
     871         ztopsw0(i)   = ZSWFT0_i(i,klev+1)
     872!        ztopsw0(i)   = ZFSDN0(i,klev+1)-ZFSUP0(i,klev+1)
     873!         
     874!        zsollw(i)    = ZFLDN(i,1)      -ZFLUP(i,1)
     875!        zsollw0(i)   = ZFLDN0(i,1)     -ZFLUP0(i,1)
     876!        ztoplw(i)    = ZFLDN(i,klev+1) -ZFLUP(i,klev+1)
     877!        ztoplw0(i)   = ZFLDN0(i,klev+1)-ZFLUP0(i,klev+1)
     878         zsollw(i)    = ZLWFT(i,1)
     879         zsollw0(i)   = ZLWFT0_i(i,1)
     880         ztoplw(i)    = ZLWFT(i,klev+1)*(-1)
     881         ztoplw0(i)   = ZLWFT0_i(i,klev+1)*(-1)
     882!         
     883           IF (fract(i) == 0.) THEN
     884!!!!! A REVOIR MPL (20090630) ca n a pas de sens quand fract=0
     885! pas plus que dans le sw_AR4
     886          zalbpla(i)   = 1.0e+39
     887         ELSE
     888          zalbpla(i)   = ZFSUP(i,klev+1)/ZFSDN(i,klev+1)
     889         ENDIF
     890         zsollwdown(i)= ZFLDN(i,1)
     891      ENDDO
     892      print*,'OK2'
     893
     894! extrait de SW_AR4
     895!     DO k = 1, KFLEV
     896!        kpl1 = k+1
     897!        DO i = 1, KDLON
     898!           PHEAT(i,k) = -(ZFSUP(i,kpl1)-ZFSUP(i,k)) -(ZFSDN(i,k)-ZFSDN(i,kpl1))
     899!           PHEAT(i,k) = PHEAT(i,k) * RDAY*RG/RCPD / PDP(i,k)
     900! ZLWFT(klon,k),ZSWFT
     901
     902      do k=1,kflev
     903         do i=1,kdlon
     904           zheat(i,k)=(ZSWFT(i,k+1)-ZSWFT(i,k))*RDAY*RG/RCPD/PDP(i,k)
     905           zheat0(i,k)=(ZSWFT0_i(i,k+1)-ZSWFT0_i(i,k))*RDAY*RG/RCPD/PDP(i,k)
     906           zcool(i,k)=(ZLWFT(i,k)-ZLWFT(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
     907           zcool0(i,k)=(ZLWFT0_i(i,k)-ZLWFT0_i(i,k+1))*RDAY*RG/RCPD/PDP(i,k)
     908!          print *,'heat cool heat0 cool0 ',zheat(i,k),zcool(i,k),zheat0(i,k),zcool0(i,k)
     909!          ZFLUCUP_i(i,k)=ZFLUC_i(i,1,k)
     910!          ZFLUCDWN_i(i,k)=ZFLUC_i(i,2,k)         
     911         enddo
     912      enddo
     913#else
     914    call abort_gcm(modname, abort_message, 1)
     915#endif
    392916    ENDIF ! iflag_rrtm
    393917!======================================================================
Note: See TracChangeset for help on using the changeset viewer.