Changeset 5118 for LMDZ6/branches/Amaury_dev/libf/phylmd
- Timestamp:
- Jul 24, 2024, 4:39:59 PM (7 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/phylmd
- Files:
-
- 5 edited
-
Dust/phys_output_write_spl_mod.F90 (modified) (7 diffs)
-
StratAer/calcaerosolstrato_rrtm.F90 (modified) (3 diffs)
-
carbon_cycle_mod.F90 (modified) (5 diffs)
-
create_limit_unstruct_mod.F90 (modified) (2 diffs)
-
infotrac_phy.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/phys_output_write_spl_mod.F90
r5117 r5118 1 2 1 ! $Id: phys_output_write_mod.F90 2298 2015-06-14 19:13:32Z fairhead $ 3 2 4 3 MODULE phys_output_write_spl_mod 5 4 6 !JE20150620<<7 !JE20150620>>8 !JE20150620<<5 !JE20150620<< 6 !JE20150620>> 7 !JE20150620<< 9 8 10 9 USE time_phylmdz_mod, ONLY: day_step_phy, start_time, itau_phy 11 10 12 11 USE phytracr_spl_mod, ONLY: ok_chimeredust, id_prec, id_fine, id_coss, & 13 id_codu, id_scdu, &14 d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, &15 d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls,&16 d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav ,&17 diff_aod550_tot,&18 diag_aod670_tot, diag_aod865_tot, &19 diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, &20 diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, &21 diag_aod550_dust, diag_aod670_dust, diag_aod865_dust, &22 diag_aod550_dustsco, diag_aod670_dustsco, diag_aod865_dustsco, &23 ! aod550_aqua, aod670_aqua, aod865_aqua, &24 ! aod550_terra, aod670_terra, aod865_terra, &25 aod550_aqua,aod550_tr2_aqua,aod550_ss_aqua,aod550_dust_aqua,aod550_dustsco_aqua,&26 aod670_aqua,aod670_tr2_aqua,aod670_ss_aqua,aod670_dust_aqua,aod670_dustsco_aqua,&27 aod865_aqua,aod865_tr2_aqua,aod865_ss_aqua,aod865_dust_aqua,aod865_dustsco_aqua,&28 aod550_terra,aod550_tr2_terra,aod550_ss_terra,aod550_dust_terra,aod550_dustsco_terra,&29 aod670_terra,aod670_tr2_terra,aod670_ss_terra,aod670_dust_terra,aod670_dustsco_terra,&30 aod865_terra,aod865_tr2_terra,aod865_ss_terra,aod865_dust_terra,aod865_dustsco_terra,&31 trm01,trm02,trm03,trm04,trm05, &32 sconc01,sconc02,sconc03,sconc04,sconc05, &33 flux01,flux02,flux03,flux04,flux05,&34 ds01,ds02,ds03,ds04,ds05, &35 dh01,dh02,dh03,dh04,dh05, &36 dtrconv01,dtrconv02,dtrconv03,dtrconv04,dtrconv05, &37 dtherm01,dtherm02,dtherm03,dtherm04,dtherm05, &38 dhkecv01,dhkecv02,dhkecv03,dhkecv04,dhkecv05, &39 d_tr_ds01,d_tr_ds02,d_tr_ds03,d_tr_ds04,d_tr_ds05, &40 dhkelsc01,dhkelsc02,dhkelsc03,dhkelsc04,dhkelsc05, &41 d_tr_cv01,d_tr_cv02,d_tr_cv03,d_tr_cv04,d_tr_cv05, &42 d_tr_trsp01,d_tr_trsp02,d_tr_trsp03,d_tr_trsp04,d_tr_trsp05, &43 d_tr_sscav01,d_tr_sscav02,d_tr_sscav03,d_tr_sscav04,d_tr_sscav05, &44 d_tr_sat01,d_tr_sat02,d_tr_sat03,d_tr_sat04,d_tr_sat05, &45 d_tr_uscav01,d_tr_uscav02,d_tr_uscav03,d_tr_uscav04,d_tr_uscav05, &46 d_tr_insc01,d_tr_insc02,d_tr_insc03,d_tr_insc04,d_tr_insc05, &47 d_tr_bcscav01,d_tr_bcscav02,d_tr_bcscav03,d_tr_bcscav04,d_tr_bcscav05, &48 d_tr_evapls01,d_tr_evapls02,d_tr_evapls03,d_tr_evapls04,d_tr_evapls05, &49 d_tr_ls01,d_tr_ls02,d_tr_ls03,d_tr_ls04,d_tr_ls05, &50 d_tr_dyn01,d_tr_dyn02,d_tr_dyn03,d_tr_dyn04,d_tr_dyn05, &51 d_tr_cl01,d_tr_cl02,d_tr_cl03,d_tr_cl04,d_tr_cl05, &52 d_tr_th01,d_tr_th02,d_tr_th03,d_tr_th04,d_tr_th05, &53 sed_ss,sed_dust,sed_dustsco,his_g2pgas,his_g2paer, &54 sed_ss3D,sed_dust3D,sed_dustsco3D, &55 fluxbb, &56 fluxff,fluxbcbb,fluxbcff,fluxbcnff, &57 fluxbcba,fluxbc,fluxombb,fluxomff,fluxomnff, &58 fluxomba,fluxomnat,fluxom,fluxh2sff,fluxh2snff, &59 fluxso2ff,fluxso2nff,fluxso2bb,fluxso2vol,fluxso2ba, &60 fluxso2,fluxso4ff,fluxso4nff,fluxso4ba,fluxso4bb, &61 fluxso4,fluxdms,fluxh2sbio,fluxdustec,&62 fluxddfine,&63 fluxddcoa,fluxddsco,fluxdd, &64 fluxssfine,fluxsscoa, &65 fluxss,flux_sparam_ind,flux_sparam_bb,flux_sparam_ff, &66 flux_sparam_ddfine,flux_sparam_ddcoa, &67 flux_sparam_ddsco,flux_sparam_ssfine, &68 flux_sparam_sscoa,u10m_ss,v10m_ss12 id_codu, id_scdu, & 13 d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, & 14 d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls, & 15 d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, & 16 diff_aod550_tot, & 17 diag_aod670_tot, diag_aod865_tot, & 18 diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, & 19 diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, & 20 diag_aod550_dust, diag_aod670_dust, diag_aod865_dust, & 21 diag_aod550_dustsco, diag_aod670_dustsco, diag_aod865_dustsco, & 22 ! aod550_aqua, aod670_aqua, aod865_aqua, & 23 ! aod550_terra, aod670_terra, aod865_terra, & 24 aod550_aqua, aod550_tr2_aqua, aod550_ss_aqua, aod550_dust_aqua, aod550_dustsco_aqua, & 25 aod670_aqua, aod670_tr2_aqua, aod670_ss_aqua, aod670_dust_aqua, aod670_dustsco_aqua, & 26 aod865_aqua, aod865_tr2_aqua, aod865_ss_aqua, aod865_dust_aqua, aod865_dustsco_aqua, & 27 aod550_terra, aod550_tr2_terra, aod550_ss_terra, aod550_dust_terra, aod550_dustsco_terra, & 28 aod670_terra, aod670_tr2_terra, aod670_ss_terra, aod670_dust_terra, aod670_dustsco_terra, & 29 aod865_terra, aod865_tr2_terra, aod865_ss_terra, aod865_dust_terra, aod865_dustsco_terra, & 30 trm01, trm02, trm03, trm04, trm05, & 31 sconc01, sconc02, sconc03, sconc04, sconc05, & 32 flux01, flux02, flux03, flux04, flux05, & 33 ds01, ds02, ds03, ds04, ds05, & 34 dh01, dh02, dh03, dh04, dh05, & 35 dtrconv01, dtrconv02, dtrconv03, dtrconv04, dtrconv05, & 36 dtherm01, dtherm02, dtherm03, dtherm04, dtherm05, & 37 dhkecv01, dhkecv02, dhkecv03, dhkecv04, dhkecv05, & 38 d_tr_ds01, d_tr_ds02, d_tr_ds03, d_tr_ds04, d_tr_ds05, & 39 dhkelsc01, dhkelsc02, dhkelsc03, dhkelsc04, dhkelsc05, & 40 d_tr_cv01, d_tr_cv02, d_tr_cv03, d_tr_cv04, d_tr_cv05, & 41 d_tr_trsp01, d_tr_trsp02, d_tr_trsp03, d_tr_trsp04, d_tr_trsp05, & 42 d_tr_sscav01, d_tr_sscav02, d_tr_sscav03, d_tr_sscav04, d_tr_sscav05, & 43 d_tr_sat01, d_tr_sat02, d_tr_sat03, d_tr_sat04, d_tr_sat05, & 44 d_tr_uscav01, d_tr_uscav02, d_tr_uscav03, d_tr_uscav04, d_tr_uscav05, & 45 d_tr_insc01, d_tr_insc02, d_tr_insc03, d_tr_insc04, d_tr_insc05, & 46 d_tr_bcscav01, d_tr_bcscav02, d_tr_bcscav03, d_tr_bcscav04, d_tr_bcscav05, & 47 d_tr_evapls01, d_tr_evapls02, d_tr_evapls03, d_tr_evapls04, d_tr_evapls05, & 48 d_tr_ls01, d_tr_ls02, d_tr_ls03, d_tr_ls04, d_tr_ls05, & 49 d_tr_dyn01, d_tr_dyn02, d_tr_dyn03, d_tr_dyn04, d_tr_dyn05, & 50 d_tr_cl01, d_tr_cl02, d_tr_cl03, d_tr_cl04, d_tr_cl05, & 51 d_tr_th01, d_tr_th02, d_tr_th03, d_tr_th04, d_tr_th05, & 52 sed_ss, sed_dust, sed_dustsco, his_g2pgas, his_g2paer, & 53 sed_ss3D, sed_dust3D, sed_dustsco3D, & 54 fluxbb, & 55 fluxff, fluxbcbb, fluxbcff, fluxbcnff, & 56 fluxbcba, fluxbc, fluxombb, fluxomff, fluxomnff, & 57 fluxomba, fluxomnat, fluxom, fluxh2sff, fluxh2snff, & 58 fluxso2ff, fluxso2nff, fluxso2bb, fluxso2vol, fluxso2ba, & 59 fluxso2, fluxso4ff, fluxso4nff, fluxso4ba, fluxso4bb, & 60 fluxso4, fluxdms, fluxh2sbio, fluxdustec, & 61 fluxddfine, & 62 fluxddcoa, fluxddsco, fluxdd, & 63 fluxssfine, fluxsscoa, & 64 fluxss, flux_sparam_ind, flux_sparam_bb, flux_sparam_ff, & 65 flux_sparam_ddfine, flux_sparam_ddcoa, & 66 flux_sparam_ddsco, flux_sparam_ssfine, & 67 flux_sparam_sscoa, u10m_ss, v10m_ss 69 68 70 69 USE dustemission_mod, ONLY: m1dflux, m2dflux, m3dflux 71 70 72 ! USE phytrac_mod, ONLY: d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, &73 ! d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls, &74 ! d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav75 76 !JE20150620>>71 ! USE phytrac_mod, ONLY: d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, & 72 ! d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls, & 73 ! d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav 74 75 !JE20150620>> 77 76 78 77 ! Author: Abderrahmane IDELKADI (original include file) … … 80 79 ! Author: Ulysse GERARD (effective implementation) 81 80 82 CONTAINS 81 CONTAINS 83 82 84 83 ! ug Routine pour définir (lors du premier passageà) ET sortir les variables 85 84 SUBROUTINE phys_output_write_spl(itap, pdtphys, paprs, pphis, & 86 pplay, lmax_th, aerosol_couple,&87 ok_ade, ok_aie, ivap, ok_sync, &88 ptconv, read_climoz, clevSTD, ptconvth, &89 d_t, qx, d_qx, d_tr_dyn, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)85 pplay, lmax_th, aerosol_couple, & 86 ok_ade, ok_aie, ivap, ok_sync, & 87 ptconv, read_climoz, clevSTD, ptconvth, & 88 d_t, qx, d_qx, d_tr_dyn, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc) 90 89 91 90 ! This SUBROUTINE does the actual writing of diagnostics that were … … 96 95 USE control_mod, ONLY: day_step, iphysiq 97 96 USE phys_output_ctrlout_mod, ONLY: o_phis, o_aire, is_ter, is_lic, is_oce, & 98 is_ave, is_sic, o_contfracATM, o_contfracOR, &99 o_aireTER, o_flat, o_slp, o_tsol, &100 o_t2m, o_t2m_min, o_t2m_max, &101 o_t2m_min_mon, o_t2m_max_mon, &102 o_q2m, o_ustar, o_u10m, o_v10m, &103 o_wind10m, o_wind10max, o_gusts, o_sicf, &104 o_psol, o_mass, o_qsurf, o_qsol, &105 o_precip, o_ndayrain, o_plul, o_pluc, &106 o_snow, o_msnow, o_fsnow, o_evap, &107 o_tops, o_tops0, o_topl, o_topl0, &108 o_SWupTOA, o_SWupTOAclr, o_SWdnTOA, &109 o_SWdnTOAclr, o_nettop, o_SWup200, &110 o_SWup200clr, o_SWdn200, o_SWdn200clr, &111 o_LWup200, o_LWup200clr, o_LWdn200, &112 o_LWdn200clr, o_sols, o_sols0, &113 o_soll, o_radsol, o_soll0, o_SWupSFC, &114 o_SWupSFCclr, o_SWdnSFC, o_SWdnSFCclr, &115 o_LWupSFC, o_LWdnSFC, o_LWupSFCclr, &116 o_LWdnSFCclr, o_bils, o_bils_diss, &117 o_bils_ec,o_bils_ech, o_bils_tke, o_bils_kinetic, &118 o_bils_latent, o_bils_enthalp, o_sens, &119 o_fder, o_ffonte, o_fqcalving, o_fqfonte, &120 o_taux, o_tauy, o_snowsrf, o_qsnow, &121 o_snowhgt, o_toice, o_sissnow, o_runoff, &122 o_albslw3, o_pourc_srf, o_fract_srf, &123 o_taux_srf, o_tauy_srf, o_tsol_srf, &124 o_evappot_srf, o_ustar_srf, o_u10m_srf, &125 o_v10m_srf, o_t2m_srf, o_evap_srf, &126 o_sens_srf, o_lat_srf, o_flw_srf, &127 o_fsw_srf, o_wbils_srf, o_wbilo_srf, &128 o_tke_srf, o_tke_max_srf,o_dltpbltke_srf, o_wstar, &129 o_cdrm, o_cdrh, o_cldl, o_cldm, o_cldh, &130 o_cldt, o_JrNt, o_cldljn, o_cldmjn, &131 o_cldhjn, o_cldtjn, o_cldq, o_lwp, o_iwp, &132 o_ue, o_ve, o_uq, o_vq, o_cape, o_pbase, &133 o_ptop, o_fbase, o_plcl, o_plfc, &134 o_wbeff, o_cape_max, o_upwd, o_Ma, &135 o_dnwd, o_dnwd0, o_ftime_con, o_mc, &136 o_prw, o_s_pblh, o_s_pblt, o_s_lcl, &137 o_s_therm, o_uSTDlevs, o_vSTDlevs, &138 o_wSTDlevs, o_zSTDlevs, o_qSTDlevs, &139 o_tSTDlevs, epsfra, o_t_oce_sic, &140 o_ale_bl, o_alp_bl, o_ale_wk, o_alp_wk, &141 o_ale, o_alp, o_cin, o_WAPE, o_wake_h, &142 o_wake_s, o_wake_deltat, o_wake_deltaq, &143 o_wake_omg, o_dtwak, o_dqwak, o_Vprecip, &144 o_ftd, o_fqd, o_wdtrainA, o_wdtrainM, &145 o_n2, o_s2, o_proba_notrig, &146 o_random_notrig, o_ale_bl_stat, &147 o_ale_bl_trig, o_alp_bl_det, &148 o_alp_bl_fluct_m, o_alp_bl_fluct_tke, &149 o_alp_bl_conv, o_alp_bl_stat, &150 o_slab_qflux, o_tslab, &151 !o_slab_bils, &152 o_slab_bilg, o_slab_sic, o_slab_tice, &153 o_weakinv, o_dthmin, o_cldtau, &154 o_cldemi, o_pr_con_l, o_pr_con_i, &155 o_pr_lsc_l, o_pr_lsc_i, o_re, o_fl, &156 o_rh2m, &157 !o_rh2m_min, o_rh2m_max, &158 o_qsat2m, o_tpot, o_tpote, o_SWnetOR, &159 o_LWdownOR, o_snowl, &160 o_solldown, o_dtsvdfo, o_dtsvdft, &161 o_dtsvdfg, o_dtsvdfi, o_z0m, o_z0h, o_od550aer, &162 o_od865aer, o_abs550aer, o_od550lt1aer, &163 o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, &164 o_sconcss, o_sconcdust, o_concso4, o_concno3, &165 o_concoa, o_concbc, o_concss, o_concdust, &166 o_loadso4, o_loadoa, o_loadbc, o_loadss, &167 o_loaddust, o_tausumaero, o_tausumaero_lw, &168 o_topswad, o_topswad0, o_solswad, o_solswad0, &169 o_toplwad, o_toplwad0, o_sollwad, o_sollwad0, &170 o_swtoaas_nat, o_swsrfas_nat, &171 o_swtoacs_nat, o_swtoaas_ant, &172 o_swsrfas_ant, o_swtoacs_ant, &173 o_swsrfcs_ant, o_swtoacf_nat, &174 o_swsrfcf_nat, o_swtoacf_ant, &175 o_swsrfcs_nat, o_swsrfcf_ant, &176 o_swtoacf_zero, o_swsrfcf_zero, &177 o_topswai, o_solswai, o_scdnc, &178 o_cldncl, o_reffclws, o_reffclwc, &179 o_cldnvi, o_lcc, o_lcc3d, o_lcc3dcon, &180 o_lcc3dstra, o_reffclwtop, o_ec550aer, &181 o_lwcon, o_iwcon, o_temp, o_theta, &182 o_ovapinit, o_ovap, o_oliq, o_geop, &183 o_vitu, o_vitv, o_vitw, o_pres, o_paprs, &184 o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &185 o_rnebls, o_rhum, o_ozone, o_ozone_light, &186 o_dtphy, o_dqphy, o_albe_srf, o_z0m_srf, o_z0h_srf, &187 o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, &188 o_tke_max, o_kz, o_kz_max, o_clwcon, &189 o_dtdyn, o_dqdyn, o_dudyn, o_dvdyn, &190 o_dtcon, o_tntc, o_ducon, o_dvcon, &191 o_dqcon, o_tnhusc, o_tnhusc, o_dtlsc, &192 o_dtlschr, o_dqlsc, o_beta_prec, &193 o_dtlscth, o_dtlscst, o_dqlscth, &194 o_dqlscst, o_plulth, o_plulst, &195 o_ptconvth, o_lmaxth, o_dtvdf, &196 o_dtdis, o_dqvdf, o_dteva, o_dqeva, &197 o_ptconv, o_ratqs, o_dtthe, &198 o_duthe, o_dvthe, o_ftime_th, &199 o_f_th, o_e_th, o_w_th, o_q_th, &200 o_a_th, o_d_th, o_f0_th, o_zmax_th, &201 o_dqthe, o_dtajs, o_dqajs, o_dtswr, &202 o_dtsw0, o_dtlwr, o_dtlw0, o_dtec, &203 o_duvdf, o_dvvdf, o_duoro, o_dvoro, &204 o_dtoro, o_dulif, o_dvlif, o_dtlif, &205 ! o_duhin, o_dvhin, o_dthin, &206 o_dqch4, o_rsu, &207 o_rsd, o_rlu, o_rld, o_rsucs, o_rsdcs, &208 o_rlucs, o_rldcs, o_tnt, o_tntr, &209 o_tntscpbl, o_tnhus, o_tnhusscpbl, &210 o_evu, o_h2o, o_mcd, o_dmc, o_ref_liq, &211 o_ref_ice, o_rsut4co2, o_rlut4co2, &212 o_rsutcs4co2, o_rlutcs4co2, o_rsu4co2, &213 o_rlu4co2, o_rsucs4co2, o_rlucs4co2, &214 o_rsd4co2, o_rld4co2, o_rsdcs4co2, &215 o_rldcs4co2, o_tnondef, o_ta, o_zg, &216 o_hus, o_hur, o_ua, o_va, o_wap, &217 o_psbg, o_tro3, o_tro3_daylight, &218 o_uxv, o_vxq, o_vxT, o_wxq, o_vxphi, &219 o_wxT, o_uxu, o_vxv, o_TxT, o_trac, &220 o_dtr_vdf, o_dtr_the, o_dtr_con, &221 o_dtr_lessi_impa, o_dtr_lessi_nucl, &222 o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, &223 ! o_dtr_ls, o_dtr_dyn, o_dtr_cl, o_dtr_trsp, o_dtr_sscav, &224 o_dtr_ls, o_dtr_trsp, o_dtr_sscav, &225 o_dtr_sat, o_dtr_uscav, o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, &226 !JE20150620<<227 ! o_vstr_gwd_rando228 o_vstr_gwd_rando, &229 o_m1dflux,o_m2dflux,o_m3dflux, &230 o_taue550, &231 o_taue670,o_taue865, &232 o_taue550_tr2, o_taue670_tr2, o_taue865_tr2, &233 o_taue550_ss,o_taue670_ss, o_taue865_ss, &234 o_taue550_dust, o_taue670_dust, o_taue865_dust, &235 o_taue550_dustsco, o_taue670_dustsco, o_taue865_dustsco, &236 o_taue550_aqua, o_taue670_aqua, o_taue865_aqua, &237 o_taue550_terra, o_taue670_terra, o_taue865_terra, &238 o_taue550_fine_aqua , o_taue670_fine_aqua ,&239 o_taue865_fine_aqua , o_taue550_coss_aqua ,&240 o_taue670_coss_aqua , o_taue865_coss_aqua ,&241 o_taue550_codu_aqua , o_taue670_codu_aqua ,&242 o_taue865_codu_aqua , o_taue670_scdu_aqua ,&243 o_taue550_scdu_aqua , o_taue865_scdu_aqua ,&244 o_taue550_fine_terra , o_taue670_fine_terra ,&245 o_taue865_fine_terra , o_taue550_coss_terra ,&246 o_taue670_coss_terra , o_taue865_coss_terra ,&247 o_taue550_codu_terra , o_taue670_codu_terra ,&248 o_taue865_codu_terra , o_taue670_scdu_terra ,&249 o_taue550_scdu_terra , o_taue865_scdu_terra ,&250 o_trm01,o_trm02,o_trm03,o_trm04,o_trm05,&251 o_sconc01,o_sconc02,o_sconc03,o_sconc04,o_sconc05, &252 o_flux01,o_flux02,o_flux03,o_flux04,o_flux05, &253 o_ds01,o_ds02,o_ds03,o_ds04,o_ds05, &254 o_dh01,o_dh02,o_dh03,o_dh04,o_dh05, &255 o_dtrconv01,o_dtrconv02,o_dtrconv03,o_dtrconv04,o_dtrconv05, &256 o_dtherm01,o_dtherm02,o_dtherm03,o_dtherm04,o_dtherm05, &257 o_dhkecv01,o_dhkecv02,o_dhkecv03,o_dhkecv04,o_dhkecv05, &258 o_d_tr_ds01,o_d_tr_ds02,o_d_tr_ds03,o_d_tr_ds04,o_d_tr_ds05, &259 o_dhkelsc01,o_dhkelsc02,o_dhkelsc03,o_dhkelsc04,o_dhkelsc05, &260 o_d_tr_sat01,o_d_tr_cv01,o_d_tr_cv02,o_d_tr_cv03,o_d_tr_cv04,o_d_tr_cv05,&261 o_d_tr_trsp01,o_d_tr_trsp02,o_d_tr_trsp03,o_d_tr_trsp04,o_d_tr_trsp05,&262 o_d_tr_sscav01,o_d_tr_sscav02,o_d_tr_sscav03,o_d_tr_sscav04,o_d_tr_sscav05,&263 o_d_tr_sat02,o_d_tr_sat03,o_d_tr_sat04,o_d_tr_sat05,&264 o_d_tr_uscav01,o_d_tr_uscav02,o_d_tr_uscav03,o_d_tr_uscav04,o_d_tr_uscav05,&265 o_d_tr_insc01,o_d_tr_insc02,o_d_tr_insc03,o_d_tr_insc04,o_d_tr_insc05,&266 o_d_tr_bcscav01,o_d_tr_bcscav02,o_d_tr_bcscav03,o_d_tr_bcscav04,o_d_tr_bcscav05,&267 o_d_tr_evapls01,o_d_tr_evapls02,o_d_tr_evapls03,o_d_tr_evapls04,o_d_tr_evapls05,&268 o_d_tr_ls01,o_d_tr_ls02,o_d_tr_ls03,o_d_tr_ls04,o_d_tr_ls05,&269 o_d_tr_dyn01,o_d_tr_dyn02,o_d_tr_dyn03,o_d_tr_dyn04,o_d_tr_dyn05,&270 o_d_tr_cl01,o_d_tr_cl02,o_d_tr_cl03,o_d_tr_cl04,o_d_tr_cl05,&271 o_d_tr_th01,o_d_tr_th02,o_d_tr_th03,o_d_tr_th04,o_d_tr_th05,&272 o_sed_ss,o_sed_dust,o_sed_dustsco,o_g2p_gas,o_g2p_aer, &273 o_sed_ss3D,o_sed_dust3D,o_sed_dustsco3D, &274 o_fluxbb, &275 o_fluxff ,o_fluxbcbb ,o_fluxbcff ,o_fluxbcnff, &276 o_fluxbcba ,o_fluxbc ,o_fluxombb ,o_fluxomff, &277 o_fluxomnff ,o_fluxomba ,o_fluxomnat ,o_fluxom, &278 o_fluxh2sff ,o_fluxh2snff,o_fluxso2ff ,o_fluxso2nff, &279 o_fluxso2bb ,o_fluxso2vol,o_fluxso2ba ,o_fluxso2, &280 o_fluxso4ff ,o_fluxso4nff,o_fluxso4bb ,o_fluxso4ba, &281 o_fluxso4 ,o_fluxdms ,o_fluxh2sbio,o_fluxdustec, &282 o_fluxddfine,o_fluxddcoa ,o_fluxddsco ,o_fluxdd ,&283 o_fluxssfine,o_fluxsscoa, o_fluxss, &284 o_flux_sparam_ind,o_flux_sparam_bb, &285 o_flux_sparam_ff ,o_flux_sparam_ddfine ,o_flux_sparam_ddcoa, &286 o_flux_sparam_ddsco,o_flux_sparam_ssfine,o_flux_sparam_sscoa, &287 o_u10m_ss,o_v10m_ss288 289 !JE20150620>>97 is_ave, is_sic, o_contfracATM, o_contfracOR, & 98 o_aireTER, o_flat, o_slp, o_tsol, & 99 o_t2m, o_t2m_min, o_t2m_max, & 100 o_t2m_min_mon, o_t2m_max_mon, & 101 o_q2m, o_ustar, o_u10m, o_v10m, & 102 o_wind10m, o_wind10max, o_gusts, o_sicf, & 103 o_psol, o_mass, o_qsurf, o_qsol, & 104 o_precip, o_ndayrain, o_plul, o_pluc, & 105 o_snow, o_msnow, o_fsnow, o_evap, & 106 o_tops, o_tops0, o_topl, o_topl0, & 107 o_SWupTOA, o_SWupTOAclr, o_SWdnTOA, & 108 o_SWdnTOAclr, o_nettop, o_SWup200, & 109 o_SWup200clr, o_SWdn200, o_SWdn200clr, & 110 o_LWup200, o_LWup200clr, o_LWdn200, & 111 o_LWdn200clr, o_sols, o_sols0, & 112 o_soll, o_radsol, o_soll0, o_SWupSFC, & 113 o_SWupSFCclr, o_SWdnSFC, o_SWdnSFCclr, & 114 o_LWupSFC, o_LWdnSFC, o_LWupSFCclr, & 115 o_LWdnSFCclr, o_bils, o_bils_diss, & 116 o_bils_ec, o_bils_ech, o_bils_tke, o_bils_kinetic, & 117 o_bils_latent, o_bils_enthalp, o_sens, & 118 o_fder, o_ffonte, o_fqcalving, o_fqfonte, & 119 o_taux, o_tauy, o_snowsrf, o_qsnow, & 120 o_snowhgt, o_toice, o_sissnow, o_runoff, & 121 o_albslw3, o_pourc_srf, o_fract_srf, & 122 o_taux_srf, o_tauy_srf, o_tsol_srf, & 123 o_evappot_srf, o_ustar_srf, o_u10m_srf, & 124 o_v10m_srf, o_t2m_srf, o_evap_srf, & 125 o_sens_srf, o_lat_srf, o_flw_srf, & 126 o_fsw_srf, o_wbils_srf, o_wbilo_srf, & 127 o_tke_srf, o_tke_max_srf, o_dltpbltke_srf, o_wstar, & 128 o_cdrm, o_cdrh, o_cldl, o_cldm, o_cldh, & 129 o_cldt, o_JrNt, o_cldljn, o_cldmjn, & 130 o_cldhjn, o_cldtjn, o_cldq, o_lwp, o_iwp, & 131 o_ue, o_ve, o_uq, o_vq, o_cape, o_pbase, & 132 o_ptop, o_fbase, o_plcl, o_plfc, & 133 o_wbeff, o_cape_max, o_upwd, o_Ma, & 134 o_dnwd, o_dnwd0, o_ftime_con, o_mc, & 135 o_prw, o_s_pblh, o_s_pblt, o_s_lcl, & 136 o_s_therm, o_uSTDlevs, o_vSTDlevs, & 137 o_wSTDlevs, o_zSTDlevs, o_qSTDlevs, & 138 o_tSTDlevs, epsfra, o_t_oce_sic, & 139 o_ale_bl, o_alp_bl, o_ale_wk, o_alp_wk, & 140 o_ale, o_alp, o_cin, o_WAPE, o_wake_h, & 141 o_wake_s, o_wake_deltat, o_wake_deltaq, & 142 o_wake_omg, o_dtwak, o_dqwak, o_Vprecip, & 143 o_ftd, o_fqd, o_wdtrainA, o_wdtrainM, & 144 o_n2, o_s2, o_proba_notrig, & 145 o_random_notrig, o_ale_bl_stat, & 146 o_ale_bl_trig, o_alp_bl_det, & 147 o_alp_bl_fluct_m, o_alp_bl_fluct_tke, & 148 o_alp_bl_conv, o_alp_bl_stat, & 149 o_slab_qflux, o_tslab, & 150 !o_slab_bils, & 151 o_slab_bilg, o_slab_sic, o_slab_tice, & 152 o_weakinv, o_dthmin, o_cldtau, & 153 o_cldemi, o_pr_con_l, o_pr_con_i, & 154 o_pr_lsc_l, o_pr_lsc_i, o_re, o_fl, & 155 o_rh2m, & 156 !o_rh2m_min, o_rh2m_max, & 157 o_qsat2m, o_tpot, o_tpote, o_SWnetOR, & 158 o_LWdownOR, o_snowl, & 159 o_solldown, o_dtsvdfo, o_dtsvdft, & 160 o_dtsvdfg, o_dtsvdfi, o_z0m, o_z0h, o_od550aer, & 161 o_od865aer, o_abs550aer, o_od550lt1aer, & 162 o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, & 163 o_sconcss, o_sconcdust, o_concso4, o_concno3, & 164 o_concoa, o_concbc, o_concss, o_concdust, & 165 o_loadso4, o_loadoa, o_loadbc, o_loadss, & 166 o_loaddust, o_tausumaero, o_tausumaero_lw, & 167 o_topswad, o_topswad0, o_solswad, o_solswad0, & 168 o_toplwad, o_toplwad0, o_sollwad, o_sollwad0, & 169 o_swtoaas_nat, o_swsrfas_nat, & 170 o_swtoacs_nat, o_swtoaas_ant, & 171 o_swsrfas_ant, o_swtoacs_ant, & 172 o_swsrfcs_ant, o_swtoacf_nat, & 173 o_swsrfcf_nat, o_swtoacf_ant, & 174 o_swsrfcs_nat, o_swsrfcf_ant, & 175 o_swtoacf_zero, o_swsrfcf_zero, & 176 o_topswai, o_solswai, o_scdnc, & 177 o_cldncl, o_reffclws, o_reffclwc, & 178 o_cldnvi, o_lcc, o_lcc3d, o_lcc3dcon, & 179 o_lcc3dstra, o_reffclwtop, o_ec550aer, & 180 o_lwcon, o_iwcon, o_temp, o_theta, & 181 o_ovapinit, o_ovap, o_oliq, o_geop, & 182 o_vitu, o_vitv, o_vitw, o_pres, o_paprs, & 183 o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, & 184 o_rnebls, o_rhum, o_ozone, o_ozone_light, & 185 o_dtphy, o_dqphy, o_albe_srf, o_z0m_srf, o_z0h_srf, & 186 o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, & 187 o_tke_max, o_kz, o_kz_max, o_clwcon, & 188 o_dtdyn, o_dqdyn, o_dudyn, o_dvdyn, & 189 o_dtcon, o_tntc, o_ducon, o_dvcon, & 190 o_dqcon, o_tnhusc, o_tnhusc, o_dtlsc, & 191 o_dtlschr, o_dqlsc, o_beta_prec, & 192 o_dtlscth, o_dtlscst, o_dqlscth, & 193 o_dqlscst, o_plulth, o_plulst, & 194 o_ptconvth, o_lmaxth, o_dtvdf, & 195 o_dtdis, o_dqvdf, o_dteva, o_dqeva, & 196 o_ptconv, o_ratqs, o_dtthe, & 197 o_duthe, o_dvthe, o_ftime_th, & 198 o_f_th, o_e_th, o_w_th, o_q_th, & 199 o_a_th, o_d_th, o_f0_th, o_zmax_th, & 200 o_dqthe, o_dtajs, o_dqajs, o_dtswr, & 201 o_dtsw0, o_dtlwr, o_dtlw0, o_dtec, & 202 o_duvdf, o_dvvdf, o_duoro, o_dvoro, & 203 o_dtoro, o_dulif, o_dvlif, o_dtlif, & 204 ! o_duhin, o_dvhin, o_dthin, & 205 o_dqch4, o_rsu, & 206 o_rsd, o_rlu, o_rld, o_rsucs, o_rsdcs, & 207 o_rlucs, o_rldcs, o_tnt, o_tntr, & 208 o_tntscpbl, o_tnhus, o_tnhusscpbl, & 209 o_evu, o_h2o, o_mcd, o_dmc, o_ref_liq, & 210 o_ref_ice, o_rsut4co2, o_rlut4co2, & 211 o_rsutcs4co2, o_rlutcs4co2, o_rsu4co2, & 212 o_rlu4co2, o_rsucs4co2, o_rlucs4co2, & 213 o_rsd4co2, o_rld4co2, o_rsdcs4co2, & 214 o_rldcs4co2, o_tnondef, o_ta, o_zg, & 215 o_hus, o_hur, o_ua, o_va, o_wap, & 216 o_psbg, o_tro3, o_tro3_daylight, & 217 o_uxv, o_vxq, o_vxT, o_wxq, o_vxphi, & 218 o_wxT, o_uxu, o_vxv, o_TxT, o_trac, & 219 o_dtr_vdf, o_dtr_the, o_dtr_con, & 220 o_dtr_lessi_impa, o_dtr_lessi_nucl, & 221 o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, & 222 ! o_dtr_ls, o_dtr_dyn, o_dtr_cl, o_dtr_trsp, o_dtr_sscav, & 223 o_dtr_ls, o_dtr_trsp, o_dtr_sscav, & 224 o_dtr_sat, o_dtr_uscav, o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, & 225 !JE20150620<< 226 ! o_vstr_gwd_rando 227 o_vstr_gwd_rando, & 228 o_m1dflux, o_m2dflux, o_m3dflux, & 229 o_taue550, & 230 o_taue670, o_taue865, & 231 o_taue550_tr2, o_taue670_tr2, o_taue865_tr2, & 232 o_taue550_ss, o_taue670_ss, o_taue865_ss, & 233 o_taue550_dust, o_taue670_dust, o_taue865_dust, & 234 o_taue550_dustsco, o_taue670_dustsco, o_taue865_dustsco, & 235 o_taue550_aqua, o_taue670_aqua, o_taue865_aqua, & 236 o_taue550_terra, o_taue670_terra, o_taue865_terra, & 237 o_taue550_fine_aqua, o_taue670_fine_aqua, & 238 o_taue865_fine_aqua, o_taue550_coss_aqua, & 239 o_taue670_coss_aqua, o_taue865_coss_aqua, & 240 o_taue550_codu_aqua, o_taue670_codu_aqua, & 241 o_taue865_codu_aqua, o_taue670_scdu_aqua, & 242 o_taue550_scdu_aqua, o_taue865_scdu_aqua, & 243 o_taue550_fine_terra, o_taue670_fine_terra, & 244 o_taue865_fine_terra, o_taue550_coss_terra, & 245 o_taue670_coss_terra, o_taue865_coss_terra, & 246 o_taue550_codu_terra, o_taue670_codu_terra, & 247 o_taue865_codu_terra, o_taue670_scdu_terra, & 248 o_taue550_scdu_terra, o_taue865_scdu_terra, & 249 o_trm01, o_trm02, o_trm03, o_trm04, o_trm05, & 250 o_sconc01, o_sconc02, o_sconc03, o_sconc04, o_sconc05, & 251 o_flux01, o_flux02, o_flux03, o_flux04, o_flux05, & 252 o_ds01, o_ds02, o_ds03, o_ds04, o_ds05, & 253 o_dh01, o_dh02, o_dh03, o_dh04, o_dh05, & 254 o_dtrconv01, o_dtrconv02, o_dtrconv03, o_dtrconv04, o_dtrconv05, & 255 o_dtherm01, o_dtherm02, o_dtherm03, o_dtherm04, o_dtherm05, & 256 o_dhkecv01, o_dhkecv02, o_dhkecv03, o_dhkecv04, o_dhkecv05, & 257 o_d_tr_ds01, o_d_tr_ds02, o_d_tr_ds03, o_d_tr_ds04, o_d_tr_ds05, & 258 o_dhkelsc01, o_dhkelsc02, o_dhkelsc03, o_dhkelsc04, o_dhkelsc05, & 259 o_d_tr_sat01, o_d_tr_cv01, o_d_tr_cv02, o_d_tr_cv03, o_d_tr_cv04, o_d_tr_cv05, & 260 o_d_tr_trsp01, o_d_tr_trsp02, o_d_tr_trsp03, o_d_tr_trsp04, o_d_tr_trsp05, & 261 o_d_tr_sscav01, o_d_tr_sscav02, o_d_tr_sscav03, o_d_tr_sscav04, o_d_tr_sscav05, & 262 o_d_tr_sat02, o_d_tr_sat03, o_d_tr_sat04, o_d_tr_sat05, & 263 o_d_tr_uscav01, o_d_tr_uscav02, o_d_tr_uscav03, o_d_tr_uscav04, o_d_tr_uscav05, & 264 o_d_tr_insc01, o_d_tr_insc02, o_d_tr_insc03, o_d_tr_insc04, o_d_tr_insc05, & 265 o_d_tr_bcscav01, o_d_tr_bcscav02, o_d_tr_bcscav03, o_d_tr_bcscav04, o_d_tr_bcscav05, & 266 o_d_tr_evapls01, o_d_tr_evapls02, o_d_tr_evapls03, o_d_tr_evapls04, o_d_tr_evapls05, & 267 o_d_tr_ls01, o_d_tr_ls02, o_d_tr_ls03, o_d_tr_ls04, o_d_tr_ls05, & 268 o_d_tr_dyn01, o_d_tr_dyn02, o_d_tr_dyn03, o_d_tr_dyn04, o_d_tr_dyn05, & 269 o_d_tr_cl01, o_d_tr_cl02, o_d_tr_cl03, o_d_tr_cl04, o_d_tr_cl05, & 270 o_d_tr_th01, o_d_tr_th02, o_d_tr_th03, o_d_tr_th04, o_d_tr_th05, & 271 o_sed_ss, o_sed_dust, o_sed_dustsco, o_g2p_gas, o_g2p_aer, & 272 o_sed_ss3D, o_sed_dust3D, o_sed_dustsco3D, & 273 o_fluxbb, & 274 o_fluxff, o_fluxbcbb, o_fluxbcff, o_fluxbcnff, & 275 o_fluxbcba, o_fluxbc, o_fluxombb, o_fluxomff, & 276 o_fluxomnff, o_fluxomba, o_fluxomnat, o_fluxom, & 277 o_fluxh2sff, o_fluxh2snff, o_fluxso2ff, o_fluxso2nff, & 278 o_fluxso2bb, o_fluxso2vol, o_fluxso2ba, o_fluxso2, & 279 o_fluxso4ff, o_fluxso4nff, o_fluxso4bb, o_fluxso4ba, & 280 o_fluxso4, o_fluxdms, o_fluxh2sbio, o_fluxdustec, & 281 o_fluxddfine, o_fluxddcoa, o_fluxddsco, o_fluxdd, & 282 o_fluxssfine, o_fluxsscoa, o_fluxss, & 283 o_flux_sparam_ind, o_flux_sparam_bb, & 284 o_flux_sparam_ff, o_flux_sparam_ddfine, o_flux_sparam_ddcoa, & 285 o_flux_sparam_ddsco, o_flux_sparam_ssfine, o_flux_sparam_sscoa, & 286 o_u10m_ss, o_v10m_ss 287 288 !JE20150620>> 290 289 291 290 USE phys_state_var_mod, ONLY: pctsrf, paire_ter, rain_fall, snow_fall, & 292 qsol, z0m, z0h, fevap, agesno, &293 nday_rain, rain_con, snow_con, &294 topsw, toplw, toplw0, swup, swdn, &295 topsw0, swup0, swdn0, SWup200, SWup200clr, &296 SWdn200, SWdn200clr, LWup200, LWup200clr, &297 LWdn200, LWdn200clr, solsw, solsw0, sollw, &298 radsol, sollw0, sollwdown, sollw, gustiness, &299 sollwdownclr, lwdn0, ftsol, ustar, u10m, &300 v10m, pbl_tke, wake_delta_pbl_TKE, &301 wstar, cape, ema_pcb, ema_pct, &302 ema_cbmf, Ma, fm_therm, ale_bl, alp_bl, ale, &303 alp, cin, wake_pe, wake_s, wake_deltat, &304 ale_wake, ale_bl_stat, &305 wake_deltaq, ftd, fqd, ale_bl_trig, albsol1, &306 rnebcon, wo, falb1, albsol2, coefh, clwcon0, &307 ratqs, entr_therm, zqasc, detr_therm, f0, &308 lwup, lwdn, lwup0, coefm, &309 swupp, lwupp, swup0p, lwup0p, swdnp, lwdnp, &310 swdn0p, lwdn0p, tnondef, O3sumSTD, uvsumSTD, &311 vqsumSTD, vTsumSTD, O3daysumSTD, wqsumSTD, &312 vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, &313 T2sumSTD, nlevSTD, &314 ! du_gwd_rando, dv_gwd_rando, &315 ulevSTD, vlevSTD, wlevSTD, philevSTD, qlevSTD, tlevSTD, &316 rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, &317 vphiSTD, wTSTD, u2STD, v2STD, T2STD, missing_val_nf90291 qsol, z0m, z0h, fevap, agesno, & 292 nday_rain, rain_con, snow_con, & 293 topsw, toplw, toplw0, swup, swdn, & 294 topsw0, swup0, swdn0, SWup200, SWup200clr, & 295 SWdn200, SWdn200clr, LWup200, LWup200clr, & 296 LWdn200, LWdn200clr, solsw, solsw0, sollw, & 297 radsol, sollw0, sollwdown, sollw, gustiness, & 298 sollwdownclr, lwdn0, ftsol, ustar, u10m, & 299 v10m, pbl_tke, wake_delta_pbl_TKE, & 300 wstar, cape, ema_pcb, ema_pct, & 301 ema_cbmf, Ma, fm_therm, ale_bl, alp_bl, ale, & 302 alp, cin, wake_pe, wake_s, wake_deltat, & 303 ale_wake, ale_bl_stat, & 304 wake_deltaq, ftd, fqd, ale_bl_trig, albsol1, & 305 rnebcon, wo, falb1, albsol2, coefh, clwcon0, & 306 ratqs, entr_therm, zqasc, detr_therm, f0, & 307 lwup, lwdn, lwup0, coefm, & 308 swupp, lwupp, swup0p, lwup0p, swdnp, lwdnp, & 309 swdn0p, lwdn0p, tnondef, O3sumSTD, uvsumSTD, & 310 vqsumSTD, vTsumSTD, O3daysumSTD, wqsumSTD, & 311 vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, & 312 T2sumSTD, nlevSTD, & 313 ! du_gwd_rando, dv_gwd_rando, & 314 ulevSTD, vlevSTD, wlevSTD, philevSTD, qlevSTD, tlevSTD, & 315 rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, & 316 vphiSTD, wTSTD, u2STD, v2STD, T2STD, missing_val_nf90 318 317 319 318 USE phys_local_var_mod, ONLY: zxfluxlat, slp, zxtsol, zt2m, & 320 t2m_min_mon, t2m_max_mon, evap, &321 zu10m, zv10m, zq2m, zustar, zxqsurf, &322 rain_lsc, snow_lsc, bils, sens, fder, &323 zxffonte, zxfqcalving, zxfqfonte, fluxu, &324 fluxv, zxsnow, qsnow, snowhgt, to_ice, &325 sissnow, runoff, albsol3_lic, evap_pot, &326 t2m, fluxt, fluxlat, fsollw, fsolsw, &327 wfbils, cdragm, cdragh, cldl, cldm, &328 cldh, cldt, JrNt, &329 ! cldljn, cldmjn, cldhjn, cldtjn &330 cldq, flwp, fiwp, ue, ve, uq, vq, &331 plcl, plfc, wbeff, upwd, dnwd, dnwd0, prw, &332 s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, &333 vwriteSTD, wwriteSTD, phiwriteSTD, qwriteSTD, &334 twriteSTD, alp_wake, wake_h, &335 !ale_wake, &336 wake_omg, d_t_wake, d_q_wake, Vprecip, &337 wdtrainA, wdtrainM, n2, s2, proba_notrig, &338 random_notrig, &339 !ale_bl_stat, &340 alp_bl_det, alp_bl_fluct_m, alp_bl_conv, &341 alp_bl_stat, alp_bl_fluct_tke, slab_wfbils, &342 weak_inversion, dthmin, cldtau, cldemi, &343 pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, &344 qsat2m, tpote, tpot, d_ts, od550aer, &345 od865aer, abs550aer, od550lt1aer, sconcso4, sconcno3, &346 sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, &347 concoa, concbc, concss, concdust, loadso4, &348 loadoa, loadbc, loadss, loaddust, tausum_aero, &349 topswad_aero, topswad0_aero, solswad_aero, &350 solswad0_aero, topsw_aero, solsw_aero, &351 topsw0_aero, solsw0_aero, topswcf_aero, &352 solswcf_aero, topswai_aero, solswai_aero, &353 toplwad_aero, toplwad0_aero, sollwad_aero, &354 sollwad0_aero, toplwai_aero, sollwai_aero, &355 !scdnc, cldncl, reffclws, reffclwc, cldnvi, &356 !lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, &357 ec550aer, flwc, fiwc, t_seri, theta, q_seri, &358 !jyg<359 !! ql_seri, zphi, u_seri, v_seri, omega, cldfra, &360 ql_seri, tr_seri, &361 zphi, u_seri, v_seri, omega, cldfra, &362 !>jyg363 rneb, rnebjn, zx_rh, d_t_dyn, d_q_dyn, &364 d_u_dyn, d_v_dyn, d_t_con, d_t_ajsb, d_t_ajs, &365 d_u_ajs, d_v_ajs, &366 d_u_con, d_v_con, d_q_con, d_q_ajs, d_t_lsc, &367 d_t_lwr,d_t_lw0,d_t_swr,d_t_sw0, &368 d_t_eva, d_q_lsc, beta_prec, d_t_lscth, &369 d_t_lscst, d_q_lscth, d_q_lscst, plul_th, &370 plul_st, d_t_vdf, d_t_diss, d_q_vdf, d_q_eva, &371 zw2, fraca, zmax_th, d_q_ajsb, d_t_ec, d_u_vdf, &372 d_v_vdf, d_u_oro, d_v_oro, d_t_oro, d_u_lif, &373 d_v_lif, d_t_lif, &374 ! d_u_hin, d_v_hin, d_t_hin, &375 d_q_ch4, pmfd, pmfu, ref_liq, ref_ice, rhwriteSTD319 t2m_min_mon, t2m_max_mon, evap, & 320 zu10m, zv10m, zq2m, zustar, zxqsurf, & 321 rain_lsc, snow_lsc, bils, sens, fder, & 322 zxffonte, zxfqcalving, zxfqfonte, fluxu, & 323 fluxv, zxsnow, qsnow, snowhgt, to_ice, & 324 sissnow, runoff, albsol3_lic, evap_pot, & 325 t2m, fluxt, fluxlat, fsollw, fsolsw, & 326 wfbils, cdragm, cdragh, cldl, cldm, & 327 cldh, cldt, JrNt, & 328 ! cldljn, cldmjn, cldhjn, cldtjn & 329 cldq, flwp, fiwp, ue, ve, uq, vq, & 330 plcl, plfc, wbeff, upwd, dnwd, dnwd0, prw, & 331 s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, & 332 vwriteSTD, wwriteSTD, phiwriteSTD, qwriteSTD, & 333 twriteSTD, alp_wake, wake_h, & 334 !ale_wake, & 335 wake_omg, d_t_wake, d_q_wake, Vprecip, & 336 wdtrainA, wdtrainM, n2, s2, proba_notrig, & 337 random_notrig, & 338 !ale_bl_stat, & 339 alp_bl_det, alp_bl_fluct_m, alp_bl_conv, & 340 alp_bl_stat, alp_bl_fluct_tke, slab_wfbils, & 341 weak_inversion, dthmin, cldtau, cldemi, & 342 pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, & 343 qsat2m, tpote, tpot, d_ts, od550aer, & 344 od865aer, abs550aer, od550lt1aer, sconcso4, sconcno3, & 345 sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, & 346 concoa, concbc, concss, concdust, loadso4, & 347 loadoa, loadbc, loadss, loaddust, tausum_aero, & 348 topswad_aero, topswad0_aero, solswad_aero, & 349 solswad0_aero, topsw_aero, solsw_aero, & 350 topsw0_aero, solsw0_aero, topswcf_aero, & 351 solswcf_aero, topswai_aero, solswai_aero, & 352 toplwad_aero, toplwad0_aero, sollwad_aero, & 353 sollwad0_aero, toplwai_aero, sollwai_aero, & 354 !scdnc, cldncl, reffclws, reffclwc, cldnvi, & 355 !lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, & 356 ec550aer, flwc, fiwc, t_seri, theta, q_seri, & 357 !jyg< 358 !! ql_seri, zphi, u_seri, v_seri, omega, cldfra, & 359 ql_seri, tr_seri, & 360 zphi, u_seri, v_seri, omega, cldfra, & 361 !>jyg 362 rneb, rnebjn, zx_rh, d_t_dyn, d_q_dyn, & 363 d_u_dyn, d_v_dyn, d_t_con, d_t_ajsb, d_t_ajs, & 364 d_u_ajs, d_v_ajs, & 365 d_u_con, d_v_con, d_q_con, d_q_ajs, d_t_lsc, & 366 d_t_lwr, d_t_lw0, d_t_swr, d_t_sw0, & 367 d_t_eva, d_q_lsc, beta_prec, d_t_lscth, & 368 d_t_lscst, d_q_lscth, d_q_lscst, plul_th, & 369 plul_st, d_t_vdf, d_t_diss, d_q_vdf, d_q_eva, & 370 zw2, fraca, zmax_th, d_q_ajsb, d_t_ec, d_u_vdf, & 371 d_v_vdf, d_u_oro, d_v_oro, d_t_oro, d_u_lif, & 372 d_v_lif, d_t_lif, & 373 ! d_u_hin, d_v_hin, d_t_hin, & 374 d_q_ch4, pmfd, pmfu, ref_liq, ref_ice, rhwriteSTD 376 375 377 376 USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, & 378 bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &379 itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando, &380 scdnc, cldncl, reffclws, reffclwc, cldnvi, &381 lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop377 bils_ec, bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, & 378 itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando, & 379 scdnc, cldncl, reffclws, reffclwc, cldnvi, & 380 lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop 382 381 USE ocean_slab_mod, ONLY: tslab, slab_bilg, tice, seaice 383 382 USE pbl_surface_mod, ONLY: snow … … 386 385 USE lmdz_geometry, ONLY: cell_area 387 386 USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, landice_opt 388 ! USE aero_mod, ONLY: naero_spc387 ! USE aero_mod, ONLY: naero_spc 389 388 USE aero_mod, ONLY: naero_tot, id_STRAT_phy 390 389 USE ioipsl, ONLY: histend, histsync … … 396 395 USE phys_cal_mod, ONLY: mth_len 397 396 USE lmdz_yomcst 397 USE lmdz_iniprint, ONLY: lunout, prt_level 398 398 399 399 IMPLICIT NONE 400 400 401 ! INCLUDE "temps.h"401 ! INCLUDE "temps.h" 402 402 INCLUDE "clesphys.h" 403 403 INCLUDE "alpale.h" 404 404 INCLUDE "compbl.h" 405 405 INCLUDE "dimensions.h" 406 include "iniprint.h"407 406 408 407 ! Input … … 413 412 LOGICAL, DIMENSION(klon, klev) :: ptconv, ptconvth 414 413 REAL :: pdtphys 415 CHARACTER (LEN =4), DIMENSION(nlevSTD) :: clevSTD416 REAL, DIMENSION(klon, nlevSTD) :: zx_tmp_fi3d_STD414 CHARACTER (LEN = 4), DIMENSION(nlevSTD) :: clevSTD 415 REAL, DIMENSION(klon, nlevSTD) :: zx_tmp_fi3d_STD 417 416 REAL, DIMENSION(klon) :: pphis 418 417 REAL, DIMENSION(klon, klev) :: pplay, d_t 419 REAL, DIMENSION(klon, klev +1) :: paprs420 REAL, DIMENSION(klon, klev,nqtot) :: qx, d_qx421 REAL, DIMENSION(klon,klev,nbtr),INTENT(IN):: d_tr_dyn418 REAL, DIMENSION(klon, klev + 1) :: paprs 419 REAL, DIMENSION(klon, klev, nqtot) :: qx, d_qx 420 REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: d_tr_dyn 422 421 REAL, DIMENSION(klon, llm) :: zmasse 423 422 INTEGER :: flag_aerosol_strat 424 INTEGER :: flag_aerosol 423 INTEGER :: flag_aerosol 425 424 LOGICAL :: ok_cdnc 426 425 REAL, DIMENSION(3) :: freq_moyNMC 427 426 428 427 ! Local 429 INTEGER, PARAMETER :: jjmp1 =jjm+1-1/jjm428 INTEGER, PARAMETER :: jjmp1 = jjm + 1 - 1 / jjm 430 429 INTEGER :: itau_w 431 INTEGER :: i, iinit, iinitend =1, iff, iq, itr, nsrf, k, ll, naero430 INTEGER :: i, iinit, iinitend = 1, iff, iq, itr, nsrf, k, ll, naero 432 431 REAL, DIMENSION (klon) :: zx_tmp_fi2d 433 REAL, DIMENSION (klon, klev) :: zx_tmp_fi3d, zpt_conv434 REAL, DIMENSION (klon, klev+1) :: zx_tmp_fi3d1435 CHARACTER (LEN =4):: bb2436 INTEGER, DIMENSION(iim *jjmp1):: ndex2d437 INTEGER, DIMENSION(iim *jjmp1*klev) :: ndex3d432 REAL, DIMENSION (klon, klev) :: zx_tmp_fi3d, zpt_conv 433 REAL, DIMENSION (klon, klev + 1) :: zx_tmp_fi3d1 434 CHARACTER (LEN = 4) :: bb2 435 INTEGER, DIMENSION(iim * jjmp1) :: ndex2d 436 INTEGER, DIMENSION(iim * jjmp1 * klev) :: ndex3d 438 437 REAL, PARAMETER :: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 439 438 REAL :: missing_val 440 REAL, PARAMETER :: un_jour =86400.439 REAL, PARAMETER :: un_jour = 86400. 441 440 442 441 IF (using_xios) THEN 443 missing_val =missing_val_xios442 missing_val = missing_val_xios 444 443 ELSE 445 missing_val =nf90_fill_real444 missing_val = nf90_fill_real 446 445 ENDIF 447 446 … … 451 450 CALL set_itau_iophy(itau_w) 452 451 453 !AS, vu avec LF : le test est fait maintenant au debut du pdt, pas a la fin, alors on ne passe plus qu'une fois454 ! Donc le "IF (.NOT.vars_defined)" devient inutile, et la boucle "DO iinit=1, iinitend" pourra etre eliminee 455 ! ainsi que iinit, iinitend456 ! IF (.NOT.vars_defined) THEN457 ! iinitend = 2458 ! ELSE459 ! iinitend = 1460 ! ENDIF452 !AS, vu avec LF : le test est fait maintenant au debut du pdt, pas a la fin, alors on ne passe plus qu'une fois 453 ! Donc le "IF (.NOT.vars_defined)" devient inutile, et la boucle "DO iinit=1, iinitend" pourra etre eliminee 454 ! ainsi que iinit, iinitend 455 ! IF (.NOT.vars_defined) THEN 456 ! iinitend = 2 457 ! ELSE 458 ! iinitend = 1 459 ! ENDIF 461 460 462 461 ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage: 463 DO iinit=1, iinitend 464 IF (using_xios) THEN 465 !$OMP MASTER 466 IF (vars_defined) THEN 467 IF (prt_level >= 10) THEN 468 WRITE(lunout,*)"phys_output_write: CALL xios_update_calendar, itau_w=",itau_w 469 ENDIF 470 ! CALL xios_update_calendar(itau_w) 471 CALL xios_update_calendar(itap) 472 ENDIF 473 !$OMP END MASTER 474 !$OMP BARRIER 475 ENDIF !using_xios 476 477 ! On procède à l'écriture ou à la définition des nombreuses variables: 478 !!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 479 CALL histwrite_phy(o_phis, pphis) 480 CALL histwrite_phy(o_aire, cell_area) 481 482 IF (vars_defined) THEN 483 DO i=1, klon 484 zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic) 485 ENDDO 486 ENDIF 487 488 CALL histwrite_phy(o_contfracATM, zx_tmp_fi2d) 489 CALL histwrite_phy(o_contfracOR, pctsrf(:,is_ter)) 490 CALL histwrite_phy(o_aireTER, paire_ter) 491 492 !!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 493 ! JE20141223 << 494 INCLUDE "spla_output_write.h" 495 ! JE20141223 >> 496 497 CALL histwrite_phy(o_flat, zxfluxlat) 498 CALL histwrite_phy(o_slp, slp) 499 CALL histwrite_phy(o_tsol, zxtsol) 500 CALL histwrite_phy(o_t2m, zt2m) 501 CALL histwrite_phy(o_t2m_min, zt2m) 502 CALL histwrite_phy(o_t2m_max, zt2m) 503 CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon) 504 CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon) 505 506 IF (vars_defined) THEN 507 DO i=1, klon 508 zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) 509 ENDDO 510 ENDIF 511 CALL histwrite_phy(o_wind10m, zx_tmp_fi2d) 512 513 IF (vars_defined) THEN 514 DO i=1, klon 515 zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) 516 ENDDO 517 ENDIF 518 CALL histwrite_phy(o_wind10max, zx_tmp_fi2d) 519 520 CALL histwrite_phy(o_gusts, gustiness) 521 522 IF (vars_defined) THEN 523 DO i = 1, klon 524 zx_tmp_fi2d(i) = pctsrf(i,is_sic) 525 ENDDO 526 ENDIF 527 CALL histwrite_phy(o_sicf, zx_tmp_fi2d) 528 CALL histwrite_phy(o_q2m, zq2m) 529 CALL histwrite_phy(o_ustar, zustar) 530 CALL histwrite_phy(o_u10m, zu10m) 531 CALL histwrite_phy(o_v10m, zv10m) 532 533 IF (vars_defined) THEN 534 DO i = 1, klon 535 zx_tmp_fi2d(i) = paprs(i,1) 536 ENDDO 537 ENDIF 538 CALL histwrite_phy(o_psol, zx_tmp_fi2d) 539 CALL histwrite_phy(o_mass, zmasse) 540 CALL histwrite_phy(o_qsurf, zxqsurf) 541 542 IF (.NOT. ok_veget) THEN 543 CALL histwrite_phy(o_qsol, qsol) 544 ENDIF 545 546 IF (vars_defined) THEN 547 DO i = 1, klon 548 zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i) 549 ENDDO 550 ENDIF 551 552 CALL histwrite_phy(o_precip, zx_tmp_fi2d) 553 CALL histwrite_phy(o_ndayrain, nday_rain) 554 555 IF (vars_defined) THEN 556 DO i = 1, klon 557 zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i) 558 ENDDO 559 ENDIF 560 CALL histwrite_phy(o_plul, zx_tmp_fi2d) 561 562 IF (vars_defined) THEN 563 DO i = 1, klon 564 zx_tmp_fi2d(i) = rain_con(i) + snow_con(i) 565 ENDDO 566 ENDIF 567 CALL histwrite_phy(o_pluc, zx_tmp_fi2d) 568 CALL histwrite_phy(o_snow, snow_fall) 569 CALL histwrite_phy(o_msnow, zxsnow) 570 CALL histwrite_phy(o_fsnow, zfra_o) 571 CALL histwrite_phy(o_evap, evap) 572 CALL histwrite_phy(o_tops, topsw) 573 CALL histwrite_phy(o_tops0, topsw0) 574 CALL histwrite_phy(o_topl, toplw) 575 CALL histwrite_phy(o_topl0, toplw0) 576 577 IF (vars_defined) THEN 578 zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, klevp1 ) 579 ENDIF 580 CALL histwrite_phy(o_SWupTOA, zx_tmp_fi2d) 581 582 IF (vars_defined) THEN 583 zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, klevp1 ) 584 ENDIF 585 CALL histwrite_phy(o_SWupTOAclr, zx_tmp_fi2d) 586 587 IF (vars_defined) THEN 588 zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, klevp1 ) 589 ENDIF 590 CALL histwrite_phy(o_SWdnTOA, zx_tmp_fi2d) 591 592 IF (vars_defined) THEN 593 zx_tmp_fi2d(1 : klon) = swdn0 ( 1 : klon, klevp1 ) 594 ENDIF 595 CALL histwrite_phy(o_SWdnTOAclr, zx_tmp_fi2d) 596 597 IF (vars_defined) THEN 598 zx_tmp_fi2d(:) = topsw(:)-toplw(:) 599 ENDIF 600 CALL histwrite_phy(o_nettop, zx_tmp_fi2d) 601 CALL histwrite_phy(o_SWup200, SWup200) 602 CALL histwrite_phy(o_SWup200clr, SWup200clr) 603 CALL histwrite_phy(o_SWdn200, SWdn200) 604 CALL histwrite_phy(o_SWdn200clr, SWdn200clr) 605 CALL histwrite_phy(o_LWup200, LWup200) 606 CALL histwrite_phy(o_LWup200clr, LWup200clr) 607 CALL histwrite_phy(o_LWdn200, LWdn200) 608 CALL histwrite_phy(o_LWdn200clr, LWdn200clr) 609 CALL histwrite_phy(o_sols, solsw) 610 CALL histwrite_phy(o_sols0, solsw0) 611 CALL histwrite_phy(o_soll, sollw) 612 CALL histwrite_phy(o_radsol, radsol) 613 CALL histwrite_phy(o_soll0, sollw0) 614 615 IF (vars_defined) THEN 616 zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 1 ) 617 ENDIF 618 CALL histwrite_phy(o_SWupSFC, zx_tmp_fi2d) 619 620 IF (vars_defined) THEN 621 zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, 1 ) 622 ENDIF 623 CALL histwrite_phy(o_SWupSFCclr, zx_tmp_fi2d) 624 625 IF (vars_defined) THEN 626 zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 1 ) 627 ENDIF 628 CALL histwrite_phy(o_SWdnSFC, zx_tmp_fi2d) 629 630 IF (vars_defined) THEN 631 zx_tmp_fi2d(1 : klon) = swdn0 ( 1 : klon, 1 ) 632 ENDIF 633 CALL histwrite_phy(o_SWdnSFCclr, zx_tmp_fi2d) 634 635 IF (vars_defined) THEN 636 zx_tmp_fi2d(1:klon)=sollwdown(1:klon)-sollw(1:klon) 637 ENDIF 638 CALL histwrite_phy(o_LWupSFC, zx_tmp_fi2d) 639 CALL histwrite_phy(o_LWdnSFC, sollwdown) 640 641 IF (vars_defined) THEN 642 sollwdownclr(1:klon) = -1.*lwdn0(1:klon,1) 643 zx_tmp_fi2d(1:klon)=sollwdownclr(1:klon)-sollw0(1:klon) 644 ENDIF 645 CALL histwrite_phy(o_LWupSFCclr, zx_tmp_fi2d) 646 CALL histwrite_phy(o_LWdnSFCclr, sollwdownclr) 647 CALL histwrite_phy(o_bils, bils) 648 CALL histwrite_phy(o_bils_diss, bils_diss) 649 CALL histwrite_phy(o_bils_ec, bils_ec) 650 IF (iflag_ener_conserv>=1) THEN 651 CALL histwrite_phy(o_bils_ech, bils_ech) 652 ENDIF 653 CALL histwrite_phy(o_bils_tke, bils_tke) 654 CALL histwrite_phy(o_bils_kinetic, bils_kinetic) 655 CALL histwrite_phy(o_bils_latent, bils_latent) 656 CALL histwrite_phy(o_bils_enthalp, bils_enthalp) 657 658 IF (vars_defined) THEN 659 zx_tmp_fi2d(1:klon)=-1*sens(1:klon) 660 ENDIF 661 CALL histwrite_phy(o_sens, zx_tmp_fi2d) 662 CALL histwrite_phy(o_fder, fder) 663 CALL histwrite_phy(o_ffonte, zxffonte) 664 CALL histwrite_phy(o_fqcalving, zxfqcalving) 665 CALL histwrite_phy(o_fqfonte, zxfqfonte) 666 IF (vars_defined) THEN 667 zx_tmp_fi2d=0. 668 DO nsrf=1,nbsrf 669 zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+pctsrf(:,nsrf)*fluxu(:,1,nsrf) 670 ENDDO 671 ENDIF 672 CALL histwrite_phy(o_taux, zx_tmp_fi2d) 673 674 IF (vars_defined) THEN 675 zx_tmp_fi2d=0. 676 DO nsrf=1,nbsrf 677 zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+pctsrf(:,nsrf)*fluxv(:,1,nsrf) 678 ENDDO 679 ENDIF 680 CALL histwrite_phy(o_tauy, zx_tmp_fi2d) 681 682 IF (landice_opt >= 1 ) THEN 683 CALL histwrite_phy(o_snowsrf, snow_o) 684 CALL histwrite_phy(o_qsnow, qsnow) 685 CALL histwrite_phy(o_snowhgt,snowhgt) 686 CALL histwrite_phy(o_toice,to_ice) 687 CALL histwrite_phy(o_sissnow,sissnow) 688 CALL histwrite_phy(o_runoff,runoff) 689 CALL histwrite_phy(o_albslw3,albsol3_lic) 690 ENDIF 691 692 DO nsrf = 1, nbsrf 693 IF (vars_defined) zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100. 694 CALL histwrite_phy(o_pourc_srf(nsrf), zx_tmp_fi2d) 695 IF (vars_defined) zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf) 696 CALL histwrite_phy(o_fract_srf(nsrf), zx_tmp_fi2d) 697 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf) 698 CALL histwrite_phy(o_taux_srf(nsrf), zx_tmp_fi2d) 699 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf) 700 CALL histwrite_phy(o_tauy_srf(nsrf), zx_tmp_fi2d) 701 IF (vars_defined) zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf) 702 CALL histwrite_phy(o_tsol_srf(nsrf), zx_tmp_fi2d) 703 IF (vars_defined) zx_tmp_fi2d(1 : klon) = evap_pot( 1 : klon, nsrf) 704 CALL histwrite_phy(o_evappot_srf(nsrf), zx_tmp_fi2d) 705 IF (vars_defined) zx_tmp_fi2d(1 : klon) = ustar(1 : klon, nsrf) 706 CALL histwrite_phy(o_ustar_srf(nsrf), zx_tmp_fi2d) 707 IF (vars_defined) zx_tmp_fi2d(1 : klon) = u10m(1 : klon, nsrf) 708 CALL histwrite_phy(o_u10m_srf(nsrf), zx_tmp_fi2d) 709 IF (vars_defined) zx_tmp_fi2d(1 : klon) = v10m(1 : klon, nsrf) 710 CALL histwrite_phy(o_v10m_srf(nsrf), zx_tmp_fi2d) 711 IF (vars_defined) zx_tmp_fi2d(1 : klon) = t2m(1 : klon, nsrf) 712 CALL histwrite_phy(o_t2m_srf(nsrf), zx_tmp_fi2d) 713 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fevap(1 : klon, nsrf) 714 CALL histwrite_phy(o_evap_srf(nsrf), zx_tmp_fi2d) 715 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf) 716 CALL histwrite_phy(o_sens_srf(nsrf), zx_tmp_fi2d) 717 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf) 718 CALL histwrite_phy(o_lat_srf(nsrf), zx_tmp_fi2d) 719 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fsollw( 1 : klon, nsrf) 720 CALL histwrite_phy(o_flw_srf(nsrf), zx_tmp_fi2d) 721 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, nsrf) 722 CALL histwrite_phy(o_fsw_srf(nsrf), zx_tmp_fi2d) 723 IF (vars_defined) zx_tmp_fi2d(1 : klon) = wfbils( 1 : klon, nsrf) 724 CALL histwrite_phy(o_wbils_srf(nsrf), zx_tmp_fi2d) 725 726 IF (iflag_pbl > 1) THEN 727 CALL histwrite_phy(o_tke_srf(nsrf), pbl_tke(:,1:klev,nsrf)) 728 CALL histwrite_phy(o_tke_max_srf(nsrf), pbl_tke(:,1:klev,nsrf)) 462 DO iinit = 1, iinitend 463 IF (using_xios) THEN 464 !$OMP MASTER 465 IF (vars_defined) THEN 466 IF (prt_level >= 10) THEN 467 WRITE(lunout, *)"phys_output_write: CALL xios_update_calendar, itau_w=", itau_w 729 468 ENDIF 730 !jyg< 731 IF (iflag_pbl > 1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1) THEN 732 CALL histwrite_phy(o_dltpbltke_srf(nsrf), wake_delta_pbl_TKE(:,1:klev,nsrf)) 733 ENDIF 734 !>jyg 735 736 ENDDO 737 DO nsrf=1,nbsrf+1 738 CALL histwrite_phy(o_wstar(nsrf), wstar(1 : klon, nsrf)) 739 ENDDO 740 741 CALL histwrite_phy(o_cdrm, cdragm) 742 CALL histwrite_phy(o_cdrh, cdragh) 743 CALL histwrite_phy(o_cldl, cldl) 744 CALL histwrite_phy(o_cldm, cldm) 745 CALL histwrite_phy(o_cldh, cldh) 746 CALL histwrite_phy(o_cldt, cldt) 747 CALL histwrite_phy(o_JrNt, JrNt) 748 749 !CALL histwrite_phy(o_cldljn, cldl*JrNt) 750 IF (vars_defined) zx_tmp_fi2d=cldl*JrNt 751 CALL histwrite_phy(o_cldljn, zx_tmp_fi2d) 752 !CALL histwrite_phy(o_cldmjn, cldm*JrNt) 753 IF (vars_defined) zx_tmp_fi2d=cldm*JrNt 754 CALL histwrite_phy(o_cldmjn, zx_tmp_fi2d) 755 !CALL histwrite_phy(o_cldhjn, cldh*JrNt) 756 IF (vars_defined) zx_tmp_fi2d=cldh*JrNt 757 CALL histwrite_phy(o_cldhjn, zx_tmp_fi2d) 758 !CALL histwrite_phy(o_cldtjn, cldt*JrNt) 759 IF (vars_defined) zx_tmp_fi2d=cldt*JrNt 760 CALL histwrite_phy(o_cldtjn, zx_tmp_fi2d) 761 762 CALL histwrite_phy(o_cldq, cldq) 763 IF (vars_defined) zx_tmp_fi2d(1:klon) = flwp(1:klon) 764 CALL histwrite_phy(o_lwp, zx_tmp_fi2d) 765 IF (vars_defined) zx_tmp_fi2d(1:klon) = fiwp(1:klon) 766 CALL histwrite_phy(o_iwp, zx_tmp_fi2d) 767 CALL histwrite_phy(o_ue, ue) 768 CALL histwrite_phy(o_ve, ve) 769 CALL histwrite_phy(o_uq, uq) 770 CALL histwrite_phy(o_vq, vq) 771 IF (iflag_con>=3) THEN ! sb 772 CALL histwrite_phy(o_cape, cape) 773 CALL histwrite_phy(o_pbase, ema_pcb) 774 CALL histwrite_phy(o_ptop, ema_pct) 775 CALL histwrite_phy(o_fbase, ema_cbmf) 776 IF (iflag_con /= 30) THEN 777 CALL histwrite_phy(o_plcl, plcl) 778 CALL histwrite_phy(o_plfc, plfc) 779 CALL histwrite_phy(o_wbeff, wbeff) 780 ENDIF 781 782 CALL histwrite_phy(o_cape_max, cape) 783 784 CALL histwrite_phy(o_upwd, upwd) 785 CALL histwrite_phy(o_Ma, Ma) 786 CALL histwrite_phy(o_dnwd, dnwd) 787 CALL histwrite_phy(o_dnwd0, dnwd0) 788 IF (vars_defined) zx_tmp_fi2d=float(itau_con)/float(itap) 789 CALL histwrite_phy(o_ftime_con, zx_tmp_fi2d) 790 IF (vars_defined) THEN 791 IF (iflag_thermals>=1)THEN 792 zx_tmp_fi3d=dnwd+dnwd0+upwd+fm_therm(:,1:klev) 793 ELSE 794 zx_tmp_fi3d=dnwd+dnwd0+upwd 795 ENDIF 796 ENDIF 797 CALL histwrite_phy(o_mc, zx_tmp_fi3d) 798 ENDIF !iflag_con .GE. 3 799 CALL histwrite_phy(o_prw, prw) 800 CALL histwrite_phy(o_s_pblh, s_pblh) 801 CALL histwrite_phy(o_s_pblt, s_pblt) 802 CALL histwrite_phy(o_s_lcl, s_lcl) 803 CALL histwrite_phy(o_s_therm, s_therm) 804 !IM : Les champs suivants (s_capCL, s_oliqCL, s_cteiCL, s_trmb1, s_trmb2, s_trmb3) ne sont pas definis dans HBTM.F 805 ! IF (o_s_capCL%flag(iff)<=lev_files(iff)) THEN 806 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 807 ! $o_s_capCL%name,itau_w,s_capCL) 808 ! ENDIF 809 ! IF (o_s_oliqCL%flag(iff)<=lev_files(iff)) THEN 810 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 811 ! $o_s_oliqCL%name,itau_w,s_oliqCL) 812 ! ENDIF 813 ! IF (o_s_cteiCL%flag(iff)<=lev_files(iff)) THEN 814 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 815 ! $o_s_cteiCL%name,itau_w,s_cteiCL) 816 ! ENDIF 817 ! IF (o_s_trmb1%flag(iff)<=lev_files(iff)) THEN 818 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 819 ! $o_s_trmb1%name,itau_w,s_trmb1) 820 ! ENDIF 821 ! IF (o_s_trmb2%flag(iff)<=lev_files(iff)) THEN 822 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 823 ! $o_s_trmb2%name,itau_w,s_trmb2) 824 ! ENDIF 825 ! IF (o_s_trmb3%flag(iff)<=lev_files(iff)) THEN 826 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 827 ! $o_s_trmb3%name,itau_w,s_trmb3) 828 ! ENDIF 829 830 IF (.NOT. using_xios) THEN 831 IF (.NOT.ok_all_xml) THEN 832 ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: 833 ! Champs interpolles sur des niveaux de pression 834 DO iff=1, nfiles 835 ll=0 836 DO k=1, nlevSTD 837 bb2=clevSTD(k) 838 IF (bb2.EQ."850".OR.bb2.EQ."700".OR. & 839 bb2.EQ."500".OR.bb2.EQ."200".OR. & 840 bb2.EQ."100".OR. & 841 bb2.EQ."50".OR.bb2.EQ."10") THEN 842 843 ! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 844 ll=ll+1 845 CALL histwrite_phy(o_uSTDlevs(ll),uwriteSTD(:,k,iff), iff) 846 CALL histwrite_phy(o_vSTDlevs(ll),vwriteSTD(:,k,iff), iff) 847 CALL histwrite_phy(o_wSTDlevs(ll),wwriteSTD(:,k,iff), iff) 848 CALL histwrite_phy(o_zSTDlevs(ll),phiwriteSTD(:,k,iff), iff) 849 CALL histwrite_phy(o_qSTDlevs(ll),qwriteSTD(:,k,iff), iff) 850 CALL histwrite_phy(o_tSTDlevs(ll),twriteSTD(:,k,iff), iff) 851 852 ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR. 853 ENDDO 854 ENDDO 855 ENDIF 856 ENDIF !.NOT.using_xios 857 858 IF (using_xios) THEN 859 IF (ok_all_xml) THEN 860 !XIOS CALL xios_get_field_attr("u850",default_value=missing_val) 861 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 862 ll=0 863 DO k=1, nlevSTD 864 bb2=clevSTD(k) 865 IF (bb2=="850".OR.bb2=="700".OR. & 866 bb2=="500".OR.bb2=="200".OR. & 867 bb2=="100".OR. & 868 bb2=="50".OR.bb2=="10") THEN 869 ll=ll+1 870 CALL histwrite_phy(o_uSTDlevs(ll),ulevSTD(:,k)) 871 CALL histwrite_phy(o_vSTDlevs(ll),vlevSTD(:,k)) 872 CALL histwrite_phy(o_wSTDlevs(ll),wlevSTD(:,k)) 873 CALL histwrite_phy(o_zSTDlevs(ll),philevSTD(:,k)) 874 CALL histwrite_phy(o_qSTDlevs(ll),qlevSTD(:,k)) 875 CALL histwrite_phy(o_tSTDlevs(ll),tlevSTD(:,k)) 876 ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR. 877 ENDDO 878 ENDIF 879 ENDIF !using_xios 880 IF (vars_defined) THEN 881 DO i=1, klon 882 IF (pctsrf(i,is_oce)>epsfra.OR. & 883 pctsrf(i,is_sic)>epsfra) THEN 884 zx_tmp_fi2d(i) = (ftsol(i, is_oce) * pctsrf(i,is_oce)+ & 885 ftsol(i, is_sic) * pctsrf(i,is_sic))/ & 886 (pctsrf(i,is_oce)+pctsrf(i,is_sic)) 887 ELSE 888 zx_tmp_fi2d(i) = 273.15 889 ENDIF 890 ENDDO 891 ENDIF 892 CALL histwrite_phy(o_t_oce_sic, zx_tmp_fi2d) 893 894 ! Couplage convection-couche limite 895 IF (iflag_con>=3) THEN 896 IF (iflag_coupl>=1) THEN 897 CALL histwrite_phy(o_ale_bl, ale_bl) 898 CALL histwrite_phy(o_alp_bl, alp_bl) 899 ENDIF !iflag_coupl>=1 900 ENDIF !(iflag_con.GE.3) 901 ! Wakes 902 IF (iflag_con==3) THEN 903 IF (iflag_wake>=1) THEN 904 CALL histwrite_phy(o_ale_wk, ale_wake) 905 CALL histwrite_phy(o_alp_wk, alp_wake) 906 CALL histwrite_phy(o_ale, ale) 907 CALL histwrite_phy(o_alp, alp) 908 CALL histwrite_phy(o_cin, cin) 909 CALL histwrite_phy(o_WAPE, wake_pe) 910 CALL histwrite_phy(o_wake_h, wake_h) 911 CALL histwrite_phy(o_wake_s, wake_s) 912 CALL histwrite_phy(o_wake_deltat, wake_deltat) 913 CALL histwrite_phy(o_wake_deltaq, wake_deltaq) 914 CALL histwrite_phy(o_wake_omg, wake_omg) 915 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_wake(1:klon,1:klev) & 916 /pdtphys 917 CALL histwrite_phy(o_dtwak, zx_tmp_fi3d) 918 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_wake(1:klon,1:klev)/pdtphys 919 CALL histwrite_phy(o_dqwak, zx_tmp_fi3d) 920 ENDIF ! iflag_wake>=1 921 CALL histwrite_phy(o_ftd, ftd) 922 CALL histwrite_phy(o_fqd, fqd) 923 ENDIF !(iflag_con.EQ.3) 924 IF (iflag_con==3.OR.iflag_con==30) THEN 925 ! sortie RomP convection descente insaturee iflag_con=30 926 ! etendue a iflag_con=3 (jyg) 927 CALL histwrite_phy(o_Vprecip, Vprecip) 928 CALL histwrite_phy(o_wdtrainA, wdtrainA) 929 CALL histwrite_phy(o_wdtrainM, wdtrainM) 930 ENDIF !(iflag_con.EQ.3.OR.iflag_con.EQ.30) 931 !!! nrlmd le 10/04/2012 932 IF (iflag_trig_bl>=1) THEN 933 CALL histwrite_phy(o_n2, n2) 934 CALL histwrite_phy(o_s2, s2) 935 CALL histwrite_phy(o_proba_notrig, proba_notrig) 936 CALL histwrite_phy(o_random_notrig, random_notrig) 937 CALL histwrite_phy(o_ale_bl_stat, ale_bl_stat) 938 CALL histwrite_phy(o_ale_bl_trig, ale_bl_trig) 939 ENDIF !(iflag_trig_bl>=1) 940 IF (iflag_clos_bl>=1) THEN 941 CALL histwrite_phy(o_alp_bl_det, alp_bl_det) 942 CALL histwrite_phy(o_alp_bl_fluct_m, alp_bl_fluct_m) 943 CALL histwrite_phy(o_alp_bl_fluct_tke, & 944 alp_bl_fluct_tke) 945 CALL histwrite_phy(o_alp_bl_conv, alp_bl_conv) 946 CALL histwrite_phy(o_alp_bl_stat, alp_bl_stat) 947 ENDIF !(iflag_clos_bl>=1) 948 !!! fin nrlmd le 10/04/2012 949 ! Output of slab ocean variables 950 IF (type_ocean=='slab ') THEN 951 CALL histwrite_phy(o_slab_qflux, slab_wfbils) 952 !CALL histwrite_phy(o_slab_bils, slab_bils) 953 IF (nslay==1) THEN 954 zx_tmp_fi2d(:)=tslab(:,1) 955 CALL histwrite_phy(o_tslab, zx_tmp_fi2d) 956 ELSE 957 CALL histwrite_phy(o_tslab, tslab) 958 ENDIF 959 IF (version_ocean=='sicINT') THEN 960 CALL histwrite_phy(o_slab_bilg, slab_bilg) 961 CALL histwrite_phy(o_slab_tice, tice) 962 CALL histwrite_phy(o_slab_sic, seaice) 963 ENDIF 964 ENDIF !type_ocean == force/slab 965 CALL histwrite_phy(o_weakinv, weak_inversion) 966 CALL histwrite_phy(o_dthmin, dthmin) 967 CALL histwrite_phy(o_cldtau, cldtau) 968 CALL histwrite_phy(o_cldemi, cldemi) 969 CALL histwrite_phy(o_pr_con_l, pmflxr(:,1:klev)) 970 CALL histwrite_phy(o_pr_con_i, pmflxs(:,1:klev)) 971 CALL histwrite_phy(o_pr_lsc_l, prfl(:,1:klev)) 972 CALL histwrite_phy(o_pr_lsc_i, psfl(:,1:klev)) 973 CALL histwrite_phy(o_re, re) 974 CALL histwrite_phy(o_fl, fl) 975 IF (vars_defined) THEN 976 DO i=1, klon 977 zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.) 978 ENDDO 979 ENDIF 980 CALL histwrite_phy(o_rh2m, zx_tmp_fi2d) 981 982 IF (vars_defined) THEN 983 DO i=1, klon 984 zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.) 985 ENDDO 986 ENDIF 987 !CALL histwrite_phy(o_rh2m_min, zx_tmp_fi2d) 988 989 IF (vars_defined) THEN 990 DO i=1, klon 991 zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.) 992 ENDDO 993 ENDIF 994 !CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d) 995 996 CALL histwrite_phy(o_qsat2m, qsat2m) 997 CALL histwrite_phy(o_tpot, tpot) 998 CALL histwrite_phy(o_tpote, tpote) 999 IF (vars_defined) zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter) 1000 CALL histwrite_phy(o_SWnetOR, zx_tmp_fi2d) 1001 CALL histwrite_phy(o_LWdownOR, sollwdown) 1002 CALL histwrite_phy(o_snowl, snow_lsc) 1003 CALL histwrite_phy(o_solldown, sollwdown) 1004 CALL histwrite_phy(o_dtsvdfo, d_ts(:,is_oce)) 1005 CALL histwrite_phy(o_dtsvdft, d_ts(:,is_ter)) 1006 CALL histwrite_phy(o_dtsvdfg, d_ts(:,is_lic)) 1007 CALL histwrite_phy(o_dtsvdfi, d_ts(:,is_sic)) 1008 CALL histwrite_phy(o_z0m, z0m(:,nbsrf+1)) 1009 CALL histwrite_phy(o_z0h, z0h(:,nbsrf+1)) 1010 ! OD550 per species 1011 !--OLIVIER 1012 !This is warranted by treating INCA aerosols as offline aerosols 1013 IF (flag_aerosol>0) THEN 1014 CALL histwrite_phy(o_od550aer, od550aer) 1015 CALL histwrite_phy(o_od865aer, od865aer) 1016 CALL histwrite_phy(o_abs550aer, abs550aer) 1017 CALL histwrite_phy(o_od550lt1aer, od550lt1aer) 1018 CALL histwrite_phy(o_sconcso4, sconcso4) 1019 CALL histwrite_phy(o_sconcno3, sconcno3) 1020 CALL histwrite_phy(o_sconcoa, sconcoa) 1021 CALL histwrite_phy(o_sconcbc, sconcbc) 1022 CALL histwrite_phy(o_sconcss, sconcss) 1023 CALL histwrite_phy(o_sconcdust, sconcdust) 1024 CALL histwrite_phy(o_concso4, concso4) 1025 CALL histwrite_phy(o_concno3, concno3) 1026 CALL histwrite_phy(o_concoa, concoa) 1027 CALL histwrite_phy(o_concbc, concbc) 1028 CALL histwrite_phy(o_concss, concss) 1029 CALL histwrite_phy(o_concdust, concdust) 1030 CALL histwrite_phy(o_loadso4, loadso4) 1031 CALL histwrite_phy(o_loadoa, loadoa) 1032 CALL histwrite_phy(o_loadbc, loadbc) 1033 CALL histwrite_phy(o_loadss, loadss) 1034 CALL histwrite_phy(o_loaddust, loaddust) 1035 !--STRAT AER 1036 ENDIF 1037 IF (flag_aerosol>0.OR.flag_aerosol_strat>=1) THEN 1038 ! DO naero = 1, naero_spc 1039 !--correction mini bug OB 1040 DO naero = 1, naero_tot 1041 CALL histwrite_phy(o_tausumaero(naero), & 1042 tausum_aero(:,2,naero) ) 1043 ENDDO 1044 ENDIF 1045 IF (flag_aerosol_strat>=1) THEN 1046 CALL histwrite_phy(o_tausumaero_lw, & 1047 tausum_aero(:,6,id_STRAT_phy) ) 1048 ENDIF 1049 IF (ok_ade) THEN 1050 CALL histwrite_phy(o_topswad, topswad_aero) 1051 CALL histwrite_phy(o_topswad0, topswad0_aero) 1052 CALL histwrite_phy(o_solswad, solswad_aero) 1053 CALL histwrite_phy(o_solswad0, solswad0_aero) 1054 CALL histwrite_phy(o_toplwad, toplwad_aero) 1055 CALL histwrite_phy(o_toplwad0, toplwad0_aero) 1056 CALL histwrite_phy(o_sollwad, sollwad_aero) 1057 CALL histwrite_phy(o_sollwad0, sollwad0_aero) 1058 !====MS forcing diagnostics 1059 CALL histwrite_phy(o_swtoaas_nat, topsw_aero(:,1)) 1060 CALL histwrite_phy(o_swsrfas_nat, solsw_aero(:,1)) 1061 CALL histwrite_phy(o_swtoacs_nat, topsw0_aero(:,1)) 1062 CALL histwrite_phy(o_swsrfcs_nat, solsw0_aero(:,1)) 1063 !ant 1064 CALL histwrite_phy(o_swtoaas_ant, topsw_aero(:,2)) 1065 CALL histwrite_phy(o_swsrfas_ant, solsw_aero(:,2)) 1066 CALL histwrite_phy(o_swtoacs_ant, topsw0_aero(:,2)) 1067 CALL histwrite_phy(o_swsrfcs_ant, solsw0_aero(:,2)) 1068 !cf 1069 IF (.NOT. aerosol_couple) THEN 1070 CALL histwrite_phy(o_swtoacf_nat, topswcf_aero(:,1)) 1071 CALL histwrite_phy(o_swsrfcf_nat, solswcf_aero(:,1)) 1072 CALL histwrite_phy(o_swtoacf_ant, topswcf_aero(:,2)) 1073 CALL histwrite_phy(o_swsrfcf_ant, solswcf_aero(:,2)) 1074 CALL histwrite_phy(o_swtoacf_zero,topswcf_aero(:,3)) 1075 CALL histwrite_phy(o_swsrfcf_zero,solswcf_aero(:,3)) 1076 ENDIF 1077 !====MS forcing diagnostics 1078 ENDIF 1079 IF (ok_aie) THEN 1080 CALL histwrite_phy(o_topswai, topswai_aero) 1081 CALL histwrite_phy(o_solswai, solswai_aero) 1082 ENDIF 1083 IF (flag_aerosol>0.AND.ok_cdnc) THEN 1084 CALL histwrite_phy(o_scdnc, scdnc) 1085 CALL histwrite_phy(o_cldncl, cldncl) 1086 CALL histwrite_phy(o_reffclws, reffclws) 1087 CALL histwrite_phy(o_reffclwc, reffclwc) 1088 CALL histwrite_phy(o_cldnvi, cldnvi) 1089 CALL histwrite_phy(o_lcc, lcc) 1090 CALL histwrite_phy(o_lcc3d, lcc3d) 1091 CALL histwrite_phy(o_lcc3dcon, lcc3dcon) 1092 CALL histwrite_phy(o_lcc3dstra, lcc3dstra) 1093 CALL histwrite_phy(o_reffclwtop, reffclwtop) 1094 ENDIF 1095 ! Champs 3D: 1096 IF (ok_ade .OR. ok_aie) THEN 1097 CALL histwrite_phy(o_ec550aer, ec550aer) 1098 ENDIF 1099 CALL histwrite_phy(o_lwcon, flwc) 1100 CALL histwrite_phy(o_iwcon, fiwc) 1101 CALL histwrite_phy(o_temp, t_seri) 1102 CALL histwrite_phy(o_theta, theta) 1103 CALL histwrite_phy(o_ovapinit, qx(:,:,ivap)) 1104 CALL histwrite_phy(o_ovap, q_seri) 1105 CALL histwrite_phy(o_oliq, ql_seri) 1106 CALL histwrite_phy(o_geop, zphi) 1107 CALL histwrite_phy(o_vitu, u_seri) 1108 CALL histwrite_phy(o_vitv, v_seri) 1109 CALL histwrite_phy(o_vitw, omega) 1110 CALL histwrite_phy(o_pres, pplay) 1111 CALL histwrite_phy(o_paprs, paprs(:,1:klev)) 1112 IF (vars_defined) THEN 1113 DO i=1, klon 1114 zx_tmp_fi3d1(i,1)= pphis(i)/RG 1115 !020611 zx_tmp_fi3d(i,1)= pphis(i)/RG 1116 ENDDO 1117 DO k=1, klev 1118 !020611 DO k=1, klev-1 1119 DO i=1, klon 1120 !020611 zx_tmp_fi3d(i,k+1)= zx_tmp_fi3d(i,k) - (t_seri(i,k) *RD * 1121 zx_tmp_fi3d1(i,k+1)= zx_tmp_fi3d1(i,k) - (t_seri(i,k) *RD * & 1122 (paprs(i,k+1) - paprs(i,k))) / ( pplay(i,k) * RG ) 1123 ENDDO 1124 ENDDO 1125 ENDIF 1126 CALL histwrite_phy(o_zfull,zx_tmp_fi3d1(:,2:klevp1)) 1127 !020611 $o_zfull%name,itau_w,zx_tmp_fi3d) 1128 1129 IF (vars_defined) THEN 1130 DO i=1, klon 1131 zx_tmp_fi3d(i,1)= pphis(i)/RG - ( & 1132 (t_seri(i,1)+zxtsol(i))/2. *RD * & 1133 (pplay(i,1) - paprs(i,1)))/( (paprs(i,1)+pplay(i,1))/2.* RG) 1134 ENDDO 1135 DO k=1, klev-1 1136 DO i=1, klon 1137 zx_tmp_fi3d(i,k+1)= zx_tmp_fi3d(i,k) - ( & 1138 (t_seri(i,k)+t_seri(i,k+1))/2. *RD * & 1139 (pplay(i,k+1) - pplay(i,k))) / ( paprs(i,k) * RG ) 1140 ENDDO 1141 ENDDO 1142 ENDIF 1143 CALL histwrite_phy(o_zhalf, zx_tmp_fi3d) 1144 CALL histwrite_phy(o_rneb, cldfra) 1145 CALL histwrite_phy(o_rnebcon, rnebcon) 1146 CALL histwrite_phy(o_rnebls, rneb) 1147 IF (vars_defined) THEN 1148 DO k=1, klev 1149 DO i=1, klon 1150 zx_tmp_fi3d(i,k)=cldfra(i,k)*JrNt(i) 1151 ENDDO 1152 ENDDO 1153 ENDIF 1154 CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d) 1155 CALL histwrite_phy(o_rhum, zx_rh) 1156 !CALL histwrite_phy(o_ozone, & 1157 ! wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd) 1158 IF (vars_defined) zx_tmp_fi3d = wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd 1159 CALL histwrite_phy(o_ozone, zx_tmp_fi3d) 1160 1161 IF (read_climoz == 2) THEN 1162 !CALL histwrite_phy(o_ozone_light, & 1163 ! wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd) 1164 IF (vars_defined) zx_tmp_fi3d = wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd 1165 CALL histwrite_phy(o_ozone_light, zx_tmp_fi3d) 1166 ENDIF 1167 1168 !AS: dans phys_output_write il y a en plus : CALL histwrite_phy(o_duphy, d_u) 1169 CALL histwrite_phy(o_dtphy, d_t) 1170 CALL histwrite_phy(o_dqphy, d_qx(:,:,ivap)) 1171 DO nsrf=1, nbsrf 1172 IF (vars_defined) zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf) 1173 CALL histwrite_phy(o_albe_srf(nsrf), zx_tmp_fi2d) 1174 IF (vars_defined) zx_tmp_fi2d(1 : klon) = z0m( 1 : klon, nsrf) 1175 CALL histwrite_phy(o_z0m_srf(nsrf), zx_tmp_fi2d) 1176 IF (vars_defined) zx_tmp_fi2d(1 : klon) = z0h( 1 : klon, nsrf) 1177 CALL histwrite_phy(o_z0h_srf(nsrf), zx_tmp_fi2d) 1178 IF (vars_defined) zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf) 1179 CALL histwrite_phy(o_ages_srf(nsrf), zx_tmp_fi2d) 1180 IF (vars_defined) zx_tmp_fi2d(1 : klon) = snow( 1 : klon, nsrf) 1181 CALL histwrite_phy(o_snow_srf(nsrf), zx_tmp_fi2d) 1182 ENDDO !nsrf=1, nbsrf 1183 CALL histwrite_phy(o_alb1, albsol1) 1184 CALL histwrite_phy(o_alb2, albsol2) 1185 !FH Sorties pour la couche limite 1186 IF (iflag_pbl>1) THEN 1187 zx_tmp_fi3d=0. 1188 IF (vars_defined) THEN 1189 DO nsrf=1,nbsrf 1190 DO k=1,klev 1191 zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) & 1192 +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf) 1193 enddo 1194 enddo 1195 ENDIF 1196 CALL histwrite_phy(o_tke, zx_tmp_fi3d) 1197 1198 CALL histwrite_phy(o_tke_max, zx_tmp_fi3d) 1199 ENDIF 1200 1201 CALL histwrite_phy(o_kz, coefh(:,:,is_ave)) 1202 1203 CALL histwrite_phy(o_kz_max, coefh(:,:,is_ave)) 1204 1205 CALL histwrite_phy(o_clwcon, clwcon0) 1206 CALL histwrite_phy(o_dtdyn, d_t_dyn) 1207 CALL histwrite_phy(o_dqdyn, d_q_dyn) 1208 CALL histwrite_phy(o_dudyn, d_u_dyn) 1209 CALL histwrite_phy(o_dvdyn, d_v_dyn) 1210 1211 IF (vars_defined) THEN 1212 zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys 1213 ENDIF 1214 CALL histwrite_phy(o_dtcon, zx_tmp_fi3d) 1215 IF (iflag_thermals==0)THEN 1216 IF (vars_defined) THEN 1217 zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + & 1218 d_t_ajsb(1:klon,1:klev)/pdtphys 1219 ENDIF 1220 CALL histwrite_phy(o_tntc, zx_tmp_fi3d) 1221 ELSEIF (iflag_thermals>=1.AND.iflag_wake==1)THEN 1222 IF (vars_defined) THEN 1223 zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + & 1224 d_t_ajs(1:klon,1:klev)/pdtphys + & 1225 d_t_wake(1:klon,1:klev)/pdtphys 1226 ENDIF 1227 CALL histwrite_phy(o_tntc, zx_tmp_fi3d) 1228 ENDIF 1229 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_con(1:klon,1:klev)/pdtphys 1230 CALL histwrite_phy(o_ducon, zx_tmp_fi3d) 1231 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_con(1:klon,1:klev)/pdtphys 1232 CALL histwrite_phy(o_dvcon, zx_tmp_fi3d) 1233 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys 1234 CALL histwrite_phy(o_dqcon, zx_tmp_fi3d) 1235 1236 IF (iflag_thermals==0) THEN 1237 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys 1238 CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d) 1239 ELSEIF (iflag_thermals>=1.AND.iflag_wake==1) THEN 1240 IF (vars_defined) THEN 1241 zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys + & 1242 d_q_ajs(1:klon,1:klev)/pdtphys + & 1243 d_q_wake(1:klon,1:klev)/pdtphys 1244 ENDIF 1245 CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d) 1246 ENDIF 1247 1248 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lsc(1:klon,1:klev)/pdtphys 1249 CALL histwrite_phy(o_dtlsc, zx_tmp_fi3d) 1250 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev)=(d_t_lsc(1:klon,1:klev)+ & 1251 d_t_eva(1:klon,1:klev))/pdtphys 1252 CALL histwrite_phy(o_dtlschr, zx_tmp_fi3d) 1253 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys 1254 CALL histwrite_phy(o_dqlsc, zx_tmp_fi3d) 1255 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=beta_prec(1:klon,1:klev) 1256 CALL histwrite_phy(o_beta_prec, zx_tmp_fi3d) 1257 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1258 ! Sorties specifiques a la separation thermiques/non thermiques 1259 IF (iflag_thermals>=1) THEN 1260 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscth(1:klon,1:klev)/pdtphys 1261 CALL histwrite_phy(o_dtlscth, zx_tmp_fi3d) 1262 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscst(1:klon,1:klev)/pdtphys 1263 CALL histwrite_phy(o_dtlscst, zx_tmp_fi3d) 1264 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys 1265 CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d) 1266 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys 1267 CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d) 1268 CALL histwrite_phy(o_plulth, plul_th) 1269 CALL histwrite_phy(o_plulst, plul_st) 1270 IF (vars_defined) THEN 1271 DO k=1,klev 1272 DO i=1,klon 1273 IF (ptconvth(i,k)) THEN 1274 zx_tmp_fi3d(i,k)=1. 1275 ELSE 1276 zx_tmp_fi3d(i,k)=0. 1277 ENDIF 1278 enddo 1279 enddo 1280 ENDIF 1281 CALL histwrite_phy(o_ptconvth, zx_tmp_fi3d) 1282 IF (vars_defined) THEN 1283 DO i=1,klon 1284 zx_tmp_fi2d(1:klon)=lmax_th(:) 1285 enddo 1286 ENDIF 1287 CALL histwrite_phy(o_lmaxth, zx_tmp_fi2d) 1288 ENDIF ! iflag_thermals>=1 1289 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1290 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)/pdtphys 1291 CALL histwrite_phy(o_dtvdf, zx_tmp_fi3d) 1292 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_diss(1:klon,1:klev)/pdtphys 1293 CALL histwrite_phy(o_dtdis, zx_tmp_fi3d) 1294 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys 1295 CALL histwrite_phy(o_dqvdf, zx_tmp_fi3d) 1296 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_eva(1:klon,1:klev)/pdtphys 1297 CALL histwrite_phy(o_dteva, zx_tmp_fi3d) 1298 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_eva(1:klon,1:klev)/pdtphys 1299 CALL histwrite_phy(o_dqeva, zx_tmp_fi3d) 1300 zpt_conv = 0. 1301 WHERE (ptconv) zpt_conv = 1. 1302 CALL histwrite_phy(o_ptconv, zpt_conv) 1303 CALL histwrite_phy(o_ratqs, ratqs) 1304 IF (vars_defined) THEN 1305 zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)/pdtphys - & 1306 d_t_ajsb(1:klon,1:klev)/pdtphys 1307 ENDIF 1308 CALL histwrite_phy(o_dtthe, zx_tmp_fi3d) 1309 IF (vars_defined) THEN 1310 zx_tmp_fi3d(1:klon,1:klev)=d_u_ajs(1:klon,1:klev)/pdtphys 1311 ENDIF 1312 CALL histwrite_phy(o_duthe, zx_tmp_fi3d) 1313 IF (vars_defined) THEN 1314 zx_tmp_fi3d(1:klon,1:klev)=d_v_ajs(1:klon,1:klev)/pdtphys 1315 ENDIF 1316 CALL histwrite_phy(o_dvthe, zx_tmp_fi3d) 1317 1318 IF (iflag_thermals>=1) THEN 1319 ! Pour l instant 0 a y reflichir pour les thermiques 1320 zx_tmp_fi2d=0. 1321 CALL histwrite_phy(o_ftime_th, zx_tmp_fi2d) 1322 CALL histwrite_phy(o_f_th, fm_therm) 1323 CALL histwrite_phy(o_e_th, entr_therm) 1324 CALL histwrite_phy(o_w_th, zw2) 1325 CALL histwrite_phy(o_q_th, zqasc) 1326 CALL histwrite_phy(o_a_th, fraca) 1327 CALL histwrite_phy(o_d_th, detr_therm) 1328 CALL histwrite_phy(o_f0_th, f0) 1329 CALL histwrite_phy(o_zmax_th, zmax_th) 1330 IF (vars_defined) THEN 1331 zx_tmp_fi3d(1:klon,1:klev)=d_q_ajs(1:klon,1:klev)/pdtphys - & 1332 d_q_ajsb(1:klon,1:klev)/pdtphys 1333 ENDIF 1334 CALL histwrite_phy(o_dqthe, zx_tmp_fi3d) 1335 ENDIF !iflag_thermals 1336 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys 1337 CALL histwrite_phy(o_dtajs, zx_tmp_fi3d) 1338 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys 1339 CALL histwrite_phy(o_dqajs, zx_tmp_fi3d) 1340 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys 1341 CALL histwrite_phy(o_dtswr, zx_tmp_fi3d) 1342 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_sw0(1:klon,1:klev)/pdtphys 1343 CALL histwrite_phy(o_dtsw0, zx_tmp_fi3d) 1344 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lwr(1:klon,1:klev)/pdtphys 1345 CALL histwrite_phy(o_dtlwr, zx_tmp_fi3d) 1346 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lw0(1:klon,1:klev)/pdtphys 1347 CALL histwrite_phy(o_dtlw0, zx_tmp_fi3d) 1348 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)/pdtphys 1349 CALL histwrite_phy(o_dtec, zx_tmp_fi3d) 1350 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_vdf(1:klon,1:klev)/pdtphys 1351 CALL histwrite_phy(o_duvdf, zx_tmp_fi3d) 1352 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_vdf(1:klon,1:klev)/pdtphys 1353 CALL histwrite_phy(o_dvvdf, zx_tmp_fi3d) 1354 IF (ok_orodr) THEN 1355 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_oro(1:klon,1:klev)/pdtphys 1356 CALL histwrite_phy(o_duoro, zx_tmp_fi3d) 1357 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_oro(1:klon,1:klev)/pdtphys 1358 CALL histwrite_phy(o_dvoro, zx_tmp_fi3d) 1359 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_oro(1:klon,1:klev)/pdtphys 1360 CALL histwrite_phy(o_dtoro, zx_tmp_fi3d) 1361 ENDIF 1362 IF (ok_orolf) THEN 1363 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_lIF (1:klon,1:klev)/pdtphys 1364 CALL histwrite_phy(o_dulif, zx_tmp_fi3d) 1365 1366 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_lIF (1:klon,1:klev)/pdtphys 1367 CALL histwrite_phy(o_dvlif, zx_tmp_fi3d) 1368 1369 IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lIF (1:klon,1:klev)/pdtphys 1370 CALL histwrite_phy(o_dtlif, zx_tmp_fi3d) 1371 ENDIF 1372 1373 ! IF (ok_hines) THEN 1374 ! IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_hin(1:klon,1:klev)/pdtphys 1375 ! CALL histwrite_phy(o_duhin, zx_tmp_fi3d) 1376 ! IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_hin(1:klon,1:klev)/pdtphys 1377 ! CALL histwrite_phy(o_dvhin, zx_tmp_fi3d) 1378 ! IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys 1379 ! CALL histwrite_phy(o_dthin, zx_tmp_fi3d) 1380 ! ENDIF 1381 1382 ! IF (ok_gwd_rando) THEN 1383 ! CALL histwrite_phy(o_du_gwd_rando, du_gwd_ranDO / pdtphys) 1384 ! CALL histwrite_phy(o_dv_gwd_rando, dv_gwd_ranDO / pdtphys) 1385 ! CALL histwrite_phy(o_vstr_gwd_rando, zvstr_gwd_rando) 1386 ! ENDIF 1387 1388 IF (ok_qch4) THEN 1389 CALL histwrite_phy(o_dqch4, d_q_ch4 / pdtphys) 1390 ENDIF 1391 1392 CALL histwrite_phy(o_rsu, swup) 1393 CALL histwrite_phy(o_rsd, swdn) 1394 CALL histwrite_phy(o_rlu, lwup) 1395 CALL histwrite_phy(o_rld, lwdn) 1396 CALL histwrite_phy(o_rsucs, swup0) 1397 CALL histwrite_phy(o_rsdcs, swdn0) 1398 CALL histwrite_phy(o_rlucs, lwup0) 1399 CALL histwrite_phy(o_rldcs, lwdn0) 1400 IF (vars_defined) THEN 1401 zx_tmp_fi3d(1:klon,1:klev)=d_t(1:klon,1:klev)+ & 1402 d_t_dyn(1:klon,1:klev) 1403 ENDIF 1404 CALL histwrite_phy(o_tnt, zx_tmp_fi3d) 1405 IF (vars_defined) THEN 1406 zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys + & 1407 d_t_lwr(1:klon,1:klev)/pdtphys 1408 ENDIF 1409 CALL histwrite_phy(o_tntr, zx_tmp_fi3d) 1410 IF (vars_defined) THEN 1411 zx_tmp_fi3d(1:klon,1:klev)= (d_t_lsc(1:klon,1:klev)+ & 1412 d_t_eva(1:klon,1:klev)+ & 1413 d_t_vdf(1:klon,1:klev))/pdtphys 1414 ENDIF 1415 CALL histwrite_phy(o_tntscpbl, zx_tmp_fi3d) 1416 IF (vars_defined) THEN 1417 zx_tmp_fi3d(1:klon,1:klev)=d_qx(1:klon,1:klev,ivap)+ & 1418 d_q_dyn(1:klon,1:klev) 1419 ENDIF 1420 CALL histwrite_phy(o_tnhus, zx_tmp_fi3d) 1421 IF (vars_defined) THEN 1422 zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys+ & 1423 d_q_eva(1:klon,1:klev)/pdtphys 1424 ENDIF 1425 CALL histwrite_phy(o_tnhusscpbl, zx_tmp_fi3d) 1426 CALL histwrite_phy(o_evu, coefm(:,:,is_ave)) 1427 IF (vars_defined) THEN 1428 zx_tmp_fi3d(1:klon,1:klev)=q_seri(1:klon,1:klev)+ & 1429 ql_seri(1:klon,1:klev) 1430 ENDIF 1431 CALL histwrite_phy(o_h2o, zx_tmp_fi3d) 1432 IF (iflag_con >= 3) THEN 1433 IF (vars_defined) THEN 1434 zx_tmp_fi3d(1:klon,1:klev)=-1 * (dnwd(1:klon,1:klev)+ & 1435 dnwd0(1:klon,1:klev)) 1436 ENDIF 1437 CALL histwrite_phy(o_mcd, zx_tmp_fi3d) 1438 IF (vars_defined) THEN 1439 zx_tmp_fi3d(1:klon,1:klev)=upwd(1:klon,1:klev) + & 1440 dnwd(1:klon,1:klev)+ dnwd0(1:klon,1:klev) 1441 ENDIF 1442 CALL histwrite_phy(o_dmc, zx_tmp_fi3d) 1443 ELSEIF (iflag_con == 2) THEN 1444 CALL histwrite_phy(o_mcd, pmfd) 1445 CALL histwrite_phy(o_dmc, pmfu + pmfd) 1446 ENDIF 1447 CALL histwrite_phy(o_ref_liq, ref_liq) 1448 CALL histwrite_phy(o_ref_ice, ref_ice) 1449 IF (RCO2_per/=RCO2_act.OR.RCH4_per/=RCH4_act.OR. & 1450 RN2O_per/=RN2O_act.OR.RCFC11_per/=RCFC11_act.OR. & 1451 RCFC12_per/=RCFC12_act) THEN 1452 IF (vars_defined) zx_tmp_fi2d(1 : klon) = swupp ( 1 : klon, klevp1 ) 1453 CALL histwrite_phy(o_rsut4co2, zx_tmp_fi2d) 1454 IF (vars_defined) zx_tmp_fi2d(1 : klon) = lwupp ( 1 : klon, klevp1 ) 1455 CALL histwrite_phy(o_rlut4co2, zx_tmp_fi2d) 1456 IF (vars_defined) zx_tmp_fi2d(1 : klon) = swup0p ( 1 : klon, klevp1 ) 1457 CALL histwrite_phy(o_rsutcs4co2, zx_tmp_fi2d) 1458 IF (vars_defined) zx_tmp_fi2d(1 : klon) = lwup0p ( 1 : klon, klevp1 ) 1459 CALL histwrite_phy(o_rlutcs4co2, zx_tmp_fi2d) 1460 CALL histwrite_phy(o_rsu4co2, swupp) 1461 CALL histwrite_phy(o_rlu4co2, lwupp) 1462 CALL histwrite_phy(o_rsucs4co2, swup0p) 1463 CALL histwrite_phy(o_rlucs4co2, lwup0p) 1464 CALL histwrite_phy(o_rsd4co2, swdnp) 1465 CALL histwrite_phy(o_rld4co2, lwdnp) 1466 CALL histwrite_phy(o_rsdcs4co2, swdn0p) 1467 CALL histwrite_phy(o_rldcs4co2, lwdn0p) 1468 ENDIF 1469 !!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!! 1470 1471 IF (.NOT. using_xios) THEN 1472 IF (.NOT.ok_all_xml) THEN 1473 ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: 1474 ! Champs interpolles sur des niveaux de pression 1475 DO iff=7, nfiles-1 !--here we deal with files 7,8 and 9 1476 1477 CALL histwrite_phy(o_tnondef,tnondef(:,:,iff-6),iff) 1478 CALL histwrite_phy(o_ta,twriteSTD(:,:,iff-6),iff) 1479 CALL histwrite_phy(o_zg,phiwriteSTD(:,:,iff-6),iff) 1480 CALL histwrite_phy(o_hus,qwriteSTD(:,:,iff-6),iff) 1481 CALL histwrite_phy(o_hur,rhwriteSTD(:,:,iff-6),iff) 1482 CALL histwrite_phy(o_ua,uwriteSTD(:,:,iff-6),iff) 1483 CALL histwrite_phy(o_va,vwriteSTD(:,:,iff-6),iff) 1484 CALL histwrite_phy(o_wap,wwriteSTD(:,:,iff-6),iff) 1485 IF (vars_defined) THEN 1486 DO k=1, nlevSTD 1487 DO i=1, klon 1488 IF (tnondef(i,k,iff-6).NE.missing_val) THEN 1489 IF (freq_outNMC(iff-6).LT.0) THEN 1490 freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6) 1491 ELSE 1492 freq_moyNMC(iff-6)=freq_outNMC(iff-6)/freq_calNMC(iff-6) 1493 ENDIF 1494 zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i,k,iff-6))/freq_moyNMC(iff-6) 1495 ELSE 1496 zx_tmp_fi3d_STD(i,k) = missing_val 1497 ENDIF 1498 ENDDO 1499 ENDDO 1500 ENDIF 1501 CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD,iff) 1502 IF (vars_defined) THEN 1503 DO k=1, nlevSTD 1504 DO i=1, klon 1505 IF (O3sumSTD(i,k,iff-6).NE.missing_val) THEN 1506 zx_tmp_fi3d_STD(i,k) = O3sumSTD(i,k,iff-6) * 1.e+9 1507 ELSE 1508 zx_tmp_fi3d_STD(i,k) = missing_val 1509 ENDIF 1510 ENDDO 1511 ENDDO !k=1, nlevSTD 1512 ENDIF 1513 CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD,iff) 1514 IF (read_climoz == 2) THEN 1515 IF (vars_defined) THEN 1516 DO k=1, nlevSTD 1517 DO i=1, klon 1518 IF (O3daysumSTD(i,k,iff-6).NE.missing_val) THEN 1519 zx_tmp_fi3d_STD(i,k) = O3daysumSTD(i,k,iff-6) * 1.e+9 1520 ELSE 1521 zx_tmp_fi3d_STD(i,k) = missing_val 1522 ENDIF 1523 ENDDO 1524 ENDDO !k=1, nlevSTD 1525 ENDIF 1526 CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD,iff) 1527 ENDIF 1528 CALL histwrite_phy(o_uxv,uvsumSTD(:,:,iff-6),iff) 1529 CALL histwrite_phy(o_vxq,vqsumSTD(:,:,iff-6),iff) 1530 CALL histwrite_phy(o_vxT,vTsumSTD(:,:,iff-6),iff) 1531 CALL histwrite_phy(o_wxq,wqsumSTD(:,:,iff-6),iff) 1532 CALL histwrite_phy(o_vxphi,vphisumSTD(:,:,iff-6),iff) 1533 CALL histwrite_phy(o_wxT,wTsumSTD(:,:,iff-6),iff) 1534 CALL histwrite_phy(o_uxu,u2sumSTD(:,:,iff-6),iff) 1535 CALL histwrite_phy(o_vxv,v2sumSTD(:,:,iff-6),iff) 1536 CALL histwrite_phy(o_TxT,T2sumSTD(:,:,iff-6),iff) 1537 ENDDO !nfiles 1538 ENDIF 1539 ENDIF 1540 1541 IF (using_xios) THEN 1542 IF (ok_all_xml) THEN 1543 ! DO iff=7, nfiles 1544 1545 ! CALL histwrite_phy(o_tnondef,tnondef(:,:,3)) 1546 CALL histwrite_phy(o_ta,tlevSTD(:,:)) 1547 CALL histwrite_phy(o_zg,philevSTD(:,:)) 1548 CALL histwrite_phy(o_hus,qlevSTD(:,:)) 1549 CALL histwrite_phy(o_hur,rhlevSTD(:,:)) 1550 CALL histwrite_phy(o_ua,ulevSTD(:,:)) 1551 CALL histwrite_phy(o_va,vlevSTD(:,:)) 1552 CALL histwrite_phy(o_wap,wlevSTD(:,:)) 1553 ! IF (vars_defined) THEN 1554 ! DO k=1, nlevSTD 1555 ! DO i=1, klon 1556 ! IF (tnondef(i,k,3).NE.missing_val) THEN 1557 ! IF (freq_outNMC(iff-6).LT.0) THEN 1558 ! freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6) 1559 ! ELSE 1560 ! freq_moyNMC(iff-6)=freq_outNMC(iff-6)/freq_calNMC(iff-6) 1561 ! ENDIF 1562 ! zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i,k,3))/freq_moyNMC(iff-6) 1563 ! ELSE 1564 ! zx_tmp_fi3d_STD(i,k) = missing_val 1565 ! ENDIF 1566 ! ENDDO 1567 ! ENDDO 1568 ! ENDIF 1569 ! CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD) 1570 IF (vars_defined) THEN 1571 DO k=1, nlevSTD 1572 DO i=1, klon 1573 IF (O3STD(i,k)/=missing_val) THEN 1574 zx_tmp_fi3d_STD(i,k) = O3STD(i,k) * 1.e+9 1575 ELSE 1576 zx_tmp_fi3d_STD(i,k) = missing_val 1577 ENDIF 1578 ENDDO 1579 ENDDO !k=1, nlevSTD 1580 ENDIF 1581 CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD) 1582 IF (read_climoz == 2) THEN 1583 IF (vars_defined) THEN 1584 DO k=1, nlevSTD 1585 DO i=1, klon 1586 IF (O3daySTD(i,k)/=missing_val) THEN 1587 zx_tmp_fi3d_STD(i,k) = O3daySTD(i,k) * 1.e+9 1588 ELSE 1589 zx_tmp_fi3d_STD(i,k) = missing_val 1590 ENDIF 1591 ENDDO 1592 ENDDO !k=1, nlevSTD 1593 ENDIF 1594 CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD) 1595 ENDIF 1596 CALL histwrite_phy(o_uxv,uvSTD(:,:)) 1597 CALL histwrite_phy(o_vxq,vqSTD(:,:)) 1598 CALL histwrite_phy(o_vxT,vTSTD(:,:)) 1599 CALL histwrite_phy(o_wxq,wqSTD(:,:)) 1600 CALL histwrite_phy(o_vxphi,vphiSTD(:,:)) 1601 CALL histwrite_phy(o_wxT,wTSTD(:,:)) 1602 CALL histwrite_phy(o_uxu,u2STD(:,:)) 1603 CALL histwrite_phy(o_vxv,v2STD(:,:)) 1604 CALL histwrite_phy(o_TxT,T2STD(:,:)) 1605 ! ENDDO !nfiles 1606 ENDIF 1607 ENDIF !using_xios 1608 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1609 itr = 0 1610 DO iq = 1, nqtot 1611 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 1612 itr = itr+1 1613 CALL histwrite_phy(o_trac(itr), tr_seri(:,:,itr)) 1614 CALL histwrite_phy(o_dtr_vdf(itr),d_tr_cl(:,:,itr)) 1615 CALL histwrite_phy(o_dtr_the(itr),d_tr_th(:,:,itr)) 1616 CALL histwrite_phy(o_dtr_con(itr),d_tr_cv(:,:,itr)) 1617 CALL histwrite_phy(o_dtr_lessi_impa(itr),d_tr_lessi_impa(:,:,itr)) 1618 CALL histwrite_phy(o_dtr_lessi_nucl(itr),d_tr_lessi_nucl(:,:,itr)) 1619 CALL histwrite_phy(o_dtr_insc(itr),d_tr_insc(:,:,itr)) 1620 CALL histwrite_phy(o_dtr_bcscav(itr),d_tr_bcscav(:,:,itr)) 1621 CALL histwrite_phy(o_dtr_evapls(itr),d_tr_evapls(:,:,itr)) 1622 CALL histwrite_phy(o_dtr_ls(itr),d_tr_ls(:,:,itr)) 1623 ! CALL histwrite_phy(o_dtr_dyn(itr),d_tr_dyn(:,:,itr)) 1624 ! CALL histwrite_phy(o_dtr_cl(itr),d_tr_cl(:,:,itr)) 1625 CALL histwrite_phy(o_dtr_trsp(itr),d_tr_trsp(:,:,itr)) 1626 CALL histwrite_phy(o_dtr_sscav(itr),d_tr_sscav(:,:,itr)) 1627 CALL histwrite_phy(o_dtr_sat(itr),d_tr_sat(:,:,itr)) 1628 CALL histwrite_phy(o_dtr_uscav(itr),d_tr_uscav(:,:,itr)) 1629 zx_tmp_fi2d=0. 1630 IF (vars_defined) THEN 1631 DO k=1,klev 1632 zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,itr) 1633 ENDDO 1634 ENDIF 1635 CALL histwrite_phy(o_trac_cum(itr), zx_tmp_fi2d) 1636 ENDDO 1637 1638 IF (.NOT.vars_defined) THEN 1639 !$OMP MASTER 1640 #ifndef CPP_IOIPSL_NO_OUTPUT 1641 DO iff=1,nfiles 1642 IF (clef_files(iff)) THEN 1643 CALL histend(nid_files(iff)) 1644 ndex2d = 0 1645 ndex3d = 0 1646 1647 ENDIF ! clef_files 1648 ENDDO ! iff 469 ! CALL xios_update_calendar(itau_w) 470 CALL xios_update_calendar(itap) 471 ENDIF 472 !$OMP END MASTER 473 !$OMP BARRIER 474 ENDIF !using_xios 475 476 ! On procède à l'écriture ou à la définition des nombreuses variables: 477 !!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 478 CALL histwrite_phy(o_phis, pphis) 479 CALL histwrite_phy(o_aire, cell_area) 480 481 IF (vars_defined) THEN 482 DO i = 1, klon 483 zx_tmp_fi2d(i) = pctsrf(i, is_ter) + pctsrf(i, is_lic) 484 ENDDO 485 ENDIF 486 487 CALL histwrite_phy(o_contfracATM, zx_tmp_fi2d) 488 CALL histwrite_phy(o_contfracOR, pctsrf(:, is_ter)) 489 CALL histwrite_phy(o_aireTER, paire_ter) 490 491 !!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 492 ! JE20141223 << 493 INCLUDE "spla_output_write.h" 494 ! JE20141223 >> 495 496 CALL histwrite_phy(o_flat, zxfluxlat) 497 CALL histwrite_phy(o_slp, slp) 498 CALL histwrite_phy(o_tsol, zxtsol) 499 CALL histwrite_phy(o_t2m, zt2m) 500 CALL histwrite_phy(o_t2m_min, zt2m) 501 CALL histwrite_phy(o_t2m_max, zt2m) 502 CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon) 503 CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon) 504 505 IF (vars_defined) THEN 506 DO i = 1, klon 507 zx_tmp_fi2d(i) = SQRT(zu10m(i) * zu10m(i) + zv10m(i) * zv10m(i)) 508 ENDDO 509 ENDIF 510 CALL histwrite_phy(o_wind10m, zx_tmp_fi2d) 511 512 IF (vars_defined) THEN 513 DO i = 1, klon 514 zx_tmp_fi2d(i) = SQRT(zu10m(i) * zu10m(i) + zv10m(i) * zv10m(i)) 515 ENDDO 516 ENDIF 517 CALL histwrite_phy(o_wind10max, zx_tmp_fi2d) 518 519 CALL histwrite_phy(o_gusts, gustiness) 520 521 IF (vars_defined) THEN 522 DO i = 1, klon 523 zx_tmp_fi2d(i) = pctsrf(i, is_sic) 524 ENDDO 525 ENDIF 526 CALL histwrite_phy(o_sicf, zx_tmp_fi2d) 527 CALL histwrite_phy(o_q2m, zq2m) 528 CALL histwrite_phy(o_ustar, zustar) 529 CALL histwrite_phy(o_u10m, zu10m) 530 CALL histwrite_phy(o_v10m, zv10m) 531 532 IF (vars_defined) THEN 533 DO i = 1, klon 534 zx_tmp_fi2d(i) = paprs(i, 1) 535 ENDDO 536 ENDIF 537 CALL histwrite_phy(o_psol, zx_tmp_fi2d) 538 CALL histwrite_phy(o_mass, zmasse) 539 CALL histwrite_phy(o_qsurf, zxqsurf) 540 541 IF (.NOT. ok_veget) THEN 542 CALL histwrite_phy(o_qsol, qsol) 543 ENDIF 544 545 IF (vars_defined) THEN 546 DO i = 1, klon 547 zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i) 548 ENDDO 549 ENDIF 550 551 CALL histwrite_phy(o_precip, zx_tmp_fi2d) 552 CALL histwrite_phy(o_ndayrain, nday_rain) 553 554 IF (vars_defined) THEN 555 DO i = 1, klon 556 zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i) 557 ENDDO 558 ENDIF 559 CALL histwrite_phy(o_plul, zx_tmp_fi2d) 560 561 IF (vars_defined) THEN 562 DO i = 1, klon 563 zx_tmp_fi2d(i) = rain_con(i) + snow_con(i) 564 ENDDO 565 ENDIF 566 CALL histwrite_phy(o_pluc, zx_tmp_fi2d) 567 CALL histwrite_phy(o_snow, snow_fall) 568 CALL histwrite_phy(o_msnow, zxsnow) 569 CALL histwrite_phy(o_fsnow, zfra_o) 570 CALL histwrite_phy(o_evap, evap) 571 CALL histwrite_phy(o_tops, topsw) 572 CALL histwrite_phy(o_tops0, topsw0) 573 CALL histwrite_phy(o_topl, toplw) 574 CALL histwrite_phy(o_topl0, toplw0) 575 576 IF (vars_defined) THEN 577 zx_tmp_fi2d(1:klon) = swup (1:klon, klevp1) 578 ENDIF 579 CALL histwrite_phy(o_SWupTOA, zx_tmp_fi2d) 580 581 IF (vars_defined) THEN 582 zx_tmp_fi2d(1:klon) = swup0 (1:klon, klevp1) 583 ENDIF 584 CALL histwrite_phy(o_SWupTOAclr, zx_tmp_fi2d) 585 586 IF (vars_defined) THEN 587 zx_tmp_fi2d(1:klon) = swdn (1:klon, klevp1) 588 ENDIF 589 CALL histwrite_phy(o_SWdnTOA, zx_tmp_fi2d) 590 591 IF (vars_defined) THEN 592 zx_tmp_fi2d(1:klon) = swdn0 (1:klon, klevp1) 593 ENDIF 594 CALL histwrite_phy(o_SWdnTOAclr, zx_tmp_fi2d) 595 596 IF (vars_defined) THEN 597 zx_tmp_fi2d(:) = topsw(:) - toplw(:) 598 ENDIF 599 CALL histwrite_phy(o_nettop, zx_tmp_fi2d) 600 CALL histwrite_phy(o_SWup200, SWup200) 601 CALL histwrite_phy(o_SWup200clr, SWup200clr) 602 CALL histwrite_phy(o_SWdn200, SWdn200) 603 CALL histwrite_phy(o_SWdn200clr, SWdn200clr) 604 CALL histwrite_phy(o_LWup200, LWup200) 605 CALL histwrite_phy(o_LWup200clr, LWup200clr) 606 CALL histwrite_phy(o_LWdn200, LWdn200) 607 CALL histwrite_phy(o_LWdn200clr, LWdn200clr) 608 CALL histwrite_phy(o_sols, solsw) 609 CALL histwrite_phy(o_sols0, solsw0) 610 CALL histwrite_phy(o_soll, sollw) 611 CALL histwrite_phy(o_radsol, radsol) 612 CALL histwrite_phy(o_soll0, sollw0) 613 614 IF (vars_defined) THEN 615 zx_tmp_fi2d(1:klon) = swup (1:klon, 1) 616 ENDIF 617 CALL histwrite_phy(o_SWupSFC, zx_tmp_fi2d) 618 619 IF (vars_defined) THEN 620 zx_tmp_fi2d(1:klon) = swup0 (1:klon, 1) 621 ENDIF 622 CALL histwrite_phy(o_SWupSFCclr, zx_tmp_fi2d) 623 624 IF (vars_defined) THEN 625 zx_tmp_fi2d(1:klon) = swdn (1:klon, 1) 626 ENDIF 627 CALL histwrite_phy(o_SWdnSFC, zx_tmp_fi2d) 628 629 IF (vars_defined) THEN 630 zx_tmp_fi2d(1:klon) = swdn0 (1:klon, 1) 631 ENDIF 632 CALL histwrite_phy(o_SWdnSFCclr, zx_tmp_fi2d) 633 634 IF (vars_defined) THEN 635 zx_tmp_fi2d(1:klon) = sollwdown(1:klon) - sollw(1:klon) 636 ENDIF 637 CALL histwrite_phy(o_LWupSFC, zx_tmp_fi2d) 638 CALL histwrite_phy(o_LWdnSFC, sollwdown) 639 640 IF (vars_defined) THEN 641 sollwdownclr(1:klon) = -1. * lwdn0(1:klon, 1) 642 zx_tmp_fi2d(1:klon) = sollwdownclr(1:klon) - sollw0(1:klon) 643 ENDIF 644 CALL histwrite_phy(o_LWupSFCclr, zx_tmp_fi2d) 645 CALL histwrite_phy(o_LWdnSFCclr, sollwdownclr) 646 CALL histwrite_phy(o_bils, bils) 647 CALL histwrite_phy(o_bils_diss, bils_diss) 648 CALL histwrite_phy(o_bils_ec, bils_ec) 649 IF (iflag_ener_conserv>=1) THEN 650 CALL histwrite_phy(o_bils_ech, bils_ech) 651 ENDIF 652 CALL histwrite_phy(o_bils_tke, bils_tke) 653 CALL histwrite_phy(o_bils_kinetic, bils_kinetic) 654 CALL histwrite_phy(o_bils_latent, bils_latent) 655 CALL histwrite_phy(o_bils_enthalp, bils_enthalp) 656 657 IF (vars_defined) THEN 658 zx_tmp_fi2d(1:klon) = -1 * sens(1:klon) 659 ENDIF 660 CALL histwrite_phy(o_sens, zx_tmp_fi2d) 661 CALL histwrite_phy(o_fder, fder) 662 CALL histwrite_phy(o_ffonte, zxffonte) 663 CALL histwrite_phy(o_fqcalving, zxfqcalving) 664 CALL histwrite_phy(o_fqfonte, zxfqfonte) 665 IF (vars_defined) THEN 666 zx_tmp_fi2d = 0. 667 DO nsrf = 1, nbsrf 668 zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + pctsrf(:, nsrf) * fluxu(:, 1, nsrf) 669 ENDDO 670 ENDIF 671 CALL histwrite_phy(o_taux, zx_tmp_fi2d) 672 673 IF (vars_defined) THEN 674 zx_tmp_fi2d = 0. 675 DO nsrf = 1, nbsrf 676 zx_tmp_fi2d(:) = zx_tmp_fi2d(:) + pctsrf(:, nsrf) * fluxv(:, 1, nsrf) 677 ENDDO 678 ENDIF 679 CALL histwrite_phy(o_tauy, zx_tmp_fi2d) 680 681 IF (landice_opt >= 1) THEN 682 CALL histwrite_phy(o_snowsrf, snow_o) 683 CALL histwrite_phy(o_qsnow, qsnow) 684 CALL histwrite_phy(o_snowhgt, snowhgt) 685 CALL histwrite_phy(o_toice, to_ice) 686 CALL histwrite_phy(o_sissnow, sissnow) 687 CALL histwrite_phy(o_runoff, runoff) 688 CALL histwrite_phy(o_albslw3, albsol3_lic) 689 ENDIF 690 691 DO nsrf = 1, nbsrf 692 IF (vars_defined) zx_tmp_fi2d(1:klon) = pctsrf(1:klon, nsrf) * 100. 693 CALL histwrite_phy(o_pourc_srf(nsrf), zx_tmp_fi2d) 694 IF (vars_defined) zx_tmp_fi2d(1:klon) = pctsrf(1:klon, nsrf) 695 CALL histwrite_phy(o_fract_srf(nsrf), zx_tmp_fi2d) 696 IF (vars_defined) zx_tmp_fi2d(1:klon) = fluxu(1:klon, 1, nsrf) 697 CALL histwrite_phy(o_taux_srf(nsrf), zx_tmp_fi2d) 698 IF (vars_defined) zx_tmp_fi2d(1:klon) = fluxv(1:klon, 1, nsrf) 699 CALL histwrite_phy(o_tauy_srf(nsrf), zx_tmp_fi2d) 700 IF (vars_defined) zx_tmp_fi2d(1:klon) = ftsol(1:klon, nsrf) 701 CALL histwrite_phy(o_tsol_srf(nsrf), zx_tmp_fi2d) 702 IF (vars_defined) zx_tmp_fi2d(1:klon) = evap_pot(1:klon, nsrf) 703 CALL histwrite_phy(o_evappot_srf(nsrf), zx_tmp_fi2d) 704 IF (vars_defined) zx_tmp_fi2d(1:klon) = ustar(1:klon, nsrf) 705 CALL histwrite_phy(o_ustar_srf(nsrf), zx_tmp_fi2d) 706 IF (vars_defined) zx_tmp_fi2d(1:klon) = u10m(1:klon, nsrf) 707 CALL histwrite_phy(o_u10m_srf(nsrf), zx_tmp_fi2d) 708 IF (vars_defined) zx_tmp_fi2d(1:klon) = v10m(1:klon, nsrf) 709 CALL histwrite_phy(o_v10m_srf(nsrf), zx_tmp_fi2d) 710 IF (vars_defined) zx_tmp_fi2d(1:klon) = t2m(1:klon, nsrf) 711 CALL histwrite_phy(o_t2m_srf(nsrf), zx_tmp_fi2d) 712 IF (vars_defined) zx_tmp_fi2d(1:klon) = fevap(1:klon, nsrf) 713 CALL histwrite_phy(o_evap_srf(nsrf), zx_tmp_fi2d) 714 IF (vars_defined) zx_tmp_fi2d(1:klon) = fluxt(1:klon, 1, nsrf) 715 CALL histwrite_phy(o_sens_srf(nsrf), zx_tmp_fi2d) 716 IF (vars_defined) zx_tmp_fi2d(1:klon) = fluxlat(1:klon, nsrf) 717 CALL histwrite_phy(o_lat_srf(nsrf), zx_tmp_fi2d) 718 IF (vars_defined) zx_tmp_fi2d(1:klon) = fsollw(1:klon, nsrf) 719 CALL histwrite_phy(o_flw_srf(nsrf), zx_tmp_fi2d) 720 IF (vars_defined) zx_tmp_fi2d(1:klon) = fsolsw(1:klon, nsrf) 721 CALL histwrite_phy(o_fsw_srf(nsrf), zx_tmp_fi2d) 722 IF (vars_defined) zx_tmp_fi2d(1:klon) = wfbils(1:klon, nsrf) 723 CALL histwrite_phy(o_wbils_srf(nsrf), zx_tmp_fi2d) 724 725 IF (iflag_pbl > 1) THEN 726 CALL histwrite_phy(o_tke_srf(nsrf), pbl_tke(:, 1:klev, nsrf)) 727 CALL histwrite_phy(o_tke_max_srf(nsrf), pbl_tke(:, 1:klev, nsrf)) 728 ENDIF 729 !jyg< 730 IF (iflag_pbl > 1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1) THEN 731 CALL histwrite_phy(o_dltpbltke_srf(nsrf), wake_delta_pbl_TKE(:, 1:klev, nsrf)) 732 ENDIF 733 !>jyg 734 735 ENDDO 736 DO nsrf = 1, nbsrf + 1 737 CALL histwrite_phy(o_wstar(nsrf), wstar(1:klon, nsrf)) 738 ENDDO 739 740 CALL histwrite_phy(o_cdrm, cdragm) 741 CALL histwrite_phy(o_cdrh, cdragh) 742 CALL histwrite_phy(o_cldl, cldl) 743 CALL histwrite_phy(o_cldm, cldm) 744 CALL histwrite_phy(o_cldh, cldh) 745 CALL histwrite_phy(o_cldt, cldt) 746 CALL histwrite_phy(o_JrNt, JrNt) 747 748 !CALL histwrite_phy(o_cldljn, cldl*JrNt) 749 IF (vars_defined) zx_tmp_fi2d = cldl * JrNt 750 CALL histwrite_phy(o_cldljn, zx_tmp_fi2d) 751 !CALL histwrite_phy(o_cldmjn, cldm*JrNt) 752 IF (vars_defined) zx_tmp_fi2d = cldm * JrNt 753 CALL histwrite_phy(o_cldmjn, zx_tmp_fi2d) 754 !CALL histwrite_phy(o_cldhjn, cldh*JrNt) 755 IF (vars_defined) zx_tmp_fi2d = cldh * JrNt 756 CALL histwrite_phy(o_cldhjn, zx_tmp_fi2d) 757 !CALL histwrite_phy(o_cldtjn, cldt*JrNt) 758 IF (vars_defined) zx_tmp_fi2d = cldt * JrNt 759 CALL histwrite_phy(o_cldtjn, zx_tmp_fi2d) 760 761 CALL histwrite_phy(o_cldq, cldq) 762 IF (vars_defined) zx_tmp_fi2d(1:klon) = flwp(1:klon) 763 CALL histwrite_phy(o_lwp, zx_tmp_fi2d) 764 IF (vars_defined) zx_tmp_fi2d(1:klon) = fiwp(1:klon) 765 CALL histwrite_phy(o_iwp, zx_tmp_fi2d) 766 CALL histwrite_phy(o_ue, ue) 767 CALL histwrite_phy(o_ve, ve) 768 CALL histwrite_phy(o_uq, uq) 769 CALL histwrite_phy(o_vq, vq) 770 IF (iflag_con>=3) THEN ! sb 771 CALL histwrite_phy(o_cape, cape) 772 CALL histwrite_phy(o_pbase, ema_pcb) 773 CALL histwrite_phy(o_ptop, ema_pct) 774 CALL histwrite_phy(o_fbase, ema_cbmf) 775 IF (iflag_con /= 30) THEN 776 CALL histwrite_phy(o_plcl, plcl) 777 CALL histwrite_phy(o_plfc, plfc) 778 CALL histwrite_phy(o_wbeff, wbeff) 779 ENDIF 780 781 CALL histwrite_phy(o_cape_max, cape) 782 783 CALL histwrite_phy(o_upwd, upwd) 784 CALL histwrite_phy(o_Ma, Ma) 785 CALL histwrite_phy(o_dnwd, dnwd) 786 CALL histwrite_phy(o_dnwd0, dnwd0) 787 IF (vars_defined) zx_tmp_fi2d = float(itau_con) / float(itap) 788 CALL histwrite_phy(o_ftime_con, zx_tmp_fi2d) 789 IF (vars_defined) THEN 790 IF (iflag_thermals>=1)THEN 791 zx_tmp_fi3d = dnwd + dnwd0 + upwd + fm_therm(:, 1:klev) 792 ELSE 793 zx_tmp_fi3d = dnwd + dnwd0 + upwd 794 ENDIF 795 ENDIF 796 CALL histwrite_phy(o_mc, zx_tmp_fi3d) 797 ENDIF !iflag_con .GE. 3 798 CALL histwrite_phy(o_prw, prw) 799 CALL histwrite_phy(o_s_pblh, s_pblh) 800 CALL histwrite_phy(o_s_pblt, s_pblt) 801 CALL histwrite_phy(o_s_lcl, s_lcl) 802 CALL histwrite_phy(o_s_therm, s_therm) 803 !IM : Les champs suivants (s_capCL, s_oliqCL, s_cteiCL, s_trmb1, s_trmb2, s_trmb3) ne sont pas definis dans HBTM.F 804 ! IF (o_s_capCL%flag(iff)<=lev_files(iff)) THEN 805 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 806 ! $o_s_capCL%name,itau_w,s_capCL) 807 ! ENDIF 808 ! IF (o_s_oliqCL%flag(iff)<=lev_files(iff)) THEN 809 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 810 ! $o_s_oliqCL%name,itau_w,s_oliqCL) 811 ! ENDIF 812 ! IF (o_s_cteiCL%flag(iff)<=lev_files(iff)) THEN 813 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 814 ! $o_s_cteiCL%name,itau_w,s_cteiCL) 815 ! ENDIF 816 ! IF (o_s_trmb1%flag(iff)<=lev_files(iff)) THEN 817 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 818 ! $o_s_trmb1%name,itau_w,s_trmb1) 819 ! ENDIF 820 ! IF (o_s_trmb2%flag(iff)<=lev_files(iff)) THEN 821 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 822 ! $o_s_trmb2%name,itau_w,s_trmb2) 823 ! ENDIF 824 ! IF (o_s_trmb3%flag(iff)<=lev_files(iff)) THEN 825 ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), 826 ! $o_s_trmb3%name,itau_w,s_trmb3) 827 ! ENDIF 828 829 IF (.NOT. using_xios) THEN 830 IF (.NOT.ok_all_xml) THEN 831 ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: 832 ! Champs interpolles sur des niveaux de pression 833 DO iff = 1, nfiles 834 ll = 0 835 DO k = 1, nlevSTD 836 bb2 = clevSTD(k) 837 IF (bb2.EQ."850".OR.bb2.EQ."700".OR. & 838 bb2.EQ."500".OR.bb2.EQ."200".OR. & 839 bb2.EQ."100".OR. & 840 bb2.EQ."50".OR.bb2.EQ."10") THEN 841 842 ! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 843 ll = ll + 1 844 CALL histwrite_phy(o_uSTDlevs(ll), uwriteSTD(:, k,iff), iff) 845 CALL histwrite_phy(o_vSTDlevs(ll), vwriteSTD(:, k,iff), iff) 846 CALL histwrite_phy(o_wSTDlevs(ll), wwriteSTD(:, k,iff), iff) 847 CALL histwrite_phy(o_zSTDlevs(ll), phiwriteSTD(:, k,iff), iff) 848 CALL histwrite_phy(o_qSTDlevs(ll), qwriteSTD(:, k,iff), iff) 849 CALL histwrite_phy(o_tSTDlevs(ll), twriteSTD(:, k,iff), iff) 850 851 ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR. 852 ENDDO 853 ENDDO 854 ENDIF 855 ENDIF !.NOT.using_xios 856 857 IF (using_xios) THEN 858 IF (ok_all_xml) THEN 859 !XIOS CALL xios_get_field_attr("u850",default_value=missing_val) 860 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 861 ll = 0 862 DO k = 1, nlevSTD 863 bb2 = clevSTD(k) 864 IF (bb2=="850".OR.bb2=="700".OR. & 865 bb2=="500".OR.bb2=="200".OR. & 866 bb2=="100".OR. & 867 bb2=="50".OR.bb2=="10") THEN 868 ll = ll + 1 869 CALL histwrite_phy(o_uSTDlevs(ll), ulevSTD(:, k)) 870 CALL histwrite_phy(o_vSTDlevs(ll), vlevSTD(:, k)) 871 CALL histwrite_phy(o_wSTDlevs(ll), wlevSTD(:, k)) 872 CALL histwrite_phy(o_zSTDlevs(ll), philevSTD(:, k)) 873 CALL histwrite_phy(o_qSTDlevs(ll), qlevSTD(:, k)) 874 CALL histwrite_phy(o_tSTDlevs(ll), tlevSTD(:, k)) 875 ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR. 876 ENDDO 877 ENDIF 878 ENDIF !using_xios 879 IF (vars_defined) THEN 880 DO i = 1, klon 881 IF (pctsrf(i, is_oce)>epsfra.OR. & 882 pctsrf(i, is_sic)>epsfra) THEN 883 zx_tmp_fi2d(i) = (ftsol(i, is_oce) * pctsrf(i, is_oce) + & 884 ftsol(i, is_sic) * pctsrf(i, is_sic)) / & 885 (pctsrf(i, is_oce) + pctsrf(i, is_sic)) 886 ELSE 887 zx_tmp_fi2d(i) = 273.15 888 ENDIF 889 ENDDO 890 ENDIF 891 CALL histwrite_phy(o_t_oce_sic, zx_tmp_fi2d) 892 893 ! Couplage convection-couche limite 894 IF (iflag_con>=3) THEN 895 IF (iflag_coupl>=1) THEN 896 CALL histwrite_phy(o_ale_bl, ale_bl) 897 CALL histwrite_phy(o_alp_bl, alp_bl) 898 ENDIF !iflag_coupl>=1 899 ENDIF !(iflag_con.GE.3) 900 ! Wakes 901 IF (iflag_con==3) THEN 902 IF (iflag_wake>=1) THEN 903 CALL histwrite_phy(o_ale_wk, ale_wake) 904 CALL histwrite_phy(o_alp_wk, alp_wake) 905 CALL histwrite_phy(o_ale, ale) 906 CALL histwrite_phy(o_alp, alp) 907 CALL histwrite_phy(o_cin, cin) 908 CALL histwrite_phy(o_WAPE, wake_pe) 909 CALL histwrite_phy(o_wake_h, wake_h) 910 CALL histwrite_phy(o_wake_s, wake_s) 911 CALL histwrite_phy(o_wake_deltat, wake_deltat) 912 CALL histwrite_phy(o_wake_deltaq, wake_deltaq) 913 CALL histwrite_phy(o_wake_omg, wake_omg) 914 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_wake(1:klon, 1:klev) & 915 / pdtphys 916 CALL histwrite_phy(o_dtwak, zx_tmp_fi3d) 917 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_wake(1:klon, 1:klev) / pdtphys 918 CALL histwrite_phy(o_dqwak, zx_tmp_fi3d) 919 ENDIF ! iflag_wake>=1 920 CALL histwrite_phy(o_ftd, ftd) 921 CALL histwrite_phy(o_fqd, fqd) 922 ENDIF !(iflag_con.EQ.3) 923 IF (iflag_con==3.OR.iflag_con==30) THEN 924 ! sortie RomP convection descente insaturee iflag_con=30 925 ! etendue a iflag_con=3 (jyg) 926 CALL histwrite_phy(o_Vprecip, Vprecip) 927 CALL histwrite_phy(o_wdtrainA, wdtrainA) 928 CALL histwrite_phy(o_wdtrainM, wdtrainM) 929 ENDIF !(iflag_con.EQ.3.OR.iflag_con.EQ.30) 930 !!! nrlmd le 10/04/2012 931 IF (iflag_trig_bl>=1) THEN 932 CALL histwrite_phy(o_n2, n2) 933 CALL histwrite_phy(o_s2, s2) 934 CALL histwrite_phy(o_proba_notrig, proba_notrig) 935 CALL histwrite_phy(o_random_notrig, random_notrig) 936 CALL histwrite_phy(o_ale_bl_stat, ale_bl_stat) 937 CALL histwrite_phy(o_ale_bl_trig, ale_bl_trig) 938 ENDIF !(iflag_trig_bl>=1) 939 IF (iflag_clos_bl>=1) THEN 940 CALL histwrite_phy(o_alp_bl_det, alp_bl_det) 941 CALL histwrite_phy(o_alp_bl_fluct_m, alp_bl_fluct_m) 942 CALL histwrite_phy(o_alp_bl_fluct_tke, & 943 alp_bl_fluct_tke) 944 CALL histwrite_phy(o_alp_bl_conv, alp_bl_conv) 945 CALL histwrite_phy(o_alp_bl_stat, alp_bl_stat) 946 ENDIF !(iflag_clos_bl>=1) 947 !!! fin nrlmd le 10/04/2012 948 ! Output of slab ocean variables 949 IF (type_ocean=='slab ') THEN 950 CALL histwrite_phy(o_slab_qflux, slab_wfbils) 951 !CALL histwrite_phy(o_slab_bils, slab_bils) 952 IF (nslay==1) THEN 953 zx_tmp_fi2d(:) = tslab(:, 1) 954 CALL histwrite_phy(o_tslab, zx_tmp_fi2d) 955 ELSE 956 CALL histwrite_phy(o_tslab, tslab) 957 ENDIF 958 IF (version_ocean=='sicINT') THEN 959 CALL histwrite_phy(o_slab_bilg, slab_bilg) 960 CALL histwrite_phy(o_slab_tice, tice) 961 CALL histwrite_phy(o_slab_sic, seaice) 962 ENDIF 963 ENDIF !type_ocean == force/slab 964 CALL histwrite_phy(o_weakinv, weak_inversion) 965 CALL histwrite_phy(o_dthmin, dthmin) 966 CALL histwrite_phy(o_cldtau, cldtau) 967 CALL histwrite_phy(o_cldemi, cldemi) 968 CALL histwrite_phy(o_pr_con_l, pmflxr(:, 1:klev)) 969 CALL histwrite_phy(o_pr_con_i, pmflxs(:, 1:klev)) 970 CALL histwrite_phy(o_pr_lsc_l, prfl(:, 1:klev)) 971 CALL histwrite_phy(o_pr_lsc_i, psfl(:, 1:klev)) 972 CALL histwrite_phy(o_re, re) 973 CALL histwrite_phy(o_fl, fl) 974 IF (vars_defined) THEN 975 DO i = 1, klon 976 zx_tmp_fi2d(i) = MIN(100., rh2m(i) * 100.) 977 ENDDO 978 ENDIF 979 CALL histwrite_phy(o_rh2m, zx_tmp_fi2d) 980 981 IF (vars_defined) THEN 982 DO i = 1, klon 983 zx_tmp_fi2d(i) = MIN(100., rh2m(i) * 100.) 984 ENDDO 985 ENDIF 986 !CALL histwrite_phy(o_rh2m_min, zx_tmp_fi2d) 987 988 IF (vars_defined) THEN 989 DO i = 1, klon 990 zx_tmp_fi2d(i) = MIN(100., rh2m(i) * 100.) 991 ENDDO 992 ENDIF 993 !CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d) 994 995 CALL histwrite_phy(o_qsat2m, qsat2m) 996 CALL histwrite_phy(o_tpot, tpot) 997 CALL histwrite_phy(o_tpote, tpote) 998 IF (vars_defined) zx_tmp_fi2d(1:klon) = fsolsw(1:klon, is_ter) 999 CALL histwrite_phy(o_SWnetOR, zx_tmp_fi2d) 1000 CALL histwrite_phy(o_LWdownOR, sollwdown) 1001 CALL histwrite_phy(o_snowl, snow_lsc) 1002 CALL histwrite_phy(o_solldown, sollwdown) 1003 CALL histwrite_phy(o_dtsvdfo, d_ts(:, is_oce)) 1004 CALL histwrite_phy(o_dtsvdft, d_ts(:, is_ter)) 1005 CALL histwrite_phy(o_dtsvdfg, d_ts(:, is_lic)) 1006 CALL histwrite_phy(o_dtsvdfi, d_ts(:, is_sic)) 1007 CALL histwrite_phy(o_z0m, z0m(:, nbsrf + 1)) 1008 CALL histwrite_phy(o_z0h, z0h(:, nbsrf + 1)) 1009 ! OD550 per species 1010 !--OLIVIER 1011 !This is warranted by treating INCA aerosols as offline aerosols 1012 IF (flag_aerosol>0) THEN 1013 CALL histwrite_phy(o_od550aer, od550aer) 1014 CALL histwrite_phy(o_od865aer, od865aer) 1015 CALL histwrite_phy(o_abs550aer, abs550aer) 1016 CALL histwrite_phy(o_od550lt1aer, od550lt1aer) 1017 CALL histwrite_phy(o_sconcso4, sconcso4) 1018 CALL histwrite_phy(o_sconcno3, sconcno3) 1019 CALL histwrite_phy(o_sconcoa, sconcoa) 1020 CALL histwrite_phy(o_sconcbc, sconcbc) 1021 CALL histwrite_phy(o_sconcss, sconcss) 1022 CALL histwrite_phy(o_sconcdust, sconcdust) 1023 CALL histwrite_phy(o_concso4, concso4) 1024 CALL histwrite_phy(o_concno3, concno3) 1025 CALL histwrite_phy(o_concoa, concoa) 1026 CALL histwrite_phy(o_concbc, concbc) 1027 CALL histwrite_phy(o_concss, concss) 1028 CALL histwrite_phy(o_concdust, concdust) 1029 CALL histwrite_phy(o_loadso4, loadso4) 1030 CALL histwrite_phy(o_loadoa, loadoa) 1031 CALL histwrite_phy(o_loadbc, loadbc) 1032 CALL histwrite_phy(o_loadss, loadss) 1033 CALL histwrite_phy(o_loaddust, loaddust) 1034 !--STRAT AER 1035 ENDIF 1036 IF (flag_aerosol>0.OR.flag_aerosol_strat>=1) THEN 1037 ! DO naero = 1, naero_spc 1038 !--correction mini bug OB 1039 DO naero = 1, naero_tot 1040 CALL histwrite_phy(o_tausumaero(naero), & 1041 tausum_aero(:, 2, naero)) 1042 ENDDO 1043 ENDIF 1044 IF (flag_aerosol_strat>=1) THEN 1045 CALL histwrite_phy(o_tausumaero_lw, & 1046 tausum_aero(:, 6, id_STRAT_phy)) 1047 ENDIF 1048 IF (ok_ade) THEN 1049 CALL histwrite_phy(o_topswad, topswad_aero) 1050 CALL histwrite_phy(o_topswad0, topswad0_aero) 1051 CALL histwrite_phy(o_solswad, solswad_aero) 1052 CALL histwrite_phy(o_solswad0, solswad0_aero) 1053 CALL histwrite_phy(o_toplwad, toplwad_aero) 1054 CALL histwrite_phy(o_toplwad0, toplwad0_aero) 1055 CALL histwrite_phy(o_sollwad, sollwad_aero) 1056 CALL histwrite_phy(o_sollwad0, sollwad0_aero) 1057 !====MS forcing diagnostics 1058 CALL histwrite_phy(o_swtoaas_nat, topsw_aero(:, 1)) 1059 CALL histwrite_phy(o_swsrfas_nat, solsw_aero(:, 1)) 1060 CALL histwrite_phy(o_swtoacs_nat, topsw0_aero(:, 1)) 1061 CALL histwrite_phy(o_swsrfcs_nat, solsw0_aero(:, 1)) 1062 !ant 1063 CALL histwrite_phy(o_swtoaas_ant, topsw_aero(:, 2)) 1064 CALL histwrite_phy(o_swsrfas_ant, solsw_aero(:, 2)) 1065 CALL histwrite_phy(o_swtoacs_ant, topsw0_aero(:, 2)) 1066 CALL histwrite_phy(o_swsrfcs_ant, solsw0_aero(:, 2)) 1067 !cf 1068 IF (.NOT. aerosol_couple) THEN 1069 CALL histwrite_phy(o_swtoacf_nat, topswcf_aero(:, 1)) 1070 CALL histwrite_phy(o_swsrfcf_nat, solswcf_aero(:, 1)) 1071 CALL histwrite_phy(o_swtoacf_ant, topswcf_aero(:, 2)) 1072 CALL histwrite_phy(o_swsrfcf_ant, solswcf_aero(:, 2)) 1073 CALL histwrite_phy(o_swtoacf_zero, topswcf_aero(:, 3)) 1074 CALL histwrite_phy(o_swsrfcf_zero, solswcf_aero(:, 3)) 1075 ENDIF 1076 !====MS forcing diagnostics 1077 ENDIF 1078 IF (ok_aie) THEN 1079 CALL histwrite_phy(o_topswai, topswai_aero) 1080 CALL histwrite_phy(o_solswai, solswai_aero) 1081 ENDIF 1082 IF (flag_aerosol>0.AND.ok_cdnc) THEN 1083 CALL histwrite_phy(o_scdnc, scdnc) 1084 CALL histwrite_phy(o_cldncl, cldncl) 1085 CALL histwrite_phy(o_reffclws, reffclws) 1086 CALL histwrite_phy(o_reffclwc, reffclwc) 1087 CALL histwrite_phy(o_cldnvi, cldnvi) 1088 CALL histwrite_phy(o_lcc, lcc) 1089 CALL histwrite_phy(o_lcc3d, lcc3d) 1090 CALL histwrite_phy(o_lcc3dcon, lcc3dcon) 1091 CALL histwrite_phy(o_lcc3dstra, lcc3dstra) 1092 CALL histwrite_phy(o_reffclwtop, reffclwtop) 1093 ENDIF 1094 ! Champs 3D: 1095 IF (ok_ade .OR. ok_aie) THEN 1096 CALL histwrite_phy(o_ec550aer, ec550aer) 1097 ENDIF 1098 CALL histwrite_phy(o_lwcon, flwc) 1099 CALL histwrite_phy(o_iwcon, fiwc) 1100 CALL histwrite_phy(o_temp, t_seri) 1101 CALL histwrite_phy(o_theta, theta) 1102 CALL histwrite_phy(o_ovapinit, qx(:, :, ivap)) 1103 CALL histwrite_phy(o_ovap, q_seri) 1104 CALL histwrite_phy(o_oliq, ql_seri) 1105 CALL histwrite_phy(o_geop, zphi) 1106 CALL histwrite_phy(o_vitu, u_seri) 1107 CALL histwrite_phy(o_vitv, v_seri) 1108 CALL histwrite_phy(o_vitw, omega) 1109 CALL histwrite_phy(o_pres, pplay) 1110 CALL histwrite_phy(o_paprs, paprs(:, 1:klev)) 1111 IF (vars_defined) THEN 1112 DO i = 1, klon 1113 zx_tmp_fi3d1(i, 1) = pphis(i) / RG 1114 !020611 zx_tmp_fi3d(i,1)= pphis(i)/RG 1115 ENDDO 1116 DO k = 1, klev 1117 !020611 DO k=1, klev-1 1118 DO i = 1, klon 1119 !020611 zx_tmp_fi3d(i,k+1)= zx_tmp_fi3d(i,k) - (t_seri(i,k) *RD * 1120 zx_tmp_fi3d1(i, k + 1) = zx_tmp_fi3d1(i, k) - (t_seri(i, k) * RD * & 1121 (paprs(i, k + 1) - paprs(i, k))) / (pplay(i, k) * RG) 1122 ENDDO 1123 ENDDO 1124 ENDIF 1125 CALL histwrite_phy(o_zfull, zx_tmp_fi3d1(:, 2:klevp1)) 1126 !020611 $o_zfull%name,itau_w,zx_tmp_fi3d) 1127 1128 IF (vars_defined) THEN 1129 DO i = 1, klon 1130 zx_tmp_fi3d(i, 1) = pphis(i) / RG - (& 1131 (t_seri(i, 1) + zxtsol(i)) / 2. * RD * & 1132 (pplay(i, 1) - paprs(i, 1))) / ((paprs(i, 1) + pplay(i, 1)) / 2. * RG) 1133 ENDDO 1134 DO k = 1, klev - 1 1135 DO i = 1, klon 1136 zx_tmp_fi3d(i, k + 1) = zx_tmp_fi3d(i, k) - (& 1137 (t_seri(i, k) + t_seri(i, k + 1)) / 2. * RD * & 1138 (pplay(i, k + 1) - pplay(i, k))) / (paprs(i, k) * RG) 1139 ENDDO 1140 ENDDO 1141 ENDIF 1142 CALL histwrite_phy(o_zhalf, zx_tmp_fi3d) 1143 CALL histwrite_phy(o_rneb, cldfra) 1144 CALL histwrite_phy(o_rnebcon, rnebcon) 1145 CALL histwrite_phy(o_rnebls, rneb) 1146 IF (vars_defined) THEN 1147 DO k = 1, klev 1148 DO i = 1, klon 1149 zx_tmp_fi3d(i, k) = cldfra(i, k) * JrNt(i) 1150 ENDDO 1151 ENDDO 1152 ENDIF 1153 CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d) 1154 CALL histwrite_phy(o_rhum, zx_rh) 1155 !CALL histwrite_phy(o_ozone, & 1156 ! wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd) 1157 IF (vars_defined) zx_tmp_fi3d = wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd 1158 CALL histwrite_phy(o_ozone, zx_tmp_fi3d) 1159 1160 IF (read_climoz == 2) THEN 1161 !CALL histwrite_phy(o_ozone_light, & 1162 ! wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd) 1163 IF (vars_defined) zx_tmp_fi3d = wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd 1164 CALL histwrite_phy(o_ozone_light, zx_tmp_fi3d) 1165 ENDIF 1166 1167 !AS: dans phys_output_write il y a en plus : CALL histwrite_phy(o_duphy, d_u) 1168 CALL histwrite_phy(o_dtphy, d_t) 1169 CALL histwrite_phy(o_dqphy, d_qx(:, :, ivap)) 1170 DO nsrf = 1, nbsrf 1171 IF (vars_defined) zx_tmp_fi2d(1:klon) = falb1(1:klon, nsrf) 1172 CALL histwrite_phy(o_albe_srf(nsrf), zx_tmp_fi2d) 1173 IF (vars_defined) zx_tmp_fi2d(1:klon) = z0m(1:klon, nsrf) 1174 CALL histwrite_phy(o_z0m_srf(nsrf), zx_tmp_fi2d) 1175 IF (vars_defined) zx_tmp_fi2d(1:klon) = z0h(1:klon, nsrf) 1176 CALL histwrite_phy(o_z0h_srf(nsrf), zx_tmp_fi2d) 1177 IF (vars_defined) zx_tmp_fi2d(1:klon) = agesno(1:klon, nsrf) 1178 CALL histwrite_phy(o_ages_srf(nsrf), zx_tmp_fi2d) 1179 IF (vars_defined) zx_tmp_fi2d(1:klon) = snow(1:klon, nsrf) 1180 CALL histwrite_phy(o_snow_srf(nsrf), zx_tmp_fi2d) 1181 ENDDO !nsrf=1, nbsrf 1182 CALL histwrite_phy(o_alb1, albsol1) 1183 CALL histwrite_phy(o_alb2, albsol2) 1184 !FH Sorties pour la couche limite 1185 IF (iflag_pbl>1) THEN 1186 zx_tmp_fi3d = 0. 1187 IF (vars_defined) THEN 1188 DO nsrf = 1, nbsrf 1189 DO k = 1, klev 1190 zx_tmp_fi3d(:, k) = zx_tmp_fi3d(:, k) & 1191 + pctsrf(:, nsrf) * pbl_tke(:, k, nsrf) 1192 enddo 1193 enddo 1194 ENDIF 1195 CALL histwrite_phy(o_tke, zx_tmp_fi3d) 1196 1197 CALL histwrite_phy(o_tke_max, zx_tmp_fi3d) 1198 ENDIF 1199 1200 CALL histwrite_phy(o_kz, coefh(:, :, is_ave)) 1201 1202 CALL histwrite_phy(o_kz_max, coefh(:, :, is_ave)) 1203 1204 CALL histwrite_phy(o_clwcon, clwcon0) 1205 CALL histwrite_phy(o_dtdyn, d_t_dyn) 1206 CALL histwrite_phy(o_dqdyn, d_q_dyn) 1207 CALL histwrite_phy(o_dudyn, d_u_dyn) 1208 CALL histwrite_phy(o_dvdyn, d_v_dyn) 1209 1210 IF (vars_defined) THEN 1211 zx_tmp_fi3d(1:klon, 1:klev) = d_t_con(1:klon, 1:klev) / pdtphys 1212 ENDIF 1213 CALL histwrite_phy(o_dtcon, zx_tmp_fi3d) 1214 IF (iflag_thermals==0)THEN 1215 IF (vars_defined) THEN 1216 zx_tmp_fi3d(1:klon, 1:klev) = d_t_con(1:klon, 1:klev) / pdtphys + & 1217 d_t_ajsb(1:klon, 1:klev) / pdtphys 1218 ENDIF 1219 CALL histwrite_phy(o_tntc, zx_tmp_fi3d) 1220 ELSEIF (iflag_thermals>=1.AND.iflag_wake==1)THEN 1221 IF (vars_defined) THEN 1222 zx_tmp_fi3d(1:klon, 1:klev) = d_t_con(1:klon, 1:klev) / pdtphys + & 1223 d_t_ajs(1:klon, 1:klev) / pdtphys + & 1224 d_t_wake(1:klon, 1:klev) / pdtphys 1225 ENDIF 1226 CALL histwrite_phy(o_tntc, zx_tmp_fi3d) 1227 ENDIF 1228 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_u_con(1:klon, 1:klev) / pdtphys 1229 CALL histwrite_phy(o_ducon, zx_tmp_fi3d) 1230 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_v_con(1:klon, 1:klev) / pdtphys 1231 CALL histwrite_phy(o_dvcon, zx_tmp_fi3d) 1232 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_con(1:klon, 1:klev) / pdtphys 1233 CALL histwrite_phy(o_dqcon, zx_tmp_fi3d) 1234 1235 IF (iflag_thermals==0) THEN 1236 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_con(1:klon, 1:klev) / pdtphys 1237 CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d) 1238 ELSEIF (iflag_thermals>=1.AND.iflag_wake==1) THEN 1239 IF (vars_defined) THEN 1240 zx_tmp_fi3d(1:klon, 1:klev) = d_q_con(1:klon, 1:klev) / pdtphys + & 1241 d_q_ajs(1:klon, 1:klev) / pdtphys + & 1242 d_q_wake(1:klon, 1:klev) / pdtphys 1243 ENDIF 1244 CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d) 1245 ENDIF 1246 1247 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_lsc(1:klon, 1:klev) / pdtphys 1248 CALL histwrite_phy(o_dtlsc, zx_tmp_fi3d) 1249 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = (d_t_lsc(1:klon, 1:klev) + & 1250 d_t_eva(1:klon, 1:klev)) / pdtphys 1251 CALL histwrite_phy(o_dtlschr, zx_tmp_fi3d) 1252 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_lsc(1:klon, 1:klev) / pdtphys 1253 CALL histwrite_phy(o_dqlsc, zx_tmp_fi3d) 1254 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = beta_prec(1:klon, 1:klev) 1255 CALL histwrite_phy(o_beta_prec, zx_tmp_fi3d) 1256 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1257 ! Sorties specifiques a la separation thermiques/non thermiques 1258 IF (iflag_thermals>=1) THEN 1259 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_lscth(1:klon, 1:klev) / pdtphys 1260 CALL histwrite_phy(o_dtlscth, zx_tmp_fi3d) 1261 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_lscst(1:klon, 1:klev) / pdtphys 1262 CALL histwrite_phy(o_dtlscst, zx_tmp_fi3d) 1263 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_lscth(1:klon, 1:klev) / pdtphys 1264 CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d) 1265 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_lscst(1:klon, 1:klev) / pdtphys 1266 CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d) 1267 CALL histwrite_phy(o_plulth, plul_th) 1268 CALL histwrite_phy(o_plulst, plul_st) 1269 IF (vars_defined) THEN 1270 DO k = 1, klev 1271 DO i = 1, klon 1272 IF (ptconvth(i, k)) THEN 1273 zx_tmp_fi3d(i, k) = 1. 1274 ELSE 1275 zx_tmp_fi3d(i, k) = 0. 1276 ENDIF 1277 enddo 1278 enddo 1279 ENDIF 1280 CALL histwrite_phy(o_ptconvth, zx_tmp_fi3d) 1281 IF (vars_defined) THEN 1282 DO i = 1, klon 1283 zx_tmp_fi2d(1:klon) = lmax_th(:) 1284 enddo 1285 ENDIF 1286 CALL histwrite_phy(o_lmaxth, zx_tmp_fi2d) 1287 ENDIF ! iflag_thermals>=1 1288 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1289 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_vdf(1:klon, 1:klev) / pdtphys 1290 CALL histwrite_phy(o_dtvdf, zx_tmp_fi3d) 1291 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_diss(1:klon, 1:klev) / pdtphys 1292 CALL histwrite_phy(o_dtdis, zx_tmp_fi3d) 1293 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_vdf(1:klon, 1:klev) / pdtphys 1294 CALL histwrite_phy(o_dqvdf, zx_tmp_fi3d) 1295 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_eva(1:klon, 1:klev) / pdtphys 1296 CALL histwrite_phy(o_dteva, zx_tmp_fi3d) 1297 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_eva(1:klon, 1:klev) / pdtphys 1298 CALL histwrite_phy(o_dqeva, zx_tmp_fi3d) 1299 zpt_conv = 0. 1300 WHERE (ptconv) zpt_conv = 1. 1301 CALL histwrite_phy(o_ptconv, zpt_conv) 1302 CALL histwrite_phy(o_ratqs, ratqs) 1303 IF (vars_defined) THEN 1304 zx_tmp_fi3d(1:klon, 1:klev) = d_t_ajs(1:klon, 1:klev) / pdtphys - & 1305 d_t_ajsb(1:klon, 1:klev) / pdtphys 1306 ENDIF 1307 CALL histwrite_phy(o_dtthe, zx_tmp_fi3d) 1308 IF (vars_defined) THEN 1309 zx_tmp_fi3d(1:klon, 1:klev) = d_u_ajs(1:klon, 1:klev) / pdtphys 1310 ENDIF 1311 CALL histwrite_phy(o_duthe, zx_tmp_fi3d) 1312 IF (vars_defined) THEN 1313 zx_tmp_fi3d(1:klon, 1:klev) = d_v_ajs(1:klon, 1:klev) / pdtphys 1314 ENDIF 1315 CALL histwrite_phy(o_dvthe, zx_tmp_fi3d) 1316 1317 IF (iflag_thermals>=1) THEN 1318 ! Pour l instant 0 a y reflichir pour les thermiques 1319 zx_tmp_fi2d = 0. 1320 CALL histwrite_phy(o_ftime_th, zx_tmp_fi2d) 1321 CALL histwrite_phy(o_f_th, fm_therm) 1322 CALL histwrite_phy(o_e_th, entr_therm) 1323 CALL histwrite_phy(o_w_th, zw2) 1324 CALL histwrite_phy(o_q_th, zqasc) 1325 CALL histwrite_phy(o_a_th, fraca) 1326 CALL histwrite_phy(o_d_th, detr_therm) 1327 CALL histwrite_phy(o_f0_th, f0) 1328 CALL histwrite_phy(o_zmax_th, zmax_th) 1329 IF (vars_defined) THEN 1330 zx_tmp_fi3d(1:klon, 1:klev) = d_q_ajs(1:klon, 1:klev) / pdtphys - & 1331 d_q_ajsb(1:klon, 1:klev) / pdtphys 1332 ENDIF 1333 CALL histwrite_phy(o_dqthe, zx_tmp_fi3d) 1334 ENDIF !iflag_thermals 1335 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_ajsb(1:klon, 1:klev) / pdtphys 1336 CALL histwrite_phy(o_dtajs, zx_tmp_fi3d) 1337 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_q_ajsb(1:klon, 1:klev) / pdtphys 1338 CALL histwrite_phy(o_dqajs, zx_tmp_fi3d) 1339 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_swr(1:klon, 1:klev) / pdtphys 1340 CALL histwrite_phy(o_dtswr, zx_tmp_fi3d) 1341 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_sw0(1:klon, 1:klev) / pdtphys 1342 CALL histwrite_phy(o_dtsw0, zx_tmp_fi3d) 1343 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_lwr(1:klon, 1:klev) / pdtphys 1344 CALL histwrite_phy(o_dtlwr, zx_tmp_fi3d) 1345 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_lw0(1:klon, 1:klev) / pdtphys 1346 CALL histwrite_phy(o_dtlw0, zx_tmp_fi3d) 1347 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_ec(1:klon, 1:klev) / pdtphys 1348 CALL histwrite_phy(o_dtec, zx_tmp_fi3d) 1349 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_u_vdf(1:klon, 1:klev) / pdtphys 1350 CALL histwrite_phy(o_duvdf, zx_tmp_fi3d) 1351 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_v_vdf(1:klon, 1:klev) / pdtphys 1352 CALL histwrite_phy(o_dvvdf, zx_tmp_fi3d) 1353 IF (ok_orodr) THEN 1354 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_u_oro(1:klon, 1:klev) / pdtphys 1355 CALL histwrite_phy(o_duoro, zx_tmp_fi3d) 1356 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_v_oro(1:klon, 1:klev) / pdtphys 1357 CALL histwrite_phy(o_dvoro, zx_tmp_fi3d) 1358 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_oro(1:klon, 1:klev) / pdtphys 1359 CALL histwrite_phy(o_dtoro, zx_tmp_fi3d) 1360 ENDIF 1361 IF (ok_orolf) THEN 1362 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_u_lIF (1:klon, 1:klev) / pdtphys 1363 CALL histwrite_phy(o_dulif, zx_tmp_fi3d) 1364 1365 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_v_lIF (1:klon, 1:klev) / pdtphys 1366 CALL histwrite_phy(o_dvlif, zx_tmp_fi3d) 1367 1368 IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev) = d_t_lIF (1:klon, 1:klev) / pdtphys 1369 CALL histwrite_phy(o_dtlif, zx_tmp_fi3d) 1370 ENDIF 1371 1372 ! IF (ok_hines) THEN 1373 ! IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_hin(1:klon,1:klev)/pdtphys 1374 ! CALL histwrite_phy(o_duhin, zx_tmp_fi3d) 1375 ! IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_hin(1:klon,1:klev)/pdtphys 1376 ! CALL histwrite_phy(o_dvhin, zx_tmp_fi3d) 1377 ! IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys 1378 ! CALL histwrite_phy(o_dthin, zx_tmp_fi3d) 1379 ! ENDIF 1380 1381 ! IF (ok_gwd_rando) THEN 1382 ! CALL histwrite_phy(o_du_gwd_rando, du_gwd_ranDO / pdtphys) 1383 ! CALL histwrite_phy(o_dv_gwd_rando, dv_gwd_ranDO / pdtphys) 1384 ! CALL histwrite_phy(o_vstr_gwd_rando, zvstr_gwd_rando) 1385 ! ENDIF 1386 1387 IF (ok_qch4) THEN 1388 CALL histwrite_phy(o_dqch4, d_q_ch4 / pdtphys) 1389 ENDIF 1390 1391 CALL histwrite_phy(o_rsu, swup) 1392 CALL histwrite_phy(o_rsd, swdn) 1393 CALL histwrite_phy(o_rlu, lwup) 1394 CALL histwrite_phy(o_rld, lwdn) 1395 CALL histwrite_phy(o_rsucs, swup0) 1396 CALL histwrite_phy(o_rsdcs, swdn0) 1397 CALL histwrite_phy(o_rlucs, lwup0) 1398 CALL histwrite_phy(o_rldcs, lwdn0) 1399 IF (vars_defined) THEN 1400 zx_tmp_fi3d(1:klon, 1:klev) = d_t(1:klon, 1:klev) + & 1401 d_t_dyn(1:klon, 1:klev) 1402 ENDIF 1403 CALL histwrite_phy(o_tnt, zx_tmp_fi3d) 1404 IF (vars_defined) THEN 1405 zx_tmp_fi3d(1:klon, 1:klev) = d_t_swr(1:klon, 1:klev) / pdtphys + & 1406 d_t_lwr(1:klon, 1:klev) / pdtphys 1407 ENDIF 1408 CALL histwrite_phy(o_tntr, zx_tmp_fi3d) 1409 IF (vars_defined) THEN 1410 zx_tmp_fi3d(1:klon, 1:klev) = (d_t_lsc(1:klon, 1:klev) + & 1411 d_t_eva(1:klon, 1:klev) + & 1412 d_t_vdf(1:klon, 1:klev)) / pdtphys 1413 ENDIF 1414 CALL histwrite_phy(o_tntscpbl, zx_tmp_fi3d) 1415 IF (vars_defined) THEN 1416 zx_tmp_fi3d(1:klon, 1:klev) = d_qx(1:klon, 1:klev, ivap) + & 1417 d_q_dyn(1:klon, 1:klev) 1418 ENDIF 1419 CALL histwrite_phy(o_tnhus, zx_tmp_fi3d) 1420 IF (vars_defined) THEN 1421 zx_tmp_fi3d(1:klon, 1:klev) = d_q_lsc(1:klon, 1:klev) / pdtphys + & 1422 d_q_eva(1:klon, 1:klev) / pdtphys 1423 ENDIF 1424 CALL histwrite_phy(o_tnhusscpbl, zx_tmp_fi3d) 1425 CALL histwrite_phy(o_evu, coefm(:, :, is_ave)) 1426 IF (vars_defined) THEN 1427 zx_tmp_fi3d(1:klon, 1:klev) = q_seri(1:klon, 1:klev) + & 1428 ql_seri(1:klon, 1:klev) 1429 ENDIF 1430 CALL histwrite_phy(o_h2o, zx_tmp_fi3d) 1431 IF (iflag_con >= 3) THEN 1432 IF (vars_defined) THEN 1433 zx_tmp_fi3d(1:klon, 1:klev) = -1 * (dnwd(1:klon, 1:klev) + & 1434 dnwd0(1:klon, 1:klev)) 1435 ENDIF 1436 CALL histwrite_phy(o_mcd, zx_tmp_fi3d) 1437 IF (vars_defined) THEN 1438 zx_tmp_fi3d(1:klon, 1:klev) = upwd(1:klon, 1:klev) + & 1439 dnwd(1:klon, 1:klev) + dnwd0(1:klon, 1:klev) 1440 ENDIF 1441 CALL histwrite_phy(o_dmc, zx_tmp_fi3d) 1442 ELSEIF (iflag_con == 2) THEN 1443 CALL histwrite_phy(o_mcd, pmfd) 1444 CALL histwrite_phy(o_dmc, pmfu + pmfd) 1445 ENDIF 1446 CALL histwrite_phy(o_ref_liq, ref_liq) 1447 CALL histwrite_phy(o_ref_ice, ref_ice) 1448 IF (RCO2_per/=RCO2_act.OR.RCH4_per/=RCH4_act.OR. & 1449 RN2O_per/=RN2O_act.OR.RCFC11_per/=RCFC11_act.OR. & 1450 RCFC12_per/=RCFC12_act) THEN 1451 IF (vars_defined) zx_tmp_fi2d(1:klon) = swupp (1:klon, klevp1) 1452 CALL histwrite_phy(o_rsut4co2, zx_tmp_fi2d) 1453 IF (vars_defined) zx_tmp_fi2d(1:klon) = lwupp (1:klon, klevp1) 1454 CALL histwrite_phy(o_rlut4co2, zx_tmp_fi2d) 1455 IF (vars_defined) zx_tmp_fi2d(1:klon) = swup0p (1:klon, klevp1) 1456 CALL histwrite_phy(o_rsutcs4co2, zx_tmp_fi2d) 1457 IF (vars_defined) zx_tmp_fi2d(1:klon) = lwup0p (1:klon, klevp1) 1458 CALL histwrite_phy(o_rlutcs4co2, zx_tmp_fi2d) 1459 CALL histwrite_phy(o_rsu4co2, swupp) 1460 CALL histwrite_phy(o_rlu4co2, lwupp) 1461 CALL histwrite_phy(o_rsucs4co2, swup0p) 1462 CALL histwrite_phy(o_rlucs4co2, lwup0p) 1463 CALL histwrite_phy(o_rsd4co2, swdnp) 1464 CALL histwrite_phy(o_rld4co2, lwdnp) 1465 CALL histwrite_phy(o_rsdcs4co2, swdn0p) 1466 CALL histwrite_phy(o_rldcs4co2, lwdn0p) 1467 ENDIF 1468 !!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!! 1469 1470 IF (.NOT. using_xios) THEN 1471 IF (.NOT.ok_all_xml) THEN 1472 ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: 1473 ! Champs interpolles sur des niveaux de pression 1474 DO iff = 7, nfiles - 1 !--here we deal with files 7,8 and 9 1475 1476 CALL histwrite_phy(o_tnondef, tnondef(:, :, iff - 6), iff) 1477 CALL histwrite_phy(o_ta, twriteSTD(:, :, iff - 6), iff) 1478 CALL histwrite_phy(o_zg, phiwriteSTD(:, :, iff - 6), iff) 1479 CALL histwrite_phy(o_hus, qwriteSTD(:, :, iff - 6), iff) 1480 CALL histwrite_phy(o_hur, rhwriteSTD(:, :, iff - 6), iff) 1481 CALL histwrite_phy(o_ua, uwriteSTD(:, :, iff - 6), iff) 1482 CALL histwrite_phy(o_va, vwriteSTD(:, :, iff - 6), iff) 1483 CALL histwrite_phy(o_wap, wwriteSTD(:, :, iff - 6), iff) 1484 IF (vars_defined) THEN 1485 DO k = 1, nlevSTD 1486 DO i = 1, klon 1487 IF (tnondef(i, k, iff - 6).NE.missing_val) THEN 1488 IF ( 1489 freq_outNMC(iff-6).LT.0) THEN 1490 freq_moyNMC(iff-6) =(mth_len*un_jour)/freq_calNMC(iff-6) 1491 ELSE 1492 freq_moyNMC(iff-6) = freq_outNMC(iff-6)/freq_calNMC(iff-6) 1493 ENDIF 1494 zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i, k, iff-6))/freq_moyNMC(iff-6) 1495 ELSE 1496 zx_tmp_fi3d_STD(i,k) = missing_val 1497 ENDIF 1498 ENDDO 1499 ENDDO 1500 ENDIF 1501 CALL histwrite_phy(o_psbg, zx_tmp_fi3d_STD, iff) 1502 IF (vars_defined) THEN 1503 DO k = 1, nlevSTD 1504 DO i = 1, klon 1505 IF (O3sumSTD(i, k, iff-6).NE.missing_val) THEN 1506 zx_tmp_fi3d_STD(i,k) = O3sumSTD(i, k, iff-6) * 1.e+9 1507 ELSE 1508 zx_tmp_fi3d_STD(i,k) = missing_val 1509 ENDIF 1510 ENDDO 1511 ENDDO !k=1, nlevSTD 1512 ENDIF 1513 CALL histwrite_phy(o_tro3, zx_tmp_fi3d_STD, iff) 1514 IF (read_climoz == 2) THEN 1515 IF (vars_defined) THEN 1516 DO k = 1, nlevSTD 1517 DO i = 1, klon 1518 IF (O3daysumSTD(i, k, iff-6).NE.missing_val) THEN 1519 zx_tmp_fi3d_STD(i,k) = O3daysumSTD(i, k, iff-6) * 1.e+9 1520 ELSE 1521 zx_tmp_fi3d_STD(i,k) = missing_val 1522 ENDIF 1523 ENDDO 1524 ENDDO !k=1, nlevSTD 1525 ENDIF 1526 CALL histwrite_phy(o_tro3_daylight, zx_tmp_fi3d_STD, iff) 1527 ENDIF 1528 CALL histwrite_phy(o_uxv, uvsumSTD(:, :, iff-6), iff) 1529 CALL histwrite_phy(o_vxq, vqsumSTD(:, :, iff-6), iff) 1530 CALL histwrite_phy(o_vxT, vTsumSTD(:, :, iff-6), iff) 1531 CALL histwrite_phy(o_wxq, wqsumSTD(:, :, iff-6), iff) 1532 CALL histwrite_phy(o_vxphi, vphisumSTD(:, :, iff-6), iff) 1533 CALL histwrite_phy(o_wxT, wTsumSTD(:, :, iff-6), iff) 1534 CALL histwrite_phy(o_uxu, u2sumSTD(:, :, iff-6), iff) 1535 CALL histwrite_phy(o_vxv, v2sumSTD(:, :, iff-6), iff) 1536 CALL histwrite_phy(o_TxT, T2sumSTD(:, :, iff-6), iff) 1537 ENDDO !nfiles 1538 ENDIF 1539 ENDIF 1540 1541 IF (using_xios) THEN 1542 IF (ok_all_xml) THEN 1543 ! DO iff=7, nfiles 1544 1545 ! CALL histwrite_phy(o_tnondef,tnondef(:,:,3)) 1546 CALL histwrite_phy(o_ta, tlevSTD(:, :)) 1547 CALL histwrite_phy(o_zg, philevSTD(:, :)) 1548 CALL histwrite_phy(o_hus, qlevSTD(:, :)) 1549 CALL histwrite_phy(o_hur, rhlevSTD(:, :)) 1550 CALL histwrite_phy(o_ua, ulevSTD(:, :)) 1551 CALL histwrite_phy(o_va, vlevSTD(:, :)) 1552 CALL histwrite_phy(o_wap, wlevSTD(:, :)) 1553 ! IF (vars_defined) THEN 1554 ! DO k=1, nlevSTD 1555 ! DO i=1, klon 1556 ! IF (tnondef(i,k,3).NE.missing_val) THEN 1557 ! IF (freq_outNMC(iff-6).LT.0) THEN 1558 ! freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6) 1559 ! ELSE 1560 ! freq_moyNMC(iff-6)=freq_outNMC(iff-6)/freq_calNMC(iff-6) 1561 ! ENDIF 1562 ! zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i,k,3))/freq_moyNMC(iff-6) 1563 ! ELSE 1564 ! zx_tmp_fi3d_STD(i,k) = missing_val 1565 ! ENDIF 1566 ! ENDDO 1567 ! ENDDO 1568 ! ENDIF 1569 ! CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD) 1570 IF (vars_defined) THEN 1571 DO k = 1, nlevSTD 1572 DO i = 1, klon 1573 IF (O3STD(i, k)/=missing_val) THEN 1574 zx_tmp_fi3d_STD(i,k) = O3STD(i, k) * 1.e+9 1575 ELSE 1576 zx_tmp_fi3d_STD(i,k) = missing_val 1577 ENDIF 1578 ENDDO 1579 ENDDO !k=1, nlevSTD 1580 ENDIF 1581 CALL histwrite_phy(o_tro3, zx_tmp_fi3d_STD) 1582 IF (read_climoz == 2) THEN 1583 IF (vars_defined) THEN 1584 DO k = 1, nlevSTD 1585 DO i = 1, klon 1586 IF (O3daySTD(i, k)/=missing_val) THEN 1587 zx_tmp_fi3d_STD(i,k) = O3daySTD(i, k) * 1.e+9 1588 ELSE 1589 zx_tmp_fi3d_STD(i,k) = missing_val 1590 ENDIF 1591 ENDDO 1592 ENDDO !k=1, nlevSTD 1593 ENDIF 1594 CALL histwrite_phy(o_tro3_daylight, zx_tmp_fi3d_STD) 1595 ENDIF 1596 CALL histwrite_phy(o_uxv, uvSTD(:, :)) 1597 CALL histwrite_phy(o_vxq, vqSTD(:, :)) 1598 CALL histwrite_phy(o_vxT, vTSTD(:, :)) 1599 CALL histwrite_phy(o_wxq, wqSTD(:, :)) 1600 CALL histwrite_phy(o_vxphi, vphiSTD(:, :)) 1601 CALL histwrite_phy(o_wxT, wTSTD(:, :)) 1602 CALL histwrite_phy(o_uxu, u2STD(:, :)) 1603 CALL histwrite_phy(o_vxv, v2STD(:, :)) 1604 CALL histwrite_phy(o_TxT, T2STD(:, :)) 1605 ! ENDDO !nfiles 1606 ENDIF 1607 ENDIF !using_xios 1608 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1609 itr = 0 1610 DO iq = 1, nqtot 1611 IF(.NOT.tracers(iq)%isInPhysics) CYCLE 1612 itr = itr+1 1613 CALL histwrite_phy(o_trac(itr), tr_seri(:, :, itr)) 1614 CALL histwrite_phy(o_dtr_vdf(itr), d_tr_cl(:, :, itr)) 1615 CALL histwrite_phy(o_dtr_the(itr), d_tr_th(:, :, itr)) 1616 CALL histwrite_phy(o_dtr_con(itr), d_tr_cv(:, :, itr)) 1617 CALL histwrite_phy(o_dtr_lessi_impa(itr), d_tr_lessi_impa(:, :, itr)) 1618 CALL histwrite_phy(o_dtr_lessi_nucl(itr), d_tr_lessi_nucl(:, :, itr)) 1619 CALL histwrite_phy(o_dtr_insc(itr), d_tr_insc(:, :, itr)) 1620 CALL histwrite_phy(o_dtr_bcscav(itr), d_tr_bcscav(:, :, itr)) 1621 CALL histwrite_phy(o_dtr_evapls(itr), d_tr_evapls(:, :, itr)) 1622 CALL histwrite_phy(o_dtr_ls(itr), d_tr_ls(:, :, itr)) 1623 ! CALL histwrite_phy(o_dtr_dyn(itr),d_tr_dyn(:,:,itr)) 1624 ! CALL histwrite_phy(o_dtr_cl(itr),d_tr_cl(:,:,itr)) 1625 CALL histwrite_phy(o_dtr_trsp(itr), d_tr_trsp(:, :, itr)) 1626 CALL histwrite_phy(o_dtr_sscav(itr), d_tr_sscav(:, :, itr)) 1627 CALL histwrite_phy(o_dtr_sat(itr), d_tr_sat(:, :, itr)) 1628 CALL histwrite_phy(o_dtr_uscav(itr), d_tr_uscav(:, :, itr)) 1629 zx_tmp_fi2d=0. 1630 IF (vars_defined) THEN 1631 DO k = 1, klev 1632 zx_tmp_fi2d(:) = zx_tmp_fi2d(:)+zmasse(:, k)*tr_seri(:, k, itr) 1633 ENDDO 1634 ENDIF 1635 CALL histwrite_phy(o_trac_cum(itr), zx_tmp_fi2d) 1636 ENDDO 1637 1638 IF (.NOT.vars_defined) THEN 1639 !$OMP MASTER 1640 #ifndef CPP_IOIPSL_NO_OUTPUT 1641 DO iff = 1, nfiles 1642 IF (clef_files(iff)) THEN 1643 CALL histend(nid_files(iff)) 1644 ndex2d = 0 1645 ndex3d = 0 1646 1647 ENDIF ! clef_files 1648 ENDDO ! iff 1649 1649 #endif 1650 !On finalise l'initialisation:1651 IF (using_xios) CALL wxios_closedef()1652 1653 !$OMP END MASTER1654 !$OMP BARRIER1655 vars_defined = .TRUE.1656 1657 ENDIF1658 1659 ENDDO ! iinit1660 1661 IF (vars_defined) THEN1662 ! On synchronise les fichiers pour IOIPSL1663 #ifndef CPP_IOIPSL_NO_OUTPUT 1664 !$OMP MASTER1665 DO iff=1,nfiles1666 IF (ok_sync .AND. clef_files(iff)) THEN1667 CALL histsync(nid_files(iff))1668 ENDIF1669 ENDDO1670 !$OMP END MASTER1650 !On finalise l'initialisation: 1651 IF (using_xios) CALL wxios_closedef() 1652 1653 !$OMP END MASTER 1654 !$OMP BARRIER 1655 vars_defined = .TRUE. 1656 1657 ENDIF 1658 1659 ENDDO ! iinit 1660 1661 IF (vars_defined) THEN 1662 ! On synchronise les fichiers pour IOIPSL 1663 #ifndef CPP_IOIPSL_NO_OUTPUT 1664 !$OMP MASTER 1665 DO iff = 1, nfiles 1666 IF (ok_sync .AND. clef_files(iff)) THEN 1667 CALL histsync(nid_files(iff)) 1668 ENDIF 1669 ENDDO 1670 !$OMP END MASTER 1671 1671 #endif 1672 ENDIF1673 1674 END SUBROUTINE phys_output_write_spl1675 1676 END MODULE phys_output_write_spl_mod1672 ENDIF 1673 1674 END SUBROUTINE phys_output_write_spl 1675 1676 END MODULE phys_output_write_spl_mod -
LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/calcaerosolstrato_rrtm.F90
r5099 r5118 1 2 1 ! $Id$ 3 2 4 SUBROUTINE calcaerosolstrato_rrtm(pplay, t_seri,paprs,debut)3 SUBROUTINE calcaerosolstrato_rrtm(pplay, t_seri, paprs, debut) 5 4 6 5 USE phys_state_var_mod, ONLY: tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, tau_aero_lw_rrtm … … 10 9 USE temps_mod 11 10 USE lmdz_yomcst 11 USE lmdz_iniprint, ONLY: lunout, prt_level 12 12 13 13 IMPLICIT NONE … … 16 16 INCLUDE "clesphys.h" 17 17 INCLUDE "paramet.h" 18 INCLUDE "iniprint.h"19 18 20 ! Variable input21 REAL, DIMENSION(klon,klev),INTENT(IN):: t_seri ! Temperature22 REAL, DIMENSION(klon,klev),INTENT(IN):: pplay ! pression pour le mileu de chaque couche (en Pa)23 LOGICAL, INTENT(IN):: debut ! le flag de l'initialisation de la physique24 REAL, DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa)19 ! Variable input 20 REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri ! Temperature 21 REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay ! pression pour le mileu de chaque couche (en Pa) 22 LOGICAL, INTENT(IN) :: debut ! le flag de l'initialisation de la physique 23 REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs ! pression pour chaque inter-couche (en Pa) 25 24 26 ! Stratospheric aerosols optical properties27 REAL, DIMENSION(klon, klev,nbands_sw_rrtm) :: tau_strat, piz_strat, cg_strat28 REAL, DIMENSION(klon, klev,nwave_sw+nwave_lw) :: tau_strat_wave29 REAL, DIMENSION(klon, klev,nbands_lw_rrtm) :: tau_lw_abs_rrtm25 ! Stratospheric aerosols optical properties 26 REAL, DIMENSION(klon, klev, nbands_sw_rrtm) :: tau_strat, piz_strat, cg_strat 27 REAL, DIMENSION(klon, klev, nwave_sw + nwave_lw) :: tau_strat_wave 28 REAL, DIMENSION(klon, klev, nbands_lw_rrtm) :: tau_lw_abs_rrtm 30 29 31 30 INTEGER k, band, wave, i 32 31 REAL zrho, zdz 33 32 34 !--calculate optical properties of the aerosol size distribution from tr_seri35 tau_strat =0.036 piz_strat =0.037 cg_strat =0.038 tau_strat_wave =0.039 tau_lw_abs_rrtm =0.033 !--calculate optical properties of the aerosol size distribution from tr_seri 34 tau_strat = 0.0 35 piz_strat = 0.0 36 cg_strat = 0.0 37 tau_strat_wave = 0.0 38 tau_lw_abs_rrtm = 0.0 40 39 41 40 CALL miecalc_aer(tau_strat, piz_strat, cg_strat, tau_strat_wave, tau_lw_abs_rrtm, paprs, debut) 42 41 43 !!--test CK: deactivate radiative effect of aerosol44 ! tau_strat=0.045 ! piz_strat=0.046 ! cg_strat=0.047 ! tau_strat_wave=0.048 ! tau_lw_abs_rrtm=0.042 !!--test CK: deactivate radiative effect of aerosol 43 ! tau_strat=0.0 44 ! piz_strat=0.0 45 ! cg_strat=0.0 46 ! tau_strat_wave=0.0 47 ! tau_lw_abs_rrtm=0.0 49 48 50 !--test CK: deactivate SW radiative effect of aerosol (but leave LW)51 ! tau_strat=0.052 ! piz_strat=0.053 ! cg_strat=0.049 !--test CK: deactivate SW radiative effect of aerosol (but leave LW) 50 ! tau_strat=0.0 51 ! piz_strat=0.0 52 ! cg_strat=0.0 54 53 55 ! DO wave=1, nwave_sw56 ! tau_strat_wave(:,:,wave)=0.057 ! ENDDO54 ! DO wave=1, nwave_sw 55 ! tau_strat_wave(:,:,wave)=0.0 56 ! ENDDO 58 57 59 !--test CK: deactivate LW radiative effect of aerosol (but leave SW)60 ! tau_lw_abs_rrtm=0.058 !--test CK: deactivate LW radiative effect of aerosol (but leave SW) 59 ! tau_lw_abs_rrtm=0.0 61 60 62 ! DO wave=nwave_sw+1, nwave_sw+nwave_lw63 ! tau_strat_wave(:,:,wave)=0.064 ! ENDDO61 ! DO wave=nwave_sw+1, nwave_sw+nwave_lw 62 ! tau_strat_wave(:,:,wave)=0.0 63 ! ENDDO 65 64 66 !--total vertical aod at the 5 SW + 1 LW wavelengths67 DO wave =1, nwave_sw+nwave_lw68 DO k =1, klev69 tausum_aero(:, wave,id_STRAT_phy)=tausum_aero(:,wave,id_STRAT_phy)+tau_strat_wave(:,k,wave)65 !--total vertical aod at the 5 SW + 1 LW wavelengths 66 DO wave = 1, nwave_sw + nwave_lw 67 DO k = 1, klev 68 tausum_aero(:, wave, id_STRAT_phy) = tausum_aero(:, wave, id_STRAT_phy) + tau_strat_wave(:, k, wave) 70 69 ENDDO 71 70 ENDDO 72 71 73 !--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones74 DO band =1, nbands_sw_rrtm72 !--weighted average for cg, piz and tau, adding strat aerosols on top of tropospheric ones 73 DO band = 1, nbands_sw_rrtm 75 74 !--no stratospheric aerosol in index 1 76 cg_aero_sw_rrtm(:, :,1,band) = cg_aero_sw_rrtm(:,:,2,band)77 piz_aero_sw_rrtm(:, :,1,band) = piz_aero_sw_rrtm(:,:,2,band)78 tau_aero_sw_rrtm(:, :,1,band) = tau_aero_sw_rrtm(:,:,2,band)75 cg_aero_sw_rrtm(:, :, 1, band) = cg_aero_sw_rrtm(:, :, 2, band) 76 piz_aero_sw_rrtm(:, :, 1, band) = piz_aero_sw_rrtm(:, :, 2, band) 77 tau_aero_sw_rrtm(:, :, 1, band) = tau_aero_sw_rrtm(:, :, 2, band) 79 78 80 79 !--tropospheric and stratospheric aerosol in index 2 81 cg_aero_sw_rrtm(:, :,2,band) = ( cg_aero_sw_rrtm(:,:,2,band)*piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) + &82 cg_strat(:,:,band)*piz_strat(:,:,band)*tau_strat(:,:,band) ) /&83 MAX( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +&84 piz_strat(:,:,band)*tau_strat(:,:,band), 1.e-15)85 piz_aero_sw_rrtm(:, :,2,band)= ( piz_aero_sw_rrtm(:,:,2,band)*tau_aero_sw_rrtm(:,:,2,band) +&86 piz_strat(:,:,band)*tau_strat(:,:,band) ) /&87 MAX( tau_aero_sw_rrtm(:,:,2,band) + tau_strat(:,:,band), 1.e-15)88 tau_aero_sw_rrtm(:, :,2,band)= tau_aero_sw_rrtm(:,:,2,band) + tau_strat(:,:,band)80 cg_aero_sw_rrtm(:, :, 2, band) = (cg_aero_sw_rrtm(:, :, 2, band) * piz_aero_sw_rrtm(:, :, 2, band) * tau_aero_sw_rrtm(:, :, 2, band) + & 81 cg_strat(:, :, band) * piz_strat(:, :, band) * tau_strat(:, :, band)) / & 82 MAX(piz_aero_sw_rrtm(:, :, 2, band) * tau_aero_sw_rrtm(:, :, 2, band) + & 83 piz_strat(:, :, band) * tau_strat(:, :, band), 1.e-15) 84 piz_aero_sw_rrtm(:, :, 2, band) = (piz_aero_sw_rrtm(:, :, 2, band) * tau_aero_sw_rrtm(:, :, 2, band) + & 85 piz_strat(:, :, band) * tau_strat(:, :, band)) / & 86 MAX(tau_aero_sw_rrtm(:, :, 2, band) + tau_strat(:, :, band), 1.e-15) 87 tau_aero_sw_rrtm(:, :, 2, band) = tau_aero_sw_rrtm(:, :, 2, band) + tau_strat(:, :, band) 89 88 ENDDO 90 89 91 DO band =1, nbands_lw_rrtm90 DO band = 1, nbands_lw_rrtm 92 91 !--no stratospheric aerosols in index 1 93 tau_aero_lw_rrtm(:, :,1,band) = tau_aero_lw_rrtm(:,:,2,band)92 tau_aero_lw_rrtm(:, :, 1, band) = tau_aero_lw_rrtm(:, :, 2, band) 94 93 !--tropospheric and stratospheric aerosol in index 2 95 tau_aero_lw_rrtm(:, :,2,band) = tau_aero_lw_rrtm(:,:,2,band) + tau_lw_abs_rrtm(:,:,band)94 tau_aero_lw_rrtm(:, :, 2, band) = tau_aero_lw_rrtm(:, :, 2, band) + tau_lw_abs_rrtm(:, :, band) 96 95 ENDDO 97 96 98 WHERE (tau_aero_sw_rrtm < 1.e-14) piz_aero_sw_rrtm =1.099 WHERE (tau_aero_sw_rrtm < 1.e-14) tau_aero_sw_rrtm =1.e-15100 WHERE (tau_aero_lw_rrtm < 1.e-14) tau_aero_lw_rrtm =1.e-1597 WHERE (tau_aero_sw_rrtm < 1.e-14) piz_aero_sw_rrtm = 1.0 98 WHERE (tau_aero_sw_rrtm < 1.e-14) tau_aero_sw_rrtm = 1.e-15 99 WHERE (tau_aero_lw_rrtm < 1.e-14) tau_aero_lw_rrtm = 1.e-15 101 100 102 tausum_strat(:, :)=0.0103 DO i =1,klon104 DO k=1,klev105 IF (stratomask(i,k)>0.5) THEN106 tausum_strat(i,1)=tausum_strat(i,1)+tau_strat_wave(i,k,2) !--550 nm107 tausum_strat(i,2)=tausum_strat(i,2)+tau_strat_wave(i,k,5) !--1020 nm108 tausum_strat(i,3)=tausum_strat(i,3)+tau_strat_wave(i,k,6) !--10 um109 ENDIF110 ENDDO101 tausum_strat(:, :) = 0.0 102 DO i = 1, klon 103 DO k = 1, klev 104 IF (stratomask(i, k)>0.5) THEN 105 tausum_strat(i, 1) = tausum_strat(i, 1) + tau_strat_wave(i, k, 2) !--550 nm 106 tausum_strat(i, 2) = tausum_strat(i, 2) + tau_strat_wave(i, k, 5) !--1020 nm 107 tausum_strat(i, 3) = tausum_strat(i, 3) + tau_strat_wave(i, k, 6) !--10 um 108 ENDIF 109 ENDDO 111 110 ENDDO 112 111 113 DO i =1,klon114 DO k=1,klev115 zrho=pplay(i,k)/t_seri(i,k)/RD !air density in kg/m3116 zdz=(paprs(i,k)-paprs(i,k+1))/zrho/RG !thickness of layer in m117 tau_strat_550(i,k)=tau_strat_wave(i,k,2)/zdz118 tau_strat_1020(i,k)=tau_strat_wave(i,k,5)/zdz119 ENDDO112 DO i = 1, klon 113 DO k = 1, klev 114 zrho = pplay(i, k) / t_seri(i, k) / RD !air density in kg/m3 115 zdz = (paprs(i, k) - paprs(i, k + 1)) / zrho / RG !thickness of layer in m 116 tau_strat_550(i, k) = tau_strat_wave(i, k, 2) / zdz 117 tau_strat_1020(i, k) = tau_strat_wave(i, k, 5) / zdz 118 ENDDO 120 119 ENDDO 121 120 -
LMDZ6/branches/Amaury_dev/libf/phylmd/carbon_cycle_mod.F90
r5112 r5118 1 1 MODULE carbon_cycle_mod 2 !=======================================================================3 ! Authors: Patricia Cadule and Laurent Fairhead4 ! base sur un travail anterieur mene par Patricia Cadule et Josefine Ghattas5 6 ! Purpose and description:7 ! -----------------------8 ! Control module for the carbon CO2 tracers :9 ! - Initialisation of carbon cycle fields10 ! - Definition of fluxes to be exchanged11 12 ! Rest of code is in tracco2i.F9013 14 ! Le cas online/offline est defini par le flag carbon_cycle_cpl (y/n)15 ! Le transport du traceur CO2 est defini par le flag carbon_cycle_tr (y/n)16 ! la provenance des champs (termes de puits) est denini par le flag level_coupling_esm17 18 ! level_coupling_esm : level of coupling of the biogeochemical fields between19 ! LMDZ, ORCHIDEE and NEMO20 ! Definitions of level_coupling_esm in physiq.def21 ! level_coupling_esm = 0 ! No field exchange between LMDZ and ORCHIDEE models22 ! ! No field exchange between LMDZ and NEMO23 ! level_coupling_esm = 1 ! Field exchange between LMDZ and ORCHIDEE models24 ! ! No field exchange between LMDZ and NEMO models25 ! level_coupling_esm = 2 ! No field exchange between LMDZ and ORCHIDEE models26 ! ! Field exchange between LMDZ and NEMO models27 ! level_coupling_esm = 3 ! Field exchange between LMDZ and ORCHIDEE models28 ! ! Field exchange between LMDZ and NEMO models29 !=======================================================================2 !======================================================================= 3 ! Authors: Patricia Cadule and Laurent Fairhead 4 ! base sur un travail anterieur mene par Patricia Cadule et Josefine Ghattas 5 6 ! Purpose and description: 7 ! ----------------------- 8 ! Control module for the carbon CO2 tracers : 9 ! - Initialisation of carbon cycle fields 10 ! - Definition of fluxes to be exchanged 11 12 ! Rest of code is in tracco2i.F90 13 14 ! Le cas online/offline est defini par le flag carbon_cycle_cpl (y/n) 15 ! Le transport du traceur CO2 est defini par le flag carbon_cycle_tr (y/n) 16 ! la provenance des champs (termes de puits) est denini par le flag level_coupling_esm 17 18 ! level_coupling_esm : level of coupling of the biogeochemical fields between 19 ! LMDZ, ORCHIDEE and NEMO 20 ! Definitions of level_coupling_esm in physiq.def 21 ! level_coupling_esm = 0 ! No field exchange between LMDZ and ORCHIDEE models 22 ! ! No field exchange between LMDZ and NEMO 23 ! level_coupling_esm = 1 ! Field exchange between LMDZ and ORCHIDEE models 24 ! ! No field exchange between LMDZ and NEMO models 25 ! level_coupling_esm = 2 ! No field exchange between LMDZ and ORCHIDEE models 26 ! ! Field exchange between LMDZ and NEMO models 27 ! level_coupling_esm = 3 ! Field exchange between LMDZ and ORCHIDEE models 28 ! ! Field exchange between LMDZ and NEMO models 29 !======================================================================= 30 30 31 31 IMPLICIT NONE … … 34 34 PUBLIC :: carbon_cycle_init, infocfields_init 35 35 36 ! Variables read from parmeter file physiq.def36 ! Variables read from parmeter file physiq.def 37 37 LOGICAL, PUBLIC :: carbon_cycle_cpl ! Coupling of CO2 fluxes between LMDZ/ORCHIDEE and LMDZ/OCEAN(PISCES) 38 !$OMP THREADPRIVATE(carbon_cycle_cpl)38 !$OMP THREADPRIVATE(carbon_cycle_cpl) 39 39 LOGICAL, PUBLIC :: carbon_cycle_tr ! 3D transport of CO2 in the atmosphere, parameter read in conf_phys 40 !$OMP THREADPRIVATE(carbon_cycle_tr)40 !$OMP THREADPRIVATE(carbon_cycle_tr) 41 41 LOGICAL, PUBLIC :: carbon_cycle_rad ! flag to activate CO2 interactive radiatively 42 !$OMP THREADPRIVATE(carbon_cycle_rad)42 !$OMP THREADPRIVATE(carbon_cycle_rad) 43 43 INTEGER, PUBLIC :: level_coupling_esm ! Level of coupling for the ESM - 0, 1, 2, 3 44 !$OMP THREADPRIVATE(level_coupling_esm)44 !$OMP THREADPRIVATE(level_coupling_esm) 45 45 LOGICAL, PUBLIC :: read_fco2_ocean_cor ! flag to read corrective oceanic CO2 flux 46 !$OMP THREADPRIVATE(read_fco2_ocean_cor) 46 !$OMP THREADPRIVATE(read_fco2_ocean_cor) 47 47 REAL, PUBLIC :: var_fco2_ocean_cor ! corrective oceanic CO2 flux 48 !$OMP THREADPRIVATE(var_fco2_ocean_cor)48 !$OMP THREADPRIVATE(var_fco2_ocean_cor) 49 49 REAL, PUBLIC :: ocean_area_tot ! total oceanic area to convert flux 50 !$OMP THREADPRIVATE(ocean_area_tot)50 !$OMP THREADPRIVATE(ocean_area_tot) 51 51 LOGICAL, PUBLIC :: read_fco2_land_cor ! flag to read corrective land CO2 flux 52 !$OMP THREADPRIVATE(read_fco2_land_cor) 52 !$OMP THREADPRIVATE(read_fco2_land_cor) 53 53 REAL, PUBLIC :: var_fco2_land_cor ! corrective land CO2 flux 54 !$OMP THREADPRIVATE(var_fco2_land_cor)54 !$OMP THREADPRIVATE(var_fco2_land_cor) 55 55 REAL, PUBLIC :: land_area_tot ! total land area to convert flux 56 !$OMP THREADPRIVATE(land_area_tot)56 !$OMP THREADPRIVATE(land_area_tot) 57 57 58 58 REAL, PUBLIC :: RCO2_glo 59 !$OMP THREADPRIVATE(RCO2_glo)59 !$OMP THREADPRIVATE(RCO2_glo) 60 60 REAL, PUBLIC :: RCO2_tot 61 !$OMP THREADPRIVATE(RCO2_tot)62 63 LOGICAL :: carbon_cycle_emis_comp_omp =.FALSE.64 LOGICAL :: carbon_cycle_emis_comp =.FALSE. ! Calculation of emission compatible65 !$OMP THREADPRIVATE(carbon_cycle_emis_comp)61 !$OMP THREADPRIVATE(RCO2_tot) 62 63 LOGICAL :: carbon_cycle_emis_comp_omp = .FALSE. 64 LOGICAL :: carbon_cycle_emis_comp = .FALSE. ! Calculation of emission compatible 65 !$OMP THREADPRIVATE(carbon_cycle_emis_comp) 66 66 67 67 LOGICAL :: RCO2_inter_omp 68 68 LOGICAL :: RCO2_inter ! RCO2 interactive : if true calculate new value RCO2 for the radiation scheme 69 !$OMP THREADPRIVATE(RCO2_inter)70 71 ! Scalare values when no transport, from physiq.def69 !$OMP THREADPRIVATE(RCO2_inter) 70 71 ! Scalare values when no transport, from physiq.def 72 72 REAL :: fos_fuel_s_omp 73 73 REAL :: fos_fuel_s ! carbon_cycle_fos_fuel dans physiq.def 74 !$OMP THREADPRIVATE(fos_fuel_s)74 !$OMP THREADPRIVATE(fos_fuel_s) 75 75 REAL :: emis_land_s ! not yet implemented 76 !$OMP THREADPRIVATE(emis_land_s)76 !$OMP THREADPRIVATE(emis_land_s) 77 77 78 78 REAL :: airetot ! Total area of the earth surface 79 !$OMP THREADPRIVATE(airetot)79 !$OMP THREADPRIVATE(airetot) 80 80 81 81 INTEGER :: ntr_co2 ! Number of tracers concerning the carbon cycle 82 !$OMP THREADPRIVATE(ntr_co2)83 84 ! fco2_ocn_day : flux CO2 from ocean for 1 day (cumulated) [gC/m2/d]. Allocation and initalization done in cpl_mod85 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocn_day 86 !$OMP THREADPRIVATE(fco2_ocn_day)82 !$OMP THREADPRIVATE(ntr_co2) 83 84 ! fco2_ocn_day : flux CO2 from ocean for 1 day (cumulated) [gC/m2/d]. Allocation and initalization done in cpl_mod 85 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocn_day 86 !$OMP THREADPRIVATE(fco2_ocn_day) 87 87 88 88 REAL, DIMENSION(:), ALLOCATABLE :: fco2_land_day ! flux CO2 from land for 1 day (cumulated) [gC/m2/d] 89 !$OMP THREADPRIVATE(fco2_land_day)89 !$OMP THREADPRIVATE(fco2_land_day) 90 90 REAL, DIMENSION(:), ALLOCATABLE :: fco2_lu_day ! Emission from land use change for 1 day (cumulated) [gC/m2/d] 91 !$OMP THREADPRIVATE(fco2_lu_day)91 !$OMP THREADPRIVATE(fco2_lu_day) 92 92 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ff ! Emission from fossil fuel [kgCO2/m2/s] 93 !$OMP THREADPRIVATE(fco2_ff)93 !$OMP THREADPRIVATE(fco2_ff) 94 94 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_bb ! Emission from biomass burning [kgCO2/m2/s] 95 !$OMP THREADPRIVATE(fco2_bb)95 !$OMP THREADPRIVATE(fco2_bb) 96 96 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land ! Net flux from terrestrial ecocsystems [kgCO2/m2/s] 97 !$OMP THREADPRIVATE(fco2_land)97 !$OMP THREADPRIVATE(fco2_land) 98 98 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_nbp ! Net flux from terrestrial ecocsystems [kgCO2/m2/s] 99 !$OMP THREADPRIVATE(fco2_land_nbp)99 !$OMP THREADPRIVATE(fco2_land_nbp) 100 100 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_nep ! Net flux from terrestrial ecocsystems [kgCO2/m2/s] 101 !$OMP THREADPRIVATE(fco2_land_nep)101 !$OMP THREADPRIVATE(fco2_land_nep) 102 102 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fLuc ! Net flux from terrestrial ecocsystems [kgCO2/m2/s] 103 !$OMP THREADPRIVATE(fco2_land_fLuc)103 !$OMP THREADPRIVATE(fco2_land_fLuc) 104 104 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fwoodharvest ! Net flux from terrestrial ecocsystems [kgCO2/m2/s] 105 !$OMP THREADPRIVATE(fco2_land_fwoodharvest)105 !$OMP THREADPRIVATE(fco2_land_fwoodharvest) 106 106 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_fHarvest ! Net flux from terrestrial ecocsystems [kgCO2/m2/s] 107 !$OMP THREADPRIVATE(fco2_land_fHarvest)107 !$OMP THREADPRIVATE(fco2_land_fHarvest) 108 108 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean ! Net flux from ocean [kgCO2/m2/s] 109 !$OMP THREADPRIVATE(fco2_ocean)109 !$OMP THREADPRIVATE(fco2_ocean) 110 110 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_ocean_cor ! Net corrective flux from ocean [kgCO2/m2/s] 111 !$OMP THREADPRIVATE(fco2_ocean_cor)111 !$OMP THREADPRIVATE(fco2_ocean_cor) 112 112 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_cor ! Net corrective flux from land [kgCO2/m2/s] 113 !$OMP THREADPRIVATE(fco2_land_cor)114 115 REAL, DIMENSION(:, :), ALLOCATABLE :: dtr_add ! Tracer concentration to be injected116 !$OMP THREADPRIVATE(dtr_add)117 118 ! Following 2 fields will be allocated and initialized in surf_land_orchidee113 !$OMP THREADPRIVATE(fco2_land_cor) 114 115 REAL, DIMENSION(:, :), ALLOCATABLE :: dtr_add ! Tracer concentration to be injected 116 !$OMP THREADPRIVATE(dtr_add) 117 118 ! Following 2 fields will be allocated and initialized in surf_land_orchidee 119 119 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_land_inst ! flux CO2 from land at one time step 120 !$OMP THREADPRIVATE(fco2_land_inst)120 !$OMP THREADPRIVATE(fco2_land_inst) 121 121 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: fco2_lu_inst ! Emission from land use change at one time step 122 !$OMP THREADPRIVATE(fco2_lu_inst)123 124 ! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE 122 !$OMP THREADPRIVATE(fco2_lu_inst) 123 124 ! Calculated co2 field to be send to the ocean via the coupler and to ORCHIDEE 125 125 REAL, DIMENSION(:), ALLOCATABLE, PUBLIC :: co2_send ! Field allocated in phyetat0 126 !$OMP THREADPRIVATE(co2_send)127 128 INTEGER, PARAMETER, PUBLIC :: id_CO2 =1 !--temporaire OB -- to be changed129 130 ! nbfields : total number of fields 126 !$OMP THREADPRIVATE(co2_send) 127 128 INTEGER, PARAMETER, PUBLIC :: id_CO2 = 1 !--temporaire OB -- to be changed 129 130 ! nbfields : total number of fields 131 131 INTEGER, PUBLIC :: nbcf 132 !$OMP THREADPRIVATE(nbcf)133 134 ! nbcf_in : number of fields IN135 INTEGER, PUBLIC 136 !$OMP THREADPRIVATE(nbcf_in)137 138 ! nbcf_in_orc : number of fields IN 139 INTEGER, PUBLIC 140 !$OMP THREADPRIVATE(nbcf_in_orc)141 142 ! nbcf_in_inca : number of fields IN (from INCA)143 INTEGER, PUBLIC 144 !$OMP THREADPRIVATE(nbcf_in_inca)145 146 ! nbcf_in_nemo : number of fields IN (from nemo)147 INTEGER, PUBLIC 148 !$OMP THREADPRIVATE(nbcf_in_nemo)149 150 ! nbcf_in_ant : number of fields IN (from anthropogenic sources)151 INTEGER, PUBLIC 152 !$OMP THREADPRIVATE(nbcf_in_ant)153 154 ! nbcf_out : number of fields OUT132 !$OMP THREADPRIVATE(nbcf) 133 134 ! nbcf_in : number of fields IN 135 INTEGER, PUBLIC :: nbcf_in 136 !$OMP THREADPRIVATE(nbcf_in) 137 138 ! nbcf_in_orc : number of fields IN 139 INTEGER, PUBLIC :: nbcf_in_orc 140 !$OMP THREADPRIVATE(nbcf_in_orc) 141 142 ! nbcf_in_inca : number of fields IN (from INCA) 143 INTEGER, PUBLIC :: nbcf_in_inca 144 !$OMP THREADPRIVATE(nbcf_in_inca) 145 146 ! nbcf_in_nemo : number of fields IN (from nemo) 147 INTEGER, PUBLIC :: nbcf_in_nemo 148 !$OMP THREADPRIVATE(nbcf_in_nemo) 149 150 ! nbcf_in_ant : number of fields IN (from anthropogenic sources) 151 INTEGER, PUBLIC :: nbcf_in_ant 152 !$OMP THREADPRIVATE(nbcf_in_ant) 153 154 ! nbcf_out : number of fields OUT 155 155 INTEGER, PUBLIC :: nbcf_out 156 !$OMP THREADPRIVATE(nbcf_out)157 158 ! Name of variables159 CHARACTER(len =25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname ! coupling field short name for restart (?) and diagnostics160 !$OMP THREADPRIVATE(cfname)161 162 CHARACTER(len =25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_in ! coupling field short name for restart (?) and diagnostics163 !$OMP THREADPRIVATE(cfname_in)164 165 CHARACTER(len =25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_out ! coupling field short name for restart (?) and diagnostics166 !$OMP THREADPRIVATE(cfname_out)167 168 CHARACTER(len =15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_in ! coupling field units for diagnostics169 !$OMP THREADPRIVATE(cfunits_in)170 171 CHARACTER(len =15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_out ! coupling field units for diagnostics172 !$OMP THREADPRIVATE(cfunits_out)173 174 CHARACTER(len =120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_in ! coupling field long name for diagnostics175 !$OMP THREADPRIVATE(cftext_in)176 177 CHARACTER(len =120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_out ! coupling field long name for diagnostics178 !$OMP THREADPRIVATE(cftext_out)179 180 CHARACTER(len =5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod1 ! model 1 (rreference) : LMDz181 !$OMP THREADPRIVATE(cfmod1)182 183 CHARACTER(len =5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod2 ! model 2184 !$OMP THREADPRIVATE(cfmod2)185 186 CHARACTER(LEN =20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_out_names187 !$OMP THREADPRIVATE(field_out_names)188 189 CHARACTER(LEN =20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_in_names190 !$OMP THREADPRIVATE(field_in_names)191 192 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: fields_in ! klon,nbcf_in193 !$OMP THREADPRIVATE(fields_in)194 195 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: yfields_in ! knon,nbcf_in196 !$OMP THREADPRIVATE(yfields_in)197 198 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: fields_out ! klon,nbcf_out199 !$OMP THREADPRIVATE(fields_out)200 201 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: yfields_out ! knon,nbcf_out202 !$OMP THREADPRIVATE(yfields_out)156 !$OMP THREADPRIVATE(nbcf_out) 157 158 ! Name of variables 159 CHARACTER(len = 25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname ! coupling field short name for restart (?) and diagnostics 160 !$OMP THREADPRIVATE(cfname) 161 162 CHARACTER(len = 25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_in ! coupling field short name for restart (?) and diagnostics 163 !$OMP THREADPRIVATE(cfname_in) 164 165 CHARACTER(len = 25), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfname_out ! coupling field short name for restart (?) and diagnostics 166 !$OMP THREADPRIVATE(cfname_out) 167 168 CHARACTER(len = 15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_in ! coupling field units for diagnostics 169 !$OMP THREADPRIVATE(cfunits_in) 170 171 CHARACTER(len = 15), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfunits_out ! coupling field units for diagnostics 172 !$OMP THREADPRIVATE(cfunits_out) 173 174 CHARACTER(len = 120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_in ! coupling field long name for diagnostics 175 !$OMP THREADPRIVATE(cftext_in) 176 177 CHARACTER(len = 120), ALLOCATABLE, DIMENSION(:), PUBLIC :: cftext_out ! coupling field long name for diagnostics 178 !$OMP THREADPRIVATE(cftext_out) 179 180 CHARACTER(len = 5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod1 ! model 1 (rreference) : LMDz 181 !$OMP THREADPRIVATE(cfmod1) 182 183 CHARACTER(len = 5), ALLOCATABLE, DIMENSION(:), PUBLIC :: cfmod2 ! model 2 184 !$OMP THREADPRIVATE(cfmod2) 185 186 CHARACTER(LEN = 20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_out_names 187 !$OMP THREADPRIVATE(field_out_names) 188 189 CHARACTER(LEN = 20), ALLOCATABLE, DIMENSION(:), PUBLIC :: field_in_names 190 !$OMP THREADPRIVATE(field_in_names) 191 192 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: fields_in ! klon,nbcf_in 193 !$OMP THREADPRIVATE(fields_in) 194 195 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: yfields_in ! knon,nbcf_in 196 !$OMP THREADPRIVATE(yfields_in) 197 198 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: fields_out ! klon,nbcf_out 199 !$OMP THREADPRIVATE(fields_out) 200 201 REAL, ALLOCATABLE, DIMENSION(:, :), PUBLIC :: yfields_out ! knon,nbcf_out 202 !$OMP THREADPRIVATE(yfields_out) 203 203 204 204 TYPE, PUBLIC :: co2_trac_type 205 206 INTEGER:: id ! Index in total tracer list, tr_seri207 CHARACTER(len=30):: file ! File name208 LOGICAL :: cpl ! True if this tracers is coupled from ORCHIDEE or PISCES.209 210 INTEGER:: updatefreq ! Frequence to inject in second211 INTEGER:: readstep ! Actual time step to read in file212 LOGICAL:: updatenow ! True if this tracer should be updated this time step205 CHARACTER(len = 8) :: name ! Tracer name in tracer.def 206 INTEGER :: id ! Index in total tracer list, tr_seri 207 CHARACTER(len = 30) :: file ! File name 208 LOGICAL :: cpl ! True if this tracers is coupled from ORCHIDEE or PISCES. 209 ! False if read from file. 210 INTEGER :: updatefreq ! Frequence to inject in second 211 INTEGER :: readstep ! Actual time step to read in file 212 LOGICAL :: updatenow ! True if this tracer should be updated this time step 213 213 END TYPE co2_trac_type 214 INTEGER, PARAMETER :: maxco2trac=5 ! Maximum number of different CO2 fluxes214 INTEGER, PARAMETER :: maxco2trac = 5 ! Maximum number of different CO2 fluxes 215 215 TYPE(co2_trac_type), DIMENSION(maxco2trac) :: co2trac 216 216 217 217 CONTAINS 218 218 219 219 SUBROUTINE carbon_cycle_init() 220 220 ! This SUBROUTINE is called from tracco2i_init, which is called from phytrac_init only at first timestep. … … 228 228 IMPLICIT NONE 229 229 INCLUDE "clesphys.h" 230 231 ! Local variables232 INTEGER 230 231 ! Local variables 232 INTEGER :: ierr 233 233 234 234 IF (carbon_cycle_cpl) THEN 235 235 236 ierr=0237 238 IF (.NOT.ALLOCATED(fco2_land)) ALLOCATE(fco2_land(klon), stat=ierr)239 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land',1)240 241 IF (.NOT.ALLOCATED(fco2_land_nbp)) ALLOCATE(fco2_land_nbp(klon), stat=ierr)242 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nbp',1)243 244 IF (.NOT.ALLOCATED(fco2_land_nep)) ALLOCATE(fco2_land_nep(klon), stat=ierr)245 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nep',1)246 247 IF (.NOT.ALLOCATED(fco2_land_fLuc)) ALLOCATE(fco2_land_fLuc(klon), stat=ierr)248 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fLuc',1)249 250 IF (.NOT.ALLOCATED(fco2_land_fwoodharvest)) ALLOCATE(fco2_land_fwoodharvest(klon), stat=ierr)251 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fwoodharvest',1)252 253 IF (.NOT.ALLOCATED(fco2_land_fHarvest)) ALLOCATE(fco2_land_fHarvest(klon), stat=ierr)254 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fHarvest',1)255 256 IF (.NOT.ALLOCATED(fco2_ff)) ALLOCATE(fco2_ff(klon), stat=ierr)257 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ff',1)258 259 IF (.NOT.ALLOCATED(fco2_bb)) ALLOCATE(fco2_bb(klon), stat=ierr)260 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_bb',1)261 262 IF (.NOT.ALLOCATED(fco2_ocean)) ALLOCATE(fco2_ocean(klon), stat=ierr)263 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean',1)264 265 IF (.NOT.ALLOCATED(fco2_ocean_cor)) ALLOCATE(fco2_ocean_cor(klon), stat=ierr)266 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean_cor',1)267 268 IF (.NOT.ALLOCATED(fco2_land_cor)) ALLOCATE(fco2_land_cor(klon), stat=ierr)269 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_cor',1)236 ierr = 0 237 238 IF (.NOT.ALLOCATED(fco2_land)) ALLOCATE(fco2_land(klon), stat = ierr) 239 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land', 1) 240 241 IF (.NOT.ALLOCATED(fco2_land_nbp)) ALLOCATE(fco2_land_nbp(klon), stat = ierr) 242 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nbp', 1) 243 244 IF (.NOT.ALLOCATED(fco2_land_nep)) ALLOCATE(fco2_land_nep(klon), stat = ierr) 245 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_nep', 1) 246 247 IF (.NOT.ALLOCATED(fco2_land_fLuc)) ALLOCATE(fco2_land_fLuc(klon), stat = ierr) 248 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fLuc', 1) 249 250 IF (.NOT.ALLOCATED(fco2_land_fwoodharvest)) ALLOCATE(fco2_land_fwoodharvest(klon), stat = ierr) 251 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fwoodharvest', 1) 252 253 IF (.NOT.ALLOCATED(fco2_land_fHarvest)) ALLOCATE(fco2_land_fHarvest(klon), stat = ierr) 254 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_fHarvest', 1) 255 256 IF (.NOT.ALLOCATED(fco2_ff)) ALLOCATE(fco2_ff(klon), stat = ierr) 257 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ff', 1) 258 259 IF (.NOT.ALLOCATED(fco2_bb)) ALLOCATE(fco2_bb(klon), stat = ierr) 260 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_bb', 1) 261 262 IF (.NOT.ALLOCATED(fco2_ocean)) ALLOCATE(fco2_ocean(klon), stat = ierr) 263 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean', 1) 264 265 IF (.NOT.ALLOCATED(fco2_ocean_cor)) ALLOCATE(fco2_ocean_cor(klon), stat = ierr) 266 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_ocean_cor', 1) 267 268 IF (.NOT.ALLOCATED(fco2_land_cor)) ALLOCATE(fco2_land_cor(klon), stat = ierr) 269 IF (ierr /= 0) CALL abort_physic('carbon_cycle_init', 'pb in allocation fco2_land_cor', 1) 270 270 271 271 ENDIF … … 275 275 SUBROUTINE infocfields_init 276 276 277 ! USE control_mod, ONLY: planet_type277 ! USE control_mod, ONLY: planet_type 278 278 USE phys_cal_mod, ONLY: mth_cur 279 279 USE mod_synchro_omp … … 283 283 USE dimphy, ONLY: klon 284 284 USE lmdz_abort_physic, ONLY: abort_physic 285 USE lmdz_iniprint, ONLY: lunout, prt_level 285 286 286 287 IMPLICIT NONE 287 288 288 !======================================================================= 289 290 ! Authors: Patricia Cadule and Laurent Fairhead 291 ! ------- 292 293 ! Purpose and description: 294 ! ----------------------- 295 296 ! Infofields 297 ! this routine enables to define the field exchanges in both directions between 298 ! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this 299 ! routing might apply to other models (e.g., NEMO, INCA, ...). 300 ! Therefore, currently with this routine, it is possible to define the coupling 301 ! fields only between LMDZ and ORCHIDEE. 302 ! The coupling_fields.def file enables to define the name of the exchanged 303 ! fields at the coupling interface. 304 ! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE 305 ! (LMDZ to ORCHIDEE) 306 ! field_out_names : the set of names of the exchanged fields in output of 307 ! ORCHIDEE (ORCHIDEE to LMDZ) 308 ! n : the number of exchanged fields at th coupling interface 309 ! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE) 310 ! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ) 311 312 ! The syntax for coupling_fields.def is as follows: 313 ! IMPORTANT: each column entry must be separated from the previous one by 3 314 ! spaces and only that 315 ! field name coupling model 1 model 2 long_name 316 ! direction 317 ! 10char -3spaces- 3char -3spaces- 4char -3spaces- 4char -3spaces- 30char 318 319 ! n 320 ! FIELD1 IN LMDZ ORC 321 ! .... 322 ! FIELD(j) IN LMDZ ORC 323 ! FIELD(j+1) OUT LMDZ ORC 324 ! ... 325 ! FIELDn OUT LMDZ ORC 326 327 !======================================================================= 328 ! ... 22/12/2017 .... 329 !----------------------------------------------------------------------- 330 ! Declarations 331 332 INCLUDE "clesphys.h" 333 INCLUDE "dimensions.h" 334 INCLUDE "iniprint.h" 335 336 ! Local variables 337 338 INTEGER :: iq, ierr, stat, error 339 340 CHARACTER(LEN=20), ALLOCATABLE, DIMENSION(:), SAVE :: cfname_root 341 CHARACTER(LEN=120), ALLOCATABLE, DIMENSION(:), SAVE :: cftext_root 342 CHARACTER(LEN=15), ALLOCATABLE, DIMENSION(:), SAVE :: cfunits_root 343 344 CHARACTER(len=3), ALLOCATABLE, DIMENSION(:) :: cfintent_root 345 CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod1_root 346 CHARACTER(len=5), ALLOCATABLE, DIMENSION(:) :: cfmod2_root 347 348 LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_in_root 349 LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_out_root 350 351 CHARACTER(len=*),parameter :: modname="infocfields" 352 353 CHARACTER(len=10),SAVE :: planet_type="earth" 354 355 !----------------------------------------------------------------------- 356 357 nbcf=0 358 nbcf_in=0 359 nbcf_out=0 360 361 IF (planet_type=='earth') THEN 362 363 IF (is_mpi_root .AND. is_omp_root) THEN 364 365 IF (level_coupling_esm>0) THEN 366 367 OPEN(200,file='coupling_fields.def',form='formatted',status='old', iostat=ierr) 289 !======================================================================= 290 291 ! Authors: Patricia Cadule and Laurent Fairhead 292 ! ------- 293 294 ! Purpose and description: 295 ! ----------------------- 296 297 ! Infofields 298 ! this routine enables to define the field exchanges in both directions between 299 ! the atmospheric circulation model (LMDZ) and ORCHIDEE. In the future this 300 ! routing might apply to other models (e.g., NEMO, INCA, ...). 301 ! Therefore, currently with this routine, it is possible to define the coupling 302 ! fields only between LMDZ and ORCHIDEE. 303 ! The coupling_fields.def file enables to define the name of the exchanged 304 ! fields at the coupling interface. 305 ! field_in_names : the set of names of the exchanged fields in input to ORCHIDEE 306 ! (LMDZ to ORCHIDEE) 307 ! field_out_names : the set of names of the exchanged fields in output of 308 ! ORCHIDEE (ORCHIDEE to LMDZ) 309 ! n : the number of exchanged fields at th coupling interface 310 ! nb_fields_in : number of inputs fields to ORCHIDEE (LMDZ to ORCHIDEE) 311 ! nb_fields_out : number of ouput fields of ORCHIDEE (ORCHIDEE to LMDZ) 312 313 ! The syntax for coupling_fields.def is as follows: 314 ! IMPORTANT: each column entry must be separated from the previous one by 3 315 ! spaces and only that 316 ! field name coupling model 1 model 2 long_name 317 ! direction 318 ! 10char -3spaces- 3char -3spaces- 4char -3spaces- 4char -3spaces- 30char 319 320 ! n 321 ! FIELD1 IN LMDZ ORC 322 ! .... 323 ! FIELD(j) IN LMDZ ORC 324 ! FIELD(j+1) OUT LMDZ ORC 325 ! ... 326 ! FIELDn OUT LMDZ ORC 327 328 !======================================================================= 329 ! ... 22/12/2017 .... 330 !----------------------------------------------------------------------- 331 ! Declarations 332 333 INCLUDE "clesphys.h" 334 INCLUDE "dimensions.h" 335 336 ! Local variables 337 338 INTEGER :: iq, ierr, stat, error 339 340 CHARACTER(LEN = 20), ALLOCATABLE, DIMENSION(:), SAVE :: cfname_root 341 CHARACTER(LEN = 120), ALLOCATABLE, DIMENSION(:), SAVE :: cftext_root 342 CHARACTER(LEN = 15), ALLOCATABLE, DIMENSION(:), SAVE :: cfunits_root 343 344 CHARACTER(len = 3), ALLOCATABLE, DIMENSION(:) :: cfintent_root 345 CHARACTER(len = 5), ALLOCATABLE, DIMENSION(:) :: cfmod1_root 346 CHARACTER(len = 5), ALLOCATABLE, DIMENSION(:) :: cfmod2_root 347 348 LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_in_root 349 LOGICAL, ALLOCATABLE, DIMENSION(:), SAVE :: mask_out_root 350 351 CHARACTER(len = *), parameter :: modname = "infocfields" 352 353 CHARACTER(len = 10), SAVE :: planet_type = "earth" 354 355 !----------------------------------------------------------------------- 356 357 nbcf = 0 358 nbcf_in = 0 359 nbcf_out = 0 360 361 IF (planet_type=='earth') THEN 362 363 IF (is_mpi_root .AND. is_omp_root) THEN 364 365 IF (level_coupling_esm>0) THEN 366 367 OPEN(200, file = 'coupling_fields.def', form = 'formatted', status = 'old', iostat = ierr) 368 368 369 369 IF (ierr==0) THEN 370 370 371 WRITE(lunout,*) trim(modname),': Open coupling_fields.def : ok'372 READ(200,*) nbcf373 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf=',nbcf374 375 376 377 378 379 380 381 382 383 nbcf_in=0384 nbcf_out=0385 386 DO iq=1,nbcf387 WRITE(lunout,*) 'infofields : field=',iq388 READ(200,'(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)',IOSTAT=ierr) &389 cfname_root(iq),cfintent_root(iq),cfmod1_root(iq),cfmod2_root(iq),cftext_root(iq),cfunits_root(iq)390 cfname_root(iq)=TRIM(cfname_root(iq))391 cfintent_root(iq)=TRIM(cfintent_root(iq))392 cfmod1_root(iq)=TRIM(cfmod1_root(iq))393 cfmod2_root(iq)=TRIM(cfmod2_root(iq))394 cftext_root(iq)=TRIM(cftext_root(iq))395 cfunits_root(iq)=TRIM(cfunits_root(iq))396 WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &397 ', number: ',iq,', INTENT: ',cfintent_root(iq)398 WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &399 ', number: ',iq,', model 1 (ref): ',cfmod1_root(iq),', model 2: ',cfmod2_root(iq)400 WRITE(lunout,*) 'coupling field: ',cfname_root(iq), &401 ', number: ',iq,', long name: ',cftext_root(iq),', units ',cfunits_root(iq)402 IF (nbcf_in+nbcf_out<nbcf) THEN403 404 nbcf_in=nbcf_in+1405 mask_in_root(iq)=.TRUE.406 mask_out_root(iq)=.FALSE.407 408 nbcf_out=nbcf_out+1409 mask_in_root(iq)=.FALSE.410 mask_out_root(iq)=.TRUE.411 412 413 WRITE(lunout,*) 'abort_gcm --- nbcf : ',nbcf414 WRITE(lunout,*) 'abort_gcm --- nbcf_in : ',nbcf_in415 WRITE(lunout,*) 'abort_gcm --- nbcf_out: ',nbcf_out416 CALL abort_physic('infocfields_init','Problem in the definition of the coupling fields',1)417 418 371 WRITE(lunout, *) trim(modname), ': Open coupling_fields.def : ok' 372 READ(200, *) nbcf 373 WRITE(lunout, *) 'infocfields_mod.F90 --- nbcf=', nbcf 374 ALLOCATE(cfname_root(nbcf)) 375 ALLOCATE(cfintent_root(nbcf)) 376 ALLOCATE(cfmod1_root(nbcf)) 377 ALLOCATE(cfmod2_root(nbcf)) 378 ALLOCATE(cftext_root(nbcf)) 379 ALLOCATE(cfunits_root(nbcf)) 380 ALLOCATE(mask_in_root(nbcf)) 381 ALLOCATE(mask_out_root(nbcf)) 382 383 nbcf_in = 0 384 nbcf_out = 0 385 386 DO iq = 1, nbcf 387 WRITE(lunout, *) 'infofields : field=', iq 388 READ(200, '(A15,3X,A3,3X,A5,3X,A5,3X,A120,3X,A15)', IOSTAT = ierr) & 389 cfname_root(iq), cfintent_root(iq), cfmod1_root(iq), cfmod2_root(iq), cftext_root(iq), cfunits_root(iq) 390 cfname_root(iq) = TRIM(cfname_root(iq)) 391 cfintent_root(iq) = TRIM(cfintent_root(iq)) 392 cfmod1_root(iq) = TRIM(cfmod1_root(iq)) 393 cfmod2_root(iq) = TRIM(cfmod2_root(iq)) 394 cftext_root(iq) = TRIM(cftext_root(iq)) 395 cfunits_root(iq) = TRIM(cfunits_root(iq)) 396 WRITE(lunout, *) 'coupling field: ', cfname_root(iq), & 397 ', number: ', iq, ', INTENT: ', cfintent_root(iq) 398 WRITE(lunout, *) 'coupling field: ', cfname_root(iq), & 399 ', number: ', iq, ', model 1 (ref): ', cfmod1_root(iq), ', model 2: ', cfmod2_root(iq) 400 WRITE(lunout, *) 'coupling field: ', cfname_root(iq), & 401 ', number: ', iq, ', long name: ', cftext_root(iq), ', units ', cfunits_root(iq) 402 IF (nbcf_in + nbcf_out<nbcf) THEN 403 IF (cfintent_root(iq)/='OUT') THEN 404 nbcf_in = nbcf_in + 1 405 mask_in_root(iq) = .TRUE. 406 mask_out_root(iq) = .FALSE. 407 ELSE IF (cfintent_root(iq)=='OUT') THEN 408 nbcf_out = nbcf_out + 1 409 mask_in_root(iq) = .FALSE. 410 mask_out_root(iq) = .TRUE. 411 ENDIF 412 ELSE 413 WRITE(lunout, *) 'abort_gcm --- nbcf : ', nbcf 414 WRITE(lunout, *) 'abort_gcm --- nbcf_in : ', nbcf_in 415 WRITE(lunout, *) 'abort_gcm --- nbcf_out: ', nbcf_out 416 CALL abort_physic('infocfields_init', 'Problem in the definition of the coupling fields', 1) 417 ENDIF 418 ENDDO !DO iq=1,nbcf 419 419 ELSE 420 WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- Problem in opening coupling_fields.def'421 WRITE(lunout,*) trim(modname),': infocfields_mod.F90 --- WARNING using defaut values'420 WRITE(lunout, *) trim(modname), ': infocfields_mod.F90 --- Problem in opening coupling_fields.def' 421 WRITE(lunout, *) trim(modname), ': infocfields_mod.F90 --- WARNING using defaut values' 422 422 ENDIF ! ierr 423 423 CLOSE(200) 424 424 425 ENDIF ! level_coupling_esm426 427 ENDIF ! (is_mpi_root .AND. is_omp_root)428 !$OMP BARRIER429 430 CALL bcast(nbcf)431 CALL bcast(nbcf_in)432 CALL bcast(nbcf_out)433 434 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf =',nbcf435 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_in =',nbcf_in436 WRITE(lunout,*) 'infocfields_mod.F90 --- nbcf_out=',nbcf_out437 438 ALLOCATE(cfname(nbcf))439 ALLOCATE(cfname_in(nbcf_in))440 ALLOCATE(cftext_in(nbcf_in))441 ALLOCATE(cfname_out(nbcf_out))442 ALLOCATE(cftext_out(nbcf_out))443 ALLOCATE(cfmod1(nbcf))444 ALLOCATE(cfmod2(nbcf))445 ALLOCATE(cfunits_in(nbcf_in))446 ALLOCATE(cfunits_out(nbcf_out))447 448 IF (is_mpi_root .AND. is_omp_root) THEN449 450 IF (nbcf>0) cfname =cfname_root451 IF (nbcf_in>0) cfname_in =PACK(cfname_root,mask_in_root)452 IF (nbcf_out>0) cfname_out =PACK(cfname_root,mask_out_root)453 IF (nbcf_in>0) cftext_in =PACK(cftext_root,mask_in_root)454 IF (nbcf_out>0) cftext_out =PACK(cftext_root,mask_out_root)455 IF (nbcf>0) cfmod1 =cfmod1_root456 IF (nbcf>0) cfmod2 =cfmod2_root457 IF (nbcf_in>0) cfunits_in =PACK(cfunits_root,mask_in_root)458 IF (nbcf_out>0) cfunits_out =PACK(cfunits_root,mask_out_root)459 460 nbcf_in_orc =0461 nbcf_in_nemo =0462 nbcf_in_inca =0463 nbcf_in_ant =0464 465 DO iq =1,nbcf466 IF (cfmod1(iq) == "ORC") nbcf_in_orc = nbcf_in_orc + 1467 IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1468 469 IF (cfmod1(iq) == "ALL") nbcf_in_orc = nbcf_in_orc+ 1 ! ALL = ORC/NEMO/INCA470 IF (cfmod1(iq) == "ALL") nbcf_in_nemo = nbcf_in_nemo + 1 ! ALL = ORC/NEMO/INCA471 IF (cfmod1(iq) == "ALL") nbcf_in_inca = nbcf_in_inca + 1 ! ALL = ORC/NEMO/INCA472 IF (cfmod1(iq) == "ANT") nbcf_in_ant = nbcf_in_ant + 1425 ENDIF ! level_coupling_esm 426 427 ENDIF ! (is_mpi_root .AND. is_omp_root) 428 !$OMP BARRIER 429 430 CALL bcast(nbcf) 431 CALL bcast(nbcf_in) 432 CALL bcast(nbcf_out) 433 434 WRITE(lunout, *) 'infocfields_mod.F90 --- nbcf =', nbcf 435 WRITE(lunout, *) 'infocfields_mod.F90 --- nbcf_in =', nbcf_in 436 WRITE(lunout, *) 'infocfields_mod.F90 --- nbcf_out=', nbcf_out 437 438 ALLOCATE(cfname(nbcf)) 439 ALLOCATE(cfname_in(nbcf_in)) 440 ALLOCATE(cftext_in(nbcf_in)) 441 ALLOCATE(cfname_out(nbcf_out)) 442 ALLOCATE(cftext_out(nbcf_out)) 443 ALLOCATE(cfmod1(nbcf)) 444 ALLOCATE(cfmod2(nbcf)) 445 ALLOCATE(cfunits_in(nbcf_in)) 446 ALLOCATE(cfunits_out(nbcf_out)) 447 448 IF (is_mpi_root .AND. is_omp_root) THEN 449 450 IF (nbcf>0) cfname = cfname_root 451 IF (nbcf_in>0) cfname_in = PACK(cfname_root, mask_in_root) 452 IF (nbcf_out>0) cfname_out = PACK(cfname_root, mask_out_root) 453 IF (nbcf_in>0) cftext_in = PACK(cftext_root, mask_in_root) 454 IF (nbcf_out>0) cftext_out = PACK(cftext_root, mask_out_root) 455 IF (nbcf>0) cfmod1 = cfmod1_root 456 IF (nbcf>0) cfmod2 = cfmod2_root 457 IF (nbcf_in>0) cfunits_in = PACK(cfunits_root, mask_in_root) 458 IF (nbcf_out>0) cfunits_out = PACK(cfunits_root, mask_out_root) 459 460 nbcf_in_orc = 0 461 nbcf_in_nemo = 0 462 nbcf_in_inca = 0 463 nbcf_in_ant = 0 464 465 DO iq = 1, nbcf 466 IF (cfmod1(iq) == "ORC") nbcf_in_orc = nbcf_in_orc + 1 467 IF (cfmod1(iq) == "NEMO") nbcf_in_nemo = nbcf_in_nemo + 1 468 IF (cfmod1(iq) == "INCA") nbcf_in_inca = nbcf_in_inca + 1 469 IF (cfmod1(iq) == "ALL") nbcf_in_orc = nbcf_in_orc + 1 ! ALL = ORC/NEMO/INCA 470 IF (cfmod1(iq) == "ALL") nbcf_in_nemo = nbcf_in_nemo + 1 ! ALL = ORC/NEMO/INCA 471 IF (cfmod1(iq) == "ALL") nbcf_in_inca = nbcf_in_inca + 1 ! ALL = ORC/NEMO/INCA 472 IF (cfmod1(iq) == "ANT") nbcf_in_ant = nbcf_in_ant + 1 473 473 ENDDO 474 474 475 ENDIF ! (is_mpi_root .AND. is_omp_root)476 !$OMP BARRIER477 478 CALL bcast(nbcf_in_orc)479 CALL bcast(nbcf_in_nemo)480 CALL bcast(nbcf_in_inca)481 CALL bcast(nbcf_in_ant)482 483 WRITE(lunout,*) 'nbcf_in_orc =',nbcf_in_orc484 WRITE(lunout,*) 'nbcf_in_nemo =',nbcf_in_nemo485 WRITE(lunout,*) 'nbcf_in_inca =',nbcf_in_inca486 WRITE(lunout,*) 'nbcf_in_ant =',nbcf_in_ant487 488 IF (nbcf_in>0) THEN489 DO iq =1,nbcf_in475 ENDIF ! (is_mpi_root .AND. is_omp_root) 476 !$OMP BARRIER 477 478 CALL bcast(nbcf_in_orc) 479 CALL bcast(nbcf_in_nemo) 480 CALL bcast(nbcf_in_inca) 481 CALL bcast(nbcf_in_ant) 482 483 WRITE(lunout, *) 'nbcf_in_orc =', nbcf_in_orc 484 WRITE(lunout, *) 'nbcf_in_nemo =', nbcf_in_nemo 485 WRITE(lunout, *) 'nbcf_in_inca =', nbcf_in_inca 486 WRITE(lunout, *) 'nbcf_in_ant =', nbcf_in_ant 487 488 IF (nbcf_in>0) THEN 489 DO iq = 1, nbcf_in 490 490 CALL bcast(cfname_in(iq)) 491 491 CALL bcast(cftext_in(iq)) 492 492 CALL bcast(cfunits_in(iq)) 493 493 ENDDO 494 ENDIF495 496 IF (nbcf_out>0) THEN497 DO iq =1,nbcf_out494 ENDIF 495 496 IF (nbcf_out>0) THEN 497 DO iq = 1, nbcf_out 498 498 CALL bcast(cfname_out(iq)) 499 499 CALL bcast(cftext_out(iq)) 500 500 CALL bcast(cfunits_out(iq)) 501 501 ENDDO 502 ENDIF503 504 IF (nbcf>0) THEN505 DO iq =1,nbcf502 ENDIF 503 504 IF (nbcf>0) THEN 505 DO iq = 1, nbcf 506 506 CALL bcast(cfmod1(iq)) 507 507 CALL bcast(cfmod2(iq)) 508 508 ENDDO 509 ENDIF510 511 IF (nbcf_in>0) WRITE(lunout,*)'infocfields_mod --- cfname_in: ',cfname_in512 IF (nbcf_out>0) WRITE(lunout,*)'infocfields_mod --- cfname_out: ',cfname_out513 514 IF (nbcf_in>0) WRITE(lunout,*)'infocfields_mod --- cftext_in: ',cftext_in515 IF (nbcf_out>0) WRITE(lunout,*)'infocfields_mod --- cftext_out: ',cftext_out516 517 IF (nbcf>0) WRITE(lunout,*)'infocfields_mod --- cfmod1: ',cfmod1518 IF (nbcf>0) WRITE(lunout,*)'infocfields_mod --- cfmod2: ',cfmod2519 520 IF (nbcf_in>0) WRITE(lunout,*)'infocfunits_mod --- cfunits_in: ',cfunits_in521 IF (nbcf_out>0) WRITE(lunout,*)'infocfunits_mod --- cfunits_out: ',cfunits_out522 523 IF (nbcf_in>0) WRITE(*,*)'infocfields_init --- number of fields in to LMDZ: ',nbcf_in524 IF (nbcf_out>0) WRITE(*,*)'infocfields_init --- number of fields out of LMDZ: ',nbcf_out525 526 ELSE527 ! Default values for other planets528 nbcf=0529 nbcf_in=0530 nbcf_out=0531 ENDIF ! planet_type532 533 ALLOCATE(fields_in(klon,nbcf_in),stat=error)534 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_in',1)535 ALLOCATE(yfields_in(klon,nbcf_in),stat=error)536 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_in',1)537 ALLOCATE(fields_out(klon,nbcf_out),stat=error)538 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation fields_out',1)539 ALLOCATE(yfields_out(klon,nbcf_out),stat=error)540 IF (error /= 0) CALL abort_physic(modname,'Pb in allocation yfields_out',1)541 542 END SUBROUTINE infocfields_init509 ENDIF 510 511 IF (nbcf_in>0) WRITE(lunout, *)'infocfields_mod --- cfname_in: ', cfname_in 512 IF (nbcf_out>0) WRITE(lunout, *)'infocfields_mod --- cfname_out: ', cfname_out 513 514 IF (nbcf_in>0) WRITE(lunout, *)'infocfields_mod --- cftext_in: ', cftext_in 515 IF (nbcf_out>0) WRITE(lunout, *)'infocfields_mod --- cftext_out: ', cftext_out 516 517 IF (nbcf>0) WRITE(lunout, *)'infocfields_mod --- cfmod1: ', cfmod1 518 IF (nbcf>0) WRITE(lunout, *)'infocfields_mod --- cfmod2: ', cfmod2 519 520 IF (nbcf_in>0) WRITE(lunout, *)'infocfunits_mod --- cfunits_in: ', cfunits_in 521 IF (nbcf_out>0) WRITE(lunout, *)'infocfunits_mod --- cfunits_out: ', cfunits_out 522 523 IF (nbcf_in>0) WRITE(*, *)'infocfields_init --- number of fields in to LMDZ: ', nbcf_in 524 IF (nbcf_out>0) WRITE(*, *)'infocfields_init --- number of fields out of LMDZ: ', nbcf_out 525 526 ELSE 527 ! Default values for other planets 528 nbcf = 0 529 nbcf_in = 0 530 nbcf_out = 0 531 ENDIF ! planet_type 532 533 ALLOCATE(fields_in(klon, nbcf_in), stat = error) 534 IF (error /= 0) CALL abort_physic(modname, 'Pb in allocation fields_in', 1) 535 ALLOCATE(yfields_in(klon, nbcf_in), stat = error) 536 IF (error /= 0) CALL abort_physic(modname, 'Pb in allocation yfields_in', 1) 537 ALLOCATE(fields_out(klon, nbcf_out), stat = error) 538 IF (error /= 0) CALL abort_physic(modname, 'Pb in allocation fields_out', 1) 539 ALLOCATE(yfields_out(klon, nbcf_out), stat = error) 540 IF (error /= 0) CALL abort_physic(modname, 'Pb in allocation yfields_out', 1) 541 542 END SUBROUTINE infocfields_init 543 543 544 544 END MODULE carbon_cycle_mod -
LMDZ6/branches/Amaury_dev/libf/phylmd/create_limit_unstruct_mod.F90
r5117 r5118 1 1 MODULE create_limit_unstruct_mod 2 3 INTEGER, PARAMETER :: lmdep=124 5 2 PRIVATE 3 INTEGER, PARAMETER :: lmdep = 12 4 5 PUBLIC create_limit_unstruct 6 6 7 7 CONTAINS … … 9 9 10 10 SUBROUTINE create_limit_unstruct 11 USE dimphy12 USE lmdz_xios13 USE ioipsl,ONLY: ioget_year_len14 USE time_phylmdz_mod, ONLY: annee_ref15 USE indice_sol_mod16 USE phys_state_var_mod17 USE lmdz_phys_para18 USE lmdz_abort_physic, ONLY: abort_physic19 IMPLICIT NONE20 I NCLUDE "iniprint.h"21 REAL, DIMENSION(:,:),ALLOCATABLE:: sic22 REAL, DIMENSION(:,:),ALLOCATABLE:: sst23 REAL, DIMENSION(klon,lmdep):: rugos24 REAL, DIMENSION(klon,lmdep):: albedo25 REAL, DIMENSION(:,:),ALLOCATABLE:: sic_mpi26 REAL, DIMENSION(:,:),ALLOCATABLE:: sst_mpi27 REAL, DIMENSION(klon_mpi,lmdep):: rugos_mpi28 REAL, DIMENSION(klon_mpi,lmdep):: albedo_mpi29 INTEGER 30 REAL 31 REAL, ALLOCATABLE :: sic_year(:,:)32 REAL, ALLOCATABLE :: sst_year(:,:)33 REAL, ALLOCATABLE :: rugos_year(:,:)34 REAL, ALLOCATABLE :: albedo_year(:,:)35 REAL, ALLOCATABLE :: pctsrf_t(:,:,:)36 REAL, ALLOCATABLE :: phy_bil(:,:)37 REAL, ALLOCATABLE :: sst_year_mpi(:,:)38 REAL, ALLOCATABLE :: rugos_year_mpi(:,:)39 REAL, ALLOCATABLE :: albedo_year_mpi(:,:)40 REAL, ALLOCATABLE :: pctsrf_t_mpi(:,:,:)41 REAL, ALLOCATABLE :: phy_bil_mpi(:,:)42 INTEGER :: l, k11 USE dimphy 12 USE lmdz_xios 13 USE ioipsl, ONLY: ioget_year_len 14 USE time_phylmdz_mod, ONLY: annee_ref 15 USE indice_sol_mod 16 USE phys_state_var_mod 17 USE lmdz_phys_para 18 USE lmdz_abort_physic, ONLY: abort_physic 19 USE lmdz_iniprint, ONLY: lunout, prt_level 20 IMPLICIT NONE 21 REAL, DIMENSION(:, :), ALLOCATABLE :: sic 22 REAL, DIMENSION(:, :), ALLOCATABLE :: sst 23 REAL, DIMENSION(klon, lmdep) :: rugos 24 REAL, DIMENSION(klon, lmdep) :: albedo 25 REAL, DIMENSION(:, :), ALLOCATABLE :: sic_mpi 26 REAL, DIMENSION(:, :), ALLOCATABLE :: sst_mpi 27 REAL, DIMENSION(klon_mpi, lmdep) :: rugos_mpi 28 REAL, DIMENSION(klon_mpi, lmdep) :: albedo_mpi 29 INTEGER :: ndays 30 REAL :: fi_ice(klon) 31 REAL, ALLOCATABLE :: sic_year(:, :) 32 REAL, ALLOCATABLE :: sst_year(:, :) 33 REAL, ALLOCATABLE :: rugos_year(:, :) 34 REAL, ALLOCATABLE :: albedo_year(:, :) 35 REAL, ALLOCATABLE :: pctsrf_t(:, :, :) 36 REAL, ALLOCATABLE :: phy_bil(:, :) 37 REAL, ALLOCATABLE :: sst_year_mpi(:, :) 38 REAL, ALLOCATABLE :: rugos_year_mpi(:, :) 39 REAL, ALLOCATABLE :: albedo_year_mpi(:, :) 40 REAL, ALLOCATABLE :: pctsrf_t_mpi(:, :, :) 41 REAL, ALLOCATABLE :: phy_bil_mpi(:, :) 42 INTEGER :: l, k 43 43 INTEGER :: nbad 44 INTEGER :: sic_time_axis_size 44 INTEGER :: sic_time_axis_size 45 45 INTEGER :: sst_time_axis_size 46 CHARACTER(LEN=99) :: mess ! error message 47 48 49 ndays=ioget_year_len(annee_ref) 50 51 IF (is_omp_master) CALL xios_get_axis_attr("time_sic",n_glo=sic_time_axis_size) 46 CHARACTER(LEN = 99) :: mess ! error message 47 48 ndays = ioget_year_len(annee_ref) 49 50 IF (is_omp_master) CALL xios_get_axis_attr("time_sic", n_glo = sic_time_axis_size) 52 51 CALL bcast_omp(sic_time_axis_size) 53 ALLOCATE(sic_mpi(klon_mpi,sic_time_axis_size)) 54 ALLOCATE(sic(klon,sic_time_axis_size)) 55 56 57 IF (is_omp_master) CALL xios_get_axis_attr("time_sst",n_glo=sst_time_axis_size) 52 ALLOCATE(sic_mpi(klon_mpi, sic_time_axis_size)) 53 ALLOCATE(sic(klon, sic_time_axis_size)) 54 55 IF (is_omp_master) CALL xios_get_axis_attr("time_sst", n_glo = sst_time_axis_size) 58 56 CALL bcast_omp(sst_time_axis_size) 59 ALLOCATE(sst_mpi(klon_mpi, sst_time_axis_size))60 ALLOCATE(sst(klon, sst_time_axis_size))61 57 ALLOCATE(sst_mpi(klon_mpi, sst_time_axis_size)) 58 ALLOCATE(sst(klon, sst_time_axis_size)) 59 62 60 IF (is_omp_master) THEN 63 CALL xios_recv_field("sic_limit", sic_mpi)64 CALL xios_recv_field("sst_limit", sst_mpi)65 CALL xios_recv_field("rugos_limit", rugos_mpi)66 CALL xios_recv_field("albedo_limit", albedo_mpi)67 ENDIF 68 CALL scatter_omp(sic_mpi, sic)69 CALL scatter_omp(sst_mpi, sst)70 CALL scatter_omp(rugos_mpi, rugos)71 CALL scatter_omp(albedo_mpi, albedo)72 73 ALLOCATE(sic_year(klon, ndays))74 ALLOCATE(sst_year(klon, ndays))75 ALLOCATE(rugos_year(klon, ndays))76 ALLOCATE(albedo_year(klon, ndays))77 ALLOCATE(pctsrf_t(klon, nbsrf,ndays))78 ALLOCATE(phy_bil(klon, ndays)); phy_bil=0.079 80 81 ! sic61 CALL xios_recv_field("sic_limit", sic_mpi) 62 CALL xios_recv_field("sst_limit", sst_mpi) 63 CALL xios_recv_field("rugos_limit", rugos_mpi) 64 CALL xios_recv_field("albedo_limit", albedo_mpi) 65 ENDIF 66 CALL scatter_omp(sic_mpi, sic) 67 CALL scatter_omp(sst_mpi, sst) 68 CALL scatter_omp(rugos_mpi, rugos) 69 CALL scatter_omp(albedo_mpi, albedo) 70 71 ALLOCATE(sic_year(klon, ndays)) 72 ALLOCATE(sst_year(klon, ndays)) 73 ALLOCATE(rugos_year(klon, ndays)) 74 ALLOCATE(albedo_year(klon, ndays)) 75 ALLOCATE(pctsrf_t(klon, nbsrf, ndays)) 76 ALLOCATE(phy_bil(klon, ndays)); phy_bil = 0.0 77 78 79 ! sic 82 80 IF (sic_time_axis_size==lmdep) THEN 83 CALL time_interpolation(ndays, sic,'gregorian',sic_year)81 CALL time_interpolation(ndays, sic, 'gregorian', sic_year) 84 82 ELSE IF (sic_time_axis_size==ndays) THEN 85 sic_year =sic83 sic_year = sic 86 84 ELSE 87 WRITE(mess, *) 'sic time axis is nor montly, nor daily. sic time interpolation ',&88 89 CALL abort_physic('create_limit_unstruct', TRIM(mess),1)90 ENDIF 91 92 sic_year(:, :)=sic_year(:,:)/100. ! convert percent to fraction93 WHERE(sic_year(:, :)>1.0) sic_year(:,:)=1.0 ! Some fractions have some time large negative values94 WHERE(sic_year(:, :)<0.0) sic_year(:,:)=0.0 ! probably better to apply alse this filter before horizontal interpolation95 96 ! sst85 WRITE(mess, *) 'sic time axis is nor montly, nor daily. sic time interpolation ', & 86 'is requiered but is not currently managed' 87 CALL abort_physic('create_limit_unstruct', TRIM(mess), 1) 88 ENDIF 89 90 sic_year(:, :) = sic_year(:, :) / 100. ! convert percent to fraction 91 WHERE(sic_year(:, :)>1.0) sic_year(:, :) = 1.0 ! Some fractions have some time large negative values 92 WHERE(sic_year(:, :)<0.0) sic_year(:, :) = 0.0 ! probably better to apply alse this filter before horizontal interpolation 93 94 ! sst 97 95 IF (sst_time_axis_size==lmdep) THEN 98 CALL time_interpolation(ndays, sst,'gregorian',sst_year)96 CALL time_interpolation(ndays, sst, 'gregorian', sst_year) 99 97 ELSE IF (sst_time_axis_size==ndays) THEN 100 sst_year =sst98 sst_year = sst 101 99 ELSE 102 WRITE(mess, *)'sic time axis is nor montly, nor daily. sic time interpolation ',&103 104 CALL abort_physic('create_limit_unstruct', TRIM(mess),1)105 ENDIF 106 WHERE(sst_year(:, :)<271.38) sst_year(:,:)=271.38107 108 109 ! rugos 110 DO l =1, lmdep111 WHERE(NINT(zmasq(:))/=1) rugos(:, l)=0.001100 WRITE(mess, *)'sic time axis is nor montly, nor daily. sic time interpolation ', & 101 'is requiered but is not currently managed' 102 CALL abort_physic('create_limit_unstruct', TRIM(mess), 1) 103 ENDIF 104 WHERE(sst_year(:, :)<271.38) sst_year(:, :) = 271.38 105 106 107 ! rugos 108 DO l = 1, lmdep 109 WHERE(NINT(zmasq(:))/=1) rugos(:, l) = 0.001 112 110 ENDDO 113 CALL time_interpolation(ndays,rugos,'360_day',rugos_year) 114 115 ! albedo 116 CALL time_interpolation(ndays,albedo,'360_day',albedo_year) 117 118 119 DO k=1,ndays 120 fi_ice=sic_year(:,k) 121 WHERE(fi_ice>=1.0 ) fi_ice=1.0 122 WHERE(fi_ice<EPSFRA) fi_ice=0.0 123 pctsrf_t(:,is_ter,k)=pctsrf(:,is_ter) ! land soil 124 pctsrf_t(:,is_lic,k)=pctsrf(:,is_lic) ! land ice 125 126 !! IF (icefile==trim(fcpldsic)) THEN ! SIC=pICE*(1-LIC-TER) 127 !! pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter)) 128 !! ELSE IF (icefile==trim(fhistsic)) THEN ! SIC=pICE 129 !! pctsrf_t(:,is_sic,k)=fi_ice(:) 130 !! ELSE ! icefile==famipsic ! SIC=pICE-LIC 131 pctsrf_t(:,is_sic,k)=fi_ice-pctsrf_t(:,is_lic,k) 132 ! END IF 133 WHERE(pctsrf_t(:,is_sic,k)<=0) pctsrf_t(:,is_sic,k)=0. 134 WHERE(1.0-zmasq<EPSFRA) 135 pctsrf_t(:,is_sic,k)=0.0 136 pctsrf_t(:,is_oce,k)=0.0 111 CALL time_interpolation(ndays, rugos, '360_day', rugos_year) 112 113 ! albedo 114 CALL time_interpolation(ndays, albedo, '360_day', albedo_year) 115 116 DO k = 1, ndays 117 fi_ice = sic_year(:, k) 118 WHERE(fi_ice>=1.0) fi_ice = 1.0 119 WHERE(fi_ice<EPSFRA) fi_ice = 0.0 120 pctsrf_t(:, is_ter, k) = pctsrf(:, is_ter) ! land soil 121 pctsrf_t(:, is_lic, k) = pctsrf(:, is_lic) ! land ice 122 123 !! IF (icefile==trim(fcpldsic)) THEN ! SIC=pICE*(1-LIC-TER) 124 !! pctsrf_t(:,is_sic,k)=fi_ice(:)*(1.-pctsrf(:,is_lic)-pctsrf(:,is_ter)) 125 !! ELSE IF (icefile==trim(fhistsic)) THEN ! SIC=pICE 126 !! pctsrf_t(:,is_sic,k)=fi_ice(:) 127 !! ELSE ! icefile==famipsic ! SIC=pICE-LIC 128 pctsrf_t(:, is_sic, k) = fi_ice - pctsrf_t(:, is_lic, k) 129 ! END IF 130 WHERE(pctsrf_t(:, is_sic, k)<=0) pctsrf_t(:, is_sic, k) = 0. 131 WHERE(1.0 - zmasq<EPSFRA) 132 pctsrf_t(:, is_sic, k) = 0.0 133 pctsrf_t(:, is_oce, k) = 0.0 137 134 ELSEWHERE 138 WHERE(pctsrf_t(:, is_sic,k)>=1.0-zmasq)139 pctsrf_t(:, is_sic,k)=1.0-zmasq140 pctsrf_t(:, is_oce,k)=0.0135 WHERE(pctsrf_t(:, is_sic, k)>=1.0 - zmasq) 136 pctsrf_t(:, is_sic, k) = 1.0 - zmasq 137 pctsrf_t(:, is_oce, k) = 0.0 141 138 ELSEWHERE 142 pctsrf_t(:, is_oce,k)=1.0-zmasq-pctsrf_t(:,is_sic,k)143 WHERE(pctsrf_t(:, is_oce,k)<EPSFRA)144 pctsrf_t(:,is_oce,k)=0.0145 pctsrf_t(:,is_sic,k)=1.0-zmasq139 pctsrf_t(:, is_oce, k) = 1.0 - zmasq - pctsrf_t(:, is_sic, k) 140 WHERE(pctsrf_t(:, is_oce, k)<EPSFRA) 141 pctsrf_t(:, is_oce, k) = 0.0 142 pctsrf_t(:, is_sic, k) = 1.0 - zmasq 146 143 END WHERE 147 144 END WHERE 148 145 END WHERE 149 nbad =COUNT(pctsrf_t(:,is_oce,k)<0.0)150 IF(nbad>0) WRITE(lunout, *) 'pb sous maille pour nb point = ',nbad151 nbad =COUNT(abs(sum(pctsrf_t(:,:,k),dim=2)-1.0)>EPSFRA)152 IF(nbad>0) WRITE(lunout, *) 'pb sous surface pour nb points = ',nbad146 nbad = COUNT(pctsrf_t(:, is_oce, k)<0.0) 147 IF(nbad>0) WRITE(lunout, *) 'pb sous maille pour nb point = ', nbad 148 nbad = COUNT(abs(sum(pctsrf_t(:, :, k), dim = 2) - 1.0)>EPSFRA) 149 IF(nbad>0) WRITE(lunout, *) 'pb sous surface pour nb points = ', nbad 153 150 END DO 154 155 ALLOCATE(sst_year_mpi(klon_mpi, ndays))156 ALLOCATE(rugos_year_mpi(klon_mpi, ndays))157 ALLOCATE(albedo_year_mpi(klon_mpi, ndays))158 ALLOCATE(pctsrf_t_mpi(klon_mpi, nbsrf,ndays))159 ALLOCATE(phy_bil_mpi(klon_mpi, ndays))160 161 CALL gather_omp(pctsrf_t 162 CALL gather_omp(sst_year 163 CALL gather_omp(phy_bil 151 152 ALLOCATE(sst_year_mpi(klon_mpi, ndays)) 153 ALLOCATE(rugos_year_mpi(klon_mpi, ndays)) 154 ALLOCATE(albedo_year_mpi(klon_mpi, ndays)) 155 ALLOCATE(pctsrf_t_mpi(klon_mpi, nbsrf, ndays)) 156 ALLOCATE(phy_bil_mpi(klon_mpi, ndays)) 157 158 CALL gather_omp(pctsrf_t, pctsrf_t_mpi) 159 CALL gather_omp(sst_year, sst_year_mpi) 160 CALL gather_omp(phy_bil, phy_bil_mpi) 164 161 CALL gather_omp(albedo_year, albedo_year_mpi) 165 CALL gather_omp(rugos_year 162 CALL gather_omp(rugos_year, rugos_year_mpi) 166 163 167 164 IF (is_omp_master) THEN 168 CALL xios_send_field("foce_limout", pctsrf_t_mpi(:,is_oce,:))169 CALL xios_send_field("fsic_limout", pctsrf_t_mpi(:,is_sic,:))170 CALL xios_send_field("fter_limout", pctsrf_t_mpi(:,is_ter,:))171 CALL xios_send_field("flic_limout", pctsrf_t_mpi(:,is_lic,:))165 CALL xios_send_field("foce_limout", pctsrf_t_mpi(:, is_oce, :)) 166 CALL xios_send_field("fsic_limout", pctsrf_t_mpi(:, is_sic, :)) 167 CALL xios_send_field("fter_limout", pctsrf_t_mpi(:, is_ter, :)) 168 CALL xios_send_field("flic_limout", pctsrf_t_mpi(:, is_lic, :)) 172 169 CALL xios_send_field("sst_limout", sst_year_mpi) 173 CALL xios_send_field("bils_limout", phy_bil_mpi)174 CALL xios_send_field("alb_limout", albedo_year_mpi) 175 CALL xios_send_field("rug_limout", rugos_year_mpi) 170 CALL xios_send_field("bils_limout", phy_bil_mpi) 171 CALL xios_send_field("alb_limout", albedo_year_mpi) 172 CALL xios_send_field("rug_limout", rugos_year_mpi) 176 173 ENDIF 177 174 END SUBROUTINE create_limit_unstruct 178 179 180 SUBROUTINE time_interpolation(ndays,field_in,calendar,field_out) 181 USE lmdz_libmath_pch, ONLY: pchsp_95, pchfe_95 182 USE lmdz_arth, ONLY: arth 183 USE dimphy, ONLY: klon 184 USE ioipsl, ONLY: ioget_year_len 185 USE time_phylmdz_mod, ONLY: annee_ref 186 USE lmdz_phys_para 187 USE lmdz_abort_physic, ONLY: abort_physic 188 IMPLICIT NONE 189 INCLUDE "iniprint.h" 190 191 INTEGER, INTENT(IN) :: ndays 192 REAL, INTENT(IN) :: field_in(klon,lmdep) 193 CHARACTER(LEN=*),INTENT(IN) :: calendar 194 REAL, INTENT(OUT) :: field_out(klon,ndays) 195 196 INTEGER :: ndays_in 197 REAL :: timeyear(lmdep) 198 REAL :: yder(lmdep) 199 INTEGER :: ij,ierr, n_extrap 200 LOGICAL :: skip 201 202 CHARACTER (len = 50) :: modname = 'create_limit_unstruct.time_interpolation' 203 CHARACTER (len = 80) :: abort_message 204 205 206 IF (is_omp_master) ndays_in=year_len(annee_ref, calendar) 207 CALL bcast_omp(ndays_in) 208 IF (is_omp_master) timeyear=mid_months(annee_ref, calendar, lmdep) 209 CALL bcast_omp(timeyear) 210 211 n_extrap = 0 212 skip=.FALSE. 213 DO ij=1,klon 214 yder = pchsp_95(timeyear, field_in(ij, :), ibeg=2, iend=2, vc_beg=0., vc_end=0.) 215 CALL pchfe_95(timeyear, field_in(ij, :), yder, skip, arth(0., real(ndays_in) / ndays, ndays), field_out(ij, :), ierr) 216 IF (ierr < 0) THEN 217 abort_message='error in pchfe_95' 218 CALL abort_physic(modname,abort_message,1) 219 endif 220 n_extrap = n_extrap + ierr 221 END DO 222 223 IF (n_extrap /= 0) THEN 224 WRITE(lunout,*) "get_2Dfield pchfe_95: n_extrap = ", n_extrap 225 ENDIF 226 227 175 176 177 SUBROUTINE time_interpolation(ndays, field_in, calendar, field_out) 178 USE lmdz_libmath_pch, ONLY: pchsp_95, pchfe_95 179 USE lmdz_arth, ONLY: arth 180 USE dimphy, ONLY: klon 181 USE ioipsl, ONLY: ioget_year_len 182 USE time_phylmdz_mod, ONLY: annee_ref 183 USE lmdz_phys_para 184 USE lmdz_abort_physic, ONLY: abort_physic 185 USE lmdz_iniprint, ONLY: lunout, prt_level 186 IMPLICIT NONE 187 188 INTEGER, INTENT(IN) :: ndays 189 REAL, INTENT(IN) :: field_in(klon, lmdep) 190 CHARACTER(LEN = *), INTENT(IN) :: calendar 191 REAL, INTENT(OUT) :: field_out(klon, ndays) 192 193 INTEGER :: ndays_in 194 REAL :: timeyear(lmdep) 195 REAL :: yder(lmdep) 196 INTEGER :: ij, ierr, n_extrap 197 LOGICAL :: skip 198 199 CHARACTER (len = 50) :: modname = 'create_limit_unstruct.time_interpolation' 200 CHARACTER (len = 80) :: abort_message 201 202 IF (is_omp_master) ndays_in = year_len(annee_ref, calendar) 203 CALL bcast_omp(ndays_in) 204 IF (is_omp_master) timeyear = mid_months(annee_ref, calendar, lmdep) 205 CALL bcast_omp(timeyear) 206 207 n_extrap = 0 208 skip = .FALSE. 209 DO ij = 1, klon 210 yder = pchsp_95(timeyear, field_in(ij, :), ibeg = 2, iend = 2, vc_beg = 0., vc_end = 0.) 211 CALL pchfe_95(timeyear, field_in(ij, :), yder, skip, arth(0., real(ndays_in) / ndays, ndays), field_out(ij, :), ierr) 212 IF (ierr < 0) THEN 213 abort_message = 'error in pchfe_95' 214 CALL abort_physic(modname, abort_message, 1) 215 endif 216 n_extrap = n_extrap + ierr 217 END DO 218 219 IF (n_extrap /= 0) THEN 220 WRITE(lunout, *) "get_2Dfield pchfe_95: n_extrap = ", n_extrap 221 ENDIF 222 228 223 END SUBROUTINE time_interpolation 229 224 !------------------------------------------------------------------------------- 230 225 231 FUNCTION year_len(y,cal_in) 226 FUNCTION year_len(y, cal_in) 227 228 !------------------------------------------------------------------------------- 229 USE ioipsl, ONLY: ioget_calendar, ioconf_calendar, lock_calendar, ioget_year_len 230 IMPLICIT NONE 231 !------------------------------------------------------------------------------- 232 ! Arguments: 233 INTEGER :: year_len 234 INTEGER, INTENT(IN) :: y 235 CHARACTER(LEN = *), INTENT(IN) :: cal_in 236 !------------------------------------------------------------------------------- 237 ! Local variables: 238 CHARACTER(LEN = 20) :: cal_out ! calendar (for outputs) 239 !------------------------------------------------------------------------------- 240 !--- Getting the input calendar to reset at the end of the function 241 CALL ioget_calendar(cal_out) 242 243 !--- Unlocking calendar and setting it to wanted one 244 CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in)) 245 246 !--- Getting the number of days in this year 247 year_len = ioget_year_len(y) 248 249 !--- Back to original calendar 250 CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out)) 251 252 END FUNCTION year_len 232 253 233 254 !------------------------------------------------------------------------------- 234 USE ioipsl, ONLY: ioget_calendar,ioconf_calendar,lock_calendar,ioget_year_len 235 IMPLICIT NONE 255 256 236 257 !------------------------------------------------------------------------------- 237 ! Arguments: 238 INTEGER :: year_len 239 INTEGER, INTENT(IN) :: y 240 CHARACTER(LEN=*), INTENT(IN) :: cal_in 241 !------------------------------------------------------------------------------- 242 ! Local variables: 243 CHARACTER(LEN=20) :: cal_out ! calendar (for outputs) 244 !------------------------------------------------------------------------------- 245 !--- Getting the input calendar to reset at the end of the function 246 CALL ioget_calendar(cal_out) 247 248 !--- Unlocking calendar and setting it to wanted one 249 CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in)) 250 251 !--- Getting the number of days in this year 252 year_len=ioget_year_len(y) 253 254 !--- Back to original calendar 255 CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out)) 256 257 END FUNCTION year_len 258 259 !------------------------------------------------------------------------------- 260 261 262 !------------------------------------------------------------------------------- 263 264 FUNCTION mid_months(y,cal_in,nm) 265 266 !------------------------------------------------------------------------------- 267 USE ioipsl, ONLY: ioget_calendar,ioconf_calendar,lock_calendar,ioget_mon_len 258 259 FUNCTION mid_months(y, cal_in, nm) 260 261 !------------------------------------------------------------------------------- 262 USE ioipsl, ONLY: ioget_calendar, ioconf_calendar, lock_calendar, ioget_mon_len 268 263 USE lmdz_abort_physic, ONLY: abort_physic 269 264 IMPLICIT NONE 270 !-------------------------------------------------------------------------------271 ! Arguments:272 INTEGER, 273 CHARACTER(LEN =*),INTENT(IN) :: cal_in ! calendar274 INTEGER, 275 REAL, DIMENSION(nm):: mid_months ! mid-month times276 !-------------------------------------------------------------------------------277 ! Local variables:278 CHARACTER(LEN =99):: mess ! error message279 CHARACTER(LEN =20):: cal_out ! calendar (for outputs)280 INTEGER, DIMENSION(nm) 281 INTEGER 282 INTEGER 283 INTEGER 284 !-------------------------------------------------------------------------------285 nd =year_len(y,cal_in)286 265 !------------------------------------------------------------------------------- 266 ! Arguments: 267 INTEGER, INTENT(IN) :: y ! year 268 CHARACTER(LEN = *), INTENT(IN) :: cal_in ! calendar 269 INTEGER, INTENT(IN) :: nm ! months/year number 270 REAL, DIMENSION(nm) :: mid_months ! mid-month times 271 !------------------------------------------------------------------------------- 272 ! Local variables: 273 CHARACTER(LEN = 99) :: mess ! error message 274 CHARACTER(LEN = 20) :: cal_out ! calendar (for outputs) 275 INTEGER, DIMENSION(nm) :: mnth ! months lengths (days) 276 INTEGER :: m ! months counter 277 INTEGER :: nd ! number of days 278 INTEGER :: k 279 !------------------------------------------------------------------------------- 280 nd = year_len(y, cal_in) 281 287 282 IF(nm==12) THEN 288 289 !--- Getting the input calendar to reset at the end of the function283 284 !--- Getting the input calendar to reset at the end of the function 290 285 CALL ioget_calendar(cal_out) 291 292 !--- Unlocking calendar and setting it to wanted one286 287 !--- Unlocking calendar and setting it to wanted one 293 288 CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_in)) 294 295 !--- Getting the length of each month 296 DO m=1,nm; mnth(m)=ioget_mon_len(y,m); END DO 297 298 !--- Back to original calendar 289 290 !--- Getting the length of each month 291 DO m = 1, nm; mnth(m) = ioget_mon_len(y, m); 292 END DO 293 294 !--- Back to original calendar 299 295 CALL lock_calendar(.FALSE.); CALL ioconf_calendar(TRIM(cal_out)) 300 301 ELSE IF(MODULO(nd, nm)/=0) THEN302 WRITE(mess, '(a,i3,a,i3,a)')'Unconsistent calendar: ',nd,' days/year, but ',&303 nm,' months/year. Months number should divide days number.'304 CALL abort_physic('mid_months', TRIM(mess),1)305 296 297 ELSE IF(MODULO(nd, nm)/=0) THEN 298 WRITE(mess, '(a,i3,a,i3,a)')'Unconsistent calendar: ', nd, ' days/year, but ', & 299 nm, ' months/year. Months number should divide days number.' 300 CALL abort_physic('mid_months', TRIM(mess), 1) 301 306 302 ELSE 307 mnth =(/(m,m=1,nm,nd/nm)/)303 mnth = (/(m, m = 1, nm, nd / nm)/) 308 304 END IF 309 310 !--- Mid-months times311 mid_months(1) =0.5*REAL(mnth(1))312 DO k =2,nm313 mid_months(k) =mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))305 306 !--- Mid-months times 307 mid_months(1) = 0.5 * REAL(mnth(1)) 308 DO k = 2, nm 309 mid_months(k) = mid_months(k - 1) + 0.5 * REAL(mnth(k - 1) + mnth(k)) 314 310 END DO 315 311 316 312 END FUNCTION mid_months 317 313 318 314 319 315 END MODULE create_limit_unstruct_mod -
LMDZ6/branches/Amaury_dev/libf/phylmd/infotrac_phy.F90
r5117 r5118 134 134 USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_STRATAER 135 135 USE lmdz_abort_physic, ONLY: abort_physic 136 USE lmdz_iniprint, ONLY: lunout, prt_level 136 137 IMPLICIT NONE 137 138 !============================================================================================================================== … … 155 156 ! Declarations: 156 157 INCLUDE "dimensions.h" 157 INCLUDE "iniprint.h"158 158 159 159 !------------------------------------------------------------------------------------------------------------------------------ … … 260 260 IF(fType == 1 .AND. ANY(['inca', 'inco']==type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def" 261 261 !--------------------------------------------------------------------------------------------------------------------------- 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 262 nqo = SIZE(tracers) - nqCO2 263 CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA 264 nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac 265 nqtrue = nbtr + nqo !--- Total number of "true" tracers 266 IF(ALL([2, 3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo=' // TRIM(int2str(nqo)), 1) 267 ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA)) 268 ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA)) 269 CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca) 270 ALLOCATE(ttr(nqtrue)) 271 ttr(1:nqo + nqCO2) = tracers 272 ttr(1:nqo)%component = 'lmdz' 273 ttr(1 + nqo:nqCO2 + nqo)%component = 'co2i' 274 ttr(1 + nqo + nqCO2:nqtrue)%component = 'inca' 275 ttr(1 + nqo:nqtrue)%name = [('CO2 ', k = 1, nqCO2), solsym_inca] 276 ttr(1 + nqo + nqCO2:nqtrue)%parent = tran0 277 ttr(1 + nqo + nqCO2:nqtrue)%phase = 'g' 278 lerr = getKey('hadv', had, ky = tracers(:)%keys) 279 lerr = getKey('vadv', vad, ky = tracers(:)%keys) 280 hadv(1:nqo + nqCO2) = had(:); hadv(1 + nqo + nqCO2:nqtrue) = hadv_inca 281 vadv(1:nqo + nqCO2) = vad(:); vadv(1 + nqo + nqCO2:nqtrue) = vadv_inca 282 CALL MOVE_ALLOC(FROM = ttr, TO = tracers) 283 DO iq = 1, nqtrue 284 t1 => tracers(iq) 285 CALL addKey('name', t1%name, t1%keys) 286 CALL addKey('component', t1%component, t1%keys) 287 CALL addKey('parent', t1%parent, t1%keys) 288 CALL addKey('phase', t1%phase, t1%keys) 289 END DO 290 IF(setGeneration(tracers)) CALL abort_physic(modname, 'See below', 1) !- SET FIELDS %iGeneration, %gen0Name 291 DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca) 292 292 !--------------------------------------------------------------------------------------------------------------------------- 293 293 ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE) … … 298 298 nbtr = nqtrue - COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' & 299 299 .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac 300 300 nqINCA = COUNT(tracers(:)%component == 'inca') 301 301 lerr = getKey('hadv', hadv, ky = tracers(:)%keys) 302 302 lerr = getKey('vadv', vadv, ky = tracers(:)%keys)
Note: See TracChangeset
for help on using the changeset viewer.
