SUBROUTINE phytracr_spl ( debutphy, iflag_conv, I pdtphys,ftsol,tsol, I t_seri,q_seri,paprs,pplay,RHcl, I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, I coefh, cdragh, cdragm, yu1, yv1, I u_seri, v_seri, xlat,xlon, I pphis,pctsrf,pmflxr,pmflxs,prfl,psfl, I da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij, I epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con, I evap,wdtrainA, wdtrainM,wght_cvfd, I fm_therm, entr_therm, rneb, I beta_fisrt,beta_v1, P scale_param_ssacc, P scale_param_sscoa,scale_param_ind, P scale_param_bb,scale_param_ff, P scale_param_dustacc,scale_param_dustcoa, E dust_ec,u10m_ec,v10m_ec, E lmt_sea_salt, E lmt_so2ff_l,lmt_so2ff_h, lmt_so2nff,lmt_so2ba, E lmt_so2bb_l, lmt_so2bb_h, E lmt_so2volc_cont,lmt_altvolc_cont, E lmt_so2volc_expl,lmt_altvolc_expl, E lmt_dmsbio,lmt_h2sbio,lmt_dmsconc, E lmt_bcff,lmt_bcnff,lmt_bcbb_l,lmt_bcbb_h, E lmt_bcba,lmt_omff,lmt_omnff,lmt_ombb_l, E lmt_ombb_h,lmt_omnat,lmt_omba, O tr_seri, O diff_aod550_tot,diag_aod865_tot, O diff_aod550_tr2,diag_aod865_tr2, O diag_aod550_dust,diag_aod865_dust, O diag_aod550_ss,diag_aod865_ss) ! E wth,cly,zprecipinsoil,lmt_sea_salt, ! Titane c USE IOIPSL USE dimphy USE infotrac USE indice_sol_mod c IMPLICIT none c c====================================================================== c Auteur(s) FH c Objet: Moniteur general des tendances traceurs c c Remarques en vrac: c ------------------ c 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien c les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide) c====================================================================== #include "dimensions.h" #include "chem.h" #include "../phylmd/YOMCST.h" #include "../phylmd/YOETHF.h" c #include "../phylmd/dimphy.h" c #include "../phylmd/indicesol.h" #include "paramet.h" #include "thermcell.h" c====================================================================== c Arguments: c c EN ENTREE: c ========== c c divers: c ------- c real,intent(in) :: pdtphys ! pas d'integration pour la physique (seconde) real, intent(in) :: ftsol(klon,nbsrf) ! temperature du sol par type real , intent(in) :: tsol(klon) ! temperature du sol moyenne real, intent(in) :: t_seri(klon,klev) ! temperature real, intent(in) :: u_seri(klon,klev) ! vent real , intent(in) :: v_seri(klon,klev) ! vent real , intent(in) :: q_seri(klon,klev) ! vapeur d eau kg/kg real tr_seri(klon,klev,nbtr) ! traceur real tmp_var(klon,klev) ! auxiliary variable to replace traceur real tmp_var2(klon,nbtr) ! auxiliary variable to replace source real tmp_var3(klon,klev,nbtr) ! auxiliary variable 3D real dummy1d ! JE auxiliary variable real aux_var2(klon) ! auxiliary variable to replace traceur real aux_var3(klon,klev) ! auxiliary variable to replace traceur real d_tr(klon,klev,nbtr) ! traceur tendance real sconc_seri(klon,nbtr) ! surface concentration of traceur c integer nbjour save nbjour c REAL diff_aod550_tot(klon) ! epaisseur optique total aerosol 550 nm REAL diag_aod670_tot(klon) ! epaisseur optique total aerosol 670 nm REAL diag_aod865_tot(klon) ! epaisseur optique total aerosol 865 nm REAL diff_aod550_tr2(klon) ! epaisseur optique Traceur 2 aerosol 550 nm, diagnostic REAL diag_aod670_tr2(klon) ! epaisseur optique Traceur 2 aerosol 670 nm, diagnostic REAL diag_aod865_tr2(klon) ! epaisseur optique Traceur 2 aerosol 865 nm, diagnostic REAL diag_aod550_ss(klon) ! epaisseur optique Sels marins aerosol 550 nm, diagnostic REAL diag_aod670_ss(klon) ! epaisseur optique Sels marins aerosol 670 nm, diagnostic REAL diag_aod865_ss(klon) ! epaisseur optique Sels marins aerosol 865 nm, diagnostic REAL diag_aod550_dust(klon) ! epaisseur optique Dust aerosol 550 nm, diagnostic REAL diag_aod670_dust(klon) ! epaisseur optique Dust aerosol 670 nm, diagnostic REAL diag_aod865_dust(klon) ! epaisseur optique Dust aerosol 865 nm, diagnostic c real , intent(in) :: paprs(klon,klev+1) ! pression pour chaque inter-couche (en Pa) real , intent(in) :: pplay(klon,klev) ! pression pour le mileu de chaque couche (en Pa) real , intent(in) :: RHcl(klon,klev) ! humidite relativen ciel clair real znivsig(klev) ! indice des couches real paire(klon) real, intent(in) :: pphis(klon) real, intent(in) :: pctsrf(klon,nbsrf) logical , intent(in) :: debutphy ! le flag de l'initialisation de la physique c c Scaling Parameters: c ---------------------- c CHARACTER*33 c_Directory CHARACTER*33 c_FileName1 CHARACTER*42 c_FileName2 CHARACTER*71 c_FullName1 CHARACTER*77 c_FullName2 INTEGER :: xidx, yidx INTEGER,DIMENSION(klon) :: mask_bbreg INTEGER,DIMENSION(klon) :: mask_ffso2reg INTEGER :: aux_mask1 INTEGER :: aux_mask2 INTEGER iregion_so4(klon) !Defines regions for SO4 INTEGER iregion_ind(klon) !Defines regions for SO2, BC & OM INTEGER iregion_bb(klon) !Defines regions for SO2, BC & OM INTEGER iregion_dust(klon) !Defines dust regions c REAL scale_param_sulf(jjm+1) !Scaling parameter for sulfate (input) c REAL scale_param_so4(klon) !Scaling parameter for sulfate used whithin phytrac REAL scale_param_ssacc !Scaling parameter for Fine Sea Salt REAL scale_param_sscoa !Scaling parameter for Coarse Sea Salt REAL scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissionsi of SO2 REAL scale_param_bb(nbreg_bb) !Scaling parameter for biomas burning (SO2, BC & OM) REAL scale_param_ff(nbreg_ind) !Scaling parameter for industrial emissions (fossil fuel) REAL scale_param_dustacc(nbreg_dust) !Scaling parameter for Fine Dust REAL scale_param_dustcoa(nbreg_dust) !Scaling parameter for Coarse Dust c c Emissions: c --------- c c---------------------------- SEA SALT & DUST emissions ------------------------ REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um REAL u10m_ec1(klon),v10m_ec1(klon) REAL u10m_ec2(klon),v10m_ec2(klon),dust_ec2(klon) REAL dust_ec(klon) ! REAL cly(klon),wth(klon),zprecipinsoil(klon) ! Titane c------------------------- SULFUR emissions ---------------------------- REAL lmt_so2volc_cont(klon) ! emissions so2 volcan (continuous) REAL lmt_altvolc_cont(klon) ! altitude so2 volcan (continuous) REAL lmt_so2volc_expl(klon) ! emissions so2 volcan (explosive) REAL lmt_altvolc_expl(klon) ! altitude so2 volcan (explosive) REAL lmt_so2ff_l(klon) ! emissions so2 fossil fuel (low) REAL lmt_so2ff_h(klon) ! emissions so2 fossil fuel (high) REAL lmt_so2nff(klon) ! emissions so2 non-fossil fuel REAL lmt_so2bb_l(klon) ! emissions de so2 biomass burning (low) REAL lmt_so2bb_h(klon) ! emissions de so2 biomass burning (high) REAL lmt_so2ba(klon) ! emissions de so2 bateau REAL lmt_dms(klon) ! emissions de dms REAL lmt_dmsconc(klon) ! concentration de dms oceanique REAL lmt_dmsbio(klon) ! emissions de dms bio REAL lmt_h2sbio(klon) ! emissions de h2s bio c------------------------- BLACK CARBON emissions ---------------------- REAL lmt_bcff(klon) ! emissions de BC fossil fuels REAL lmt_bcnff(klon) ! emissions de BC non-fossil fuels REAL lmt_bcbb_l(klon) ! emissions de BC biomass basses REAL lmt_bcbb_h(klon) ! emissions de BC biomass hautes REAL lmt_bcba(klon) ! emissions de BC bateau c------------------------ ORGANIC MATTER emissions --------------------- REAL lmt_omff(klon) ! emissions de OM fossil fuels REAL lmt_omnff(klon) ! emissions de OM non-fossil fuels REAL lmt_ombb_l(klon) ! emissions de OM biomass basses REAL lmt_ombb_h(klon) ! emissions de OM biomass hautes REAL lmt_omnat(klon) ! emissions de OM Natural REAL lmt_omba(klon) ! emissions de OM bateau c c Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h c c convection: c ----------- c REAL , intent(in) :: pmfu(klon,klev) ! flux de masse dans le panache montant REAL , intent(in) :: pmfd(klon,klev) ! flux de masse dans le panache descendant REAL, intent(in) :: pen_u(klon,klev) ! flux entraine dans le panache montant REAL, intent(in) :: pde_u(klon,klev) ! flux detraine dans le panache montant REAL, intent(in) :: pen_d(klon,klev) ! flux entraine dans le panache descendant REAL, intent(in) :: pde_d(klon,klev) ! flux detraine dans le panache descendant c c Convection KE scheme: c --------------------- c c! Variables pour le lessivage convectif REAL,DIMENSION(klon,klev),INTENT(IN) :: da REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2 REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam REAL,DIMENSION(klon,klev),INTENT(IN) :: mp REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated c updraft mass flux REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated c downdraft mass flux INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con REAL,DIMENSION(klon,klev),INTENT(IN) :: evap REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM REAL,DIMENSION(klon,klev),INTENT(IN) :: ep REAL,DIMENSION(klon),INTENT(IN) :: sigd REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij REAL,DIMENSION(klon,klev),INTENT(IN) :: clw REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL c KE: Tendances de traceurs (Td) et flux de traceurs: ! ------------------------ REAL,DIMENSION(klon,klev) :: Mint REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a REAL,DIMENSION(klon,klev,nbtr) :: zmfdam REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2 REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra c dans pluie,air descente insaturee REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qTrdi,dtrcvMA ! conc traceur c descente air insaturee et td convective MA REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv ! Td convection/traceur REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th ! Td thermique REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: qPrls !jyg: concentration ! !tra dans pluie LS a la surf. ! outputs for cvltr_spl REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv_o REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp_o REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav_o REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat_o REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav_o INTEGER :: nsplit ! !CHECK!! !!!$OMP !!!!THREADPRIVATE(qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa,d_tr_lessi_nucl) !!!!$OMP THREADPRIVATE(d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qPr,qDi) !$OMP THREADPRIVATE(d_tr_insc,d_tr_bcscav,d_tr_evapls,d_tr_ls,qPrls) !!!!!$OMP THREADPRIVATE(d_tr,d_tr_cl,d_tr_dry,flux_tr_dry,d_tr_dec,d_tr_cv) c c Lessivage c --------- c REAL, intent(in) :: pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection REAL, intent(in) :: prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale ! JE REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection ! Titane ! JE REAL prfl(klon,klev), psfl(klon,klev) !--large-scale ! Titane REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle) ! REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion ! ! de l'eau cond (de fisrtilp) REAL,DIMENSION(klon,klev),INTENT(out) :: beta_v1 ! -- (originale version) INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav !Thermiques: !---------- REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm c c Couche limite: c -------------- c REAL , intent(in) :: coefh(klon,klev) ! coeff melange CL REAL , intent(in) :: cdragh(klon), cdragm(klon) REAL, intent(in) :: yu1(klon) ! vent dans la 1iere couche REAL, intent(in) :: yv1(klon) ! vent dans la 1iere couche c c c---------------------------------------------------------------------- REAL his_ds(klon,nbtr) REAL his_dhlsc(klon,nbtr) ! in-cloud scavenging lsc REAL his_dhcon(klon,nbtr) ! in-cloud scavenging con REAL his_dhbclsc(klon,nbtr) ! below-cloud scavenging lsc REAL his_dhbccon(klon,nbtr) ! below-cloud scavenging con REAL trm(klon,nbtr) c REAL u10m_ec(klon), v10m_ec(klon) c REAL his_th(klon,nbtr) REAL his_dhkecv(klon,nbtr) REAL his_dhkelsc(klon,nbtr) c c Coordonnees c ----------- c REAL, intent(in) :: xlat(klon) ! latitudes pour chaque point REAL, intent(in) :: xlon(klon) ! longitudes pour chaque point C INTEGER i, k, it, j, ig c c DEFINITION OF DIAGNOSTIC VARIABLES c REAL diag_trm(nbtr), diag_drydep(nbtr) REAL diag_wetdep(nbtr), diag_cvtdep(nbtr) REAL diag_emissn(nbtr), diag_g2part REAL diag_sedimt REAL trm_aux(nbtr), src_aux(nbtr) c c Variables locales pour effectuer les appels en serie c---------------------------------------------------- REAL source_tr(klon,nbtr) REAL flux_tr(klon,nbtr) REAL m_conc(klon,klev) REAL sed_ss(klon) ! corresponds to tracer 3 REAL sed_dust(klon) ! corresponds to tracer 4 REAL henry(nbtr) !--cste de Henry mol/l/atm REAL kk(nbtr) !--coefficient de var avec T (K) REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige REAL vdep_oce(nbtr), vdep_sic(nbtr) REAL vdep_ter(nbtr), vdep_lic(nbtr) REAL dtrconv(klon,nbtr) REAL zrho(klon,klev), zdz(klon,klev) REAL zalt(klon,klev) REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique c . Kg/m2 REAL,DIMENSION(klon,klev) :: ztra_th REAL qmin, qmax, aux ! PARAMETER (qmin=0.0, qmax=1.e33) PARAMETER (qmin=1.e33, qmax=-1.e33) c Variables to save data into file c---------------------------------- CHARACTER*2 str2 LOGICAL ok_histrac PARAMETER (ok_histrac=.true.) INTEGER ndex2d(iim*(jjm+1)), ndex3d(iim*(jjm+1)*klev) INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5 SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5 INTEGER itra SAVE itra ! compteur pour la physique INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA) REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev) REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev) REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1) REAL zsto, zout, zout_h, zout_m, zjulian REAL fluxbb(klon), fluxff(klon) REAL fluxbcbb(klon), fluxbcff(klon), fluxbcnff(klon) REAL fluxombb(klon), fluxomff(klon), fluxomnat(klon) REAL fluxomnff(klon), fluxomba(klon), fluxbcba(klon) REAL fluxso2ff(klon), fluxso2bb(klon), fluxso2(klon) REAL fluxso2nff(klon), fluxso2vol(klon), fluxso2ba(klon) REAL fluxh2sff(klon), fluxh2snff(klon) REAL fluxso4ff(klon), fluxso4bb(klon), fluxso4ba(klon) REAL fluxh2sbio(klon), fluxso4nff(klon) REAL fluxdms(klon) REAL fluxbc(klon), fluxom(klon), fluxso4(klon) REAL fluxdd(klon), fluxss(klon) REAL fluxdustec(klon), fluxssfine(klon), fluxsscoa(klon) REAL fluxddfine(klon), fluxddcoa(klon) REAL flux_sparam_bb(klon), flux_sparam_ff(klon) REAL flux_sparam_ind(klon) !, flux_sparam_sulf(klon,klev) REAL flux_sparam_ddfine(klon), flux_sparam_ddcoa(klon) REAL flux_sparam_ssfine(klon), flux_sparam_sscoa(klon) c------------------DMS SO2 SO4 H2S DMSO MSA H2O2 c------------------BC1, BC2, OM1, OM2,flyash dust1 dust2 c------------------Sea Salt 1-8 bins c------------------Precursors (gases), Fine, Coarse Aerosols C c C DATA henry /1.4, 0.0, 0.0, 0.0/ C c C DATA kk /2900., 0., 0., 0./ C c C DATA alpha_r /0., 0.001, 0.001, 0.001/ C c C DATA alpha_s /0., 0.01, 0.01, 0.01/ C c C cnhl DATA vdep_oce /0.7, 0.05, 1.2, 1.2/ C cnhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities C DATA vdep_oce /0.28, 0.28, 1.2, 1.2/ C c C DATA vdep_sic /0.2, 0.17, 1.2, 1.2/ C c C DATA vdep_ter /0.3, 0.14, 1.2, 1.2/ C DATA vdep_lic /0.2, 0.17, 1.2, 1.2/ c------Molar Masses REAL masse(nbtr) c REAL fracso2emis !--fraction so2 emis en so2 PARAMETER (fracso2emis=0.95) REAL frach2sofso2 !--fraction h2s from so2 PARAMETER (frach2sofso2=0.0426) c c Controles c------------- LOGICAL convection,lessivage,lminmax DATA convection,lessivage,lminmax s /.true.,.true.,.true./ c REAL xconv(nbtr) c LOGICAL anthropo, bateau, edgar DATA anthropo,bateau,edgar/.true.,.true.,.true./ c cc bc_source INTEGER kminbc, kmaxbc PARAMETER (kminbc=3, kmaxbc=5) c REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont c c JE for updating in cltrac REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa) REAL,DIMENSION(klon,nbtr) :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE jyg REAL,DIMENSION(klon,nbtr) :: flux_tr_dry c SAVE d_tr_dry c JE for include gas to particle conversion in output REAL his_g2pgas(klon) ! gastoparticle in gas units (check!) REAL his_g2paer(klon) ! gastoparticle in aerosol units (check!) c INTEGER ,intent(in) :: iflag_conv LOGICAL iscm3 ! debug variable. for checkmass ! JE c------------------------------------------------------------------------ c only to compute time consumption of each process c---- INTEGER clock_start,clock_end,clock_rate,clock_start_spla INTEGER clock_end_outphytracr,clock_start_outphytracr INTEGER ti_init,dife,ti_inittype,ti_inittwrite INTEGER ti_spla,ti_emis,ti_depo,ti_cltr,ti_ther INTEGER ti_sedi,ti_gasp,ti_wetap,ti_cvltr,ti_lscs,ti_brop,ti_outs INTEGER ti_nophytracr,clock_per_max REAL tia_init,tia_inittype,tia_inittwrite REAL tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther REAL tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs REAL tia_brop,tia_outs REAL tia_nophytracr SAVE tia_init,tia_inittype,tia_inittwrite SAVE tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther SAVE tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs SAVE tia_brop,tia_outs SAVE ti_nophytracr SAVE tia_nophytracr SAVE clock_end_outphytracr,clock_start_outphytracr SAVE clock_per_max LOGICAL logitime c====================================================================== c INITIALISATIONS c====================================================================== CALL checknanqfi(da(:,:),1.,-1.,' da_ before . phytracr_inphytracr') c c computing time logitime=.true. IF (logitime) THEN clock_start=0 clock_end=0 clock_rate=0 CALL SYSTEM_CLOCK(COUNT_RATE=clock_rate,COUNT_MAX=clock_per_max) CALL SYSTEM_CLOCK(COUNT=clock_start_spla) clock_start=clock_start_spla ! IF (.NOT.debutphy) THEN clock_end_outphytracr=clock_start_spla ! print*,'JE clock',clock_rate,clock_per_max ! ENDIF ENDIF c---fraction of tracer that is convected (?? xconv(1)=0.8 xconv(2)=0.5 xconv(3)=0.5 xconv(4)=0.6 masse(1)=32. masse(2)=6.02e23 masse(3)=6.02e23 masse(4)=6.02e23 henry= (/1.4, 0.0, 0.0, 0.0/) kk = (/2900., 0., 0., 0./) alpha_r = (/0., 0.001, 0.001, 0.001/) alpha_s = (/0., 0.01, 0.01, 0.01/) c nhl DATA vdep_oce /0.7, 0.05, 1.2, 1.2/ c nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities vdep_oce = (/0.28, 0.28, 1.2, 1.2/) vdep_sic = (/0.2, 0.17, 1.2, 1.2/) vdep_ter = (/0.3, 0.14, 1.2, 1.2/) vdep_lic = (/0.2, 0.17, 1.2, 1.2/) lmt_dms(:)=0.0 aux_var2(:)=0.0 aux_var3(:,:)=0.0 source_tr(:,:)=0.0 flux_tr(:,:)=0.0 flux_sparam_bb(:)=0.0 flux_sparam_ff(:)=0.0 flux_sparam_ind(:)=0.0 flux_sparam_ddfine(:)=0.0 flux_sparam_ddcoa(:)=0.0 flux_sparam_ssfine(:)=0.0 flux_sparam_sscoa(:)=0.0 d_tr_dry(:,:)=0.0 flux_tr_dry(:,:)=0.0 ! RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644 RG = 9.80665 RNAVO =6.02e23 RLVTT=2.5008E+6 RLSTT=2.8345E+6 R4IES=7.66 R3IES=21.875 R4LES=35.86 R3LES=17.269 RTT=273.16 RMV=18.0153 RKBOL=1.380658E-23 R=RNAVO*RKBOL R5LES=R3LES*(RTT-R4LES) R5IES=R3IES*(RTT-R4IES) RV=1000.*R/RMV RCPV=4.*RV RCPD=3.5*RD RVTMP2=RCPV/RCPD-1 RETV=RV/RD-1. c iscm3=.false. if (debutphy) then print *, 'let s check nbtr=', nbtr print *, 'xlat and xlon' c JE initializon to cero the tracers DO it=1, nbtr tr_seri(:,:,it)=0.0 ENDDO c JE end ! Initializing to zero tr_seri for comparison purposes ! tr_seri(:,:,:)=0.0 c ! DO it=1,nbtr ! trm_aux(it)=0.0 ! src_aux(it)=0.0 ! diag_trm(it)=0.0 ! diag_drydep(it)=0.0 ! diag_wetdep(it)=0.0 ! diag_cvtdep(it)=0.0 ! diag_emissn(it)=0.0 ! ENDDO ! diag_g2part=0.0 print *,'PREPARE FILES TO SAVE VARIABLES' c nbjour=30 ecrit_tra = NINT(86400./pdtphys) !--1-day average ecrit_tra_h = NINT(86400./pdtphys*0.25) !--6-hour average ecrit_tra_m = NINT(86400./pdtphys*FLOAT(nbjour)) !--1-mth average print *,'ecrit_tra=', pdtphys, ecrit_tra IF (ok_histrac) THEN itra=0 c CALL ymds2ju(1900, 1, 1, 0.0, zjulian) c print *, 'klon,iim,jjm+1 = ',klon,iim,jjm+1 CALL gr_fi_ecrit(1,klon,iim,jjm+1,xlon,zx_lon) c DO i = 1, iim zx_lon(i,1) = xlon(i+1) zx_lon(i,jjm+1) = xlon(i+1) ENDDO c CALL histbeg("histrac_spl", iim,zx_lon, jjm+1,zx_lat, . 1,iim,1,jjm+1, 0, zjulian, pdtphys, . nhori1, nid_tra1) c CALL histbeg("lessivage_spl", iim,zx_lon, jjm+1,zx_lat, . 1,iim,1,jjm+1, 0, zjulian, pdtphys, . nhori2, nid_tra2) c CALL histbeg("traceur_spl", iim,zx_lon, jjm+1,zx_lat, . 1,iim,1,jjm+1, 0, zjulian, pdtphys, . nhori3, nid_tra3) c CALL histvert(nid_tra1, "presnivs", "Vertical levels", "mb", . klev, presnivs, nvert) c CALL histvert(nid_tra2, "presnivs", "Vertical levels", "mb", . klev, presnivs, nvert) c CALL histvert(nid_tra3, "presnivs", "Vertical levels", "mb", . klev, presnivs, nvert) c zsto = pdtphys zout = pdtphys * FLOAT(ecrit_tra) zout_h = pdtphys * FLOAT(ecrit_tra_h) zout_m = pdtphys * FLOAT(ecrit_tra_m) print *,'zsto zout=', zsto, zout c c----------------- HISTORY FILES OF TRACER EMISSIONS ------------------- c c HISTRAC c CALL histdef(nid_tra1, "fluxbb", "Flux BB", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxff", "Flux FF", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxbcbb", "Flux BC-BB", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxbcff", "Flux BC-FF", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxbcnff", "Flux BC-NFF", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxbcba", "Flux BC-BA", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxbc", "Flux BC", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxombb", "Flux OM-BB", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxomff", "Flux OM-FF", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxomnff", "Flux OM-NFF", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxomba", "Flux OM-BA", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxomnat", "Flux OM-NT", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxom", "Flux OM", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxh2sff","Flux H2S FF","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxh2snff","Flux H2S non-FF", . "mgS/m2/s",iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxso2ff","Flux SO2 FF","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxso2nff","Flux SO2 non-FF", . "mgS/m2/s",iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxso2bb", "Flux SO2 BB","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxso2vol","Flux SO2 Vol","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxso2ba", "Flux SO2 Ba","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxso2", "Flux SO2","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxso4ff","Flux SO4 FF","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxso4nff","Flux SO4 non-FF", . "mgS/m2/s", iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxso4bb", "Flux SO4 BB","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxso4ba", "Flux SO4 Ba","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxso4", "Flux SO4","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxdms", "Flux DMS", "mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxh2sbio","Flux H2S Bio","mgS/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1, "fluxdustec", . "Flux Dust EC", "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxddfine","DD Fine Mode","mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxddcoa","DD Coarse Mode","mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxdd","Flux DD","mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxssfine","SS Fine Mode","mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxsscoa","SS Coarse Mode","mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"fluxss","Flux SS","mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c cnhl CALL histdef(nid_tra1,"fluxso4chem","SO4 chem prod", cnhl . "gAer/kgAir", cnhl . iim,jjm+1,nhori1, klev,1,klev,nvert, 32, cnhl . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"flux_sparam_ind","Ind emiss", . "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"flux_sparam_bb","BB emiss", . "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"flux_sparam_ff","FF emiss", . "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"flux_sparam_ddfine","DD fine emiss", . "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"flux_sparam_ddcoa","DD coarse emiss", . "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"flux_sparam_ssfine","SS fine emiss", . "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"flux_sparam_sscoa","SS coarse emiss", . "mg/m2/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"u10m","Zonal wind at 10 m", . "m/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra1,"v10m","Meridional wind at 10 m", . "m/s", . iim,jjm+1,nhori1, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c cnhl CALL histdef(nid_tra1,"flux_sparam_sulf","SO4 chem prod", cnhl . "gAer/kgAir", cnhl . iim,jjm+1,nhori1, klev,1,klev,nvert, 32, cnhl . "ave(X)", zsto,zout) c c TRACEUR c CALL histdef(nid_tra3, "taue550", "Tau ext 550", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue670", "Tau ext 670", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue865", "Tau ext 865", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue550_tr2", "Tau ext 550tr2", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue670_tr2", "Tau ext 670tr2", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue865_tr2", "Tau ext 865tr2", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue550_ss", "Tau ext 550ss", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue670_ss", "Tau ext 670ss", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue865_ss", "Tau ext 865ss", " ", . iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue550_dust", "Tau ext 550dust", " " . ,iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue670_dust", "Tau ext 670dust", " " . ,iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "taue865_dust", "Tau ext 865dust", " " . ,iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) DO it=1, nbtr c WRITE(str2,'(i2.2)') it c CALL histdef(nid_tra3, "trm"//str2, "Burden No."//str2, . "mgS/m2", iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra3, "sconc"//str2, "Surf Conc. No."//str2, . "mg/m3", iim,jjm+1,nhori3, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c c LESSIVAGE c CALL histdef(nid_tra2, "flux"//str2, "emission"//str2, . "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra2, "ds"//str2, "Depot sec No."//str2, . "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra2,"dh"//str2, . "Depot hum No."//str2, . "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra2,"dtrconv"//str2, . "Tiedke convective"//str2, . "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"dtherm"//str2, . "Thermals dtracer"//str2, . "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"dhkecv"//str2, . "KE dep hum convective"//str2, . "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"dhkelsc"//str2, . "KE dep hum large scale"//str2, . "mgS/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"d_tr_cv"//str2, . "cvltr d_tr_cv"//str2, . "mgS/m2/s", . iim,jjm+1,nhori2, klev,1,klev,nvert, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"d_tr_trsp"//str2 . ,"cvltr d_tr_trsp"//str2, . "mgS/m2/s", . iim,jjm+1,nhori2, klev,1,klev,nvert, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"d_tr_sscav"//str2 . ,"cvltr d_tr_sscav"//str2,"mgS/m2/s", . iim,jjm+1,nhori2, klev,1,klev,nvert, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"d_tr_sat"//str2 . ,"cvltr d_tr_sat"//str2, . "mgS/m2/s", . iim,jjm+1,nhori2, klev,1,klev,nvert, 32, . "ave(X)", zsto,zout) CALL histdef(nid_tra2,"d_tr_uscav"//str2 . ,"cvltr d_tr_uscav"//str2, . "mgS/m2/s", . iim,jjm+1,nhori2, klev,1,klev,nvert, 32, . "ave(X)", zsto,zout) c ENDDO c CALL histdef(nid_tra2, "sed_ss", "Sedmet. Tr3", . "mg/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra2, "sed_dust", "Sedmet. Tr4", . "mg/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra2, "g2p_gas", "Gas2particle gas sink", . "mg-S/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c CALL histdef(nid_tra2, "g2p_aer", "Gas2particle tr2 src", . "mg/m2/s", iim,jjm+1,nhori2, 1,1,1, -99, 32, . "ave(X)", zsto,zout) c c-------------------------------------------------------------------- c CALL histend(nid_tra1) c CALL histend(nid_tra2) c CALL histend(nid_tra3) c c-------------------------------------------------------------------- ! nbjour=1 ENDIF !--ok_histrac c ! IF (.NOT.edgar.AND.bateau) THEN ! PRINT *,'ATTENTION risque de compter double les bateaux' ! STOP ! ENDIF c c c endif ! debutphy c c====================================================================== c Initialisations c====================================================================== c c c je KE init IF (debutphy) THEN ALLOCATE(d_tr_cv(klon,klev,nbtr)) ALLOCATE(d_tr_trsp(klon,klev,nbtr)) ALLOCATE(d_tr_sscav(klon,klev,nbtr), . d_tr_sat(klon,klev,nbtr)) ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr), . qDi(klon,klev,nbtr)) ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr)) ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr)) ALLOCATE(d_tr_th(klon,klev,nbtr)) ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr)) ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr)) ALLOCATE(qPrls(klon,nbtr)) ALLOCATE(d_tr_cl(klon,klev,nbtr)) ALLOCATE(d_tr_cv_o(klon,klev,nbtr)) ALLOCATE(d_tr_trsp_o(klon,klev,nbtr)) ALLOCATE(d_tr_sscav_o(klon,klev,nbtr), . d_tr_sat_o(klon,klev,nbtr)) ALLOCATE(d_tr_uscav_o(klon,klev,nbtr)) ! !Config Key = iflag_lscav !Config Desc = Large scale scavenging parametrization: 0=none, !1=old(Genthon92), ! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon. !Config Def = 4 !Config !$OMP MASTER iflag_lscav_omp=4 call getin('iflag_lscav', iflag_lscav_omp) !$OMP END MASTER !$OMP BARRIER iflag_lscav=iflag_lscav_omp ! initialiation for time computation tia_spla=0. tia_emis=0. tia_depo=0. tia_cltr=0. tia_ther=0. tia_sedi=0. tia_gasp=0. tia_wetap=0. tia_cvltr=0. tia_lscs=0. tia_brop=0. tia_outs=0. tia_nophytracr=0. clock_start_outphytracr=clock_end_outphytracr+1 ENDIF ! debutphy ! initialiation for time computation ti_spla=0 ti_emis=0 ti_depo=0 ti_cltr=0 ti_ther=0 ti_sedi=0 ti_gasp=0 ti_wetap=0 ti_cvltr=0 ti_lscs=0 ti_brop=0 ti_outs=0 DO k=1,klev DO i=1,klon Mint(i,k)=0. END DO END DO c DO it=1, nbtr DO k=1,klev DO i=1,klon d_tr_cv(i,k,it)=0. d_tr_trsp(i,k,it)=0. d_tr_sscav(i,k,it)=0. d_tr_sat(i,k,it)=0. d_tr_uscav(i,k,it)=0. d_tr(i,k,it)=0. d_tr_insc(i,k,it)=0. d_tr_bcscav(i,k,it)=0. d_tr_evapls(i,k,it)=0. d_tr_ls(i,k,it)=0. d_tr_cl(i,k,it)=0. d_tr_cv_o(i,k,it)=0. d_tr_trsp_o(i,k,it)=0. d_tr_sscav_o(i,k,it)=0. d_tr_sat_o(i,k,it)=0. d_tr_uscav_o(i,k,it)=0. qDi(i,k,it)=0. qPr(i,k,it)=0. qPa(i,k,it)=0. qMel(i,k,it)=0. qTrdi(i,k,it)=0. dtrcvMA(i,k,it)=0. zmfd1a(i,k,it)=0. zmfdam(i,k,it)=0. zmfphi2(i,k,it)=0. END DO END DO END DO DO it=1, nbtr DO i=1,klon qPrls(i,it)=0.0 dtrconv(i,it)=0.0 ENDDO ENDDO DO it=1, nbtr DO i=1, klon his_dhlsc(i,it)=0.0 his_dhcon(i,it)=0.0 his_dhbclsc(i,it)=0.0 his_dhbccon(i,it)=0.0 trm(i,it)=0.0 his_th(i,it)=0.0 his_dhkecv(i,it)=0.0 his_dhkelsc(i,it)=0.0 ENDDO ENDDO cJE: DO i=1, klon his_g2pgas(i) = 0.0 his_g2paer(i) = 0.0 ENDDO c endJE c DO k=1, klev DO i = 1, klon zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/RG ENDDO ENDDO c DO i = 1, klon zalt(i,1)=pphis(i)/RG ENDDO DO k=1, klev-1 DO i = 1, klon zalt(i,k+1)=zalt(i,k)+zdz(i,k) ENDDO ENDDO IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_init=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_init=tia_init+REAL(ti_init)/REAL(clock_rate) ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF c c====================================================================== c Initialisations of Scaling Parameters c====================================================================== C C ----------------------------- SO4 ----------------------------------- C c scale_param_so4(1)=scale_param_sulf(1) c scale_param_so4(klon)=scale_param_sulf(jjm+1) c DO j = 2, jjm c DO i = 1, iim c ig=iim*(j-2)+i+1 c scale_param_so4(ig)=scale_param_sulf(j) c ENDDO c ENDDO C C ----------------------- SO2, BC & OM -------------------------------- C ----------------FOSSIL FUEL AND INUDSTRIAL EMISSIONS----------------- iregion_dust(:)=-999 iregion_ind(:)=-999 iregion_bb(:)=-999 ! READING BB MASK ! c_Directory='/ccc/work/cont003/dsm/nhuneeus/REGION_MASK/' c_Directory='/d6/jelmd/LMDZ_INPUT/REGION_MASK/' ! c_FileName1='GFED_phyBBmask_lowres_v2.txt' c JE por v2 c_FileName1='GFED_phyBBmask_lowres.txt' c JE por v2 c_FileName2='Country_phyFFandSO2mask_lowres.txt' c c_FileName1='GFED_phyBBmask_lowres_v2.txt' c c_FileName2='Country_phyFFandSO2mask_lowres_v2.txt' c_FileName1='GFED_phyBBmask_lowres_je48x36.txt' c_FileName2='Country_phyFFandSO2mask_lowres_je48x36.txt' c_FullName1=c_Directory//c_FileName1 c_FullName2=c_Directory//c_FileName2 print *,'BB mask NL = ',c_FullName1 ! OPEN (UNIT=1,FILE=c_FullName1) OPEN (UNIT=111,FILE=c_FullName2) DO j=1,klon ! print *, j, klon aux_mask1=0 aux_mask2=0 READ(1,102) aux_mask1 ! mask_BBreg(j)=aux_mask1 iregion_bb(j)=aux_mask1 READ(111,102) aux_mask2 ! print *,'aux_mask1, aux_mask2 ! . =',aux_mask1,aux_mask2,INT(aux_mask1),INT(aux_mask2) ! mask_ffso2reg(j)=aux_mask2 iregion_ind(j)=aux_mask2 ENDDO CLOSE (UNIT=1) CLOSE (UNIT=111) ! IF (debutphy) THEN OPEN(25,FILE='dustregions_pyvar.data') OPEN(55,FILE='indregions_pyvar.data') OPEN(75,FILE='bbregions_pyvar.data') ENDIF DO i = 1, klon C ----------------------- SO2, BC & OM --------------------------------- C -----------------------BIOMASS BURNING-------------------------------- C ------------------------------- DUST --------------------------------- C IF ((xlat(i).GT.11).AND.(xlon(i).LT.-85)) THEN c NORTH WEST AMERICA = 1 iregion_dust(i)=1 ELSEIF ((xlat(i).LE.11).AND.(xlon(i).LT.-25)) THEN c SOUTH AMERICA = 2 iregion_dust(i)=2 ELSEIF ((xlat(i).GE.11).AND.(xlon(i).GE.-25).AND. . (xlon(i).LE.14)) THEN c WEST SAHARA = 3 iregion_dust(i)=3 ELSEIF ((xlat(i).GT.-1.75*xlon(i)+89).AND. . (xlat(i).GT.0.524*xlon(i)-11.048).AND. . (xlat(i).LT.-0.464*xlon(i)+53.179).AND. . (xlat(i).LT.36)) THEN c SAUDI ARABIA = 9 iregion_dust(i)=9 ELSEIF ((xlat(i).LT.11).AND.(xlon(i).GE.-25).AND. . (xlon(i).LE.77)) THEN c AFRICA SUB-SAHARA = 5 iregion_dust(i)=5 ELSEIF ((xlon(i).GT.77).AND.(xlat(i).LT.-5)) THEN c AUSTRALIA = 8 iregion_dust(i)=8 ELSEIF ((xlon(i).GE.77).AND.(xlat(i).GE.-5)) THEN c ASIA EAST = 6 REGION ADDED iregion_dust(i)=6 ELSEIF (xlat(i).GT.11.AND.xlon(i).GE.-85.AND. . xlon(i).LT.-25) THEN c NORTH EAST AMERICA = 11 iregion_dust(i)=11 ELSEIF ((xlon(i).LT.77).AND.(xlat(i).LT.36).AND. . (xlat(i).GE.11).AND. . (xlat(i).GT.-0.464*xlon(i)+53.179).OR. . (xlat(i).LT.0.524*xlon(i)-11.048)) THEN c INDIAN SUBCONTINENT iregion_dust(i)=10 ELSEIF ((xlon(i).GT.33).AND.(xlon(i).LT.77).AND. . (xlat(i).GE.36)) THEN c ASIA WEST = 7 iregion_dust(i)=7 ELSEIF ((xlat(i).GE.11).AND. . (xlon(i).GT.14).AND. . (xlat(i).LT.-1.75*xlon(i)+89).OR.xlon(i).LE.33) THEN c EAST SAHARA = 4 iregion_dust(i)=4 ENDIF IF (debutphy) THEN c WRITTING REGIONS INTO FILE IF (iregion_dust(i).LT.10) THEN WRITE (25,101) iregion_dust(i) ELSE WRITE (25,102) iregion_dust(i) ENDIF WRITE (55,*) iregion_ind(i) WRITE (75,*) iregion_bb(i) ! WRITE (55,102) iregion_ind(i) ! WRITE (75,102) iregion_bb(i) ENDIF ! debutphy/write regions ENDDO ! print *,'NEW DUST REGION, NOW 11 REGIONS!' IF (debutphy) THEN CLOSE(25) CLOSE(55) CLOSE(75) 101 FORMAT (i1) 102 FORMAT (i2) ! stop ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_inittype=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_inittype=tia_inittype+REAL(ti_inittype)/REAL(clock_rate) ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF c c======================================================================= c SAVING SURFACE TYPE c======================================================================= IF (debutphy) THEN OPEN(35,FILE='surface_ocean.data') OPEN(45,FILE='surface_seaice.data') OPEN(65,FILE='surface_land.data') OPEN(85,FILE='surface_landice.data') DO i = 1, klon WRITE (35,103) pctsrf(i,is_oce) WRITE (45,103) pctsrf(i,is_sic) WRITE (65,103) pctsrf(i,is_ter) WRITE (85,103) pctsrf(i,is_lic) ENDDO CLOSE(35) CLOSE(45) CLOSE(65) CLOSE(85) 103 FORMAT (f6.2) ENDIF ! stop c c======================================================================= ! CALL checknanqfi(tr_seri(:,:,1),qmin,qmax,'nan_TEST0it1') ! CALL checknanqfi(tr_seri(:,:,2),qmin,qmax,'nan_TEST0it2') ! CALL checknanqfi(tr_seri(:,:,3),qmin,qmax,'nan_TEST0it3') ! CALL checknanqfi(tr_seri(:,:,4),qmin,qmax,'nan_TEST0it4') c DO it=1, nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO iscm3=.true. ! CALL checknanqfi(t_seri(:,:),qmin,qmax,'nan_t_seri') ! CALL abort_gcm('TEST1', 'Pass nan t_seri', 1) ! CALL checknanqfi(tr_seri(:,:,1),qmin,qmax,'nan_TEST1it1') ! CALL checknanqfi(tr_seri(:,:,2),qmin,qmax,'nan_TEST1it2') ! CALL checknanqfi(tr_seri(:,:,3),qmin,qmax,'nan_TEST1it3') ! CALL checknanqfi(tr_seri(:,:,4),qmin,qmax,'nan_TEST1it4') ! DO it=1, nbtr ! CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax, ! . 'after kg_to_cm3') ! ENDDO c======================================================================= c DO k=1, klev DO i=1, klon m_conc(i,k)=pplay(i,k)/t_seri(i,k)/RKBOL*1.e-6 ENDDO ENDDO ! c IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_avt_coarem') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'avt coarem') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: avt coarem') ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_inittwrite=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_inittwrite=tia_inittwrite+REAL(ti_inittwrite)/REAL(clock_rate) ENDIF c c c======================================================================= c EMISSIONS OF COARSE AEROSOLS c======================================================================= IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF c c PRINT *, 'DUST EMISSION VALUES FOR REAGION EAST ASIA' c DO i=1, klon c IF ((xlon(i).GT.105).AND.(xlat(i).GE.-5)) THEN c print *, 'DUST_EC,LON,LAT = ',dust_ec(i),xlon(i),xlat(i) c ENDIF c ENDDO print *,'Number of tracers = ',nbtr print *,'AT BEGINNING OF PHYTRACR_SPL' ! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)), ! . MAXVAL(tr_seri(:,:,3)) CALL coarsemission(pctsrf,pdtphys,t_seri, . pmflxr,pmflxs,prfl,psfl, . scale_param_ssacc,scale_param_sscoa, . scale_param_dustacc,scale_param_dustcoa, . iregion_dust,dust_ec, . lmt_sea_salt,qmin,qmax, . flux_sparam_ddfine,flux_sparam_ddcoa, . flux_sparam_ssfine,flux_sparam_sscoa, . source_tr,flux_tr) IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_coarem') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after coarem') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after coarem') ENDIF c c c c====================================================================== c EMISSIONS OF AEROSOL PRECURSORS c====================================================================== c print *,'INPUT TO PRECUREMISSION' CALL precuremission(ftsol,u10m_ec,v10m_ec,pctsrf, . u_seri,v_seri,paprs,pplay,cdragh,cdragm, . t_seri,q_seri,tsol,fracso2emis,frach2sofso2, . bateau,zdz,zalt,kminbc,kmaxbc,pdtphys, . scale_param_bb,scale_param_ind, . iregion_ind, iregion_bb, . lmt_so2ff_l,lmt_so2ff_h, lmt_so2nff,lmt_so2ba, . lmt_so2bb_l,lmt_so2bb_h, . lmt_so2volc_cont,lmt_altvolc_cont, . lmt_so2volc_expl,lmt_altvolc_expl, . lmt_dmsbio,lmt_h2sbio, lmt_dmsconc, lmt_dms, . flux_sparam_ind, flux_sparam_bb, . source_tr,flux_tr,tr_seri) ! IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after precur') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after precur') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after precur') ENDIF c c c======================================================================= c EMISSIONS OF FINE AEROSOLS c======================================================================= c CALL finemission(zdz,pdtphys,zalt,kminbc,kmaxbc, . scale_param_bb,scale_param_ff, . iregion_ind,iregion_bb, . lmt_bcff, lmt_bcnff, lmt_bcbb_l,lmt_bcbb_h, . lmt_bcba, lmt_omff, lmt_omnff, . lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba, . flux_sparam_bb, flux_sparam_ff, . source_tr,flux_tr,tr_seri) c ! IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_fineem') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after fineem') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after fineem') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after fineem') ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_emis=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_emis=tia_emis+REAL(ti_emis)/REAL(clock_rate) ENDIF c c======================================================================= c DRY DEPOSITION AND BOUNDARY LAYER MIXING c======================================================================= c ! DO it=1,nbtr ! CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, ! . pplay,t_seri,iscm3,'') ! ENDDO !====================================================================== ! -- Dry deposition -- !====================================================================== IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF DO it=1, nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL cm3_to_kg(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO iscm3=.false. c---------------------------- IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_depo') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before depo') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before depo') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: before depo') ENDIF CALL deposition(vdep_oce,vdep_sic,vdep_ter,vdep_lic,pctsrf, . zrho,zdz,pdtphys,RHcl,masse,t_seri,pplay,paprs, . lminmax,qmin,qmax, . his_ds,source_tr,tr_seri) c IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_depo') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after depo') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after depo') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after depo') ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_depo=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_depo=tia_depo+REAL(ti_depo)/REAL(clock_rate) ENDIF c !====================================================================== ! -- Boundary layer mixing -- !====================================================================== IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF c DO k = 1, klev DO i = 1, klon delp(i,k) = paprs(i,k)-paprs(i,k+1) END DO END DO c DO it=1, nbtr DO j=1, klev DO i=1, klon tmp_var(i,j)=tr_seri(i,j,it) aux_var2(i)=source_tr(i,it) ENDDO ENDDO IF (iflag_conv.EQ.2) THEN ! Tiedke CALL cltrac_spl(pdtphys,coefh,yu1,yv1,t_seri,tmp_var, . aux_var2,paprs,pplay,aux_var3) ELSE IF (iflag_conv.GE.3) THEN !KE CALL cltrac(pdtphys, coefh,t_seri,tmp_var,aux_var2,paprs,pplay, . delp,aux_var3,d_tr_dry,flux_tr_dry(:,it)) ENDIF DO i=1, klon DO j=1, klev tr_seri(i,j,it)=tmp_var(i,j) d_tr(i,j,it)=aux_var3(i,j) ENDDO ENDDO DO k = 1, klev DO i = 1, klon tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k,it) ENDDO ENDDO print *,' AFTER Cltrac' IF (lminmax) THEN CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after cltrac') ENDIF ENDDO !--end itr loop IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_cltr=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_cltr=tia_cltr+REAL(ti_cltr)/REAL(clock_rate) ENDIF !====================================================================== ! -- Calcul de l'effet des thermiques for KE-- !====================================================================== IF (iflag_conv.GE.3) THEN IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before therm') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before therm') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before therm') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'before therm') ENDIF DO it=1,nbtr DO k=1,klev DO i=1,klon tmp_var3(i,k,it)=tr_seri(i,k,it) d_tr_th(i,k,it)=0. tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.) !JE: precursor >>1e10 tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10) END DO END DO END DO !JE new implicit scheme 20140323 DO it=1,nbtr CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm, . zmasse,tr_seri(1:klon,1:klev,it), . d_tr(1:klon,1:klev,it),ztra_th,0 ) DO k=1,klev DO i=1,klon d_tr(i,k,it)=pdtphys*d_tr(i,k,it) d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k,it) tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k,it),0.) END DO END DO ENDDO ! old scheme explicit ! nsplit=10 ! DO it=1,nbtr ! DO isplit=1,nsplit ! CALL dqthermcell(klon,klev,pdtphys/nsplit, ! . fm_therm,entr_therm,zmasse, ! . tr_seri(1:klon,1:klev,it), ! . d_tr(1:klon,1:klev,it),ztra_th) ! DO k=1,klev ! DO i=1,klon ! d_tr(i,k,it)=pdtphys*d_tr(i,k,it)/nsplit ! d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k,it) ! tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k,it),0.) ! END DO ! END DO ! END DO ! nsplit1 ! END DO ! it !JE end modif 20140323 DO it=1,nbtr DO k=1,klev DO i=1,klon tmp_var(i,k)=tr_seri(i,k,it)-tmp_var3(i,k,it) ENDDO ENDDO IF (lminmax) THEN CALL checkmass(tmp_var(:,:),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'dtr therm ') ENDIF CALL kg_to_cm3(pplay,t_seri,tmp_var) DO k=1,klev DO i=1,klon his_th(i,it)=his_th(i,it)+ . (tmp_var(i,k))/RNAVO* . masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys END DO !klon END DO !klev END DO !it IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after therm') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after therm') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after therm') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'after therm') ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_ther=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_ther=tia_ther+REAL(ti_ther)/REAL(clock_rate) ENDIF ENDIF ! iflag_conv KE c------------------------------------ c Sedimentation c----------------------------------- IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF DO it=1,nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO !--end itr loop iscm3=.true. c-------------------------------------- print *,' BEFORE Sediment' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_sedi') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before sedi') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before sedi') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: before sedi') ENDIF print *,'SPLA VERSION OF SEDIMENTATION IS USED' CALL sediment_mod(t_seri,pplay,zrho,paprs,pdtphys,RHcl,!xlon,xlat, . sed_ss,sed_dust,tr_seri) c print *,'AFTER Sediment' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_sedi') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after sedi') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after sedi') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after sedi') ENDIF c c======================================================================= c IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_sedi=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_sedi=tia_sedi+REAL(ti_sedi)/REAL(clock_rate) ENDIF DO it=1, nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL cm3_to_kg(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO iscm3=.false. c c c====================================================================== c GAS TO PARTICLE CONVERSION c====================================================================== c IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_beforegastopar') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before gastopar') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before gastopar') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: before gastopar') ENDIF CALL gastoparticle(pdtphys,zdz,zrho,xlat, . pplay,t_seri, . tr_seri,his_g2pgas ,his_g2paer) c IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_gastopar') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after gastopar') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after gastopar') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after gastopar') ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_gasp=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_gasp=tia_gasp+REAL(ti_gasp)/REAL(clock_rate) ENDIF c c====================================================================== c EFFECT OF PRECIPITATION: iflag_conv=2 c====================================================================== c IF (iflag_conv.EQ.2) THEN IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF DO it=1, nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO iscm3=.true. c------------------------------ print *,'iflag_conv bef lessiv',iflag_conv IF (lessivage) THEN c print *,' BEFORE Incloud' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_incloud') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before incloud') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before incloud') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: before incloud') ENDIF ! CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl, ! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, ! . his_dhlsc,his_dhcon,tr_seri) print *,'iflag_conv bef incloud',iflag_conv IF (iflag_conv.EQ.2) THEN ! Tiedke CALL incloud_scav(.false.,qmin,qmax,masse,henry,kk,prfl, . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, . his_dhlsc,his_dhcon,tr_seri) !---------- to use this option please comment lsc_scav at the end ! ELSE IF (iflag_conv.GE.3) THEN ! ! CALL incloud_scav_lsc(.false.,qmin,qmax,masse,henry,kk,prfl, ! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, ! . his_dhlsc,his_dhcon,tr_seri) !-------------------------------------------------------------- ENDIF c c print *,' BEFORE blcloud (after incloud)' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_blcloud') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before blcloud') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before blcloud') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: before blcloud') ENDIF ! CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl, ! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, ! . his_dhbclsc,his_dhbccon,tr_seri) IF (iflag_conv.EQ.2) THEN ! Tiedke CALL blcloud_scav(.false.,qmin,qmax,pdtphys,prfl,psfl, . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, . his_dhbclsc,his_dhbccon,tr_seri) !---------- to use this option please comment lsc_scav at the end ! and comment IF iflag=2 after "EFFECT OF PRECIPITATION:" ! ! ! ELSE IF (iflag_conv.GE.3) THEN ! ! CALL blcloud_scav_lsc(.false.,qmin,qmax,pdtphys,prfl,psfl, ! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, ! . his_dhbclsc,his_dhbccon,tr_seri) ! !---------------------------------------------------------------------- ENDIF print *,' AFTER blcloud ' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_blcloud') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after blcloud') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after blcloud') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after blcloud') ENDIF ENDIF !--lessivage DO it=1, nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL cm3_to_kg(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO iscm3=.false. c IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_wetap=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_wetap=tia_wetap+REAL(ti_wetap)/REAL(clock_rate) ENDIF ENDIF ! iflag_conv=2 c c c====================================================================== c EFFECT OF CONVECTION c====================================================================== c IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF IF (convection) THEN c print *,' BEFORE trconvect' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_trconve') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before trconve') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before trconve') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: before trconve') ENDIF ! JE CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u, ! . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse, ! . dtrconv,tr_seri) ! ------------------------------------------------------------- IF (iflag_conv.EQ.2) THEN ! Tiedke CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u, . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,.false.,masse, . dtrconv,tr_seri) DO it=1, nbtr d_tr_cv(:,:,it)=0. ENDDO ELSE IF (iflag_conv.GE.3) THEN ! KE print *,'JE: KE in phytracr_spl' DO it=1, nbtr DO k = 1, klev DO i = 1, klon tmp_var3(i,k,it)=tr_seri(i,k,it) END DO END DO ENDDO DO it=1, nbtr ! routine for aerosols . otherwise, check cvltrorig print *,'Check sum before cvltr it',it,SUM(tr_seri(:,:,it)) IF (.FALSE.) THEN CALL cvltr_spl(pdtphys, da, phi,phi2,d1a,dam, mp,ep, . sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, . pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, ! . paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, . paprs,it,tmp_var3,upwd,dnwd,itop_con,ibas_con, . henry,kk,zrho, . d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr, . qPa,qMel,qTrdi,dtrcvMA,Mint, . zmfd1a,zmfphi2,zmfdam) ! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr) ENDIF IF (.FALSE.) THEN CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep, . sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, . pmflxr,pmflxs,evap,t_seri,wdtrainA,wdtrainM, . paprs,it,tmp_var3,upwd,dnwd,itop_con,ibas_con, . d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr, . qPa,qMel,qTrdi,dtrcvMA,Mint, . zmfd1a,zmfphi2,zmfdam) ! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr) ENDIF !!!!!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri, !!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3, !!! . upwd,dnwd,d_tr_cv) print *,'justbefore cvltrnoscav it= ',it CALL checknanqfi(da(:,:),1.,-1.,' da') CALL checknanqfi(wght_cvfd(:,:),1.,-1.,'weigth ') CALL checknanqfi(mp(:,:),1.,-1.,'mp ') CALL checknanqfi(paprs(:,:),1.,-1.,'paprs ') CALL checknanqfi(pplay(:,:),1.,-1.,'pplay ') CALL checknanqfi(tmp_var3(:,:,it),1.,-1.,'tmp_var3 ') CALL checknanqfi(upwd(:,:),1.,-1.,'upwd ') CALL checknanqfi(dnwd(:,:),1.,-1.,'dnwd ') CALL checknanqfi(d_tr_cv(:,:,it),1.,-1.,'d_tr_cv ') IF (.TRUE.) THEN CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs, . pplay,tmp_var3,upwd,dnwd,d_tr_cv) ENDIF DO k = 1, klev DO i = 1, klon ! tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it) tr_seri(i,k,it)=(tmp_var3(i,k,it)+d_tr_cv(i,k,it)) tmp_var(i,k)=d_tr_cv(i,k,it) END DO END DO CALL kg_to_cm3(pplay,t_seri,tmp_var) !just for his_* computation DO k = 1, klev DO i = 1, klon dtrconv(i,it)=0.0 his_dhkecv(i,it)=his_dhkecv(i,it)-tmp_var(i,k) . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys END DO END DO print *,'Check sum after cvltr it',it,SUM(tr_seri(:,:,it)) CALL minmaxqfi2(d_tr_cv(:,:,it),qmin,qmax,'d_tr_cv:') CALL minmaxqfi2(d_tr_trsp(:,:,it),qmin,qmax,'d_tr_trsp:') CALL minmaxqfi2(d_tr_sscav(:,:,it),qmin,qmax,'d_tr_sscav:') CALL minmaxqfi2(d_tr_sat(:,:,it),qmin,qmax,'d_tr_sat:') CALL minmaxqfi2(d_tr_uscav(:,:,it),qmin,qmax,'d_tr_uscav:') CALL checkmass(d_tr_cv(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,.false.,'d_tr_cv:') ENDDO ! it=1,nbtr ENDIF ! iflag_conv IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_trcon') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after trconv') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after trconv') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after trconv') ENDIF ENDIF ! convection IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_cvltr=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_cvltr=tia_cvltr+REAL(ti_cvltr)/REAL(clock_rate) ENDIF c c c======================================================================= c LARGE SCALE SCAVENGING KE c======================================================================= c IF (iflag_conv.GE.3) THEN IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF IF (lessivage) THEN print *,' BEFORE lsc_scav ' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_lsc_scav') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before lsc_scav') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'before lsc_scav') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: before lsc_scav') ENDIF ql_incloud_ref = 10.e-4 ql_incloud_ref = 5.e-4 ! calcul du contenu en eau liquide au sein du nuage ql_incl = ql_incloud_ref ! choix du lessivage IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN print *,'JE iflag_lscav',iflag_lscav DO it = 1, nbtr ! incloud scavenging and removal by large scale rain ! orig : ql_incl ! was replaced by 0.5e-3 kg/kg ! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR ! Liu (2001) proposed to use 1.5e-3 kg/kg CALL lsc_scav(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl, . rneb,beta_fisrt, beta_v1,pplay,paprs, . t_seri,tr_seri,d_tr_insc, . d_tr_bcscav,d_tr_evapls,qPrls) !large scale scavenging tendency DO k = 1, klev DO i = 1, klon d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it) . +d_tr_evapls(i,k,it) tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it) tmp_var(i,k)=d_tr_ls(i,k,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO k=1,klev DO i=1,klon his_dhkelsc(i,it)=his_dhkelsc(i,it)-tmp_var(i,k) . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys END DO END DO END DO !tr ELSE his_dhkelsc(i,it)=0.0 print *,'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4' ENDIF !iflag_lscav print *,' AFTER lsc_scav ' IF (lminmax) THEN DO it=1,nbtr CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_lsc_scav') ENDDO DO it=1,nbtr CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after lsc_scav') ENDDO DO it=1,nbtr CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, . pplay,t_seri,iscm3,'after lsc_scav') ENDDO CALL minmaxsource(source_tr,qmin,qmax,'src: after lsc_scav') ENDIF ENDIF ! lessivage IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_lscs=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_lscs=tia_lscs+REAL(ti_lscs)/REAL(clock_rate) ENDIF ENDIF !iflag_conv c======================================================================= c COMPUTING THE BURDEN c======================================================================= c IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF DO it=1, nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO iscm3=.true. c c Computing burden in mg/m2 DO it=1, nbtr DO k=1, klev DO i=1, klon trm(i,it)=trm(i,it)+tr_seri(i,k,it)*1.e6*zdz(i,k)* . masse(it)*1.e3/RNAVO !--mg S/m2 ENDDO ENDDO ENDDO c c Computing Surface concentration in ug/m3 c DO it=1, nbtr DO i=1, klon sconc_seri(i,it)=tr_seri(i,1,it)*1.e6* . masse(it)*1.e3/RNAVO !--mg/m3 (tr_seri ist in g/cm3) ENDDO ENDDO c c======================================================================= c CALCULATION OF OPTICAL PROPERTIES c======================================================================= c CALL aeropt_spl(zdz, tr_seri, RHcl, . diff_aod550_tot,diag_aod670_tot,diag_aod865_tot, . diff_aod550_tr2,diag_aod670_tr2,diag_aod865_tr2, . diag_aod550_ss,diag_aod670_ss,diag_aod865_ss, . diag_aod550_dust,diag_aod670_dust,diag_aod865_dust) IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_brop=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_brop=tia_brop+REAL(ti_brop)/REAL(clock_rate) ENDIF c c====================================================================== c Stockage sur bande histoire c====================================================================== c IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_start) ENDIF DO it=1, nbtr DO j=1,klev DO i=1,klon tmp_var(i,j)=tr_seri(i,j,it) ENDDO ENDDO CALL cm3_to_kg(pplay,t_seri,tmp_var) DO j=1,klev DO i=1,klon tr_seri(i,j,it)=tmp_var(i,j) ENDDO ENDDO ENDDO iscm3=.false. c c c====================================================================== c SAVING AEROSOL RELATED VARIABLES INTO FILE c====================================================================== c IF (ok_histrac) THEN c ndex2d = 0 ndex3d = 0 c itra=itra+1 print *,'SAVING VARIABLES FOR DAY ',itra c fluxbb(:)=0.0 fluxff(:)=0.0 fluxbcbb(:)=0.0 fluxbcff(:)=0.0 fluxbcnff(:)=0.0 fluxbcba(:)=0.0 fluxbc(:)=0.0 fluxombb(:)=0.0 fluxomff(:)=0.0 fluxomnat(:)=0.0 fluxomba(:)=0.0 fluxomnff(:)=0.0 fluxom(:)=0.0 fluxh2sff(:)=0.0 fluxh2snff(:)=0.0 fluxh2sbio(:)=0.0 fluxso2ff(:)=0.0 fluxso2nff(:)=0.0 fluxso2bb(:)=0.0 fluxso2vol(:)=0.0 fluxso2ba(:)=0.0 fluxso2(:)=0.0 fluxso4ff(:)=0.0 fluxso4nff(:)=0.0 fluxso4bb(:)=0.0 fluxso4ba(:)=0.0 fluxso4(:)=0.0 fluxdms(:)=0.0 fluxdustec(:)=0.0 fluxddfine(:)=0.0 fluxddcoa(:)=0.0 fluxdd(:)=0.0 fluxssfine(:)=0.0 fluxsscoa(:)=0.0 fluxss(:)=0.0 DO i=1, klon IF (iregion_ind(i).GT.0) THEN ! LAND ! SULFUR EMISSIONS fluxh2sff(i)= (lmt_so2ff_l(i)+lmt_so2ff_h(i))*frach2sofso2* . scale_param_ind(iregion_ind(i))* . 1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s fluxso2ff(i)=scale_param_ind(iregion_ind(i)) * fracso2emis * . (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO * . masse_s * 1.e3 ! mgS/m2/s ! SULPHATE EMISSIONS fluxso4ff(i)=scale_param_ind(iregion_ind(i))*(1-fracso2emis)* . (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO * . masse_s * 1.e3 ! mgS/m2/s ! BLACK CARBON EMISSIONS fluxbcff(i)=scale_param_ff(iregion_ind(i))* . lmt_bcff(i)*1.e4*1.e3 !/g/m2/s ! ORGANIC MATTER EMISSIONS fluxomff(i)=scale_param_ff(iregion_ind(i))* . (lmt_omff(i))*1.e4*1.e3 !/g/m2/s ! FOSSIL FUEL EMISSIONS fluxff(i)=fluxbcff(i)+fluxomff(i) ENDIF IF (iregion_bb(i).GT.0) THEN ! LAND ! SULFUR EMISSIONS fluxso2bb(i) =scale_param_bb(iregion_bb(i)) * fracso2emis * . (lmt_so2bb_l(i)+lmt_so2bb_h(i))* . (1.-pctsrf(i,is_oce))*1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s ! SULPHATE EMISSIONS fluxso4bb(i) =scale_param_bb(iregion_bb(i))*(1-fracso2emis)* . (lmt_so2bb_l(i)+lmt_so2bb_h(i))* . (1.-pctsrf(i,is_oce))*1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s ! BLACK CARBON EMISSIONS fluxbcbb(i)=scale_param_bb(iregion_bb(i))* . (lmt_bcbb_l(i)+lmt_bcbb_h(i))*1.e4*1.e3 !mg/m2/s ! ORGANIC MATTER EMISSIONS fluxombb(i)=scale_param_bb(iregion_bb(i))* . (lmt_ombb_l(i)+lmt_ombb_h(i))*1.e4*1.e3 !mg/m2/s ! BIOMASS BURNING EMISSIONS fluxbb(i)=fluxbcbb(i)+fluxombb(i) ENDIF ! H2S EMISSIONS fluxh2sbio(i)=lmt_h2sbio(i)*1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s fluxh2snff(i)= lmt_so2nff(i)*frach2sofso2* . 1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s ! SULFUR DIOXIDE EMISSIONS fluxso2nff(i)=fracso2emis * lmt_so2nff(i) * 1.e4/RNAVO * . masse_s * 1.e3 ! mgS/m2/s fluxso2vol(i)=(lmt_so2volc_cont(i)+lmt_so2volc_expl(i)) . *1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s fluxso2ba(i) =lmt_so2ba(i)*1.e4/RNAVO*masse_s*1.e3* . fracso2emis ! mgS/m2/s fluxso2(i)=fluxso2ff(i)+fluxso2bb(i)+fluxso2nff(i)+ . fluxso2vol(i)+fluxso2ba(i) ! DMS EMISSIONS fluxdms(i)=( lmt_dms(i)+lmt_dmsbio(i) ) . *1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s ! SULPHATE EMISSIONS fluxso4ba(i) =lmt_so2ba(i)*1.e4/RNAVO*masse_s*1.e3 . *(1-fracso2emis) ! mgS/m2/s fluxso4nff(i)=(1-fracso2emis)*lmt_so2nff(i) * 1.e4/RNAVO * . masse_s * 1.e3 ! mgS/m2/s fluxso4(i)=fluxso4ff(i)+fluxso4bb(i)+fluxso4ba(i)+fluxso4nff(i) ! BLACK CARBON EMISSIONS fluxbcnff(i)=lmt_bcnff(i)*1.e4*1.e3 !mg/m2/s fluxbcba(i)=lmt_bcba(i)*1.e4*1.e3 !mg/m2/s fluxbc(i)=fluxbcbb(i)+fluxbcff(i)+fluxbcnff(i)+fluxbcba(i) ! ORGANIC MATTER EMISSIONS fluxomnat(i)=lmt_omnat(i)*1.e4*1.e3 !mg/m2/s fluxomba(i)=lmt_omba(i)*1.e4*1.e3 !mg/m2/s fluxomnff(i)=lmt_omnff(i)*1.e4*1.e3 !mg/m2/s fluxom(i)=fluxombb(i)+fluxomff(i)+fluxomnat(i)+fluxomba(i)+ . fluxomnff(i) ! DUST EMISSIONS fluxdustec(i)=dust_ec(i)*1.e6 fluxddfine(i)=scale_param_dustacc(iregion_dust(i)) . * dust_ec(i)*0.093*1.e6 fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i)) . * dust_ec(i)*0.905*1.e6 fluxdd(i)=fluxddfine(i)+fluxddcoa(i) ! SEA SALT EMISSIONS fluxssfine(i)=scale_param_ssacc*lmt_sea_salt(i,1)*1.e4*1.e3 fluxsscoa(i)=scale_param_sscoa*lmt_sea_salt(i,2)*1.e4*1.e3 fluxss(i)=fluxssfine(i)+fluxsscoa(i) ENDDO ! prepare outputs cvltr DO it=1, nbtr DO k=1,klev DO i=1,klon tmp_var(i,k)=d_tr_cv(i,k,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO k=1,klev DO i=1,klon d_tr_cv_o(i,k,it)=tmp_var(i,k) . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys ENDDO ENDDO ENDDO DO it=1, nbtr DO k=1,klev DO i=1,klon tmp_var(i,k)=d_tr_trsp(i,k,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO k=1,klev DO i=1,klon d_tr_trsp_o(i,k,it)=tmp_var(i,k) . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys ENDDO ENDDO ENDDO DO it=1, nbtr DO k=1,klev DO i=1,klon tmp_var(i,k)=d_tr_sscav(i,k,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO k=1,klev DO i=1,klon d_tr_sscav_o(i,k,it)=tmp_var(i,k) . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys ENDDO ENDDO ENDDO DO it=1, nbtr DO k=1,klev DO i=1,klon tmp_var(i,k)=d_tr_sat(i,k,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO k=1,klev DO i=1,klon d_tr_sat_o(i,k,it)=tmp_var(i,k) . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys ENDDO ENDDO ENDDO DO it=1, nbtr DO k=1,klev DO i=1,klon tmp_var(i,k)=d_tr_uscav(i,k,it) ENDDO ENDDO CALL kg_to_cm3(pplay,t_seri,tmp_var) DO k=1,klev DO i=1,klon d_tr_uscav_o(i,k,it)=tmp_var(i,k) . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys ENDDO ENDDO ENDDO c c SAVING VARIABLES IN TRACEUR c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diff_aod550_tot,zx_tmp_2d) CALL histwrite(nid_tra3,"taue550",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_tot,zx_tmp_2d) CALL histwrite(nid_tra3,"taue670",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_tot,zx_tmp_2d) CALL histwrite(nid_tra3,"taue865",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diff_aod550_tr2,zx_tmp_2d) CALL histwrite(nid_tra3,"taue550_tr2",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_tr2,zx_tmp_2d) CALL histwrite(nid_tra3,"taue670_tr2",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_tr2,zx_tmp_2d) CALL histwrite(nid_tra3,"taue865_tr2",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod550_ss,zx_tmp_2d) CALL histwrite(nid_tra3,"taue550_ss",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_ss,zx_tmp_2d) CALL histwrite(nid_tra3,"taue670_ss",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_ss,zx_tmp_2d) CALL histwrite(nid_tra3,"taue865_ss",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod550_dust,zx_tmp_2d) CALL histwrite(nid_tra3,"taue550_dust",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod670_dust,zx_tmp_2d) CALL histwrite(nid_tra3,"taue670_dust",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1, klon,iim,jjm+1, diag_aod865_dust,zx_tmp_2d) CALL histwrite(nid_tra3,"taue865_dust",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c DO it=1,nbtr c WRITE(str2,'(i2.2)') it c CALL gr_fi_ecrit(1,klon,iim,jjm+1,trm(1,it),zx_tmp_2d) CALL histwrite(nid_tra3,"trm"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,sconc_seri(1,it),zx_tmp_2d) CALL histwrite(nid_tra3,"sconc"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c c SAVING VARIABLES IN LESSIVAGE c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_tr(1,it),zx_tmp_2d) CALL histwrite(nid_tra2,"flux"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_ds(1,it),zx_tmp_2d) CALL histwrite(nid_tra2,"ds"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c DO i=1, klon zx_tmp_fi2d(i) = his_dhlsc(i,it)+his_dhcon(i,it)+ . his_dhbclsc(i,it)+his_dhbccon(i,it) ENDDO c CALL gr_fi_ecrit(1,klon,iim,jjm+1,zx_tmp_fi2d,zx_tmp_2d) CALL histwrite(nid_tra2,"dh"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) C CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_dhkecv(1,it),zx_tmp_2d) CALL histwrite(nid_tra2,"dhkecv"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_dhkelsc(1,it),zx_tmp_2d) CALL histwrite(nid_tra2,"dhkelsc"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_cv_o(1,1,it), . zx_tmp_3d) CALL histwrite(nid_tra2,"d_tr_cv"//str2,itra,zx_tmp_3d, . iim*(jjm+1)*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_trsp_o(1,1,it), . zx_tmp_3d) CALL histwrite(nid_tra2,"d_tr_trsp"//str2,itra,zx_tmp_3d, . iim*(jjm+1)*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_sscav_o(1,1,it), . zx_tmp_3d) CALL histwrite(nid_tra2,"d_tr_sscav"//str2,itra,zx_tmp_3d, . iim*(jjm+1)*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_sat_o(1,1,it), . zx_tmp_3d) CALL histwrite(nid_tra2,"d_tr_sat"//str2,itra,zx_tmp_3d, . iim*(jjm+1)*klev,ndex3d) CALL gr_fi_ecrit(klev,klon,iim,jjm+1,d_tr_uscav_o(1,1,it), . zx_tmp_3d) CALL histwrite(nid_tra2,"d_tr_uscav"//str2,itra,zx_tmp_3d, . iim*(jjm+1)*klev,ndex3d) CALL gr_fi_ecrit(1,klon,iim,jjm+1,dtrconv(1,it),zx_tmp_2d) CALL histwrite(nid_tra2,"dtrconv"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_th(1,it),zx_tmp_2d) CALL histwrite(nid_tra2,"dtherm"//str2,itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c ENDDO c CALL gr_fi_ecrit(1,klon,iim,jjm+1,sed_ss,zx_tmp_2d) CALL histwrite(nid_tra2,"sed_ss",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,sed_dust,zx_tmp_2d) CALL histwrite(nid_tra2,"sed_dust",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_g2pgas,zx_tmp_2d) CALL histwrite(nid_tra2,"g2p_gas",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,his_g2paer,zx_tmp_2d) CALL histwrite(nid_tra2,"g2p_aer",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c SAVING VARIABLES IN HISTRAC c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbb,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxbb",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c c ========================= BC ============================= CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcbb,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxbcbb",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxbcff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcnff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxbcnff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbcba,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxbcba",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxbc,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxbc",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c ========================= OM ============================= CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxombb,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxombb",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxomff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomnff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxomnff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomba,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxomba",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxomnat,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxomnat",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxom,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxom",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c ========================= SO4 ============================= CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4ff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso4ff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4nff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso4nff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4bb,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso4bb",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4ba,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso4ba",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso4,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso4",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c ========================= H2S ============================= CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxh2sff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxh2sff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxh2snff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxh2snff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxh2sbio,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxh2sbio",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c ========================= SO2 ============================= CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2ff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso2ff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2nff,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso2nff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2bb,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso2bb",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2vol,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso2vol",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2ba,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso2ba",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxso2,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxso2",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxdms,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxdms",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c ========================= DD ============================= CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxdustec,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxdustec",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxddfine,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxddfine",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxddcoa,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxddcoa",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxdd,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxdd",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c ========================= SS ============================= CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxssfine,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxssfine",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxsscoa,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxsscoa",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,fluxss,zx_tmp_2d) CALL histwrite(nid_tra1,"fluxss",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c cnhl CALL gr_fi_ecrit(klev,klon,iim,jjm+1,fluxso4chem,zx_tmp_3d) cnhl CALL histwrite(nid_tra1,"fluxso4chem",itra,zx_tmp_3d, cnhl . iim*(jjm+1)*klev,ndex3d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ind,zx_tmp_2d) CALL histwrite(nid_tra1,"flux_sparam_ind",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_bb,zx_tmp_2d) CALL histwrite(nid_tra1,"flux_sparam_bb",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ff,zx_tmp_2d) CALL histwrite(nid_tra1,"flux_sparam_ff",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ddfine,zx_tmp_2d) CALL histwrite(nid_tra1,"flux_sparam_ddfine",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ddcoa,zx_tmp_2d) CALL histwrite(nid_tra1,"flux_sparam_ddcoa",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_ssfine,zx_tmp_2d) CALL histwrite(nid_tra1,"flux_sparam_ssfine",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,flux_sparam_sscoa,zx_tmp_2d) CALL histwrite(nid_tra1,"flux_sparam_sscoa",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,u10m_ec,zx_tmp_2d) CALL histwrite(nid_tra1,"u10m",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c CALL gr_fi_ecrit(1,klon,iim,jjm+1,v10m_ec,zx_tmp_2d) CALL histwrite(nid_tra1,"v10m",itra,zx_tmp_2d, . iim*(jjm+1),ndex2d) c cnhl CALL gr_fi_ecrit(klev,klon,iim,jjm+1,flux_sparam_sulf,zx_tmp_3d) cnhl CALL histwrite(nid_tra1,"flux_sparam_sulf",itra,zx_tmp_3d, cnhl . iim*(jjm+1)*klev,ndex3d) c ENDIF ! ok_histrac IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start ti_outs=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_outs=tia_outs+REAL(ti_outs)/REAL(clock_rate) ENDIF IF (logitime) THEN CALL SYSTEM_CLOCK(COUNT=clock_end) dife=clock_end-clock_start_spla ti_spla=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_spla=tia_spla+REAL(ti_spla)/REAL(clock_rate) print *,'---times for this timestep: time proc, time proc/time . phytracr_spl---' print *,'time spla',REAL(ti_spla)/REAL(clock_rate) . ,REAL(ti_spla)/REAL(ti_spla) print *,'time init',REAL(ti_init)/REAL(clock_rate) . ,REAL(ti_init)/REAL(ti_spla) print *,'time inittype',REAL(ti_inittype)/REAL(clock_rate) . ,REAL(ti_inittype)/REAL(ti_spla) print *,'time inittwrite',REAL(ti_inittwrite)/REAL(clock_rate) . ,REAL(ti_inittwrite)/REAL(ti_spla) print *,'time emis',REAL(ti_emis)/REAL(clock_rate) . ,REAL(ti_emis)/REAL(ti_spla) print *,'time depo ',REAL(ti_depo)/REAL(clock_rate) . ,REAL(ti_depo)/REAL(ti_spla) print *,'time cltr',REAL(ti_cltr)/REAL(clock_rate) . ,REAL(ti_cltr)/REAL(ti_spla) print *,'time ther',REAL(ti_ther)/REAL(clock_rate) . ,REAL(ti_ther)/REAL(ti_spla) print *,'time sedi',REAL(ti_sedi)/REAL(clock_rate) . ,REAL(ti_sedi)/REAL(ti_spla) print *,'time gas to part',REAL(ti_gasp)/REAL(clock_rate) . ,REAL(ti_gasp)/REAL(ti_spla) print *,'time AP wet',REAL(ti_wetap)/REAL(clock_rate) . ,REAL(ti_wetap)/REAL(ti_spla) print *,'time convective',REAL(ti_cvltr)/REAL(clock_rate) . ,REAL(ti_cvltr)/REAL(ti_spla) print *,'time NP lsc scav',REAL(ti_lscs)/REAL(clock_rate) . ,REAL(ti_lscs)/REAL(ti_spla) print *,'time opt,brdn,etc',REAL(ti_brop)/REAL(clock_rate) . ,REAL(ti_brop)/REAL(ti_spla) print *,'time outputs',REAL(ti_outs)/REAL(clock_rate) . ,REAL(ti_outs)/REAL(ti_spla) print *,'---time accumulated: time proc, time proc/time . phytracr_spl---' print *,'time spla',tia_spla print *,'time init',tia_init,tia_init/tia_spla print *,'time inittype',tia_inittype,tia_inittype/tia_spla print *,'time inittwrite',tia_inittwrite,tia_inittwrite/tia_spla print *,'time emis',tia_emis,tia_emis/tia_spla print *,'time depo',tia_depo,tia_depo/tia_spla print *,'time cltr',tia_cltr,tia_cltr/tia_spla print *,'time ther',tia_ther,tia_ther/tia_spla print *,'time sedi',tia_sedi,tia_sedi/tia_spla print *,'time gas to part',tia_gasp,tia_gasp/tia_spla print *,'time AP wet',tia_wetap,tia_wetap/tia_spla print *,'time convective',tia_cvltr,tia_cvltr/tia_spla print *,'time NP lsc scav',tia_lscs,tia_lscs/tia_spla print *,'time opt,brdn,etc',tia_brop,tia_brop/tia_spla print *,'time outputs',tia_outs,tia_outs/tia_spla dife=clock_end_outphytracr-clock_start_outphytracr ti_nophytracr=dife*MAX(0,SIGN(1,dife)) . +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) tia_nophytracr=tia_nophytracr+REAL(ti_nophytracr)/REAL(clock_rate) print *,'Time outside phytracr; Time accum outside phytracr' print*,REAL(ti_nophytracr)/REAL(clock_rate),tia_nophytracr clock_start_outphytracr=clock_end ENDIF print *,'END PHYTRACR_SPL ' END