Ignore:
Timestamp:
Oct 30, 2016, 4:35:25 PM (8 years ago)
Author:
oboucher
Message:

Adding a module for stratospheric aerosols with a bin scheme.
The module gets activated with -strataer true compiling option.
May not quite work yet, more testing needed, but should not affect
the rest of LMDz as everything is under a CPP_StratAer key.

Location:
LMDZ5/trunk/libf/phylmd
Files:
15 added
7 edited

Legend:

Unmodified
Added
Removed

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

    r2320 r2690  
    9595                               indnum_fn_num_,index_trac_,&
    9696                               niso_,ntraceurs_zone_,ntraciso_)
    97   ! transfer information on tracers from dynamics to physics
    98   USE print_control_mod, ONLY: prt_level, lunout
    99   IMPLICIT NONE
     97
     98    ! transfer information on tracers from dynamics to physics
     99    USE print_control_mod, ONLY: prt_level, lunout
     100    IMPLICIT NONE
     101
    100102    INTEGER,INTENT(IN) :: nqtot_
    101103    INTEGER,INTENT(IN) :: nqo_

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

    r2670 r2690  
    2929      REAL, SAVE, ALLOCATABLE :: d_u_dyn(:,:), d_v_dyn(:,:)
    3030      !$OMP THREADPRIVATE(d_u_dyn, d_v_dyn)
    31 !!!!
    3231      REAL, SAVE, ALLOCATABLE :: d_tr_dyn(:,:,:)
    3332      !$OMP THREADPRIVATE(d_tr_dyn)
    34 !!!!
    3533      REAL, SAVE, ALLOCATABLE :: d_t_con(:,:),d_q_con(:,:)
    3634      !$OMP THREADPRIVATE(d_t_con,d_q_con)
    … …  
    420418!$OMP THREADPRIVATE(sissnow,runoff,albsol3_lic)
    421419
     420#ifdef CPP_StratAer
     421! variables for strat. aerosol CK
     422      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: R2SO4
     423!$OMP THREADPRIVATE(R2SO4)
     424      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: DENSO4
     425!$OMP THREADPRIVATE(DENSO4)
     426      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f_r_wet
     427!$OMP THREADPRIVATE(f_r_wet)
     428      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: sfluxaer
     429!$OMP THREADPRIVATE(sfluxaer)
     430      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: decfluxaer
     431!$OMP THREADPRIVATE(decfluxaer)
     432      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: mdw
     433!$OMP THREADPRIVATE(mdw)
     434      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulf_convert
     435!$OMP THREADPRIVATE(sulf_convert)
     436      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulf_nucl
     437!$OMP THREADPRIVATE(sulf_nucl)
     438      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulf_cond_evap
     439!$OMP THREADPRIVATE(sulf_cond_evap)
     440      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ocs_convert
     441!$OMP THREADPRIVATE(ocs_convert)
     442      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SO2_backgr_tend
     443!$OMP THREADPRIVATE(SO2_backgr_tend)
     444      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: OCS_backgr_tend
     445!$OMP THREADPRIVATE(OCS_backgr_tend)
     446      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: OCS_lifetime
     447!$OMP THREADPRIVATE(OCS_lifetime)
     448      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SO2_lifetime
     449!$OMP THREADPRIVATE(SO2_lifetime)
     450      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: alpha_bin
     451!$OMP THREADPRIVATE(alpha_bin)
     452      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: piz_bin
     453!$OMP THREADPRIVATE(piz_bin)
     454      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cg_bin
     455!$OMP THREADPRIVATE(cg_bin)
     456      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_550
     457!$OMP THREADPRIVATE(tau_strat_550)
     458      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_550_lay
     459!$OMP THREADPRIVATE(tau_strat_550_lay)
     460      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_1020
     461!$OMP THREADPRIVATE(tau_strat_1020)
     462      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tausum_strat
     463!$OMP THREADPRIVATE(tausum_strat)
     464      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: sulf_dep_dry
     465!$OMP THREADPRIVATE(sulf_dep_dry)
     466      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: sulf_dep_wet
     467!$OMP THREADPRIVATE(sulf_dep_wet)
     468      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: surf_PM25_sulf
     469!$OMP THREADPRIVATE(surf_PM25_sulf)
     470      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: p_tropopause
     471!$OMP THREADPRIVATE(p_tropopause)
     472      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vsed_aer
     473!$OMP THREADPRIVATE(vsed_aer)
     474#endif
     475
    422476CONTAINS
    423477
    … …  
    659713      ALLOCATE (sissnow(klon),runoff(klon),albsol3_lic(klon))
    660714
    661 
     715#ifdef CPP_StratAer
     716      ALLOCATE (R2SO4(klon,klev))
     717      ALLOCATE (DENSO4(klon,klev))
     718      ALLOCATE (f_r_wet(klon,klev))
     719      ALLOCATE (sfluxaer(klon))
     720      ALLOCATE (decfluxaer(klon,nbtr))
     721      ALLOCATE (mdw(nbtr))
     722      ALLOCATE (sulf_convert(klon,klev))
     723      ALLOCATE (sulf_nucl(klon,klev))
     724      ALLOCATE (sulf_cond_evap(klon,klev))
     725      ALLOCATE (ocs_convert(klon,klev))
     726      ALLOCATE (SO2_backgr_tend(klon,klev))
     727      ALLOCATE (OCS_backgr_tend(klon,klev))
     728      ALLOCATE (OCS_lifetime(klon,klev))
     729      ALLOCATE (SO2_lifetime(klon,klev))
     730      ALLOCATE (alpha_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave+nwave_lw,nbtr))
     731      ALLOCATE (piz_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave+nwave_lw,nbtr))
     732      ALLOCATE (cg_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave+nwave_lw,nbtr))
     733      ALLOCATE (tau_strat_550(klon,klev))
     734      ALLOCATE (tau_strat_550_lay(klon,klev))
     735      ALLOCATE (tau_strat_1020(klon,klev))
     736      ALLOCATE (tausum_strat(klon,3))
     737      ALLOCATE (sulf_dep_dry(klon))
     738      ALLOCATE (sulf_dep_wet(klon))
     739      ALLOCATE (surf_PM25_sulf(klon))
     740      ALLOCATE (p_tropopause(klon))
     741      ALLOCATE (vsed_aer(klon,klev))
     742#endif
    662743
    663744END SUBROUTINE phys_local_var_init
    … …  
    876957      DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
    877958
     959#ifdef CPP_StratAer
     960! variables for strat. aerosol CK
     961      DEALLOCATE (R2SO4)
     962      DEALLOCATE (DENSO4)
     963      DEALLOCATE (f_r_wet)
     964      DEALLOCATE (sfluxaer)
     965      DEALLOCATE (decfluxaer)
     966      DEALLOCATE (mdw)
     967      DEALLOCATE (sulf_convert)
     968      DEALLOCATE (sulf_nucl)
     969      DEALLOCATE (sulf_cond_evap)
     970      DEALLOCATE (ocs_convert)
     971      DEALLOCATE (SO2_backgr_tend)
     972      DEALLOCATE (OCS_backgr_tend)
     973      DEALLOCATE (SO2_lifetime)
     974      DEALLOCATE (OCS_lifetime)
     975      DEALLOCATE (alpha_bin)
     976      DEALLOCATE (piz_bin)
     977      DEALLOCATE (cg_bin)
     978      DEALLOCATE (tau_strat_550)
     979      DEALLOCATE (tau_strat_550_lay)
     980      DEALLOCATE (tau_strat_1020)
     981      DEALLOCATE (tausum_strat)
     982      DEALLOCATE (sulf_dep_dry)
     983      DEALLOCATE (sulf_dep_wet)
     984      DEALLOCATE (surf_PM25_sulf)
     985      DEALLOCATE (p_tropopause)
     986      DEALLOCATE (vsed_aer)
     987#endif
     988
    878989END SUBROUTINE phys_local_var_end
    879990

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

    r2670 r2690  
    11741174    'lcc', 'Cloud liquid fraction at top of cloud', '1', (/ ('', i=1, 9) /))
    11751175
     1176#ifdef CPP_StratAer
     1177  TYPE(ctrl_out), SAVE :: o_ext_strat_550 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1178    'ext_strat_550', 'Strat. aerosol extinction coefficient at 550 nm', '1/m', (/ ('', i=1, 9) /))
     1179  TYPE(ctrl_out), SAVE :: o_ext_strat_1020 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1180    'ext_strat_1020', 'Strat. aerosol extinction coefficient at 1020 nm', '1/m', (/ ('', i=1, 9) /))
     1181  TYPE(ctrl_out), SAVE :: o_tau_strat_550 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1182    'OD550_strat_only', 'Stratospheric Aerosol Optical depth at 550 nm ', '1', (/ ('', i=1, 9) /))
     1183  TYPE(ctrl_out), SAVE :: o_tau_strat_1020 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1184    'OD1020_strat_only', 'Stratospheric Aerosol Optical depth at 1020 nm ', '1', (/ ('', i=1, 9) /))
     1185  TYPE(ctrl_out), SAVE :: o_sulf_convert = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1186    'sulf_convert', 'SO2 mass flux converted to H2SO4', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1187  TYPE(ctrl_out), SAVE :: o_sulf_nucl = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1188    'sulf_nucl', 'H2SO4 nucleation mass flux', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1189  TYPE(ctrl_out), SAVE :: o_sulf_cond_evap = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1190    'sulf_cond_evap', 'H2SO4 condensation/evaporation mass flux', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1191  TYPE(ctrl_out), SAVE :: o_ocs_convert = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1192    'ocs_convert', 'OCS mass flux converted to SO2', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1193  TYPE(ctrl_out), SAVE :: o_R2SO4 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1194    'R2SO4', 'H2SO4 mass fraction in aerosol', '%', (/ ('', i=1, 9) /))
     1195  TYPE(ctrl_out), SAVE :: o_OCS_lifetime = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1196    'OCS_lifetime', 'OCS lifetime', 's', (/ ('', i=1, 9) /))
     1197  TYPE(ctrl_out), SAVE :: o_SO2_lifetime = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1198    'SO2_lifetime', 'SO2 lifetime', 's', (/ ('', i=1, 9) /))
     1199  TYPE(ctrl_out), SAVE :: o_SO2_backgr_tend = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1200    'SO2_backgr_tend', 'SO2 background tendency', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1201  TYPE(ctrl_out), SAVE :: o_OCS_backgr_tend = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1202    'OCS_backgr_tend', 'OCS background tendency', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1203  TYPE(ctrl_out), SAVE :: o_vsed_aer = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1204    'vsed_aer', 'Strat. aerosol sedimentation velocity (mass-weighted)', 'm/s', (/ ('', i=1, 9) /))
     1205  TYPE(ctrl_out), SAVE :: o_f_r_wet = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1206    'f_r_wet', 'Conversion factor dry to wet aerosol radius', '-', (/ ('', i=1, 9) /))
     1207  TYPE(ctrl_out), SAVE :: o_sulf_dep_dry = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1208    'sulf_dep_dry', 'Sulfur dry deposition flux', 'kg(S)/m2/s', (/ ('', i=1, 9) /))
     1209  TYPE(ctrl_out), SAVE :: o_sulf_dep_wet = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1210    'sulf_dep_wet', 'Sulfur wet deposition flux', 'kg(S)/m2/s', (/ ('', i=1, 9) /))
     1211  TYPE(ctrl_out), SAVE :: o_surf_PM25_sulf = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1212    'surf_PM25_sulf', 'Sulfate PM2.5 concentration at the surface', 'ug/m3', (/ ('', i=1, 9) /))
     1213  TYPE(ctrl_out), SAVE :: o_p_tropopause = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1214    'p_tropopause', 'Tropopause pressure', 'Pa', (/ ('', i=1, 9) /))
     1215  TYPE(ctrl_out), SAVE :: o_sfluxaer = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1216    'sflux', 'Ground sedimentation flux of strat. particles', 'kg(S)/m2/s', (/ ('', i=1, 9) /))
     1217#endif
    11761218
    11771219!!!!!!!!!!!!!!!!!!!!!! 3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

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

    r2665 r2690  
    427427            DO iq=nqo+1,nqtot
    428428            iiq=niadv(iq)
    429             o_trac(iq-nqo) = ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
     429            o_trac(iq-nqo) = ctrl_out((/ 1, 5, 5, 5, 10, 10, 11, 11, 11 /), &
    430430                           tname(iiq),'Tracer '//ttext(iiq), "-",  &
    431431                           (/ '', '', '', '', '', '', '', '', '' /))
    … …  
    500500                              (/ '', '', '', '', '', '', '', '', '' /))
    501501
    502             o_trac_cum(iq-nqo) = ctrl_out((/ 3, 4, 10, 10, 10, 10, 11, 11, 11 /), &
     502            o_trac_cum(iq-nqo) = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11 /), &
    503503                               'cum'//tname(iiq),&
    504504                               'Cumulated tracer '//ttext(iiq), "-", &

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

    r2670 r2690  
    182182         o_alt_tropo
    183183
     184#ifdef CPP_StratAer
     185    USE phys_output_ctrlout_mod, only:  &
     186         o_sulf_convert, o_sulf_nucl, o_sulf_cond_evap, o_ocs_convert, &
     187         o_sfluxaer, o_R2SO4, o_OCS_lifetime, o_SO2_lifetime, &
     188         o_OCS_backgr_tend, o_SO2_backgr_tend, o_sulf_dep_dry, o_sulf_dep_wet, &
     189         o_surf_PM25_sulf, o_ext_strat_550, o_tau_strat_550, &
     190         o_p_tropopause, o_vsed_aer, o_tau_strat_1020, o_ext_strat_1020, o_f_r_wet
     191#endif
    184192
    185193    USE phys_state_var_mod, only: pctsrf, paire_ter, rain_fall, snow_fall, &
    … …  
    273281         ep, epmax_diag ! epmax_cape
    274282
     283#ifdef CPP_StratAer
     284    USE phys_local_var_mod, only:  &
     285         sulf_convert, sulf_nucl, sulf_cond_evap, ocs_convert, &
     286         sfluxaer, R2SO4, OCS_lifetime, SO2_lifetime, &
     287         OCS_backgr_tend, SO2_backgr_tend, sulf_dep_dry, sulf_dep_wet, &
     288         surf_PM25_sulf, tau_strat_550, p_tropopause, tausum_strat, &
     289         vsed_aer, tau_strat_1020, f_r_wet
     290#endif
     291
    275292    USE phys_output_var_mod, only: vars_defined, snow_o, zfra_o, bils_diss, &
    276293         bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
    … …  
    292309         alt_tropo
    293310
    294  
    295 
    296311    USE ocean_slab_mod, only: nslay, tslab, slab_bils, slab_bilg, tice, &
    297312        seaice, slab_ekman,slab_hdiff, dt_ekman, dt_hdiff
    … …  
    370385    CALL set_itau_iophy(itau_w)
    371386
    372     IF(.NOT.vars_defined) THEN
     387    IF (.NOT.vars_defined) THEN
    373388       iinitend = 2
    374389    ELSE
    … …  
    381396       !$OMP MASTER
    382397       IF (vars_defined) THEN
    383           if (prt_level >= 10) then
     398          IF (prt_level >= 10) then
    384399             write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w
    385           endif
     400          ENDIF
    386401!          CALL xios_update_calendar(itau_w)
    387402          CALL xios_update_calendar(itap)
    388        END IF
     403       ENDIF
    389404       !$OMP END MASTER
    390405       !$OMP BARRIER
    … …  
    395410
    396411       zx_tmp_fi2d = cell_area
    397        if (is_north_pole_phy) then
     412       IF (is_north_pole_phy) then
    398413         zx_tmp_fi2d(1) = cell_area(1)/nbp_lon
    399        endif
    400        if (is_south_pole_phy) then
     414       ENDIF
     415       IF (is_south_pole_phy) then
    401416         zx_tmp_fi2d(klon) = cell_area(klon)/nbp_lon
    402        endif
     417       ENDIf
    403418       CALL histwrite_phy(o_aire, zx_tmp_fi2d)
    404419
    … …  
    779794       CALL histwrite_phy(o_uq, uq)
    780795       CALL histwrite_phy(o_vq, vq)
    781        IF(iflag_con.GE.3) THEN ! sb
     796       IF (iflag_con.GE.3) THEN ! sb
    782797          CALL histwrite_phy(o_cape, cape)
    783798          CALL histwrite_phy(o_pbase, ema_pcb)
    784799          CALL histwrite_phy(o_ptop, ema_pct)
    785800          CALL histwrite_phy(o_fbase, ema_cbmf)
    786           if (iflag_con /= 30) then
     801          IF (iflag_con /= 30) THEN
    787802             CALL histwrite_phy(o_plcl, plcl)
    788803             CALL histwrite_phy(o_plfc, plfc)
    789804             CALL histwrite_phy(o_wbeff, wbeff)
    790           end if
     805          ENDIF
    791806
    792807          CALL histwrite_phy(o_cape_max, cape)
    … …  
    799814          CALL histwrite_phy(o_ftime_con, zx_tmp_fi2d)
    800815          IF (vars_defined) THEN
    801              IF(iflag_thermals>=1)THEN
     816             IF (iflag_thermals>=1)THEN
    802817                zx_tmp_fi3d=dnwd+dnwd0+upwd+fm_therm(:,1:klev)
    803818             ELSE
    … …  
    850865          DO k=1, nlevSTD
    851866             bb2=clevSTD(k)
    852              IF(bb2.EQ."850".OR.bb2.EQ."700".OR. &
     867             IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
    853868                  bb2.EQ."500".OR.bb2.EQ."200".OR. &
    854869                  bb2.EQ."100".OR. &
    … …  
    871886#endif
    872887#ifdef CPP_XIOS
    873   IF(ok_all_xml) THEN
     888  IF (ok_all_xml) THEN
    874889!XIOS  CALL xios_get_field_attr("u850",default_value=missing_val)
    875890!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    877892          DO k=1, nlevSTD
    878893             bb2=clevSTD(k)
    879              IF(bb2.EQ."850".OR.bb2.EQ."700".OR. &
     894             IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
    880895                bb2.EQ."500".OR.bb2.EQ."200".OR. &
    881896                bb2.EQ."100".OR. &
    … …  
    9941009          ELSE
    9951010              CALL histwrite_phy(o_tslab, tslab(:,1:nslay))
    996           END IF
     1011          ENDIF
    9971012          IF (version_ocean=='sicINT') THEN
    9981013              CALL histwrite_phy(o_slab_bilg, slab_bilg)
    9991014              CALL histwrite_phy(o_slab_tice, tice)
    10001015              CALL histwrite_phy(o_slab_sic, seaice)
    1001           END IF
     1016          ENDIF
    10021017          IF (slab_hdiff) THEN
    10031018            IF (nslay.EQ.1) THEN
    … …  
    10061021            ELSE
    10071022                CALL histwrite_phy(o_slab_hdiff, dt_hdiff(:,1:nslay))
    1008             END IF
    1009           END IF
     1023            ENDIF
     1024          ENDIF
    10101025          IF (slab_ekman.GT.0) THEN
    10111026            IF (nslay.EQ.1) THEN
    … …  
    10141029            ELSE
    10151030                CALL histwrite_phy(o_slab_ekman, dt_ekman(:,1:nslay))
    1016             END IF
    1017           END IF
     1031            ENDIF
     1032          ENDIF
    10181033       ENDIF !type_ocean == force/slab
    10191034       CALL histwrite_phy(o_weakinv, weak_inversion)
    … …  
    10941109          ENDIF
    10951110          IF (flag_aerosol.GT.0.OR.flag_aerosol_strat.GT.0) THEN
    1096 !             DO naero = 1, naero_spc
    1097 !--correction mini bug OB
    10981111             DO naero = 1, naero_tot
    1099                 CALL histwrite_phy(o_tausumaero(naero), &
    1100                      tausum_aero(:,2,naero) )
     1112                CALL histwrite_phy(o_tausumaero(naero),tausum_aero(:,2,naero))
    11011113             END DO
    11021114          ENDIF
    11031115          IF (flag_aerosol_strat.GT.0) THEN
    1104              CALL histwrite_phy(o_tausumaero_lw, &
    1105                   tausum_aero(:,6,id_STRAT_phy) )
    1106           ENDIF
    1107        ENDIF
     1116             CALL histwrite_phy(o_tausumaero_lw,tausum_aero(:,6,id_STRAT_phy))
     1117          ENDIF
     1118       ENDIF
     1119#ifdef CPP_StratAer
     1120       IF (type_trac=='coag') THEN
     1121          CALL histwrite_phy(o_sulf_convert, sulf_convert)
     1122          CALL histwrite_phy(o_sulf_nucl, sulf_nucl)
     1123          CALL histwrite_phy(o_sulf_cond_evap, sulf_cond_evap)
     1124          CALL histwrite_phy(o_ocs_convert, ocs_convert)
     1125          CALL histwrite_phy(o_R2SO4, R2SO4)
     1126          CALL histwrite_phy(o_OCS_lifetime, OCS_lifetime)
     1127          CALL histwrite_phy(o_SO2_lifetime, SO2_lifetime)
     1128          CALL histwrite_phy(o_OCS_backgr_tend, OCS_backgr_tend)
     1129          CALL histwrite_phy(o_SO2_backgr_tend, SO2_backgr_tend)
     1130          CALL histwrite_phy(o_sulf_dep_dry, sulf_dep_dry)
     1131          CALL histwrite_phy(o_sulf_dep_wet, sulf_dep_wet)
     1132          CALL histwrite_phy(o_surf_PM25_sulf, surf_PM25_sulf)
     1133          CALL histwrite_phy(o_p_tropopause, p_tropopause)
     1134          CALL histwrite_phy(o_sfluxaer, sfluxaer)
     1135          CALL histwrite_phy(o_vsed_aer, vsed_aer)
     1136          CALL histwrite_phy(o_f_r_wet, f_r_wet)
     1137          CALL histwrite_phy(o_ext_strat_550, tau_strat_550)
     1138          CALL histwrite_phy(o_ext_strat_1020, tau_strat_1020)
     1139          CALL histwrite_phy(o_tau_strat_550, tausum_strat(:,1))
     1140          CALL histwrite_phy(o_tau_strat_1020, tausum_strat(:,2))
     1141       ENDIF
     1142#endif
    11081143       IF (ok_ade) THEN
    11091144          CALL histwrite_phy(o_topswad, topswad_aero*swradcorr)
    … …  
    11161151          CALL histwrite_phy(o_sollwad0, sollwad0_aero)
    11171152          !====MS forcing diagnostics
    1118           if (new_aod) then
     1153          IF (new_aod) THEN
    11191154             zx_tmp_fi2d(:)=topsw_aero(:,1)*swradcorr(:)
    11201155             CALL histwrite_phy(o_swtoaas_nat,zx_tmp_fi2d)
    … …  
    11351170             CALL histwrite_phy(o_swsrfcs_ant,zx_tmp_fi2d)
    11361171             !cf
    1137              if (.not. aerosol_couple) then
     1172             IF (.not. aerosol_couple) THEN
    11381173                zx_tmp_fi2d(:)=topswcf_aero(:,1)*swradcorr(:)
    11391174                CALL histwrite_phy(o_swtoacf_nat,zx_tmp_fi2d)
    … …  
    11481183                zx_tmp_fi2d(:)=solswcf_aero(:,3)*swradcorr(:)
    11491184                CALL histwrite_phy(o_swsrfcf_zero,zx_tmp_fi2d)
    1150              endif
    1151           endif ! new_aod
     1185             ENDIF
     1186          ENDIF ! new_aod
    11521187          !====MS forcing diagnostics
    11531188       ENDIF
    … …  
    12611296       CALL histwrite_phy(o_alb2, albsol2)
    12621297       !FH Sorties pour la couche limite
    1263        if (iflag_pbl>1) then
     1298       IF (iflag_pbl>1) THEN
    12641299          zx_tmp_fi3d=0.
    12651300          IF (vars_defined) THEN
    1266              do nsrf=1,nbsrf
    1267                 do k=1,klev
     1301             DO nsrf=1,nbsrf
     1302                DO k=1,klev
    12681303                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
    12691304                        +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
    1270                 enddo
    1271              enddo
     1305                ENDDO
     1306             ENDDO
    12721307          ENDIF
    12731308          CALL histwrite_phy(o_tke, zx_tmp_fi3d)
    … …  
    13251360       CALL histwrite_phy(o_dqcon2d, zx_tmp_fi2d)
    13261361
    1327        IF(iflag_thermals.EQ.0) THEN
     1362       IF (iflag_thermals.EQ.0) THEN
    13281363          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys
    13291364          CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d)
    1330        ELSE IF(iflag_thermals.GE.1.AND.iflag_wake.EQ.1) THEN
     1365       ELSE IF (iflag_thermals.GE.1.AND.iflag_wake.EQ.1) THEN
    13311366          IF (vars_defined) THEN
    13321367             zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys + &
    … …  
    13501385!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13511386       ! Sorties specifiques a la separation thermiques/non thermiques
    1352        if (iflag_thermals>=1) then
    1353           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscth(1:klon,1:klev)/pdtphys
     1387       IF (iflag_thermals>=1) THEN
     1388          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscth(1:klon,1:klev)/pdtphys
    13541389          CALL histwrite_phy(o_dtlscth, zx_tmp_fi3d)
    1355           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscst(1:klon,1:klev)/pdtphys
     1390          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscst(1:klon,1:klev)/pdtphys
    13561391          CALL histwrite_phy(o_dtlscst, zx_tmp_fi3d)
    1357           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys
     1392          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys
    13581393          CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d)
    13591394          CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    13601395          CALL histwrite_phy(o_dqlscth2d, zx_tmp_fi2d)
    1361           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys
     1396          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys
    13621397          CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d)
    13631398          CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    … …  
    13661401          CALL histwrite_phy(o_plulst, plul_st)
    13671402          IF (vars_defined) THEN
    1368              do k=1,klev
    1369                 do i=1,klon
    1370                    if (ptconvth(i,k)) then
     1403             DO k=1,klev
     1404                DO i=1,klon
     1405                   IF (ptconvth(i,k)) THEN
    13711406                      zx_tmp_fi3d(i,k)=1.
    1372                    else
     1407                   ELSE
    13731408                      zx_tmp_fi3d(i,k)=0.
    1374                    endif
    1375                 enddo
    1376              enddo
     1409                   ENDIF
     1410                ENDDO
     1411             ENDDO
    13771412          ENDIF
    13781413          CALL histwrite_phy(o_ptconvth, zx_tmp_fi3d)
    … …  
    13831418          ENDIF
    13841419          CALL histwrite_phy(o_lmaxth, zx_tmp_fi2d)
    1385        endif ! iflag_thermals>=1
     1420       ENDIF ! iflag_thermals>=1
    13861421!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13871422       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)/pdtphys
    13881423       CALL histwrite_phy(o_dtvdf, zx_tmp_fi3d)
    1389        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_diss(1:klon,1:klev)/pdtphys
     1424       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_diss(1:klon,1:klev)/pdtphys
    13901425       CALL histwrite_phy(o_dtdis, zx_tmp_fi3d)
    13911426       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys
    … …  
    14371472          CALL histwrite_phy(o_dqthe2d, zx_tmp_fi2d)
    14381473       ENDIF !iflag_thermals
    1439        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
     1474       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
    14401475       CALL histwrite_phy(o_dtajs, zx_tmp_fi3d)
    1441        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
     1476       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
    14421477       CALL histwrite_phy(o_dqajs, zx_tmp_fi3d)
    14431478       CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    14441479       CALL histwrite_phy(o_dqajs2d, zx_tmp_fi2d)
    1445        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys
     1480       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys
    14461481       CALL histwrite_phy(o_dtswr, zx_tmp_fi3d)
    1447        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_sw0(1:klon,1:klev)/pdtphys
     1482       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_sw0(1:klon,1:klev)/pdtphys
    14481483       CALL histwrite_phy(o_dtsw0, zx_tmp_fi3d)
    1449        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lwr(1:klon,1:klev)/pdtphys
     1484       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lwr(1:klon,1:klev)/pdtphys
    14501485       CALL histwrite_phy(o_dtlwr, zx_tmp_fi3d)
    1451        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lw0(1:klon,1:klev)/pdtphys
     1486       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lw0(1:klon,1:klev)/pdtphys
    14521487       CALL histwrite_phy(o_dtlw0, zx_tmp_fi3d)
    1453        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)/pdtphys
     1488       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)/pdtphys
    14541489       CALL histwrite_phy(o_dtec, zx_tmp_fi3d)
    1455        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_vdf(1:klon,1:klev)/pdtphys
     1490       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_vdf(1:klon,1:klev)/pdtphys
    14561491       CALL histwrite_phy(o_duvdf, zx_tmp_fi3d)
    1457        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_vdf(1:klon,1:klev)/pdtphys
     1492       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_vdf(1:klon,1:klev)/pdtphys
    14581493       CALL histwrite_phy(o_dvvdf, zx_tmp_fi3d)
    14591494       IF (ok_orodr) THEN
    1460           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_oro(1:klon,1:klev)/pdtphys
     1495          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_oro(1:klon,1:klev)/pdtphys
    14611496          CALL histwrite_phy(o_duoro, zx_tmp_fi3d)
    1462           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_oro(1:klon,1:klev)/pdtphys
     1497          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_oro(1:klon,1:klev)/pdtphys
    14631498          CALL histwrite_phy(o_dvoro, zx_tmp_fi3d)
    1464           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_oro(1:klon,1:klev)/pdtphys
     1499          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_oro(1:klon,1:klev)/pdtphys
    14651500          CALL histwrite_phy(o_dtoro, zx_tmp_fi3d)
    14661501       ENDIF
    14671502       IF (ok_orolf) THEN
    1468           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_lif(1:klon,1:klev)/pdtphys
     1503          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_lif(1:klon,1:klev)/pdtphys
    14691504          CALL histwrite_phy(o_dulif, zx_tmp_fi3d)
    14701505
    1471           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_lif(1:klon,1:klev)/pdtphys
     1506          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_lif(1:klon,1:klev)/pdtphys
    14721507          CALL histwrite_phy(o_dvlif, zx_tmp_fi3d)
    14731508
    1474           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lif(1:klon,1:klev)/pdtphys
     1509          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lif(1:klon,1:klev)/pdtphys
    14751510          CALL histwrite_phy(o_dtlif, zx_tmp_fi3d)
    14761511       ENDIF
    … …  
    14791514          CALL histwrite_phy(o_du_gwd_hines, du_gwd_hines/pdtphys)
    14801515          CALL histwrite_phy(o_dv_gwd_hines, dv_gwd_hines/pdtphys)
    1481           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys
     1516          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys
    14821517          CALL histwrite_phy(o_dthin, zx_tmp_fi3d)
    14831518          CALL histwrite_phy(o_ustr_gwd_hines, zustr_gwd_hines)
    14841519          CALL histwrite_phy(o_vstr_gwd_hines, zvstr_gwd_hines)
    1485        end IF
    1486 
    1487        if (.not. ok_hines .and. ok_gwd_rando) then
     1520       ENDIF
     1521
     1522       IF (.not. ok_hines .and. ok_gwd_rando) THEN
    14881523          CALL histwrite_phy(o_du_gwd_front, du_gwd_front / pdtphys)
    14891524          CALL histwrite_phy(o_dv_gwd_front, dv_gwd_front / pdtphys)
    … …  
    14921527       ENDIF
    14931528
    1494        IF (ok_gwd_rando) then
     1529       IF (ok_gwd_rando) THEN
    14951530          CALL histwrite_phy(o_du_gwd_rando, du_gwd_rando / pdtphys)
    14961531          CALL histwrite_phy(o_dv_gwd_rando, dv_gwd_rando / pdtphys)
    … …  
    14991534          CALL histwrite_phy(o_east_gwstress, east_gwstress )
    15001535          CALL histwrite_phy(o_west_gwstress, west_gwstress )
    1501        end IF
    1502 
    1503        IF (ok_qch4) then
     1536       ENDIF
     1537
     1538       IF (ok_qch4) THEN
    15041539          CALL histwrite_phy(o_dqch4, d_q_ch4 / pdtphys)
    15051540       ENDIF
    … …  
    15271562       CALL histwrite_phy(o_rldcs, lwdn0)
    15281563
    1529        IF(vars_defined) THEN
     1564       IF (vars_defined) THEN
    15301565          zx_tmp_fi3d(1:klon,1:klev)=d_t(1:klon,1:klev)+ &
    15311566               d_t_dyn(1:klon,1:klev)
    … …  
    15331568       CALL histwrite_phy(o_tnt, zx_tmp_fi3d)
    15341569
    1535        IF(vars_defined) THEN
     1570       IF (vars_defined) THEN
    15361571          zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys + &
    15371572               d_t_lwr(1:klon,1:klev)/pdtphys
    15381573       ENDIF
    15391574       CALL histwrite_phy(o_tntr, zx_tmp_fi3d)
    1540        IF(vars_defined) THEN
     1575       IF (vars_defined) THEN
    15411576          zx_tmp_fi3d(1:klon,1:klev)= (d_t_lsc(1:klon,1:klev)+ &
    15421577               d_t_eva(1:klon,1:klev)+ &
    … …  
    15441579       ENDIF
    15451580       CALL histwrite_phy(o_tntscpbl, zx_tmp_fi3d)
    1546        IF(vars_defined) THEN
     1581       IF (vars_defined) THEN
    15471582          zx_tmp_fi3d(1:klon,1:klev)=d_qx(1:klon,1:klev,ivap)+ &
    15481583               d_q_dyn(1:klon,1:klev)
    15491584       ENDIF
    15501585       CALL histwrite_phy(o_tnhus, zx_tmp_fi3d)
    1551        IF(vars_defined) THEN
     1586       IF (vars_defined) THEN
    15521587          zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys+ &
    15531588               d_q_eva(1:klon,1:klev)/pdtphys
    … …  
    15551590       CALL histwrite_phy(o_tnhusscpbl, zx_tmp_fi3d)
    15561591       CALL histwrite_phy(o_evu, coefm(:,:,is_ave))
    1557        IF(vars_defined) THEN
     1592       IF (vars_defined) THEN
    15581593          zx_tmp_fi3d(1:klon,1:klev)=q_seri(1:klon,1:klev)+ &
    15591594               ql_seri(1:klon,1:klev)
    15601595       ENDIF
    15611596       CALL histwrite_phy(o_h2o, zx_tmp_fi3d)
    1562        if (iflag_con >= 3) then
    1563           IF(vars_defined) THEN
     1597       IF (iflag_con >= 3) THEN
     1598          IF (vars_defined) THEN
    15641599             zx_tmp_fi3d(1:klon,1:klev)=-1 * (dnwd(1:klon,1:klev)+ &
    15651600                  dnwd0(1:klon,1:klev))
    15661601          ENDIF
    15671602          CALL histwrite_phy(o_mcd, zx_tmp_fi3d)
    1568           IF(vars_defined) THEN
     1603          IF (vars_defined) THEN
    15691604             zx_tmp_fi3d(1:klon,1:klev)=upwd(1:klon,1:klev) + &
    15701605                  dnwd(1:klon,1:klev)+ dnwd0(1:klon,1:klev)
    15711606          ENDIF
    15721607          CALL histwrite_phy(o_dmc, zx_tmp_fi3d)
    1573        else if (iflag_con == 2) then
     1608       ELSE IF (iflag_con == 2) THEN
    15741609          CALL histwrite_phy(o_mcd,  pmfd)
    15751610          CALL histwrite_phy(o_dmc,  pmfu + pmfd)
    1576        end if
     1611       ENDIF
    15771612       CALL histwrite_phy(o_ref_liq, ref_liq)
    15781613       CALL histwrite_phy(o_ref_ice, ref_ice)
    1579        if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
     1614       IF (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
    15801615            RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
    15811616            RCFC12_per.NE.RCFC12_act) THEN
    1582           IF(vars_defined) zx_tmp_fi2d(:) = swupp(:,klevp1)*swradcorr(:)
     1617          IF (vars_defined) zx_tmp_fi2d(:) = swupp(:,klevp1)*swradcorr(:)
    15831618          CALL histwrite_phy(o_rsut4co2, zx_tmp_fi2d)
    1584           IF(vars_defined) zx_tmp_fi2d(:) = lwupp(:,klevp1)
     1619          IF (vars_defined) zx_tmp_fi2d(:) = lwupp(:,klevp1)
    15851620          CALL histwrite_phy(o_rlut4co2, zx_tmp_fi2d)
    1586           IF(vars_defined) zx_tmp_fi2d(:) = swup0p(:,klevp1)*swradcorr(:)
     1621          IF (vars_defined) zx_tmp_fi2d(:) = swup0p(:,klevp1)*swradcorr(:)
    15871622          CALL histwrite_phy(o_rsutcs4co2, zx_tmp_fi2d)
    1588           IF(vars_defined) zx_tmp_fi2d(:) = lwup0p(:,klevp1)
     1623          IF (vars_defined) zx_tmp_fi2d(:) = lwup0p(:,klevp1)
    15891624          CALL histwrite_phy(o_rlutcs4co2, zx_tmp_fi2d)
    15901625          DO k=1, klevp1
    … …  
    16261661          CALL histwrite_phy(o_va,vwriteSTD(:,:,iff-6),iff)
    16271662          CALL histwrite_phy(o_wap,wwriteSTD(:,:,iff-6),iff)
    1628           IF(vars_defined) THEN
     1663          IF (vars_defined) THEN
    16291664             DO k=1, nlevSTD
    16301665                DO i=1, klon
    1631                    IF(tnondef(i,k,iff-6).NE.missing_val) THEN
    1632                       IF(freq_outNMC(iff-6).LT.0) THEN
     1666                   IF (tnondef(i,k,iff-6).NE.missing_val) THEN
     1667                      IF (freq_outNMC(iff-6).LT.0) THEN
    16331668                         freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6)
    16341669                      ELSE
    … …  
    16431678          ENDIF
    16441679          CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD,iff)
    1645           IF(vars_defined) THEN
     1680          IF (vars_defined) THEN
    16461681             DO k=1, nlevSTD
    16471682                DO i=1, klon
    1648                    IF(O3sumSTD(i,k,iff-6).NE.missing_val) THEN
     1683                   IF (O3sumSTD(i,k,iff-6).NE.missing_val) THEN
    16491684                      zx_tmp_fi3d_STD(i,k) = O3sumSTD(i,k,iff-6) * 1.e+9
    16501685                   ELSE
    … …  
    16551690          ENDIF
    16561691          CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD,iff)
    1657           if (read_climoz == 2) THEN
    1658              IF(vars_defined) THEN
     1692          IF (read_climoz == 2) THEN
     1693             IF (vars_defined) THEN
    16591694                DO k=1, nlevSTD
    16601695                   DO i=1, klon
    1661                       IF(O3daysumSTD(i,k,iff-6).NE.missing_val) THEN
     1696                      IF (O3daysumSTD(i,k,iff-6).NE.missing_val) THEN
    16621697                         zx_tmp_fi3d_STD(i,k) = O3daysumSTD(i,k,iff-6) * 1.e+9
    16631698                      ELSE
    … …  
    16831718#endif
    16841719#ifdef CPP_XIOS
    1685   IF(ok_all_xml) THEN
     1720  IF (ok_all_xml) THEN
    16861721!      DO iff=7, nfiles
    16871722
    … …  
    16941729          CALL histwrite_phy(o_va,vlevSTD(:,:))
    16951730          CALL histwrite_phy(o_wap,wlevSTD(:,:))
    1696 !         IF(vars_defined) THEN
     1731!         IF (vars_defined) THEN
    16971732!            DO k=1, nlevSTD
    16981733!               DO i=1, klon
    1699 !                  IF(tnondef(i,k,3).NE.missing_val) THEN
    1700 !                     IF(freq_outNMC(iff-6).LT.0) THEN
     1734!                  IF (tnondef(i,k,3).NE.missing_val) THEN
     1735!                     IF (freq_outNMC(iff-6).LT.0) THEN
    17011736!                        freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6)
    17021737!                     ELSE
    … …  
    17111746!         ENDIF
    17121747!         CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD)
    1713           IF(vars_defined) THEN
     1748          IF (vars_defined) THEN
    17141749             DO k=1, nlevSTD
    17151750                DO i=1, klon
    1716                    IF(O3STD(i,k).NE.missing_val) THEN
     1751                   IF (O3STD(i,k).NE.missing_val) THEN
    17171752                      zx_tmp_fi3d_STD(i,k) = O3STD(i,k) * 1.e+9
    17181753                   ELSE
    … …  
    17231758          ENDIF
    17241759          CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD)
    1725           if (read_climoz == 2) THEN
    1726              IF(vars_defined) THEN
     1760          IF (read_climoz == 2) THEN
     1761             IF (vars_defined) THEN
    17271762                DO k=1, nlevSTD
    17281763                   DO i=1, klon
    1729                       IF(O3daySTD(i,k).NE.missing_val) THEN
     1764                      IF (O3daySTD(i,k).NE.missing_val) THEN
    17301765                         zx_tmp_fi3d_STD(i,k) = O3daySTD(i,k) * 1.e+9
    17311766                      ELSE
    … …  
    17361771             ENDIF
    17371772             CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD)
    1738           endif
     1773          ENDIF
    17391774          CALL histwrite_phy(o_uxv,uvSTD(:,:))
    17401775          CALL histwrite_phy(o_vxq,vqSTD(:,:))
    … …  
    17511786!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    17521787        IF (nqtot.GE.nqo+1) THEN
    1753             DO iq=nqo+1,nqtot
    1754               IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
    1755 
    1756 !jyg<
    1757 !!             CALL histwrite_phy(o_trac(iq-nqo), qx(:,:,iq))
     1788          DO iq=nqo+1,nqtot
     1789            IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN
    17581790             CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    1759 !>jyg
    17601791             CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    17611792             CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
    … …  
    17721803             CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))
    17731804             zx_tmp_fi2d=0.
    1774              IF(vars_defined) THEN
     1805             IF (vars_defined) THEN
    17751806                DO k=1,klev
    1776 !jyg<
    1777 !!                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*qx(:,k,iq)
    17781807                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
    1779 !>jyg
    17801808                ENDDO
    17811809             ENDIF
    17821810             CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
    1783              endif
    1784           ENDDO
    1785        ENDIF
    1786 
    1787        IF(.NOT.vars_defined) THEN
     1811            ENDIF
     1812          ENDDO
     1813       ENDIF
     1814
     1815       IF (.NOT.vars_defined) THEN
    17881816          !$OMP MASTER
    17891817#ifndef CPP_IOIPSL_NO_OUTPUT
    … …  
    18011829          CALL wxios_closedef()
    18021830#endif
    1803 
    18041831          !$OMP END MASTER
    18051832          !$OMP BARRIER
    18061833          vars_defined = .TRUE.
    1807 
    1808        END IF
    1809 
    1810     END DO
    1811 
    1812     IF(vars_defined) THEN
     1834       ENDIF
     1835
     1836    ENDDO
     1837
     1838    IF (vars_defined) THEN
    18131839       ! On synchronise les fichiers pour IOIPSL
    18141840#ifndef CPP_IOIPSL_NO_OUTPUT
    … …  
    18231849    ENDIF
    18241850
    1825 
    18261851  END SUBROUTINE phys_output_write
    18271852

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

    r2684 r2690  
    745745    REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
    746746    REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
    747 
    748     !
    749     !  REAL zxsnow(klon)
     747    !
    750748    REAL zxsnow_dummy(klon)
    751749    REAL zsav_tsol(klon)
    … …  
    763761    real zqsat(klon,klev)
    764762    !
    765     INTEGER i, k, iq, ig, j, nsrf, ll, l, iiq
     763    INTEGER i, k, iq, j, nsrf, ll, l
    766764    !
    767765    REAL t_coup
    … …  
    884882    !IM 141004 END
    885883    !IM 190504 BEG
    886     INTEGER ij
    887884    !  INTEGER imp1jmp1
    888885    !  PARAMETER(imp1jmp1=(iim+1)*jjmp1)
    … …  
    893890    LOGICAL ok_msk
    894891    REAL msk(klon)
    895     !IM
    896     REAL airetot, pi
    897892    !ym A voir plus tard
    898893    !ym      REAL zm_wo(jjmp1, klev)
    … …  
    932927    !$OMP THREADPRIVATE(ok_sync)
    933928    real date0
    934     integer idayref
    935929
    936930    ! essai writephys
    … …  
    953947    DATA      ip_ebil/0/
    954948    !$OMP THREADPRIVATE(ip_ebil)
    955     INTEGER   if_ebil ! level for energy conserv. dignostics
    956     SAVE      if_ebil
    957     !$OMP THREADPRIVATE(if_ebil)
    958949    REAL q2m(klon,nbsrf)  ! humidite a 2m
    959950
    … …  
    34833474          ELSE
    34843475#ifdef CPP_RRTM
     3476#ifndef CPP_StratAer
     3477          !--prescribed strat aerosols
     3478          !--only in the case of non-interactive strat aerosols
    34853479            IF (flag_aerosol_strat.EQ.1) THEN
    34863480             CALL readaerosolstrato1_rrtm(debut)
    … …  
    34923486             CALL abort_physic(modname,abort_message,1)
    34933487            ENDIF
     3488#endif
    34943489#else
    34953490             abort_message='You should compile with -rrtm if running ' &
    … …  
    34993494          ENDIF
    35003495       ENDIF
     3496!
     3497#ifdef CPP_RRTM
     3498#ifdef CPP_StratAer
     3499       !--interactive strat aerosols
     3500       CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
     3501#endif
     3502#endif
    35013503       !--fin STRAT AEROSOL
    35023504       !     

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

    r2637 r2690  
    9797    USE tracreprobus_mod
    9898    USE indice_sol_mod
    99 
    10099    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    101100    USE print_control_mod, ONLY: lunout
    102101    USE aero_mod, ONLY : naero_grp
     102
     103#ifdef CPP_StratAer
     104    USE traccoag_mod
     105    USE phys_local_var_mod, ONLY: mdw, sulf_dep_dry, sulf_dep_wet
     106    USE infotrac, ONLY: nbtr_sulgas, id_SO2_strat, id_H2SO4_strat
     107    USE aerophys
     108#endif
    103109
    104110    IMPLICIT NONE
    … …  
    208214    !--------------
    209215    !
    210     !
    211216    REAL,DIMENSION(:),INTENT(IN)   :: cdragh          ! (klon) coeff drag pour T et Q
    212217    REAL,DIMENSION(:,:),INTENT(IN) :: coefh           ! (klon,klev) coeff melange CL (m**2/s)
    … …  
    215220    REAL,DIMENSION(:),INTENT(IN)   :: yu1             ! (klon) vents au premier niveau
    216221    REAL,DIMENSION(:),INTENT(IN)   :: yv1             ! (klon) vents au premier niveau
    217 
    218222    !
    219223    !Lessivage:
    … …  
    238242    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
    239243
    240 
     244#ifdef CPP_StratAer
     245    REAL,DIMENSION(klon)           :: v_dep_dry !dry deposition velocity of stratospheric sulfate in m/s
     246#endif
    241247    ! Output argument
    242248    !----------------
    243249    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
    244250    REAL,DIMENSION(klon,klev)                    :: sourceBE
     251
    245252    !=======================================================================================
    246253    !                        -- LOCAL VARIABLES --
    … …  
    267274    INTEGER                   :: itau_w      ! pas de temps ecriture = nstep + itau_phy
    268275    LOGICAL,PARAMETER         :: ok_sync=.TRUE.
    269 
    270276    !
    271277    ! Nature du traceur
    … …  
    456462       CASE('repr')
    457463          source(:,:)=0.
     464#ifdef CPP_StratAer
     465       CASE('coag')
     466          source(:,:)=0.
     467          DO it= 1, nbtr_sulgas
     468            aerosol(it)=.FALSE.
     469            IF (it==id_H2SO4_strat) aerosol(it)=.TRUE.
     470          ENDDO
     471          DO it= nbtr_sulgas+1, nbtr
     472            aerosol(it)=.TRUE.
     473          ENDDO
     474#endif
    458475       END SELECT
    459476
    … …  
    504521                !--for now we do not scavenge in cvltr
    505522                flag_cvltr(it)=.false.
     523
     524#ifdef CPP_StratAer
     525             CASE('coag')
     526                IF (convscav.and.aerosol(it)) THEN
     527                   flag_cvltr(it)=.true.
     528                   ccntrAA(it) =ccntrAA_in   
     529                   ccntrENV(it)=ccntrENV_in
     530                   coefcoli(it)=coefcoli_in
     531                ELSE
     532                   flag_cvltr(it)=.false.
     533                ENDIF
     534#endif
     535
    506536             END SELECT
    507537          ENDDO
    … …  
    572602       ! Appel fait en fin de phytrac pour avoir les emissions modifiees par
    573603       ! la couche limite et la convection avant le calcul de la chimie
     604
    574605    CASE('repr')
    575606       !   -- CHIMIE REPROBUS --
    576 
    577607       CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
    578608            presnivs, xlat, xlon, pphis, pphi, &
    … …  
    580610            tr_seri)
    581611
     612#ifdef CPP_StratAer
     613    CASE('coag')
     614       !   --STRATOSPHERIC AER IN THE STRAT --
     615       CALL traccoag(pdtphys, gmtime, debutphy, julien, &
     616            presnivs, xlat, xlon, pphis, pphi, &
     617            t_seri, pplay, paprs, sh, rh , &
     618            tr_seri)
     619#endif
     620
    582621    END SELECT
    583622    !======================================================================
    … …  
    591630          IF (iflag_con.LT.2) THEN
    592631             !--pas de transport convectif
    593 
    594632             d_tr_cv(:,:,it)=0.
     633
    595634          ELSE IF (iflag_con.EQ.2) THEN
    596635             !--ancien transport convectif de Tiedtke
    … …  
    648687
    649688       END DO ! nbtr
     689
     690#ifdef CPP_StratAer
     691       IF (type_trac=='coag') THEN
     692         ! initialize wet deposition flux of sulfur
     693         sulf_dep_wet(:)=0.0
     694         ! compute wet deposition flux of sulfur (sum over gases and particles)
     695         ! and convert to kg(S)/m2/s
     696         DO i = 1, klon
     697         DO k = 1, klev
     698         DO it = 1, nbtr
     699         !do not include SO2 because most of it comes trom the troposphere
     700           IF (it==id_H2SO4_strat) THEN
     701             sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol) &
     702                            & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     703           ELSEIF (it.GT.nbtr_sulgas) THEN
     704             sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol)  &
     705                            & *dens_aer_dry*4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3 &
     706                            & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     707           ENDIF
     708         ENDDO
     709         ENDDO
     710         ENDDO
     711       ENDIF
     712#endif
    650713
    651714    END IF ! convection
    … …  
    692755       !  Injection during BL mixing
    693756       !
     757#ifdef CPP_StratAer
     758       IF (type_trac=='coag') THEN
     759
     760         ! initialize dry deposition flux of sulfur
     761         sulf_dep_dry(:)=0.0
     762
     763         ! compute dry deposition velocity as function of surface type (numbers
     764         ! from IPSL note 23, 2002)
     765         v_dep_dry(:) =  pctsrf(:,is_ter) * 2.5e-3 &
     766                     & + pctsrf(:,is_oce) * 0.5e-3 &
     767                     & + pctsrf(:,is_lic) * 2.5e-3 &
     768                     & + pctsrf(:,is_sic) * 2.5e-3
     769
     770         ! compute surface dry deposition flux
     771         zrho(:,1)=pplay(:,1)/t_seri(:,1)/RD
     772
     773         DO it=1, nbtr
     774          source(:,it) = - v_dep_dry(:) * tr_seri(:,1,it) * zrho(:,1)
     775         ENDDO
     776
     777       ENDIF
     778#endif
     779
    694780       DO it=1, nbtr
    695781          !
    … …  
    703789             tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it)
    704790             !
    705           END IF
     791#ifdef CPP_StratAer
     792             IF (type_trac=='coag') THEN
     793               ! compute dry deposition flux of sulfur (sum over gases and particles)
     794               IF (it==id_H2SO4_strat) THEN
     795                 sulf_dep_dry(:)=sulf_dep_dry(:)-source(:,it)*(mSatom/mH2SO4mol)
     796               ELSEIF (it.GT.nbtr_sulgas) THEN
     797                 sulf_dep_dry(:)=sulf_dep_dry(:)-source(:,it)*(mSatom/mH2SO4mol)*dens_aer_dry &
     798                                & *4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3
     799               ENDIF
     800             ENDIF
     801#endif
     802             !
     803          ENDIF
    706804          !
    707        END DO
     805       ENDDO
    708806       !
    709807    ELSE IF (iflag_vdf_trac==0) THEN
    … …  
    720818       !
    721819       ! Nothing happens
    722        !
    723820       d_tr_cl=0.
    724821       !
    … …  
    772869
    773870          END DO  !tr
     871
     872#ifdef CPP_StratAer
     873         IF (type_trac=='coag') THEN
     874           ! compute wet deposition flux of sulfur (sum over gases and
     875           ! particles) and convert to kg(S)/m2/s
     876           ! adding contribution of d_tr_ls to d_tr_cv (above)
     877           DO i = 1, klon
     878           DO k = 1, klev
     879           DO it = 1, nbtr
     880             IF (it==id_H2SO4_strat) THEN
     881               sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol) &
     882                              & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     883             ELSEIF (it.GT.nbtr_sulgas) THEN
     884               sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol)  &
     885                              & *dens_aer_dry*4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3 &
     886                              & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     887             ENDIF
     888           ENDDO
     889           ENDDO
     890           ENDDO
     891         ENDIF
     892#endif
    774893
    775894       ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl
Note: See TracChangeset for help on using the changeset viewer.