Ignore:
Timestamp:
Nov 30, 2016, 1:28:41 PM (8 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2664:2719 into testing branch

Location:
LMDZ5/branches/testing
Files:
3 deleted
67 edited
19 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

  • LMDZ5/branches/testing/DefLists/context_lmdz.xml

    r2669 r2720  
    6565    <axis id="cth16" name="cth" standard_name="altitude" unit="m">
    6666    </axis>
     67    <axis id="ReffIce" standard_name="ReffIce" unit="microne" >
     68    </axis>
     69    <axis id="ReffLiq" standard_name="ReffLiq" unit="microne" >
     70    </axis>
    6771
    6872  </axis_definition>

  • LMDZ5/branches/testing/DefLists/cosp_output_nl.txt

    r2435 r2720  
    106106  Liwpmodis=.false.,
    107107  Lclmodis=.false.,
     108  Lcrimodis=.false.,
     109  Lcrlmodis=.false.,
    108110  !- RTTOV
    109111  Ltbrttov=.false.,

  • LMDZ5/branches/testing/DefLists/field_def_lmdz.xml

    r2669 r2720  
    111111        <field id="bils_enthalp"    long_name="Surf. total heat flux"    unit="W/m2" />
    112112        <field id="bils_latent"    long_name="Surf. total heat flux"    unit="W/m2" />
    113         <field id="bils_ech"    long_name="peu importe"    unit="W/m2" />
    114         <field id="du_gwd_rando"    long_name="peu importe"    unit="W/m2" />
    115         <field id="dv_gwd_rando"    long_name="peu importe"    unit="W/m2" />
    116         <field id="ustr_gwd_hines"    long_name="zonal wind stress Hines gravity waves"    unit="Pa" />
    117         <field id="vstr_gwd_hines"    long_name="meridional wind stress Hines gravity waves"    unit="Pa" />
    118         <field id="ustr_gwd_front"    long_name="zonal wind stress fronts gravity waves"    unit="Pa" />
    119         <field id="vstr_gwd_front"    long_name="meridional wind stress fronts gravity waves"    unit="Pa" />
    120         <field id="ustr_gwd_rando"    long_name="zonal wind stress random gravity waves"    unit="Pa" />
    121         <field id="vstr_gwd_rando"    long_name="meridinal wind stress random gravity waves"    unit="Pa" />
     113        <field id="bils_ech"    long_name="peu importe"    unit="W/m2" />
     114        <field id="du_gwd_rando"    long_name="peu importe"    unit="W/m2" />
     115        <field id="dv_gwd_rando"    long_name="peu importe"    unit="W/m2" />
     116        <field id="ustr_gwd_hines"    long_name="zonal wind stress Hines gravity waves"    unit="Pa" />
     117        <field id="vstr_gwd_hines"    long_name="meridional wind stress Hines gravity waves"    unit="Pa" />
     118        <field id="ustr_gwd_front"    long_name="zonal wind stress fronts gravity waves"    unit="Pa" />
     119        <field id="vstr_gwd_front"    long_name="meridional wind stress fronts gravity waves"    unit="Pa" />
     120        <field id="ustr_gwd_rando"    long_name="zonal wind stress random gravity waves"    unit="Pa" />
     121        <field id="vstr_gwd_rando"    long_name="meridinal wind stress random gravity waves"    unit="Pa" />
    122122        <field id="sens"    long_name="Sensible heat flux"    unit="W/m2" />
    123123        <field id="fder"    long_name="Heat flux derivation"    unit="W/m2" />
    … …  
    176176        <field id="wbilo_oce"    long_name="Bilan eau oce"    unit="kg/(m2*s)" />
    177177        <field id="wbilo_sic"    long_name="Bilan eau sic"    unit="kg/(m2*s)" />
     178        <field id="wevap_ter"    long_name="Evap eau ter"    unit="kg/(m2*s)" />
     179        <field id="wevap_lic"    long_name="Evap eau lic"    unit="kg/(m2*s)" />
     180        <field id="wevap_oce"    long_name="Evap eau oce"    unit="kg/(m2*s)" />
     181        <field id="wevap_sic"    long_name="Evap eau sic"    unit="kg/(m2*s)" />
     182        <field id="wrain_ter"    long_name="Pluie eau ter"    unit="kg/(m2*s)" />
     183        <field id="wrain_lic"    long_name="Pluie eau lic"    unit="kg/(m2*s)" />
     184        <field id="wrain_oce"    long_name="Pluie eau oce"    unit="kg/(m2*s)" />
     185        <field id="wrain_sic"    long_name="Pluie eau sic"    unit="kg/(m2*s)" />
     186        <field id="wsnow_ter"    long_name="Neige eau ter"    unit="kg/(m2*s)" />
     187        <field id="wsnow_lic"    long_name="Neige eau lic"    unit="kg/(m2*s)" />
     188        <field id="wsnow_oce"    long_name="Neige eau oce"    unit="kg/(m2*s)" />
     189        <field id="wsnow_sic"    long_name="Neige eau sic"    unit="kg/(m2*s)" />
    178190        <field id="cdrm"    long_name="Momentum drag coef."    unit="-" />
    179191        <field id="cdrh"    long_name="Heat drag coef."    unit="-" />
    … …  
    479491        <field id="upwd"    long_name="saturated updraft"    unit="kg/m2/s" />
    480492        <field id="ep"    long_name="ep"    unit="su" />
     493        <field id="duphy"    long_name="Physics du"    unit="K/s" />
    481494        <field id="dtphy"    long_name="Physics dT"    unit="K/s" />
    482495        <field id="dqphy"    long_name="Physics dQ"    unit="(kg/kg)/s" />
    … …  
    560573        <field id="dulif"    long_name="Orography dU"    unit="m/s2" />
    561574        <field id="dvlif"    long_name="Orography dV"    unit="m/s2" />
    562         <field id="du_gwd_hines" long_name="Hines GWD dU" unit="m/s2" />
    563         <field id="dv_gwd_hines" long_name="Hines GWD dV" unit="m/s2" />
    564         <field id="du_gwd_front" long_name="Fronts GWD dU" unit="m/s2" />
    565         <field id="dv_gwd_front" long_name="Fronts GWD dV" unit="m/s2" />
    566         <field id="east_gwstress" long_name="Eastward GW Stress" unit="Pa" />
    567         <field id="west_gwstress" long_name="Westward GW Stress" unit="Pa" />
     575        <field id="du_gwd_hines" long_name="Hines GWD dU" unit="m/s2" />
     576        <field id="dv_gwd_hines" long_name="Hines GWD dV" unit="m/s2" />
     577        <field id="du_gwd_front" long_name="Fronts GWD dU" unit="m/s2" />
     578        <field id="dv_gwd_front" long_name="Fronts GWD dV" unit="m/s2" />
     579        <field id="east_gwstress" long_name="Eastward GW Stress" unit="Pa" />
     580        <field id="west_gwstress" long_name="Westward GW Stress" unit="Pa" />
    568581        <field id="dtoro"    long_name="Orography dT"    unit="K/s" />
    569582        <field id="dtlif"    long_name="Orography dT"    unit="K/s" />
    … …  
    600613        <field id="stratomask"    long_name="Stratospheric fraction"    unit="-" />
    601614    </field_group>
     615
     616    <field_group id="fields_strataer_trac_3D" domain_ref="dom_glo" axis_ref="presnivs"/>
     617    <field_group id="fields_strataer_trac_2D" domain_ref="dom_glo"/>
     618
     619    <field_group id="fields_strataer_3D" domain_ref="dom_glo" axis_ref="presnivs">
     620        <field id="ext_strat_550"      long_name="Strat. aerosol extinction coefficient at 550 nm"       unit="1/m" />
     621        <field id="ext_strat_1020"     long_name="Strat. aerosol extinction coefficient at 1020 nm"      unit="1/m" />
     622        <field id="sulf_convert"       long_name="SO2 mass flux converted to H2SO4"                      unit="kg(S)/m2/layer/s" />
     623        <field id="sulf_nucl"          long_name="H2SO4 nucleation mass flux"                            unit="kg(S)/m2/layer/s" />
     624        <field id="sulf_cond_evap"     long_name="H2SO4 condensation/evaporation mass flux"              unit="kg(S)/m2/layer/s" />
     625        <field id="ocs_convert"        long_name="OCS mass flux converted to SO2"                        unit="kg(S)/m2/layer/s" />
     626        <field id="R2SO4"              long_name="H2SO4 mass fraction in aerosol"                        unit="%" />
     627        <field id="OCS_lifetime"       long_name="OCS lifetime"                                          unit="s" />
     628        <field id="SO2_lifetime"       long_name="SO2 lifetime"                                          unit="s" />
     629        <field id="SO2_backgr_tend"    long_name="SO2 background tendency"                               unit="kg(S)/m2/layer/s" />
     630        <field id="OCS_backgr_tend"    long_name="OCS background tendency"                               unit="kg(S)/m2/layer/s" />
     631        <field id="vsed_aer"           long_name="Strat. aerosol sedimentation velocity (mass-weighted)" unit="m/s" />
     632        <field id="f_r_wet"            long_name="Conversion factor dry to wet aerosol radius"           unit="-" />
     633    </field_group>
     634
     635    <field_group id="fields_strataer_2D" domain_ref="dom_glo">
     636        <field id="OD550_strat_only"   long_name="Stratospheric Aerosol Optical depth at 550 nm "        unit="1" />
     637        <field id="OD1020_strat_only"  long_name="Stratospheric Aerosol Optical depth at 1020 nm "       unit="1" />
     638        <field id="sulf_dep_dry"       long_name="Sulfur dry deposition flux"                            unit="kg(S)/m2/s" />
     639        <field id="sulf_dep_wet"       long_name="Sulfur wet deposition flux"                            unit="kg(S)/m2/s" />
     640        <field id="surf_PM25_sulf"     long_name="Sulfate PM2.5 concentration at the surface"            unit="ug/m3" />
     641        <field id="p_tropopause"       long_name="Tropopause pressure"                                   unit="Pa" />
     642        <field id="sflux"              long_name="Ground sedimentation flux of strat. particles"         unit="kg(S)/m2/s" />
     643    </field_group>
    602644   
    603645    <field_group  id="fields_NMC" domain_ref="dom_glo" axis_ref="plev">
    … …  
    624666    </field_group>
    625667
    626     <field_group id="fields_trac" domain_ref="dom_glo">
     668    <field_group id="fields_trac_2D" domain_ref="dom_glo">
    627669          <field id="cumRN"    long_name="Cumulated tracer  RNVL1"    unit="-" />
    628670          <field id="cumPB"    long_name="Cumulated tracer  PBVL1"    unit="-" />
    629           <field id="cumAga"    long_name="Cumulated tracer  Aga"    unit="-" />
    630     </field_group>
    631 
    632     <field_group id="fields_trac" domain_ref="dom_glo" axis_ref="presnivs">
     671          <field id="cumAga"   long_name="Cumulated tracer  Aga"    unit="-" />
     672          <field id="cumdRN_dry"  long_name="Surface dry deposition tracer  RNVL1"  unit="- s-1" />
     673          <field id="cumdPB_dry"  long_name="Surface dry deposition tracer  PBVL1"  unit="- s-1" />
     674          <field id="cumdAga_dry" long_name="Surface dry deposition tracer  Aga"    unit="- s-1" />
     675    </field_group>
     676
     677    <field_group id="fields_trac_3D" domain_ref="dom_glo" axis_ref="presnivs">
    633678      <field id="RN"    long_name="Tracer RNVL1"    unit="-" />
    634679      <field id="dRN_vdf"    long_name="Tendance tracer RNVL1"    unit="-" />
    … …  
    720765      <field id="c20_atb532" long_name="Lidar Attenuated Total Backscatter (532 nm)" unit="1" axis_ref="height_mlev" />
    721766      <field id="beta_mol532" long_name="Lidar Molecular Backscatter (532 nm)" unit="m-1 sr-1" axis_ref="height_mlev" />
    722       <field id="cllcalipsoice"    long_name="Lidar Ice-Phase Low-level Cloud Fraction"   unit="%" />
    723       <field id="clhcalipsoice"    long_name="Lidar Ice-Phase Hight-level Cloud Fraction"   unit="%" />
    724       <field id="clmcalipsoice"    long_name="Lidar Ice-Phase Mid-level Cloud Fraction"   unit="%" />
    725       <field id="cltcalipsoice"    long_name="Lidar Ice-Phase Total Cloud Fraction"   unit="%" />
    726       <field id="clcalipsoice"  long_name="Lidar Ice-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" />
    727       <field id="cllcalipsoliq"    long_name="Lidar Liq-Phase Low-level Cloud Fraction"   unit="%" />
    728       <field id="clhcalipsoliq"    long_name="Lidar Liq-Phase Hight-level Cloud Fraction"   unit="%" />
    729       <field id="clmcalipsoliq"    long_name="Lidar Liq-Phase Mid-level Cloud Fraction"   unit="%" />
    730       <field id="cltcalipsoliq"    long_name="Lidar Liq-Phase Total Cloud Fraction"   unit="%" />
    731       <field id="clcalipsoliq"  long_name="Lidar Liq-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" />
     767      <field id="cllcalipsoice"   long_name="Lidar Ice-Phase Low-level Cloud Fraction"   unit="%" />
     768      <field id="clhcalipsoice"   long_name="Lidar Ice-Phase Hight-level Cloud Fraction"   unit="%" />
     769      <field id="clmcalipsoice"   long_name="Lidar Ice-Phase Mid-level Cloud Fraction"   unit="%" />
     770      <field id="cltcalipsoice"   long_name="Lidar Ice-Phase Total Cloud Fraction"   unit="%" />
     771      <field id="clcalipsoice"    long_name="Lidar Ice-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" />
     772      <field id="cllcalipsoliq"   long_name="Lidar Liq-Phase Low-level Cloud Fraction"   unit="%" />
     773      <field id="clhcalipsoliq"   long_name="Lidar Liq-Phase Hight-level Cloud Fraction"   unit="%" />
     774      <field id="clmcalipsoliq"   long_name="Lidar Liq-Phase Mid-level Cloud Fraction"   unit="%" />
     775      <field id="cltcalipsoliq"   long_name="Lidar Liq-Phase Total Cloud Fraction"   unit="%" />
     776      <field id="clcalipsoliq"    long_name="Lidar Liq-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" />
    732777      <field id="cllcalipsoun"    long_name="Lidar Undefined-Phase Low-level Cloud Fraction"   unit="%" />
    733778      <field id="clhcalipsoun"    long_name="Lidar Undefined-Phase Hight-level Cloud Fraction"   unit="%" />
    734779      <field id="clmcalipsoun"    long_name="Lidar Undefined-Phase Mid-level Cloud Fraction"   unit="%" />
    735780      <field id="cltcalipsoun"    long_name="Lidar Undefined-Phase Total Cloud Fraction"   unit="%" />
    736       <field id="clcalipsoun"  long_name="Lidar Undefined-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" />
    737       <field id="clcalipsotmp"  long_name="Lidar Cloud Fraction (532 nm)" unit="%" axis_ref="temp" />
    738       <field id="clcalipsotmpliq"  long_name="Lidar Liq-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="temp" />
    739       <field id="clcalipsotmpice"  long_name="Lidar Ice-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="temp" />
     781      <field id="clcalipsoun"     long_name="Lidar Undefined-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="height" />
     782      <field id="clcalipsotmp"    long_name="Lidar Cloud Fraction (532 nm)" unit="%" axis_ref="temp" />
     783      <field id="clcalipsotmpliq" long_name="Lidar Liq-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="temp" />
     784      <field id="clcalipsotmpice" long_name="Lidar Ice-Phase Cloud Fraction (532 nm)" unit="%" axis_ref="temp" />
    740785      <field id="clcalipsotmpun"  long_name="Undefined-Phase Total Cloud Fraction"   unit="%" axis_ref="temp" />
    741786    </field_group> 
    … …  
    867912    </field_group>
    868913
    869 
    870914   <field_group id="field_scalar" operation="instant" freq_op="30d" grid_ref="grid_scalar">
    871915      <field id="R_ecc" long_name="R_ecc" unit="-" />
    … …  
    873917      <field id="R_incl" long_name="R_incl" unit="deg" />
    874918      <field id="solaire" long_name="solaire" unit="W/m2" />
    875 
    876919      <field id="rsun1" long_name="Fraction constante solaire bande 1" unit="W/m2" />
    877920      <field id="rsun2" long_name="Fraction constante solaire bande 2" unit="W/m2" />
    … …  
    880923      <field id="rsun5" long_name="Fraction constante solaire bande 5" unit="W/m2" />
    881924      <field id="rsun6" long_name="Fraction constante solaire bande 6" unit="W/m2" />
    882 
    883925      <field id="co2_ppm" long_name="co2_ppm" unit="ppm" />
    884926      <field id="CH4_ppb" long_name="CH4_ppb" unit="ppb" />

  • LMDZ5/branches/testing/DefLists/file_def_histLES_lmdz.xml

    r2594 r2720  
    163163                <field field_ref="wbilo_oce" level="10" />
    164164                <field field_ref="wbilo_sic" level="10" />
     165                <field field_ref="wevap_ter" level="10" />
     166                <field field_ref="wevap_lic" level="10" />
     167                <field field_ref="wevap_oce" level="10" />
     168                <field field_ref="wevap_sic" level="10" />
     169                <field field_ref="wrain_ter" level="10" />
     170                <field field_ref="wrain_lic" level="10" />
     171                <field field_ref="wrain_oce" level="10" />
     172                <field field_ref="wrain_sic" level="10" />
     173                <field field_ref="wsnow_ter" level="10" />
     174                <field field_ref="wsnow_lic" level="10" />
     175                <field field_ref="wsnow_oce" level="10" />
     176                <field field_ref="wsnow_sic" level="10" />
    165177                <field field_ref="cdrm" level="10" />
    166178                <field field_ref="cdrh" level="10" />
    … …  
    448460                <field field_ref="upwd" level="10" />
    449461                <field field_ref="ep" level="10" />
     462                <field field_ref="duphy" level="10" />
    450463                <field field_ref="dtphy" level="10" />
    451464                <field field_ref="dqphy" level="10" />

  • LMDZ5/branches/testing/DefLists/file_def_histdayCOSP_lmdz.xml

    r2594 r2720  
    164164                <field field_ref="c06_clmodis" level="1" axis_ref="pressure2" />
    165165                <field field_ref="c07_clmodis" level="1" axis_ref="pressure2" />
     166                <field field_ref="c01_crimodis" level="1" axis_ref="ReffIce" />
     167                <field field_ref="c02_crimodis" level="1" axis_ref="ReffIce" />
     168                <field field_ref="c03_crimodis" level="1" axis_ref="ReffIce" />
     169                <field field_ref="c04_crimodis" level="1" axis_ref="ReffIce" />
     170                <field field_ref="c05_crimodis" level="1" axis_ref="ReffIce" />
     171                <field field_ref="c06_crimodis" level="1" axis_ref="ReffIce" />
     172                <field field_ref="c07_crimodis" level="1" axis_ref="ReffIce" />
     173                <field field_ref="c01_crlmodis" level="1" axis_ref="ReffLiq" />
     174                <field field_ref="c02_crlmodis" level="1" axis_ref="ReffLiq" />
     175                <field field_ref="c03_crlmodis" level="1" axis_ref="ReffLiq" />
     176                <field field_ref="c04_crlmodis" level="1" axis_ref="ReffLiq" />
     177                <field field_ref="c05_crlmodis" level="1" axis_ref="ReffLiq" />
     178                <field field_ref="c06_crlmodis" level="1" axis_ref="ReffLiq" />
     179                <field field_ref="c07_crlmodis" level="1" axis_ref="ReffLiq" />
    166180            </field_group>
    167181

  • LMDZ5/branches/testing/DefLists/file_def_histday_lmdz.xml

    r2594 r2720  
    163163                <field field_ref="wbilo_oce" level="10" />
    164164                <field field_ref="wbilo_sic" level="10" />
     165                <field field_ref="wevap_ter" level="10" />
     166                <field field_ref="wevap_lic" level="10" />
     167                <field field_ref="wevap_oce" level="10" />
     168                <field field_ref="wevap_sic" level="10" />
     169                <field field_ref="wrain_ter" level="10" />
     170                <field field_ref="wrain_lic" level="10" />
     171                <field field_ref="wrain_oce" level="10" />
     172                <field field_ref="wrain_sic" level="10" />
     173                <field field_ref="wsnow_ter" level="10" />
     174                <field field_ref="wsnow_lic" level="10" />
     175                <field field_ref="wsnow_oce" level="10" />
     176                <field field_ref="wsnow_sic" level="10" />
    165177                <field field_ref="cdrm" level="10" />
    166178                <field field_ref="cdrh" level="10" />
    … …  
    448460                <field field_ref="upwd" level="10" />
    449461                <field field_ref="ep" level="10" />
     462                <field field_ref="duphy" level="10" />
    450463                <field field_ref="dtphy" level="10" />
    451464                <field field_ref="dqphy" level="10" />

  • LMDZ5/branches/testing/DefLists/file_def_histhfCOSP_lmdz.xml

    r2594 r2720  
    164164                <field field_ref="c06_clmodis" level="1" axis_ref="pressure2" />
    165165                <field field_ref="c07_clmodis" level="1" axis_ref="pressure2" />
     166                <field field_ref="c01_crimodis" level="1" axis_ref="ReffIce" />
     167                <field field_ref="c02_crimodis" level="1" axis_ref="ReffIce" />
     168                <field field_ref="c03_crimodis" level="1" axis_ref="ReffIce" />
     169                <field field_ref="c04_crimodis" level="1" axis_ref="ReffIce" />
     170                <field field_ref="c05_crimodis" level="1" axis_ref="ReffIce" />
     171                <field field_ref="c06_crimodis" level="1" axis_ref="ReffIce" />
     172                <field field_ref="c07_crimodis" level="1" axis_ref="ReffIce" />
     173                <field field_ref="c01_crlmodis" level="1" axis_ref="ReffLiq" />
     174                <field field_ref="c02_crlmodis" level="1" axis_ref="ReffLiq" />
     175                <field field_ref="c03_crlmodis" level="1" axis_ref="ReffLiq" />
     176                <field field_ref="c04_crlmodis" level="1" axis_ref="ReffLiq" />
     177                <field field_ref="c05_crlmodis" level="1" axis_ref="ReffLiq" />
     178                <field field_ref="c06_crlmodis" level="1" axis_ref="ReffLiq" />
     179                <field field_ref="c07_crlmodis" level="1" axis_ref="ReffLiq" />
    166180            </field_group>
    167181

  • LMDZ5/branches/testing/DefLists/file_def_histhf_lmdz.xml

    r2594 r2720  
    163163                <field field_ref="wbilo_oce" level="10" />
    164164                <field field_ref="wbilo_sic" level="10" />
     165                <field field_ref="wevap_ter" level="10" />
     166                <field field_ref="wevap_lic" level="10" />
     167                <field field_ref="wevap_oce" level="10" />
     168                <field field_ref="wevap_sic" level="10" />
     169                <field field_ref="wrain_ter" level="10" />
     170                <field field_ref="wrain_lic" level="10" />
     171                <field field_ref="wrain_oce" level="10" />
     172                <field field_ref="wrain_sic" level="10" />
     173                <field field_ref="wsnow_ter" level="10" />
     174                <field field_ref="wsnow_lic" level="10" />
     175                <field field_ref="wsnow_oce" level="10" />
     176                <field field_ref="wsnow_sic" level="10" />
    165177                <field field_ref="cdrm" level="10" />
    166178                <field field_ref="cdrh" level="7" />
    … …  
    478490                <field field_ref="upwd" level="10" />
    479491                <field field_ref="ep" level="10" />
     492                <field field_ref="duphy" level="10" />
    480493                <field field_ref="dtphy" level="10" />
    481494                <field field_ref="dqphy" level="10" />

  • LMDZ5/branches/testing/DefLists/file_def_histins_lmdz.xml

    r2594 r2720  
    163163                <field field_ref="wbilo_oce" level="10" />
    164164                <field field_ref="wbilo_sic" level="10" />
     165                <field field_ref="wevap_ter" level="10" />
     166                <field field_ref="wevap_lic" level="10" />
     167                <field field_ref="wevap_oce" level="10" />
     168                <field field_ref="wevap_sic" level="10" />
     169                <field field_ref="wrain_ter" level="10" />
     170                <field field_ref="wrain_lic" level="10" />
     171                <field field_ref="wrain_oce" level="10" />
     172                <field field_ref="wrain_sic" level="10" />
     173                <field field_ref="wsnow_ter" level="10" />
     174                <field field_ref="wsnow_lic" level="10" />
     175                <field field_ref="wsnow_oce" level="10" />
     176                <field field_ref="wsnow_sic" level="10" />
    165177                <field field_ref="cdrm" level="10" />
    166178                <field field_ref="cdrh" level="10" />
    … …  
    448460                <field field_ref="upwd" level="10" />
    449461                <field field_ref="ep" level="10" />
     462                <field field_ref="duphy" level="10" />
    450463                <field field_ref="dtphy" level="10" />
    451464                <field field_ref="dqphy" level="10" />

  • LMDZ5/branches/testing/DefLists/file_def_histmthCOSP_lmdz.xml

    r2594 r2720  
    163163                <field field_ref="c06_clmodis" level="1" axis_ref="pressure2" />
    164164                <field field_ref="c07_clmodis" level="1" axis_ref="pressure2" />
     165                <field field_ref="c01_crimodis" level="1" axis_ref="ReffIce" />
     166                <field field_ref="c02_crimodis" level="1" axis_ref="ReffIce" />
     167                <field field_ref="c03_crimodis" level="1" axis_ref="ReffIce" />
     168                <field field_ref="c04_crimodis" level="1" axis_ref="ReffIce" />
     169                <field field_ref="c05_crimodis" level="1" axis_ref="ReffIce" />
     170                <field field_ref="c06_crimodis" level="1" axis_ref="ReffIce" />
     171                <field field_ref="c07_crimodis" level="1" axis_ref="ReffIce" />
     172                <field field_ref="c01_crlmodis" level="1" axis_ref="ReffLiq" />
     173                <field field_ref="c02_crlmodis" level="1" axis_ref="ReffLiq" />
     174                <field field_ref="c03_crlmodis" level="1" axis_ref="ReffLiq" />
     175                <field field_ref="c04_crlmodis" level="1" axis_ref="ReffLiq" />
     176                <field field_ref="c05_crlmodis" level="1" axis_ref="ReffLiq" />
     177                <field field_ref="c06_crlmodis" level="1" axis_ref="ReffLiq" />
     178                <field field_ref="c07_crlmodis" level="1" axis_ref="ReffLiq" />
    165179            </field_group>
    166180

  • LMDZ5/branches/testing/DefLists/file_def_histmth_lmdz.xml

    r2682 r2720  
    99<!--              <field field_ref="Alt" level="1" />  -->
    1010<!--            </field_group>  -->
    11        
    1211
    1312            <field_group operation="instant" freq_op="30d">
    … …  
    2928                <field field_ref="CFC11_ppt" level="1" name="CFC11_ppt" />
    3029                <field field_ref="CFC12_ppt" level="1" name="CFC12_ppt" />
    31 
    3230            </field_group>
    3331
    … …  
    185183                <field field_ref="wbilo_oce" level="1" />
    186184                <field field_ref="wbilo_sic" level="1" />
     185                <field field_ref="wevap_ter" level="1" />
     186                <field field_ref="wevap_lic" level="1" />
     187                <field field_ref="wevap_oce" level="1" />
     188                <field field_ref="wevap_sic" level="1" />
     189                <field field_ref="wrain_ter" level="1" />
     190                <field field_ref="wrain_lic" level="1" />
     191                <field field_ref="wrain_oce" level="1" />
     192                <field field_ref="wrain_sic" level="1" />
     193                <field field_ref="wsnow_ter" level="1" />
     194                <field field_ref="wsnow_lic" level="1" />
     195                <field field_ref="wsnow_oce" level="1" />
     196                <field field_ref="wsnow_sic" level="1" />
    187197                <field field_ref="cdrm" level="1" />
    188198                <field field_ref="cdrh" level="1" />
    … …  
    325335                <field field_ref="z0m" level="10" />
    326336                <field field_ref="z0h" level="10" />
    327                 <field field_ref="topswad" level="2" />
    328                 <field field_ref="topswad0" level="2" />
    329                 <field field_ref="topswai" level="2" />
    330                 <field field_ref="solswad" level="2" />
    331                 <field field_ref="solswad0" level="2" />
    332                 <field field_ref="solswai" level="2" />
     337                <field field_ref="topswad" level="5" />
     338                <field field_ref="topswad0" level="5" />
     339                <field field_ref="topswai" level="5" />
     340                <field field_ref="solswad" level="5" />
     341                <field field_ref="solswad0" level="5" />
     342                <field field_ref="solswai" level="5" />
    333343                <field field_ref="OD550_ASBCM" level="2" />
    334344                <field field_ref="OD550_ASPOMM" level="2" />
    … …  
    470480                <field field_ref="upwd" level="2" />
    471481                <field field_ref="ep" level="2" />
     482                <field field_ref="duphy" level="2" />
    472483                <field field_ref="dtphy" level="2" />
    473484                <field field_ref="dqphy" level="2" />
    … …  
    588599                <field field_ref="rldcs4co2" level="5" />
    589600            </field_group>
     601
     602            <field_group group_ref="fields_strataer_3D" operation="average" freq_op="1ts" level="1" />
     603            <field_group group_ref="fields_strataer_2D" operation="average" freq_op="1ts" level="1" />
     604            <field_group group_ref="fields_strataer_trac_3D" operation="average" freq_op="1ts" level="1" />
     605            <field_group group_ref="fields_strataer_trac_2D" operation="average" freq_op="1ts" level="1" />
     606
    590607        </file>
    591608
    592609        </file_group>
    593610    </file_definition>
    594    

  • LMDZ5/branches/testing/DefLists/file_def_histstn_lmdz.xml

    r2594 r2720  
    163163                <field field_ref="wbilo_oce" level="10" />
    164164                <field field_ref="wbilo_sic" level="10" />
     165                <field field_ref="wevap_ter" level="10" />
     166                <field field_ref="wevap_lic" level="10" />
     167                <field field_ref="wevap_oce" level="10" />
     168                <field field_ref="wevap_sic" level="10" />
     169                <field field_ref="wrain_ter" level="10" />
     170                <field field_ref="wrain_lic" level="10" />
     171                <field field_ref="wrain_oce" level="10" />
     172                <field field_ref="wrain_sic" level="10" />
     173                <field field_ref="wsnow_ter" level="10" />
     174                <field field_ref="wsnow_lic" level="10" />
     175                <field field_ref="wsnow_oce" level="10" />
     176                <field field_ref="wsnow_sic" level="10" />
    165177                <field field_ref="cdrm" level="10" />
    166178                <field field_ref="cdrh" level="10" />
    … …  
    448460                <field field_ref="upwd" level="10" />
    449461                <field field_ref="ep" level="10" />
     462                <field field_ref="duphy" level="10" />
    450463                <field field_ref="dtphy" level="10" />
    451464                <field field_ref="dqphy" level="10" />

  • LMDZ5/branches/testing/DefLists/run.def

    r2488 r2720  
    66INCLUDEDEF=vert.def
    77INCLUDEDEF=physiq.def
    8 INCLUDEDEF=convection.def
    98INCLUDEDEF=orchidee.def
    109INCLUDEDEF=output.def

  • LMDZ5/branches/testing/bld.cfg

    r2641 r2720  
    2929src::rrtm    %RRTM
    3030src::dust    %DUST
     31src::strataer %STRATAER
    3132src::grid    %SRC_PATH/grid
    3233src::filtrez %FILTRE
    … …  
    108109bld::tool::SHELL   /bin/bash
    109110bld::tool::SHELL   /bin/ksh
     111bld::tool::SHELL   /bin/ksh

  • LMDZ5/branches/testing/libf/dyn3d/conf_gcm.F90

    r2641 r2720  
    1818  USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
    1919                       ok_guide, ok_limit, ok_strato, purmats, read_start, &
    20                        ysinus
     20                       ysinus, read_orop
    2121  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
    2222                       alphax,alphay,taux,tauy
    … …  
    854854     CALL getin('ok_etat0',ok_etat0)
    855855
     856     !Config  Key  = read_orop
     857     !Config  Desc = lecture du fichier de params orographiques sous maille
     858     !Config  Def  = f
     859     !Config  Help = lecture fichier plutot que grid_noro
     860
     861     read_orop = .FALSE.
     862     CALL getin('read_orop',read_orop)
     863
    856864     write(lunout,*)' #########################################'
    857865     write(lunout,*)' Configuration des parametres de cel0' &
    … …  
    900908     write(lunout,*)' ok_limit = ', ok_limit
    901909     write(lunout,*)' ok_etat0 = ', ok_etat0
     910     write(lunout,*)' read_orop = ', read_orop
    902911  end IF test_etatinit
    903912

  • LMDZ5/branches/testing/libf/dyn3d/logic_mod.F90

    r2641 r2720  
    2525  LOGICAL ok_strato
    2626  LOGICAL ok_gradsfile
    27   LOGICAL ok_limit
    28   LOGICAL ok_etat0
     27  LOGICAL ok_limit  ! true for boundary conditions file creation (limit.nc)
     28  LOGICAL ok_etat0  ! true for initial states creation (start.nc, startphy.nc)
     29  LOGICAL read_orop ! true for sub-cell scales orographic params read in file
    2930  LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    3031                 ! (only used if disvert_type==2)

  • LMDZ5/branches/testing/libf/dyn3d_common/infotrac.F90

    r2594 r2720  
    4141  CHARACTER(len=8),DIMENSION(:),ALLOCATABLE, SAVE :: solsym
    4242   
    43     ! CRisi: cas particulier des isotopes
    44     LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso
    45     INTEGER :: niso_possibles   
    46     PARAMETER ( niso_possibles=5)
    47     real, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal
    48     LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
    49     INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
    50     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
    51     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
    52     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
    53     INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
    54     INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
    55     INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
    56     INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
     43! CRisi: cas particulier des isotopes
     44  LOGICAL,SAVE :: ok_isotopes,ok_iso_verif,ok_isotrac,ok_init_iso
     45  INTEGER :: niso_possibles   
     46  PARAMETER ( niso_possibles=5)
     47  REAL, DIMENSION (niso_possibles),SAVE :: tnat,alpha_ideal
     48  LOGICAL, DIMENSION(niso_possibles),SAVE ::  use_iso
     49  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  iqiso ! donne indice iq en fn de (ixt,phase)
     50  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_num ! donne numéro iso entre 1 et niso_possibles en fn de nqtot
     51  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  iso_indnum ! donne numéro iso entre 1 et niso effectif en fn de nqtot
     52  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  zone_num ! donne numéro de la zone de tracage en fn de nqtot
     53  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE ::  phase_num ! donne numéro de la zone de tracage en fn de nqtot
     54  INTEGER, DIMENSION(niso_possibles), SAVE :: indnum_fn_num ! donne indice entre entre 1 et niso en fonction du numéro d isotope entre 1 et niso_possibles
     55  INTEGER, ALLOCATABLE, DIMENSION(:,:), SAVE ::  index_trac ! numéro ixt en fn izone, indnum entre 1 et niso
     56  INTEGER,SAVE :: niso,ntraceurs_zone,ntraciso
     57
     58#ifdef CPP_StratAer
     59!--CK/OB for stratospheric aerosols
     60  INTEGER, SAVE :: nbtr_bin
     61  INTEGER, SAVE :: nbtr_sulgas
     62  INTEGER, SAVE :: id_OCS_strat
     63  INTEGER, SAVE :: id_SO2_strat
     64  INTEGER, SAVE :: id_H2SO4_strat
     65  INTEGER, SAVE :: id_BIN01_strat
     66  INTEGER, SAVE :: id_TEST_strat
     67#endif
    5768 
    5869CONTAINS
    … …  
    141152       CALL abort_gcm('infotrac_init','You must compile with cpp key REPROBUS',1)
    142153#endif
     154    ELSE IF (type_trac == 'coag') THEN
     155       WRITE(lunout,*) 'Tracers are treated for COAGULATION tests : type_trac=', type_trac
     156#ifndef CPP_StratAer
     157       WRITE(lunout,*) 'To run this option you must add cpp key StratAer and compile with StratAer code'
     158       CALL abort_gcm('infotrac_init','You must compile with cpp key StratAer',1)
     159#endif
    143160    ELSE IF (type_trac == 'lmdz') THEN
    144161       WRITE(lunout,*) 'Tracers are treated in LMDZ only : type_trac=', type_trac
    … …  
    148165    END IF
    149166
    150 
    151167    ! Test if config_inca is other then none for run without INCA
    152168    IF (type_trac/='inca' .AND. config_inca/='none') THEN
    … …  
    155171    END IF
    156172
    157 
    158173!-----------------------------------------------------------------------
    159174!
    … …  
    162177!
    163178!-----------------------------------------------------------------------
    164     IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
     179    IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN
    165180       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
    166181       IF(ierr.EQ.0) THEN
    … …  
    171186          WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
    172187          WRITE(lunout,*) trim(modname),': WARNING using defaut values'
    173           if (planet_type=='earth') then
     188          IF (planet_type=='earth') THEN
    174189            nqtrue=4 ! Default value for Earth
    175           else
     190          ELSE
    176191            nqtrue=1 ! Default value for other planets
    177           endif
    178        END IF
     192          ENDIF
     193       ENDIF
    179194!jyg<
    180195!!       if ( planet_type=='earth') then
    … …  
    211226       ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr))
    212227
    213     END IF   ! type_trac
     228    ENDIF   ! type_trac
    214229!>jyg
    215230
    … …  
    266281!    Get choice of advection schema from file tracer.def or from INCA
    267282!---------------------------------------------------------------------
    268     IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
     283    IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN
    269284       IF(ierr.EQ.0) THEN
    270285          ! Continue to read tracer.def
    … …  
    346361       END DO
    347362
    348        if ( planet_type=='earth') then
     363       IF ( planet_type=='earth') THEN
    349364         !CR: nombre de traceurs de l eau
    350          if (tnom_0(3) == 'H2Oi') then
     365         IF (tnom_0(3) == 'H2Oi') THEN
    351366            nqo=3
    352          else
     367         ELSE
    353368            nqo=2
    354          endif
     369         ENDIF
    355370         ! For Earth, water vapour & liquid tracers are not in the physics
    356371         nbtr=nqtrue-nqo
    357        else
     372       ELSE
    358373         ! Other planets (for now); we have the same number of tracers
    359374         ! in the dynamics than in the physics
    360375         nbtr=nqtrue
    361        endif
    362 
    363     ENDIF  ! (type_trac == 'lmdz' .OR. type_trac == 'repr')
     376       ENDIF
     377
     378#ifdef CPP_StratAer
     379       IF (type_trac == 'coag') THEN
     380         nbtr_bin=0
     381         nbtr_sulgas=0
     382         DO iq=1,nqtrue
     383           IF (tnom_0(iq)(1:3)=='BIN') THEN !check if tracer name contains 'BIN'
     384             nbtr_bin=nbtr_bin+1
     385           ENDIF
     386           IF (tnom_0(iq)(1:3)=='GAS') THEN !check if tracer name contains 'GAS'
     387             nbtr_sulgas=nbtr_sulgas+1
     388           ENDIF
     389         ENDDO
     390         print*,'nbtr_bin=',nbtr_bin
     391         print*,'nbtr_sulgas=',nbtr_sulgas
     392         DO iq=1,nqtrue
     393           IF (tnom_0(iq)=='GASOCS') THEN
     394             id_OCS_strat=iq-nqo
     395           ENDIF
     396           IF (tnom_0(iq)=='GASSO2') THEN
     397             id_SO2_strat=iq-nqo
     398           ENDIF
     399           IF (tnom_0(iq)=='GASH2SO4') THEN
     400             id_H2SO4_strat=iq-nqo
     401           ENDIF
     402           IF (tnom_0(iq)=='BIN01') THEN
     403             id_BIN01_strat=iq-nqo
     404           ENDIF
     405           IF (tnom_0(iq)=='GASTEST') THEN
     406             id_TEST_strat=iq-nqo
     407           ENDIF
     408         ENDDO
     409         print*,'id_OCS_strat  =',id_OCS_strat
     410         print*,'id_SO2_strat  =',id_SO2_strat
     411         print*,'id_H2SO4_strat=',id_H2SO4_strat
     412         print*,'id_BIN01_strat=',id_BIN01_strat
     413       ENDIF
     414#endif
     415
     416    ENDIF  ! (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac = 'coag')
    364417!jyg<
    365418!

  • LMDZ5/branches/testing/libf/dyn3dmem/conf_gcm.F90

    r2641 r2720  
    2222  USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
    2323                       ok_guide, ok_limit, ok_strato, purmats, read_start, &
    24                        ysinus
     24                       ysinus, read_orop
    2525  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
    2626                       alphax,alphay,taux,tauy
    … …  
    929929     CALL getin('ok_etat0',ok_etat0)
    930930
     931     !Config  Key  = read_orop
     932     !Config  Desc = lecture du fichier de params orographiques sous maille
     933     !Config  Def  = f
     934     !Config  Help = lecture fichier plutot que grid_noro
     935
     936     read_orop = .FALSE.
     937     CALL getin('read_orop',read_orop)
     938
    931939     write(lunout,*)' #########################################'
    932940     write(lunout,*)' Configuration des parametres de cel0' &
    … …  
    977985     write(lunout,*)' ok_limit = ', ok_limit
    978986     write(lunout,*)' ok_etat0 = ', ok_etat0
     987     write(lunout,*)' read_orop = ', read_orop
    979988  end IF test_etatinit
    980989

  • LMDZ5/branches/testing/libf/dyn3dmem/logic_mod.F90

    r2641 r2720  
    2525  LOGICAL ok_strato
    2626  LOGICAL ok_gradsfile
    27   LOGICAL ok_limit
    28   LOGICAL ok_etat0
     27  LOGICAL ok_limit  ! true for boundary conditions file creation (limit.nc)
     28  LOGICAL ok_etat0  ! true for initial states creation (start.nc, startphy.nc)
     29  LOGICAL read_orop ! true for sub-cell scales orographic params read in file
    2930  LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    3031                 ! (only used if disvert_type==2)

  • LMDZ5/branches/testing/libf/dyn3dpar/conf_gcm.F90

    r2641 r2720  
    2121  USE logic_mod, ONLY: fxyhypb, iflag_phys, ok_etat0, ok_gradsfile, &
    2222                       ok_guide, ok_limit, ok_strato, purmats, read_start, &
    23                        ysinus
     23                       ysinus, read_orop
    2424  USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
    2525                       alphax,alphay,taux,tauy
    … …  
    925925     CALL getin('ok_etat0',ok_etat0)
    926926
     927     !Config  Key  = read_orop
     928     !Config  Desc = lecture du fichier de params orographiques sous maille
     929     !Config  Def  = f
     930     !Config  Help = lecture fichier plutot que grid_noro
     931
     932     read_orop = .FALSE.
     933     CALL getin('read_orop',read_orop)
     934
    927935     write(lunout,*)' #########################################'
    928936     write(lunout,*)' Configuration des parametres de cel0' &
    … …  
    973981     write(lunout,*)' ok_limit = ', ok_limit
    974982     write(lunout,*)' ok_etat0 = ', ok_etat0
     983     write(lunout,*)' read_orop = ', read_orop
    975984  end IF test_etatinit
    976985

  • LMDZ5/branches/testing/libf/dyn3dpar/logic_mod.F90

    r2641 r2720  
    2525  LOGICAL ok_strato
    2626  LOGICAL ok_gradsfile
    27   LOGICAL ok_limit
    28   LOGICAL ok_etat0
     27  LOGICAL ok_limit  ! true for boundary conditions file creation (limit.nc)
     28  LOGICAL ok_etat0  ! true for initial states creation (start.nc, startphy.nc)
     29  LOGICAL read_orop ! true for sub-cell scales orographic params read in file
    2930  LOGICAL hybrid ! vertical coordinate is hybrid if true (sigma otherwise)
    3031                 ! (only used if disvert_type==2)

  • LMDZ5/branches/testing/libf/dynphy_lonlat/phylmd/ce0l.F90

    r2641 r2720  
    1212!     * "masque" can be:
    1313!       - read from file "o2a.nc"          (for coupled runs).
     14!       - read from file "startphy0.nc"    (from a previous run).
    1415!       - created in etat0phys or etat0dyn (for forced  runs).
    1516!     It is then passed to limit_netcdf to ensure consistancy.
    … …  
    2021  USE etat0phys,      ONLY: etat0phys_netcdf
    2122  USE limit,          ONLY: limit_netcdf
    22   USE netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR
     23  USE netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR,    &
     24         NF90_INQUIRE_DIMENSION, NF90_INQ_DIMID, NF90_INQ_VARID, NF90_GET_VAR
    2325  USE infotrac,       ONLY: type_trac, infotrac_init
    2426  USE dimphy,         ONLY: klon
    … …  
    6062  REAL, ALLOCATABLE  :: lat_omask(:,:), dlat_omask(:), ocetmp (:,:)
    6163  REAL               :: date, lev(1)
     64
     65!--- Local variables for land mask from startphy0 file reading
     66  INTEGER            :: nid_sta, nid_nph, nid_msk, nphys
     67  REAL, ALLOCATABLE  :: masktmp(:)
     68
    6269#ifndef CPP_PARA
    6370! for iniphysiq in serial mode
    … …  
    133140  ENDIF
    134141
    135 !--- LAND MASK. TWO CASES:
     142!--- LAND MASK. THREE CASES:
    136143!   1) read from ocean model    file "o2a.nc"    (coupled runs)
    137 !   2) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
    138 ! Coupled simulations (case 1) use the ocean model mask to compute the
     144!   2) read from previous run   file="startphy0.nc"
     145!   3) computed from topography file "Relief.nc" (masque(:,:)=-99999.)
     146! In the first case, the mask from the ocean model is used compute the
    139147! weights to ensure ocean fractions are the same for atmosphere and ocean.
    140148!*******************************************************************************
    141   IF(NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)/=NF90_NOERR) THEN
    142     WRITE(lunout,*)'BEWARE !! No ocean mask "o2a.nc" file found'
    143     WRITE(lunout,*)'Forced run.'
    144     masque(:,:)=-99999.
    145   ELSE
     149  IF(NF90_OPEN("o2a.nc", NF90_NOWRITE, nid_o2a)==NF90_NOERR) THEN
    146150    iret=NF90_CLOSE(nid_o2a)
    147151    WRITE(lunout,*)'BEWARE !! Ocean mask "o2a.nc" file found'
    … …  
    175179    masque(iip1 ,:)=masque(1,:)
    176180    DEALLOCATE(ocemask)
     181  ELSE IF(NF90_OPEN("startphy0.nc", NF90_NOWRITE, nid_sta)==NF90_NOERR) THEN
     182    WRITE(lunout,*)'BEWARE !! File "startphy0.nc" found.'
     183    WRITE(lunout,*)'Getting the land mask from a previous run.'
     184    iret=NF90_INQ_DIMID(nid_sta,'points_physiques',nid_nph)
     185    iret=NF90_INQUIRE_DIMENSION(nid_sta,nid_nph,len=nphys)
     186    IF(nphys/=klon) THEN
     187      WRITE(lunout,*)'Mismatching dimensions for land mask'
     188      WRITE(lunout,*)'nphys  = ',nphys ,' klon = ',klon
     189      iret=NF90_CLOSE(nid_sta)
     190      CALL abort_gcm(modname,'',1)
     191    END IF
     192    ALLOCATE(masktmp(klon))
     193    iret=NF90_INQ_VARID(nid_sta,'masque',nid_msk)
     194    iret=NF90_GET_VAR(nid_sta,nid_msk,masktmp)
     195    iret=NF90_CLOSE(nid_sta)
     196    CALL gr_fi_dyn(1,klon,iip1,jjp1,masktmp,masque)
     197    IF(prt_level>=1) THEN
     198      WRITE(fmt,"(i4,'i1)')")iip1 ; fmt='('//ADJUSTL(fmt)
     199      WRITE(lunout,*)'LAND MASK :'
     200      WRITE(lunout,fmt) NINT(masque)
     201    END IF
     202    DEALLOCATE(masktmp)
     203  ELSE
     204    WRITE(lunout,*)'BEWARE !! No ocean mask "o2a.nc" file or "startphy0.nc" file found'
     205    WRITE(lunout,*)'Land mask will be built from the topography file.'
     206    masque(:,:)=-99999.
    177207  END IF
    178208  phis(:,:)=-99999.

  • LMDZ5/branches/testing/libf/dynphy_lonlat/phylmd/etat0dyn_netcdf.F90

    r2641 r2720  
    3838  USE comconst_mod, ONLY: pi, cpp, kappa
    3939  USE comvert_mod, ONLY: ap, bp, preff, pressure_exner
    40   USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn, itau_phy
     40  USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn, itau_phy, start_time
    4141 
    4242  IMPLICIT NONE
    … …  
    172172  CALL caldyn0( itau, uvent, vvent, tpot, psol, masse, pk, phis,               &
    173173                phi,  w, pbaru, pbarv, time+iday-dayref)
    174   WRITE(lunout,*)'sortie caldyn0'     
     174  WRITE(lunout,*)'sortie caldyn0'
     175  start_time = 0.
    175176#ifdef CPP_PARA
    176177  CALL dynredem0_loc( "start.nc", dayref, phis)

  • LMDZ5/branches/testing/libf/dynphy_lonlat/phylmd/etat0phys_netcdf.F90

    r2669 r2720  
    5959  INTEGER,            SAVE      :: iml_phys, jml_phys, llm_phys, ttm_phys, fid_phys
    6060  REAL, ALLOCATABLE,  SAVE      :: lon_phys(:,:), lat_phys(:,:), levphys_ini(:)
     61  CHARACTER(LEN=256), PARAMETER :: oroparam="oro_params.nc"
    6162  CHARACTER(LEN=256), PARAMETER :: orofname="Relief.nc", orogvar="RELIEF"
    6263  CHARACTER(LEN=256), PARAMETER :: phyfname="ECPHY.nc",  psrfvar="SP"
    … …  
    255256!   This routine launch grid_noro, which computes parameters for SSO scheme as
    256257!   described in LOTT & MILLER (1997) and LOTT(1999).
     258!   In case the file oroparam is present and the key read_orop is activated,
     259!   grid_noro is bypassed and sub-cell parameters are read from the file.
    257260!===============================================================================
    258   USE grid_noro_m, ONLY: grid_noro
     261  USE grid_noro_m, ONLY: grid_noro, read_noro
     262  USE logic_mod,   ONLY: read_orop
    259263  IMPLICIT NONE
    260264!-------------------------------------------------------------------------------
    … …  
    266270  CHARACTER(LEN=256) :: modname
    267271  INTEGER            :: fid, llm_tmp,ttm_tmp, iml,jml, iml_rel,jml_rel, itau(1)
     272  INTEGER            :: ierr
    268273  REAL               :: lev(1), date, dt
    269274  REAL, ALLOCATABLE  :: lon_rad(:), lon_ini(:), lon_rel(:,:), relief_hi(:,:)
    … …  
    306311  ALLOCATE(zpic0(iml,jml),zval0(iml,jml)) !--- Peaks and valley heights
    307312
     313!--- READ SUB-CELL SCALES PARAMETERS FROM A FILE (AT RIGHT RESOLUTION)
     314  OPEN(UNIT=66,FILE=oroparam,STATUS='OLD',IOSTAT=ierr)
     315  IF(ierr==0.AND.read_orop) THEN
     316    CLOSE(UNIT=66)
     317    CALL read_noro(lon_in,lat_in,oroparam,                                     &
     318                   phis,zmea0,zstd0,zsig0,zgam0,zthe0,zpic0,zval0,masque)
     319  ELSE
    308320!--- CALL OROGRAPHY MODULE TO COMPUTE FIELDS
    309   CALL grid_noro(lon_rad,lat_rad,relief_hi,lon_in,lat_in,phis,zmea0,zstd0,     &
    310                                       zsig0,zgam0,zthe0,zpic0,zval0,masque)
     321    CALL grid_noro(lon_rad,lat_rad,relief_hi,lon_in,lat_in,                    &
     322                   phis,zmea0,zstd0,zsig0,zgam0,zthe0,zpic0,zval0,masque)
     323  END IF
    311324  phis = phis * 9.81
    312325  phis(iml,:) = phis(1,:)

  • LMDZ5/branches/testing/libf/dynphy_lonlat/phylmd/limit_netcdf.F90

    r2641 r2720  
    7171  USE netcdf95,           ONLY: nf95_def_var, nf95_put_att, nf95_put_var
    7272  USE comconst_mod, ONLY: pi
     73  USE phys_cal_mod, ONLY: calend
    7374  IMPLICIT NONE
    7475!-------------------------------------------------------------------------------
    … …  
    244245  !--- Attributes creation
    245246  CALL ncerr(NF90_PUT_ATT(nid,id_tim, "title","Jour dans l annee"),fnam)
     247  CALL ncerr(NF90_PUT_ATT(nid,id_tim, "calendar",calend),fnam)
    246248  CALL ncerr(NF90_PUT_ATT(nid,id_FOCE,"title","Fraction ocean"),fnam)
    247249  CALL ncerr(NF90_PUT_ATT(nid,id_FSIC,"title","Fraction glace de mer"),fnam)
    … …  
    405407      CASE('SIC', 'SST'); cal_in='gregorian'
    406408    END SELECT
    407   CALL msg(5,'WARNING: missing "calendar" attribute for "time" in '&
     409    CALL msg(5,'WARNING: missing "calendar" attribute for "time" in '&
    408410     &//TRIM(fnam)//'. Choosing default value.')
    409411  END IF
     412  CALL strclean(cal_in)                     !--- REMOVE (WEIRD) NULL CHARACTERS
    410413  CALL msg(5,'var, calendar, dim: '//TRIM(dnam)//' '//TRIM(cal_in), lmdep)
    411414 
    … …  
    477480  fnam_p=fnam(1:idx)//'_p.nc'
    478481  IF(NF90_OPEN(fnam_p,NF90_NOWRITE,ncid)==NF90_NOERR) THEN
    479     CALL msg(0,'Reading previous year file ("'//TRIM(fnam_p)//'") first record for '//TRIM(title))
     482    CALL msg(0,'Reading next year file ("'//TRIM(fnam_p)//'") first record for '//TRIM(title))
    480483    CALL ncerr(NF90_INQ_VARID(ncid, varname, varid),fnam_p)
    481484    CALL ncerr(NF90_GET_VAR(ncid,varid,champ,[1,1,1],[imdep,jmdep,1]),fnam_p)
    … …  
    767770!-------------------------------------------------------------------------------
    768771
     772
     773!-------------------------------------------------------------------------------
     774!
     775SUBROUTINE strclean(s)
     776!
     777!-------------------------------------------------------------------------------
     778  IMPLICIT NONE
     779!-------------------------------------------------------------------------------
     780! Purpose: Remove tail null characters from the input string.
     781!-------------------------------------------------------------------------------
     782! Parameters:
     783  CHARACTER(LEN=*), INTENT(INOUT) :: s
     784!-------------------------------------------------------------------------------
     785! Local variable:
     786  INTEGER :: k
     787!-------------------------------------------------------------------------------
     788  k=LEN_TRIM(s); DO WHILE(ICHAR(s(k:k))==0); s(k:k)=' '; k=LEN_TRIM(s); END DO
     789
     790END SUBROUTINE strclean
     791!
     792!-------------------------------------------------------------------------------
     793
    769794#endif
    770795! of #ifndef CPP_1D

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

    r2408 r2720  
    136136    RUWFRT=gwd_front_ruwmax 
    137137    SATFRT=gwd_front_sat
    138     CMAX = 40.    ! Characteristic phase speed
     138    CMAX = 50.    ! Characteristic phase speed
    139139! Phase speed test
    140140!   RUWFRT=0.01
    … …  
    145145! CRUCIAL PARAMETERS FOR THE WIND FILTERING
    146146    XLAUNCH=0.95 ! Parameter that control launching altitude
    147     RDISS = 1    ! Diffusion parameter
     147    RDISS = 0.5  ! Diffusion parameter
    148148
    149149    ! maximum of rain for which our theory applies (in kg/m^2/s)
    … …  
    377377       !  RESTORE DIMENSION OF A FLUX
    378378       !     *RD*TR/PR
    379              *1. + RUW0(JW, :)
     379       !     *1. + RUW0(JW, :)
     380             *1.
    380381
    381382       ! Factor related to the characteristics of the waves: NONE
    … …  
    417418          ! No breaking (Eq.6)
    418419          ! Dissipation (Eq. 8)
    419           WWP(JW, :) = WWM(JW, :) * EXP(- 2. * RDISS * PR / (PH(:, LL + 1) &
     420          WWP(JW, :) = WWM(JW, :) * EXP(- 4. * RDISS * PR / (PH(:, LL + 1) &
    420421               + PH(:, LL)) * ((BV(:, LL + 1) + BV(:, LL)) / 2.)**3 &
    421422               / MAX(ABS(ZOP(JW, :) + ZOM(JW, :)) / 2., ZOISEC)**4 &

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

    r2641 r2720  
    7171  REAL                                               :: aire
    7272  REAL, DIMENSION(klon, klev)                        :: p,  pi
    73   REAL, DIMENSION(klon, klev+1)                      ::  ph, omgbe
     73  REAL, DIMENSION(klon, klev+1)                      ::  ph
     74  REAL, DIMENSION(klon, klev)                        ::  omgbe
    7475  REAL, DIMENSION(klon, klev)                        :: te, qe
    7576  REAL, DIMENSION(klon, klev)                        :: dtdwn, dqdwn
    … …  
    8182  REAL, DIMENSION(klon)                              :: hw, wape, fip, gfl
    8283  REAL, DIMENSION(klon)                              :: sigmaw, wdens
    83   REAL, DIMENSION(klon, klev+1)                      :: omgbdth
     84  REAL, DIMENSION(klon, klev)                        :: omgbdth
    8485  REAL, DIMENSION(klon, klev)                        :: dp_omgb
    8586  REAL, DIMENSION(klon, klev)                        :: dtke, dqke
    86   REAL, DIMENSION(klon, klev+1)                      :: omg
     87  REAL, DIMENSION(klon, klev)                        :: omg
    8788  REAL, DIMENSION(klon, klev)                        :: dp_deltomg, spread
    8889  REAL, DIMENSION(klon)                              :: cstar
    … …  
    122123    END DO
    123124  END DO
    124 
    125   omgbe(:, klev+1) = 0.
    126125
    127126  DO i = 1, klon

  • LMDZ5/branches/testing/libf/phylmd/clesphys.h

    r2594 r2720  
    1313       LOGICAL ok_limitvrai
    1414       LOGICAL ok_all_xml
    15        INTEGER nbapp_rad, iflag_con,iflag_ener_conserv
     15       INTEGER nbapp_rad, iflag_con, nbapp_cv, iflag_ener_conserv
    1616       REAL co2_ppm, co2_ppm0, solaire
    1717       LOGICAL ok_suntime_rrtm
    … …  
    113113     &     , top_height                                                 &
    114114     &     , cycle_diurne, soil_model, new_oliq                         &
    115      &     , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad, iflag_con     &
     115     &     , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad                &
     116     &     , iflag_con, nbapp_cv                                        &
    116117     &     , iflag_ener_conserv                                         &
    117118     &     , ok_4xCO2atm                                                &

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

    r2669 r2720  
    44!
    55!
    6 module conf_phys_m
    7 
    8   implicit none
    9 
    10 contains
    11 
    12   subroutine conf_phys(ok_journe, ok_mensuel, ok_instan, ok_hf, &
     6MODULE conf_phys_m
     7
     8  IMPLICIT NONE
     9
     10CONTAINS
     11
     12  SUBROUTINE conf_phys(ok_journe, ok_mensuel, ok_instan, ok_hf, &
    1313       ok_LES,&
    1414       callstats,&
    … …  
    2323       alp_offset)
    2424
    25     use IOIPSL
     25    USE IOIPSL
    2626    USE surface_data
    2727    USE phys_cal_mod
    28     USE carbon_cycle_mod, ONLY : carbon_cycle_tr, carbon_cycle_cpl
    29     USE mod_grid_phy_lmdz, only: klon_glo
     28    USE carbon_cycle_mod,  ONLY: carbon_cycle_tr, carbon_cycle_cpl
     29    USE mod_grid_phy_lmdz, ONLY: klon_glo
    3030    USE print_control_mod, ONLY: lunout
    31 
    3231
    3332    include "conema3.h"
    … …  
    7069
    7170    ! Sortie:
    72     logical              :: ok_newmicro
    73     integer              :: iflag_radia
    74     logical              :: ok_journe, ok_mensuel, ok_instan, ok_hf
    75     logical              :: ok_LES
     71    LOGICAL              :: ok_newmicro
     72    INTEGER              :: iflag_radia
     73    LOGICAL              :: ok_journe, ok_mensuel, ok_instan, ok_hf
     74    LOGICAL              :: ok_LES
    7675    LOGICAL              :: callstats
    7776    LOGICAL              :: ok_ade, ok_aie, ok_cdnc, aerosol_couple
    … …  
    8180    LOGICAL              :: new_aod
    8281    REAL                 :: bl95_b0, bl95_b1
    83     real                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut,tau_ratqs
    84     integer              :: iflag_cld_th
    85     integer              :: iflag_ratqs
    86 
    87     character (len = 6),SAVE  :: type_ocean_omp, version_ocean_omp, ocean_omp
    88     character (len = 10),SAVE  :: type_veget_omp
    89     CHARACTER(len = 8),SAVE   :: aer_type_omp
    90     logical,SAVE              :: ok_snow_omp
    91     logical,SAVE              :: ok_newmicro_omp
    92     logical,SAVE              :: ok_all_xml_omp
    93     logical,SAVE        :: ok_journe_omp, ok_mensuel_omp, ok_instan_omp, ok_hf_omp       
    94     logical,SAVE        :: ok_LES_omp   
    95     LOGICAL,SAVE        :: callstats_omp
    96     LOGICAL,SAVE        :: ok_ade_omp, ok_aie_omp, ok_cdnc_omp, aerosol_couple_omp
     82    REAL                 :: fact_cldcon, facttemps,ratqsbas,ratqshaut,tau_ratqs
     83    INTEGER              :: iflag_cld_th
     84    INTEGER              :: iflag_ratqs
     85
     86    CHARACTER (len = 6), SAVE  :: type_ocean_omp, version_ocean_omp, ocean_omp
     87    CHARACTER (len = 10),SAVE  :: type_veget_omp
     88    CHARACTER (len = 8), SAVE  :: aer_type_omp
     89    LOGICAL, SAVE       :: ok_snow_omp
     90    LOGICAL, SAVE       :: ok_newmicro_omp
     91    LOGICAL, SAVE       :: ok_all_xml_omp
     92    LOGICAL, SAVE       :: ok_journe_omp, ok_mensuel_omp, ok_instan_omp, ok_hf_omp       
     93    LOGICAL, SAVE       :: ok_LES_omp   
     94    LOGICAL, SAVE       :: callstats_omp
     95    LOGICAL, SAVE       :: ok_ade_omp, ok_aie_omp, ok_cdnc_omp, aerosol_couple_omp
    9796    INTEGER, SAVE       :: flag_aerosol_omp
    9897    INTEGER, SAVE       :: flag_aerosol_strat_omp
    … …  
    102101    REAL,SAVE           :: freq_ISCCP_omp, ecrit_ISCCP_omp
    103102    REAL,SAVE           :: freq_COSP_omp, freq_AIRS_omp
    104     real,SAVE           :: fact_cldcon_omp, facttemps_omp,ratqsbas_omp
    105     real,SAVE           :: tau_cld_cv_omp, coefw_cld_cv_omp
    106     integer,SAVE        :: iflag_cld_cv_omp
    107 
    108 
    109     real,SAVE           :: ratqshaut_omp
    110     real,SAVE           :: tau_ratqs_omp
     103    REAL,SAVE           :: fact_cldcon_omp, facttemps_omp,ratqsbas_omp
     104    REAL,SAVE           :: tau_cld_cv_omp, coefw_cld_cv_omp
     105    INTEGER, SAVE       :: iflag_cld_cv_omp
     106
     107
     108    REAL, SAVE          :: ratqshaut_omp
     109    REAL, SAVE          :: tau_ratqs_omp
    111110    REAL, SAVE          :: t_coupl_omp
    112     integer,SAVE        :: iflag_radia_omp
    113     integer,SAVE        :: iflag_rrtm_omp
    114     integer,SAVE        :: iflag_albedo_omp !albedo SB
    115     logical,save        :: ok_chlorophyll_omp ! albedo SB 
    116     integer,SAVE        :: NSW_omp
    117     integer,SAVE        :: iflag_cld_th_omp, ip_ebil_phy_omp
    118     integer,SAVE        :: iflag_ratqs_omp
    119 
    120     Real,SAVE           :: f_cdrag_ter_omp,f_cdrag_oce_omp
    121     Real,SAVE           :: f_rugoro_omp   , z0min_omp
    122     Real,SAVE           :: z0m_seaice_omp,z0h_seaice_omp
    123     REAL,SAVE           :: min_wind_speed_omp,f_gust_wk_omp,f_gust_bl_omp,f_qsat_oce_omp, f_z0qh_oce_omp
    124     INTEGER,SAVE        :: iflag_gusts_omp,iflag_z0_oce_omp
     111    INTEGER, SAVE       :: iflag_radia_omp
     112    INTEGER, SAVE       :: iflag_rrtm_omp
     113    INTEGER, SAVE       :: iflag_albedo_omp !albedo SB
     114    LOGICAL, SAVE       :: ok_chlorophyll_omp ! albedo SB 
     115    INTEGER, SAVE       :: NSW_omp
     116    INTEGER, SAVE       :: iflag_cld_th_omp, ip_ebil_phy_omp
     117    INTEGER, SAVE       :: iflag_ratqs_omp
     118
     119    REAL, SAVE          :: f_cdrag_ter_omp,f_cdrag_oce_omp
     120    REAL, SAVE          :: f_rugoro_omp   , z0min_omp
     121    REAL, SAVE          :: z0m_seaice_omp,z0h_seaice_omp
     122    REAL, SAVE          :: min_wind_speed_omp,f_gust_wk_omp,f_gust_bl_omp,f_qsat_oce_omp, f_z0qh_oce_omp
     123    INTEGER, SAVE       :: iflag_gusts_omp,iflag_z0_oce_omp
    125124
    126125    ! Local
    127     real                 :: zzz
    128 
    129     real :: seuil_inversion
    130     real,save :: seuil_inversion_omp
    131 
    132     integer,SAVE :: iflag_thermals_ed_omp,iflag_thermals_optflux_omp,iflag_thermals_closure_omp
    133     real, SAVE :: fact_thermals_ed_dz_omp
    134     integer,SAVE :: iflag_thermals_omp,nsplit_thermals_omp
    135     real,save :: tau_thermals_omp,alp_bl_k_omp
     126    REAL                 :: zzz
     127
     128    REAL :: seuil_inversion
     129    REAL,SAVE :: seuil_inversion_omp
     130
     131    INTEGER,SAVE :: iflag_thermals_ed_omp,iflag_thermals_optflux_omp,iflag_thermals_closure_omp
     132    REAL, SAVE :: fact_thermals_ed_dz_omp
     133    INTEGER,SAVE :: iflag_thermals_omp,nsplit_thermals_omp
     134    REAL,SAVE :: tau_thermals_omp,alp_bl_k_omp
    136135    ! nrlmd le 10/04/2012
    137     integer,SAVE :: iflag_trig_bl_omp,iflag_clos_bl_omp
    138     integer,SAVE :: tau_trig_shallow_omp,tau_trig_deep_omp
    139     real,SAVE    :: s_trig_omp
     136    INTEGER,SAVE :: iflag_trig_bl_omp,iflag_clos_bl_omp
     137    INTEGER,SAVE :: tau_trig_shallow_omp,tau_trig_deep_omp
     138    REAL,SAVE    :: s_trig_omp
    140139    ! fin nrlmd le 10/04/2012
    141     real :: alp_offset
     140    REAL :: alp_offset
    142141    REAL, SAVE :: alp_offset_omp
    143     integer,SAVE :: iflag_coupl_omp,iflag_clos_omp,iflag_wake_omp
    144     integer,SAVE :: iflag_cvl_sigd_omp
     142    INTEGER,SAVE :: iflag_coupl_omp,iflag_clos_omp,iflag_wake_omp
     143    INTEGER,SAVE :: iflag_cvl_sigd_omp
    145144    REAL, SAVE :: coef_clos_ls_omp
    146145    REAL, SAVE :: supcrit1_omp, supcrit2_omp
    147146    INTEGER, SAVE :: iflag_mix_omp
    148147    INTEGER, SAVE :: iflag_mix_adiab_omp
    149     real, save :: scut_omp, qqa1_omp, qqa2_omp, gammas_omp, Fmax_omp, alphas_omp
     148    REAL, SAVE :: scut_omp, qqa1_omp, qqa2_omp, gammas_omp, Fmax_omp, alphas_omp
    150149    REAL, SAVE :: tmax_fonte_cv_omp
    151150
    … …  
    187186    INTEGER,SAVE :: iflag_pbl_split_omp
    188187    INTEGER,SAVE :: iflag_order2_sollw_omp
    189     Integer, save :: lev_histins_omp, lev_histLES_omp
     188    INTEGER, SAVE :: lev_histins_omp, lev_histLES_omp
    190189    INTEGER, SAVE :: lev_histdayNMC_omp
    191190    INTEGER, SAVE :: levout_histNMC_omp(3)
    … …  
    205204    LOGICAL,SAVE :: ok_lic_melt_omp
    206205    !
    207     LOGICAL,SAVE :: cycle_diurne_omp,soil_model_omp,new_oliq_omp
    208     LOGICAL,SAVE :: ok_orodr_omp, ok_orolf_omp, ok_limitvrai_omp
     206    LOGICAL,SAVE  :: cycle_diurne_omp,soil_model_omp,new_oliq_omp
     207    LOGICAL,SAVE  :: ok_orodr_omp, ok_orolf_omp, ok_limitvrai_omp
    209208    INTEGER, SAVE :: nbapp_rad_omp, iflag_con_omp
     209    INTEGER, SAVE :: nbapp_cv_omp
    210210    INTEGER, SAVE :: iflag_ener_conserv_omp
    211211    LOGICAL, SAVE :: ok_conserv_q_omp
    212212    INTEGER, SAVE :: iflag_fisrtilp_qsat_omp
    213213    INTEGER, SAVE :: iflag_bergeron_omp
    214     LOGICAL,SAVE :: ok_strato_omp
    215     LOGICAL,SAVE :: ok_hines_omp, ok_gwd_rando_omp
    216     real, SAVE:: gwd_rando_ruwmax_omp, gwd_rando_sat_omp
    217     real, SAVE:: gwd_front_ruwmax_omp, gwd_front_sat_omp
    218     real, save:: sso_gkdrag_omp,sso_grahil_omp,sso_grcrit_omp
    219     real, save:: sso_gfrcri_omp,sso_gkwake_omp,sso_gklift_omp
    220     LOGICAL,SAVE :: ok_qch4_omp
    221     LOGICAL,SAVE      :: carbon_cycle_tr_omp
    222     LOGICAL,SAVE      :: carbon_cycle_cpl_omp
    223 
    224     integer, intent(out):: read_climoz ! read ozone climatology, OpenMP shared
     214    LOGICAL,SAVE  :: ok_strato_omp
     215    LOGICAL,SAVE  :: ok_hines_omp, ok_gwd_rando_omp
     216    REAL, SAVE    :: gwd_rando_ruwmax_omp, gwd_rando_sat_omp
     217    REAL, SAVE    :: gwd_front_ruwmax_omp, gwd_front_sat_omp
     218    REAL, SAVE    :: sso_gkdrag_omp,sso_grahil_omp,sso_grcrit_omp
     219    REAL, SAVE    :: sso_gfrcri_omp,sso_gkwake_omp,sso_gklift_omp
     220    LOGICAL,SAVE  :: ok_qch4_omp
     221    LOGICAL,SAVE  :: carbon_cycle_tr_omp
     222    LOGICAL,SAVE  :: carbon_cycle_cpl_omp
     223
     224    INTEGER, INTENT(OUT):: read_climoz ! read ozone climatology, OpenMP shared
    225225    ! Allowed values are 0, 1 and 2
    226226    ! 0: do not read an ozone climatology
    … …  
    239239    !
    240240    type_ocean_omp = 'force '
    241     call getin('type_ocean', type_ocean_omp)
     241    CALL getin('type_ocean', type_ocean_omp)
    242242    !
    243243    !Config Key  = version_ocean
    … …  
    247247    !
    248248    version_ocean_omp = 'xxxxxx'
    249     call getin('version_ocean', version_ocean_omp)
     249    CALL getin('version_ocean', version_ocean_omp)
    250250
    251251    !Config Key  = OCEAN
    … …  
    255255    !
    256256    ocean_omp = 'yyyyyy'
    257     call getin('OCEAN', ocean_omp)
     257    CALL getin('OCEAN', ocean_omp)
    258258    IF (ocean_omp /= 'yyyyyy') THEN
    259259       WRITE(lunout,*)'ERROR! Old variable name OCEAN used in parmeter file.'
    … …  
    261261       WRITE(lunout,*)'You have to update your parameter file physiq.def to succed running'
    262262       CALL abort_physic('conf_phys','Variable OCEAN no longer existing, use variable name type_ocean',1)
    263     END IF
     263    ENDIF
    264264
    265265    !Config Key  = t_coupl
    … …  
    269269    !
    270270    t_coupl_omp = 86400.
    271     call getin('t_coupl', t_coupl_omp)
     271    CALL getin('t_coupl', t_coupl_omp)
    272272    IF (t_coupl_omp == 0) THEN
    273273       WRITE(lunout,*)'ERROR! Timestep of coupling between atmosphere and ocean'
    274274       WRITE(lunout,*)'cannot be zero.'
    275275       CALL abort_physic('conf_phys','t_coupl = 0.',1)
    276     END IF
     276    ENDIF
    277277
    278278    !
    279279    !Config Key  = ok_all_xml
    280280    !Config Desc = utiliser les xml pourles définitions des champs pour xios
    281     !Config Def  = .false.
    282     !Config Help =
    283     !
    284     ok_all_xml_omp = .false.
    285     call getin('ok_all_xml', ok_all_xml_omp)
     281    !Config Def  = .FALSE.
     282    !Config Help =
     283    !
     284    ok_all_xml_omp = .FALSE.
     285    CALL getin('ok_all_xml', ok_all_xml_omp)
    286286    !
    287287
    … …  
    289289    !Config Key  = VEGET
    290290    !Config Desc = Type de modele de vegetation
    291     !Config Def  = .false.
     291    !Config Def  = .FALSE.
    292292    !Config Help = Type de modele de vegetation utilise
    293293    !
    294294    type_veget_omp ='orchidee'
    295     call getin('VEGET', type_veget_omp)
     295    CALL getin('VEGET', type_veget_omp)
    296296    !
    297297
    … …  
    299299    !Config Key  = ok_snow
    300300    !Config Desc = Flag to activate snow model SISVAT
    301     !Config Def  = .false.
    302     ok_snow_omp = .false.
    303     call getin('ok_snow', ok_snow_omp)
     301    !Config Def  = .FALSE.
     302    ok_snow_omp = .FALSE.
     303    CALL getin('ok_snow', ok_snow_omp)
    304304    ! Martin
    305305
    306306    !Config Key  = OK_journe
    307307    !Config Desc = Pour des sorties journalieres
    308     !Config Def  = .false.
     308    !Config Def  = .FALSE.
    309309    !Config Help = Pour creer le fichier histday contenant les sorties
    310310    !              journalieres
    311311    !
    312     ok_journe_omp = .false.
    313     call getin('OK_journe', ok_journe_omp)
     312    ok_journe_omp = .FALSE.
     313    CALL getin('OK_journe', ok_journe_omp)
    314314    !
    315315    !Config Key  = ok_hf
    316316    !Config Desc = Pour des sorties haute frequence
    317     !Config Def  = .false.
     317    !Config Def  = .FALSE.
    318318    !Config Help = Pour creer le fichier histhf contenant les sorties
    319319    !              haute frequence ( 3h ou 6h)
    320320    !
    321     ok_hf_omp = .false.
    322     call getin('ok_hf', ok_hf_omp)
     321    ok_hf_omp = .FALSE.
     322    CALL getin('ok_hf', ok_hf_omp)
    323323    !
    324324    !Config Key  = OK_mensuel
    325325    !Config Desc = Pour des sorties mensuelles
    326     !Config Def  = .true.
     326    !Config Def  = .TRUE.
    327327    !Config Help = Pour creer le fichier histmth contenant les sorties
    328328    !              mensuelles
    329329    !
    330     ok_mensuel_omp = .true.
    331     call getin('OK_mensuel', ok_mensuel_omp)
     330    ok_mensuel_omp = .TRUE.
     331    CALL getin('OK_mensuel', ok_mensuel_omp)
    332332    !
    333333    !Config Key  = OK_instan
    334334    !Config Desc = Pour des sorties instantanees
    335     !Config Def  = .false.
     335    !Config Def  = .FALSE.
    336336    !Config Help = Pour creer le fichier histins contenant les sorties
    337337    !              instantanees
    338338    !
    339     ok_instan_omp = .false.
    340     call getin('OK_instan', ok_instan_omp)
     339    ok_instan_omp = .FALSE.
     340    CALL getin('OK_instan', ok_instan_omp)
    341341    !
    342342    !Config Key  = ok_ade
    343343    !Config Desc = Aerosol direct effect or not?
    344     !Config Def  = .false.
     344    !Config Def  = .FALSE.
    345345    !Config Help = Used in radlwsw.F
    346346    !
    347     ok_ade_omp = .false.
    348     call getin('ok_ade', ok_ade_omp)
     347    ok_ade_omp = .FALSE.
     348    CALL getin('ok_ade', ok_ade_omp)
    349349
    350350    !
    351351    !Config Key  = ok_aie
    352352    !Config Desc = Aerosol indirect effect or not?
    353     !Config Def  = .false.
     353    !Config Def  = .FALSE.
    354354    !Config Help = Used in nuage.F and radlwsw.F
    355355    !
    356     ok_aie_omp = .false.
    357     call getin('ok_aie', ok_aie_omp)
     356    ok_aie_omp = .FALSE.
     357    CALL getin('ok_aie', ok_aie_omp)
    358358
    359359    !
    360360    !Config Key  = ok_cdnc
    361361    !Config Desc = ok cloud droplet number concentration
    362     !Config Def  = .false.
     362    !Config Def  = .FALSE.
    363363    !Config Help = Used in newmicro.F
    364364    !
    365     ok_cdnc_omp = .false.
    366     call getin('ok_cdnc', ok_cdnc_omp)
     365    ok_cdnc_omp = .FALSE.
     366    CALL getin('ok_cdnc', ok_cdnc_omp)
    367367    !
    368368    !Config Key  = aerosol_couple
    369369    !Config Desc = read aerosol in file or calcul by inca
    370     !Config Def  = .false.
     370    !Config Def  = .FALSE.
    371371    !Config Help = Used in physiq.F
    372372    !
    373     aerosol_couple_omp = .false.
     373    aerosol_couple_omp = .FALSE.
    374374    CALL getin('aerosol_couple',aerosol_couple_omp)
    375375    !
    … …  
    410410    !Config Help = Used in physiq.F / aeropt
    411411    !
    412     flag_bc_internal_mixture_omp = .false.
     412    flag_bc_internal_mixture_omp = .FALSE.
    413413    CALL getin('flag_bc_internal_mixture',flag_bc_internal_mixture_omp)
    414414
    … …  
    416416    !Config Key  = new_aod
    417417    !Config Desc = which calcul of aeropt
    418     !Config Def  = false
     418    !Config Def  = FALSE
    419419    !Config Help = Used in physiq.F
    420420    !
    421     new_aod_omp = .true.
     421    new_aod_omp = .TRUE.
    422422    CALL getin('new_aod',new_aod_omp)
    423423
    … …  
    429429    !
    430430    aer_type_omp = 'scenario'
    431     call getin('aer_type', aer_type_omp)
     431    CALL getin('aer_type', aer_type_omp)
    432432
    433433    !
    434434    !Config Key  = bl95_b0
    435435    !Config Desc = Parameter in CDNC-maer link (Boucher&Lohmann 1995)
    436     !Config Def  = .false.
     436    !Config Def  = .FALSE.
    437437    !Config Help = Used in nuage.F
    438438    !
    439439    bl95_b0_omp = 2.
    440     call getin('bl95_b0', bl95_b0_omp)
     440    CALL getin('bl95_b0', bl95_b0_omp)
    441441
    442442    !Config Key  = bl95_b1
    443443    !Config Desc = Parameter in CDNC-maer link (Boucher&Lohmann 1995)
    444     !Config Def  = .false.
     444    !Config Def  = .FALSE.
    445445    !Config Help = Used in nuage.F
    446446    !
    447447    bl95_b1_omp = 0.2
    448     call getin('bl95_b1', bl95_b1_omp)
     448    CALL getin('bl95_b1', bl95_b1_omp)
    449449
    450450    !Config Key  = freq_ISCCP
    … …  
    455455    !
    456456    freq_ISCCP_omp = 10800.
    457     call getin('freq_ISCCP', freq_ISCCP_omp)
     457    CALL getin('freq_ISCCP', freq_ISCCP_omp)
    458458    !
    459459    !Config Key  = ecrit_ISCCP
    … …  
    465465    !
    466466    ecrit_ISCCP_omp = 1.
    467     call getin('ecrit_ISCCP', ecrit_ISCCP_omp)
     467    CALL getin('ecrit_ISCCP', ecrit_ISCCP_omp)
    468468
    469469    !Config Key  = freq_COSP
    … …  
    474474    !
    475475    freq_COSP_omp = 10800.
    476     call getin('freq_COSP', freq_COSP_omp)
     476    CALL getin('freq_COSP', freq_COSP_omp)
    477477
    478478    !Config Key  = freq_AIRS
    … …  
    483483    !
    484484    freq_AIRS_omp = 10800.
    485     call getin('freq_AIRS', freq_AIRS_omp)
     485    CALL getin('freq_AIRS', freq_AIRS_omp)
    486486
    487487    !
    … …  
    492492    !               
    493493    ip_ebil_phy_omp = 0
    494     call getin('ip_ebil_phy', ip_ebil_phy_omp)
     494    CALL getin('ip_ebil_phy', ip_ebil_phy_omp)
     495    IF (ip_ebil_phy_omp/=0) THEN
     496       CALL abort_physic('conf_phys','ip_ebil_phy_omp doit etre 0 sur cette version',1)
     497    ENDIF
     498
    495499    !
    496500    !Config Key  = seuil_inversion
    … …  
    500504    !               
    501505    seuil_inversion_omp = -0.1
    502     call getin('seuil_inversion', seuil_inversion_omp)
     506    CALL getin('seuil_inversion', seuil_inversion_omp)
    503507
    504508    !
    … …  
    512516    !valeur AMIP II
    513517    R_ecc_omp = 0.016715
    514     call getin('R_ecc', R_ecc_omp)
     518    CALL getin('R_ecc', R_ecc_omp)
    515519    !
    516520    !Config Key  = R_peri
    … …  
    522526    !valeur AMIP II
    523527    R_peri_omp = 102.7
    524     call getin('R_peri', R_peri_omp)
     528    CALL getin('R_peri', R_peri_omp)
    525529    !
    526530    !Config Key  = R_incl
    … …  
    532536    !valeur AMIP II
    533537    R_incl_omp = 23.441
    534     call getin('R_incl', R_incl_omp)
     538    CALL getin('R_incl', R_incl_omp)
    535539    !
    536540    !Config Key  = solaire
    … …  
    542546    !valeur AMIP II
    543547    solaire_omp = 1365.
    544     call getin('solaire', solaire_omp)
     548    CALL getin('solaire', solaire_omp)
    545549    !
    546550    !Config Key  = ok_sun_time
    547551    !Config Desc = oui ou non variabilite solaire
    548     !Config Def  = .false.
     552    !Config Def  = .FALSE.
    549553    !Config Help =
    550554    !
    551555    !
    552556    !valeur AMIP II
    553     ok_suntime_rrtm_omp = .false.
    554     call getin('ok_suntime_rrtm',ok_suntime_rrtm_omp)
     557    ok_suntime_rrtm_omp = .FALSE.
     558    CALL getin('ok_suntime_rrtm',ok_suntime_rrtm_omp)
    555559    !
    556560    !Config Key  = co2_ppm
    … …  
    562566    !valeur AMIP II
    563567    co2_ppm_omp = 348.
    564     call getin('co2_ppm', co2_ppm_omp)
     568    CALL getin('co2_ppm', co2_ppm_omp)
    565569    !
    566570    !Config Key  = RCO2
    … …  
    574578    RCO2_omp = co2_ppm_omp * 1.0e-06  * 44.011/28.97 ! pour co2_ppm=348.
    575579
    576     !  call getin('RCO2', RCO2)
     580    !  CALL getin('RCO2', RCO2)
    577581    !
    578582    !Config Key  = RCH4
    … …  
    588592    !ancienne valeur
    589593    ! RCH4 = 1.72E-06* 16.043/28.97
    590     !OK call getin('RCH4', RCH4)
     594    !OK CALL getin('RCH4', RCH4)
    591595    zzz = 1650.
    592     call getin('CH4_ppb', zzz)
     596    CALL getin('CH4_ppb', zzz)
    593597    CH4_ppb_omp = zzz
    594598    RCH4_omp = CH4_ppb_omp * 1.0E-09 * 16.043/28.97
    … …  
    606610    !ancienne valeur
    607611    ! RN2O = 310.E-09* 44.013/28.97
    608     !OK  call getin('RN2O', RN2O)
     612    !OK  CALL getin('RN2O', RN2O)
    609613    zzz=306.
    610     call getin('N2O_ppb', zzz)
     614    CALL getin('N2O_ppb', zzz)
    611615    N2O_ppb_omp = zzz
    612616    RN2O_omp = N2O_ppb_omp * 1.0E-09 * 44.013/28.97
    … …  
    620624    !OK RCFC11 = 280.E-12* 137.3686/28.97
    621625    zzz = 280.
    622     call getin('CFC11_ppt',zzz)
     626    CALL getin('CFC11_ppt',zzz)
    623627    CFC11_ppt_omp = zzz
    624628    RCFC11_omp=CFC11_ppt_omp* 1.0E-12 * 137.3686/28.97
    625629    ! RCFC11 = 1.327690990680013E-09
    626     !OK call getin('RCFC11', RCFC11)
     630    !OK CALL getin('RCFC11', RCFC11)
    627631    !
    628632    !Config Key  = RCFC12
    … …  
    634638    !OK RCFC12 = 484.E-12* 120.9140/28.97
    635639    zzz = 484.
    636     call getin('CFC12_ppt',zzz)
     640    CALL getin('CFC12_ppt',zzz)
    637641    CFC12_ppt_omp = zzz
    638642    RCFC12_omp = CFC12_ppt_omp * 1.0E-12 * 120.9140/28.97
    639643    ! RCFC12 = 2.020102726958923E-09
    640     !OK call getin('RCFC12', RCFC12)
     644    !OK CALL getin('RCFC12', RCFC12)
    641645
    642646    !ajout CFMIP begin
    … …  
    648652    !               
    649653    co2_ppm_per_omp = co2_ppm_omp
    650     call getin('co2_ppm_per', co2_ppm_per_omp)
     654    CALL getin('co2_ppm_per', co2_ppm_per_omp)
    651655    !
    652656    !Config Key  = RCO2_per
    … …  
    660664    !Config Key  = ok_4xCO2atm
    661665    !Config Desc = Calcul ou non effet radiatif 4xco2
    662     !Config Def  = .false.
    663     !Config Help =
    664 
    665     ok_4xCO2atm_omp = .false.
    666     call getin('ok_4xCO2atm',ok_4xCO2atm_omp)
     666    !Config Def  = .FALSE.
     667    !Config Help =
     668
     669    ok_4xCO2atm_omp = .FALSE.
     670    CALL getin('ok_4xCO2atm',ok_4xCO2atm_omp)
    667671
    668672    !Config Key  = RCH4_per
    … …  
    672676    !               
    673677    zzz = CH4_ppb_omp
    674     call getin('CH4_ppb_per', zzz)
     678    CALL getin('CH4_ppb_per', zzz)
    675679    CH4_ppb_per_omp = zzz
    676680    RCH4_per_omp = CH4_ppb_per_omp * 1.0E-09 * 16.043/28.97
    … …  
    682686    !               
    683687    zzz = N2O_ppb_omp
    684     call getin('N2O_ppb_per', zzz)
     688    CALL getin('N2O_ppb_per', zzz)
    685689    N2O_ppb_per_omp = zzz
    686690    RN2O_per_omp = N2O_ppb_per_omp * 1.0E-09 * 44.013/28.97
    … …  
    692696    !               
    693697    zzz = CFC11_ppt_omp
    694     call getin('CFC11_ppt_per',zzz)
     698    CALL getin('CFC11_ppt_per',zzz)
    695699    CFC11_ppt_per_omp = zzz
    696700    RCFC11_per_omp=CFC11_ppt_per_omp* 1.0E-12 * 137.3686/28.97
    … …  
    702706    !               
    703707    zzz = CFC12_ppt_omp
    704     call getin('CFC12_ppt_per',zzz)
     708    CALL getin('CFC12_ppt_per',zzz)
    705709    CFC12_ppt_per_omp = zzz
    706710    RCFC12_per_omp = CFC12_ppt_per_omp * 1.0E-12 * 120.9140/28.97
    … …  
    778782    CALL getin('iflag_con',iflag_con_omp)
    779783
     784    !Config  Key  = nbapp_cv
     785    !Config  Desc = Frequence d'appel a la convection
     786    !Config  Def  = 0
     787    !Config  Help = Nombre  d'appels des routines de convection
     788    !Config         par jour. Si =0, appel a chaque pas de temps physique.
     789    nbapp_cv_omp = 0
     790    CALL getin('nbapp_cv',nbapp_cv_omp)
     791
    780792    !Config  Key  = iflag_ener_conserv
    781793    !Config  Desc = Flag de convection
    … …  
    851863    !
    852864    epmax_omp = .993
    853     call getin('epmax', epmax_omp)
     865    CALL getin('epmax', epmax_omp)
    854866
    855867    coef_epmax_cape_omp = 0.0   
    856     call getin('coef_epmax_cape', coef_epmax_cape_omp)       
     868    CALL getin('coef_epmax_cape', coef_epmax_cape_omp)       
    857869    !
    858870    !Config Key  = ok_adj_ema
    859871    !Config Desc = 
    860     !Config Def  = false
    861     !Config Help =
    862     !
    863     ok_adj_ema_omp = .false.
    864     call getin('ok_adj_ema',ok_adj_ema_omp)
     872    !Config Def  = FALSE
     873    !Config Help =
     874    !
     875    ok_adj_ema_omp = .FALSE.
     876    CALL getin('ok_adj_ema',ok_adj_ema_omp)
    865877    !
    866878    !Config Key  = iflag_clw
    … …  
    870882    !
    871883    iflag_clw_omp = 0
    872     call getin('iflag_clw',iflag_clw_omp)
     884    CALL getin('iflag_clw',iflag_clw_omp)
    873885    !
    874886    !Config Key  = cld_lc_lsc
    … …  
    878890    !
    879891    cld_lc_lsc_omp = 2.6e-4
    880     call getin('cld_lc_lsc',cld_lc_lsc_omp)
     892    CALL getin('cld_lc_lsc',cld_lc_lsc_omp)
    881893    !
    882894    !Config Key  = cld_lc_con
    … …  
    886898    !
    887899    cld_lc_con_omp = 2.6e-4
    888     call getin('cld_lc_con',cld_lc_con_omp)
     900    CALL getin('cld_lc_con',cld_lc_con_omp)
    889901    !
    890902    !Config Key  = cld_tau_lsc
    … …  
    894906    !
    895907    cld_tau_lsc_omp = 3600.
    896     call getin('cld_tau_lsc',cld_tau_lsc_omp)
     908    CALL getin('cld_tau_lsc',cld_tau_lsc_omp)
    897909    !
    898910    !Config Key  = cld_tau_con
    … …  
    902914    !
    903915    cld_tau_con_omp = 3600.
    904     call getin('cld_tau_con',cld_tau_con_omp)
     916    CALL getin('cld_tau_con',cld_tau_con_omp)
    905917    !
    906918    !Config Key  = ffallv_lsc
    … …  
    910922    !
    911923    ffallv_lsc_omp = 1.
    912     call getin('ffallv_lsc',ffallv_lsc_omp)
     924    CALL getin('ffallv_lsc',ffallv_lsc_omp)
    913925    !
    914926    !Config Key  = ffallv_con
    … …  
    918930    !
    919931    ffallv_con_omp = 1.
    920     call getin('ffallv_con',ffallv_con_omp)
     932    CALL getin('ffallv_con',ffallv_con_omp)
    921933    !
    922934    !Config Key  = coef_eva
    … …  
    926938    !
    927939    coef_eva_omp = 2.e-5
    928     call getin('coef_eva',coef_eva_omp)
     940    CALL getin('coef_eva',coef_eva_omp)
    929941    !
    930942    !Config Key  = reevap_ice
    931943    !Config Desc = 
    932     !Config Def  = .false.
    933     !Config Help =
    934     !
    935     reevap_ice_omp = .false.
    936     call getin('reevap_ice',reevap_ice_omp)
     944    !Config Def  = .FALSE.
     945    !Config Help =
     946    !
     947    reevap_ice_omp = .FALSE.
     948    CALL getin('reevap_ice',reevap_ice_omp)
    937949
    938950    !Config Key  = iflag_ratqs
    … …  
    942954    !
    943955    iflag_ratqs_omp = 1
    944     call getin('iflag_ratqs',iflag_ratqs_omp)
     956    CALL getin('iflag_ratqs',iflag_ratqs_omp)
    945957
    946958    !
    … …  
    951963    !
    952964    iflag_radia_omp = 1
    953     call getin('iflag_radia',iflag_radia_omp)
     965    CALL getin('iflag_radia',iflag_radia_omp)
    954966
    955967    !
    … …  
    960972    !
    961973    iflag_rrtm_omp = 0
    962     call getin('iflag_rrtm',iflag_rrtm_omp)
     974    CALL getin('iflag_rrtm',iflag_rrtm_omp)
    963975
    964976    !
    … …  
    969981    !
    970982    NSW_omp = 2
    971     call getin('NSW',NSW_omp)
     983    CALL getin('NSW',NSW_omp)
    972984    !albedo SB >>>
    973985    iflag_albedo_omp = 0
    974     call getin('iflag_albedo',iflag_albedo_omp)
    975 
    976     ok_chlorophyll_omp=.false.
    977     call getin('ok_chlorophyll',ok_chlorophyll_omp)
     986    CALL getin('iflag_albedo',iflag_albedo_omp)
     987
     988    ok_chlorophyll_omp=.FALSE.
     989    CALL getin('ok_chlorophyll',ok_chlorophyll_omp)
    978990    !albedo SB <<<
    979991
    … …  
    9881000    ! pour assurer une retrocompatiblite.
    9891001    ! A abandonner un jour
    990     call getin('iflag_cldcon',iflag_cld_th_omp)
    991     call getin('iflag_cld_th',iflag_cld_th_omp)
     1002    CALL getin('iflag_cldcon',iflag_cld_th_omp)
     1003    CALL getin('iflag_cld_th',iflag_cld_th_omp)
    9921004    iflag_cld_cv_omp = 0
    993     call getin('iflag_cld_cv',iflag_cld_cv_omp)
     1005    CALL getin('iflag_cld_cv',iflag_cld_cv_omp)
    9941006
    9951007    !
    … …  
    10001012    !
    10011013    tau_cld_cv_omp = 10.
    1002     call getin('tau_cld_cv',tau_cld_cv_omp)
     1014    CALL getin('tau_cld_cv',tau_cld_cv_omp)
    10031015
    10041016    !
    … …  
    10091021    !
    10101022    coefw_cld_cv_omp = 0.1
    1011     call getin('coefw_cld_cv',coefw_cld_cv_omp)
     1023    CALL getin('coefw_cld_cv',coefw_cld_cv_omp)
    10121024
    10131025
    … …  
    10211033    !
    10221034    iflag_pdf_omp = 0
    1023     call getin('iflag_pdf',iflag_pdf_omp)
     1035    CALL getin('iflag_pdf',iflag_pdf_omp)
    10241036    !
    10251037    !Config Key  = fact_cldcon
    … …  
    10291041    !
    10301042    fact_cldcon_omp = 0.375
    1031     call getin('fact_cldcon',fact_cldcon_omp)
     1043    CALL getin('fact_cldcon',fact_cldcon_omp)
    10321044
    10331045    !
    … …  
    10381050    !
    10391051    facttemps_omp = 1.e-4
    1040     call getin('facttemps',facttemps_omp)
     1052    CALL getin('facttemps',facttemps_omp)
    10411053
    10421054    !
    10431055    !Config Key  = ok_newmicro
    10441056    !Config Desc = 
    1045     !Config Def  = .true.
    1046     !Config Help =
    1047     !
    1048     ok_newmicro_omp = .true.
    1049     call getin('ok_newmicro',ok_newmicro_omp)
     1057    !Config Def  = .TRUE.
     1058    !Config Help =
     1059    !
     1060    ok_newmicro_omp = .TRUE.
     1061    CALL getin('ok_newmicro',ok_newmicro_omp)
    10501062    !
    10511063    !Config Key  = ratqsbas
    … …  
    10551067    !
    10561068    ratqsbas_omp = 0.01
    1057     call getin('ratqsbas',ratqsbas_omp)
     1069    CALL getin('ratqsbas',ratqsbas_omp)
    10581070    !
    10591071    !Config Key  = ratqshaut
    … …  
    10631075    !
    10641076    ratqshaut_omp = 0.3
    1065     call getin('ratqshaut',ratqshaut_omp)
     1077    CALL getin('ratqshaut',ratqshaut_omp)
    10661078
    10671079    !Config Key  = tau_ratqs
    … …  
    10711083    !
    10721084    tau_ratqs_omp = 1800.
    1073     call getin('tau_ratqs',tau_ratqs_omp)
     1085    CALL getin('tau_ratqs',tau_ratqs_omp)
    10741086
    10751087    !
    … …  
    10831095    !
    10841096    solarlong0_omp = -999.999
    1085     call getin('solarlong0',solarlong0_omp)
     1097    CALL getin('solarlong0',solarlong0_omp)
    10861098    !
    10871099    !-----------------------------------------------------------------------
    … …  
    10901102    ! Default value -1 to activate the full computation
    10911103    qsol0_omp = -1.
    1092     call getin('qsol0',qsol0_omp)
     1104    CALL getin('qsol0',qsol0_omp)
    10931105    evap0_omp = -1.
    1094     call getin('evap0',evap0_omp)
     1106    CALL getin('evap0',evap0_omp)
    10951107    albsno0_omp = -1.
    1096     call getin('albsno0',albsno0_omp)
     1108    CALL getin('albsno0',albsno0_omp)
    10971109    !
    10981110    !-----------------------------------------------------------------------
    … …  
    11041116    !
    11051117    inertie_ice_omp = 2000.
    1106     call getin('inertie_ice',inertie_ice_omp)
     1118    CALL getin('inertie_ice',inertie_ice_omp)
    11071119    !
    11081120    !Config Key  = inertie_sno
    … …  
    11121124    !
    11131125    inertie_sno_omp = 2000.
    1114     call getin('inertie_sno',inertie_sno_omp)
     1126    CALL getin('inertie_sno',inertie_sno_omp)
    11151127    !
    11161128    !Config Key  = inertie_sol
    … …  
    11201132    !
    11211133    inertie_sol_omp = 2000.
    1122     call getin('inertie_sol',inertie_sol_omp)
     1134    CALL getin('inertie_sol',inertie_sol_omp)
    11231135
    11241136    !
    … …  
    11291141    !
    11301142    rad_froid_omp = 35.0
    1131     call getin('rad_froid',rad_froid_omp)
     1143    CALL getin('rad_froid',rad_froid_omp)
    11321144
    11331145    !
    … …  
    11381150    !
    11391151    rad_chau1_omp = 13.0
    1140     call getin('rad_chau1',rad_chau1_omp)
     1152    CALL getin('rad_chau1',rad_chau1_omp)
    11411153
    11421154    !
    … …  
    11471159    !
    11481160    rad_chau2_omp = 9.0
    1149     call getin('rad_chau2',rad_chau2_omp)
     1161    CALL getin('rad_chau2',rad_chau2_omp)
    11501162
    11511163    !
    … …  
    11561168    !
    11571169    t_glace_min_omp = 258.
    1158     call getin('t_glace_min',t_glace_min_omp)
     1170    CALL getin('t_glace_min',t_glace_min_omp)
    11591171
    11601172    !
    … …  
    11651177    !
    11661178    t_glace_max_omp = 273.13
    1167     call getin('t_glace_max',t_glace_max_omp)
     1179    CALL getin('t_glace_max',t_glace_max_omp)
    11681180
    11691181    !
    … …  
    11741186    !
    11751187    exposant_glace_omp = 1.
    1176     call getin('exposant_glace',exposant_glace_omp)
     1188    CALL getin('exposant_glace',exposant_glace_omp)
    11771189
    11781190    !
    … …  
    11831195    !
    11841196    iflag_t_glace_omp = 0
    1185     call getin('iflag_t_glace',iflag_t_glace_omp)
     1197    CALL getin('iflag_t_glace',iflag_t_glace_omp)
    11861198
    11871199    !
    … …  
    11921204    !
    11931205    iflag_cloudth_vert_omp = 0
    1194     call getin('iflag_cloudth_vert',iflag_cloudth_vert_omp)
     1206    CALL getin('iflag_cloudth_vert',iflag_cloudth_vert_omp)
    11951207
    11961208    !
    … …  
    12011213    !
    12021214    iflag_ice_thermo_omp = 0
    1203     call getin('iflag_ice_thermo',iflag_ice_thermo_omp)
     1215    CALL getin('iflag_ice_thermo',iflag_ice_thermo_omp)
    12041216
    12051217    !Config Key  = rei_min
    … …  
    12091221    !
    12101222    rei_min_omp = 3.5
    1211     call getin('rei_min',rei_min_omp)
     1223    CALL getin('rei_min',rei_min_omp)
    12121224
    12131225    !
    … …  
    12181230    !
    12191231    rei_max_omp = 61.29
    1220     call getin('rei_max',rei_max_omp)
     1232    CALL getin('rei_max',rei_max_omp)
    12211233
    12221234    !
    … …  
    12271239    !
    12281240    top_height_omp = 3
    1229     call getin('top_height',top_height_omp)
     1241    CALL getin('top_height',top_height_omp)
    12301242
    12311243    !
    … …  
    12361248    !
    12371249    overlap_omp = 3
    1238     call getin('overlap',overlap_omp)
    1239 
    1240 
    1241     !
     1250    CALL getin('overlap',overlap_omp)
     1251
    12421252    !
    12431253    !Config Key  = cdmmax
    … …  
    12471257    !
    12481258    cdmmax_omp = 1.3E-3
    1249     call getin('cdmmax',cdmmax_omp)
     1259    CALL getin('cdmmax',cdmmax_omp)
    12501260
    12511261    !
    … …  
    12561266    !
    12571267    cdhmax_omp = 1.1E-3
    1258     call getin('cdhmax',cdhmax_omp)
     1268    CALL getin('cdhmax',cdhmax_omp)
    12591269
    12601270    !261103
    … …  
    12661276    !
    12671277    ksta_omp = 1.0e-10
    1268     call getin('ksta',ksta_omp)
     1278    CALL getin('ksta',ksta_omp)
    12691279
    12701280    !
    … …  
    12751285    !
    12761286    ksta_ter_omp = 1.0e-10
    1277     call getin('ksta_ter',ksta_ter_omp)
     1287    CALL getin('ksta_ter',ksta_ter_omp)
    12781288
    12791289    !Config Key  = f_ri_cd_min
    … …  
    12831293    !
    12841294    f_ri_cd_min_omp = 0.1
    1285     call getin('f_ri_cd_min',f_ri_cd_min_omp)
     1295    CALL getin('f_ri_cd_min',f_ri_cd_min_omp)
    12861296
    12871297    !
    12881298    !Config Key  = ok_kzmin
    12891299    !Config Desc =
    1290     !Config Def  = .true.
    1291     !Config Help =
    1292     !
    1293     ok_kzmin_omp = .true.
    1294     call getin('ok_kzmin',ok_kzmin_omp)
     1300    !Config Def  = .TRUE.
     1301    !Config Help =
     1302    !
     1303    ok_kzmin_omp = .TRUE.
     1304    CALL getin('ok_kzmin',ok_kzmin_omp)
    12951305
    12961306    pbl_lmixmin_alpha_omp=0.0
    1297     call getin('pbl_lmixmin_alpha',pbl_lmixmin_alpha_omp)
    1298 
     1307    CALL getin('pbl_lmixmin_alpha',pbl_lmixmin_alpha_omp)
    12991308
    13001309    !
    … …  
    13051314    !
    13061315    fmagic_omp = 1.
    1307     call getin('fmagic',fmagic_omp)
     1316    CALL getin('fmagic',fmagic_omp)
    13081317
    13091318    !
    … …  
    13141323    !
    13151324    pmagic_omp = 0.
    1316     call getin('pmagic',pmagic_omp)
     1325    CALL getin('pmagic',pmagic_omp)
    13171326
    13181327
    13191328    !Config Key = ok_lic_melt
    13201329    !Config Desc = Prise en compte de la fonte de la calotte dans le bilan d'eau
    1321     !Config Def  = .false.
    1322     !Config Help = mettre a .false. pour assurer la conservation en eau
    1323     ok_lic_melt_omp = .false.
    1324     call getin('ok_lic_melt', ok_lic_melt_omp)
     1330    !Config Def  = .FALSE.
     1331    !Config Help = mettre a .FALSE. pour assurer la conservation en eau
     1332    ok_lic_melt_omp = .FALSE.
     1333    CALL getin('ok_lic_melt', ok_lic_melt_omp)
    13251334
    13261335    !
    … …  
    13341343    !
    13351344    iflag_pbl_omp = 1
    1336     call getin('iflag_pbl',iflag_pbl_omp)
     1345    CALL getin('iflag_pbl',iflag_pbl_omp)
    13371346    !
    13381347    !Config Key  = iflag_pbl_split
    … …  
    13421351    !
    13431352    iflag_pbl_split_omp = 0
    1344     call getin('iflag_pbl_split',iflag_pbl_split_omp)
     1353    CALL getin('iflag_pbl_split',iflag_pbl_split_omp)
    13451354    !
    13461355    !Config Key  = iflag_order2_sollw
    … …  
    13501359    !
    13511360    iflag_order2_sollw_omp = 0
    1352     call getin('iflag_order2_sollw',iflag_order2_sollw_omp)
     1361    CALL getin('iflag_order2_sollw',iflag_order2_sollw_omp)
    13531362    !
    13541363    !Config Key  = iflag_thermals
    … …  
    13581367    !
    13591368    iflag_thermals_omp = 0
    1360     call getin('iflag_thermals',iflag_thermals_omp)
     1369    CALL getin('iflag_thermals',iflag_thermals_omp)
    13611370    !
    13621371    !Config Key  = iflag_thermals_ed
    … …  
    13671376    fact_thermals_ed_dz_omp = 0.1
    13681377
    1369     call getin('fact_thermals_ed_dz',fact_thermals_ed_dz_omp)
     1378    CALL getin('fact_thermals_ed_dz',fact_thermals_ed_dz_omp)
    13701379    !
    13711380    !
    … …  
    13761385    !
    13771386    iflag_thermals_ed_omp = 0
    1378     call getin('iflag_thermals_ed',iflag_thermals_ed_omp)
     1387    CALL getin('iflag_thermals_ed',iflag_thermals_ed_omp)
    13791388    !
    13801389    !
    … …  
    13851394    !
    13861395    iflag_thermals_optflux_omp = 0
    1387     call getin('iflag_thermals_optflux',iflag_thermals_optflux_omp)
     1396    CALL getin('iflag_thermals_optflux',iflag_thermals_optflux_omp)
    13881397    !
    13891398    !Config Key  = iflag_thermals_closure
    … …  
    13931402    !
    13941403    iflag_thermals_closure_omp = 1
    1395     call getin('iflag_thermals_closure',iflag_thermals_closure_omp)
    1396     !
    1397     !
    1398     !
     1404    CALL getin('iflag_thermals_closure',iflag_thermals_closure_omp)
    13991405    !
    14001406    !Config Key  = nsplit_thermals
    … …  
    14041410    !
    14051411    nsplit_thermals_omp = 1
    1406     call getin('nsplit_thermals',nsplit_thermals_omp)
     1412    CALL getin('nsplit_thermals',nsplit_thermals_omp)
    14071413
    14081414    !Config Key  = alp_bl_k
    … …  
    14121418    !
    14131419    alp_bl_k_omp = 1.
    1414     call getin('alp_bl_k',alp_bl_k_omp)
     1420    CALL getin('alp_bl_k',alp_bl_k_omp)
    14151421
    14161422    ! nrlmd le 10/04/2012
    … …  
    14221428    !
    14231429    iflag_trig_bl_omp = 0
    1424     call getin('iflag_trig_bl',iflag_trig_bl_omp)
     1430    CALL getin('iflag_trig_bl',iflag_trig_bl_omp)
    14251431
    14261432    !Config Key  = s_trig_bl
    … …  
    14301436    !
    14311437    s_trig_omp = 2e7
    1432     call getin('s_trig',s_trig_omp)
     1438    CALL getin('s_trig',s_trig_omp)
    14331439
    14341440    !Config Key  = tau_trig_shallow
    … …  
    14381444    !
    14391445    tau_trig_shallow_omp = 600
    1440     call getin('tau_trig_shallow',tau_trig_shallow_omp)
     1446    CALL getin('tau_trig_shallow',tau_trig_shallow_omp)
    14411447
    14421448    !Config Key  = tau_trig_deep
    … …  
    14461452    !
    14471453    tau_trig_deep_omp = 1800
    1448     call getin('tau_trig_deep',tau_trig_deep_omp)
     1454    CALL getin('tau_trig_deep',tau_trig_deep_omp)
    14491455
    14501456    !Config Key  = iflag_clos_bl
    … …  
    14541460    !
    14551461    iflag_clos_bl_omp = 0
    1456     call getin('iflag_clos_bl',iflag_clos_bl_omp)
     1462    CALL getin('iflag_clos_bl',iflag_clos_bl_omp)
    14571463
    14581464    ! fin nrlmd le 10/04/2012
    … …  
    14651471    !
    14661472    tau_thermals_omp = 0.
    1467     call getin('tau_thermals',tau_thermals_omp)
     1473    CALL getin('tau_thermals',tau_thermals_omp)
    14681474
    14691475    !
    … …  
    14741480    !
    14751481    iflag_coupl_omp = 0
    1476     call getin('iflag_coupl',iflag_coupl_omp)
     1482    CALL getin('iflag_coupl',iflag_coupl_omp)
    14771483
    14781484    !
    … …  
    14831489    !
    14841490    iflag_clos_omp = 1
    1485     call getin('iflag_clos',iflag_clos_omp)
     1491    CALL getin('iflag_clos',iflag_clos_omp)
    14861492    !
    14871493    !Config Key  = coef_clos_ls
    … …  
    14911497    !
    14921498    coef_clos_ls_omp = 0.
    1493     call getin('coef_clos_ls',coef_clos_ls_omp)
     1499    CALL getin('coef_clos_ls',coef_clos_ls_omp)
    14941500
    14951501    !
    … …  
    15001506    !
    15011507    iflag_cvl_sigd_omp = 0
    1502     call getin('iflag_cvl_sigd',iflag_cvl_sigd_omp)
     1508    CALL getin('iflag_cvl_sigd',iflag_cvl_sigd_omp)
    15031509
    15041510    !Config Key  = iflag_wake
    … …  
    15081514    !
    15091515    iflag_wake_omp = 0
    1510     call getin('iflag_wake',iflag_wake_omp)
     1516    CALL getin('iflag_wake',iflag_wake_omp)
    15111517
    15121518    !Config Key  = alp_offset
    … …  
    15161522    !
    15171523    alp_offset_omp = 0.
    1518     call getin('alp_offset',alp_offset_omp)
     1524    CALL getin('alp_offset',alp_offset_omp)
    15191525
    15201526    !
    … …  
    15251531    !
    15261532    lev_histhf_omp = 1
    1527     call getin('lev_histhf',lev_histhf_omp)
     1533    CALL getin('lev_histhf',lev_histhf_omp)
    15281534
    15291535    !
    … …  
    15341540    !
    15351541    lev_histday_omp = 1
    1536     call getin('lev_histday',lev_histday_omp)
     1542    CALL getin('lev_histday',lev_histday_omp)
    15371543
    15381544    !
    … …  
    15431549    !
    15441550    lev_histmth_omp = 2
    1545     call getin('lev_histmth',lev_histmth_omp)
     1551    CALL getin('lev_histmth',lev_histmth_omp)
    15461552    !
    15471553    !Config Key  = lev_histins
    … …  
    15511557    !
    15521558    lev_histins_omp = 1
    1553     call getin('lev_histins',lev_histins_omp)
     1559    CALL getin('lev_histins',lev_histins_omp)
    15541560    !
    15551561    !Config Key  = lev_histLES
    … …  
    15591565    !
    15601566    lev_histLES_omp = 1
    1561     call getin('lev_histLES',lev_histLES_omp)
     1567    CALL getin('lev_histLES',lev_histLES_omp)
    15621568    !
    15631569    !Config Key  = lev_histdayNMC
    … …  
    15671573    !
    15681574    lev_histdayNMC_omp = 8
    1569     call getin('lev_histdayNMC',lev_histdayNMC_omp)
     1575    CALL getin('lev_histdayNMC',lev_histdayNMC_omp)
    15701576    !
    15711577    !Config Key  = levout_histNMC
    … …  
    15771583    levout_histNMC_omp(2) = 5
    15781584    levout_histNMC_omp(3) = 5
    1579     call getin('levout_histNMC',levout_histNMC_omp)
     1585    CALL getin('levout_histNMC',levout_histNMC_omp)
    15801586    !
    15811587    !histNMC BEG
    … …  
    15871593    !Config Help =
    15881594    !
    1589     ok_histNMC_omp(1) = .false.
    1590     ok_histNMC_omp(2) = .false.
    1591     ok_histNMC_omp(3) = .false.
    1592     call getin('ok_histNMC',ok_histNMC_omp)
     1595    ok_histNMC_omp(1) = .FALSE.
     1596    ok_histNMC_omp(2) = .FALSE.
     1597    ok_histNMC_omp(3) = .FALSE.
     1598    CALL getin('ok_histNMC',ok_histNMC_omp)
    15931599    !
    15941600    !Config Key  = freq_outNMC
    … …  
    16021608    freq_outNMC_omp(2) = 1.
    16031609    freq_outNMC_omp(3) = 1./4.
    1604     call getin('freq_outNMC',freq_outNMC_omp)
     1610    CALL getin('freq_outNMC',freq_outNMC_omp)
    16051611    !
    16061612    !Config Key  = freq_calNMC
    … …  
    16141620    freq_calNMC_omp(2) = pasphys
    16151621    freq_calNMC_omp(3) = pasphys
    1616     call getin('freq_calNMC',freq_calNMC_omp)
     1622    CALL getin('freq_calNMC',freq_calNMC_omp)
    16171623    !
    16181624    !Config Key  = type_run
    … …  
    16221628    !
    16231629    type_run_omp = 'AMIP'
    1624     call getin('type_run',type_run_omp)
     1630    CALL getin('type_run',type_run_omp)
    16251631
    16261632    !
    16271633    !Config Key  = ok_cosp
    16281634    !Config Desc =
    1629     !Config Def  = .false.
    1630     !Config Help =
    1631     !
    1632     ok_cosp_omp = .false.
    1633     call getin('ok_cosp',ok_cosp_omp)
     1635    !Config Def  = .FALSE.
     1636    !Config Help =
     1637    !
     1638    ok_cosp_omp = .FALSE.
     1639    CALL getin('ok_cosp',ok_cosp_omp)
    16341640
    16351641    !
    16361642    !Config Key  = ok_airs
    16371643    !Config Desc =
    1638     !Config Def  = .false.
    1639     !Config Help =
    1640     !
    1641     ok_airs_omp = .false.
    1642     call getin('ok_airs',ok_airs_omp)
     1644    !Config Def  = .FALSE.
     1645    !Config Help =
     1646    !
     1647    ok_airs_omp = .FALSE.
     1648    CALL getin('ok_airs',ok_airs_omp)
    16431649
    16441650    !
    16451651    !Config Key  = ok_mensuelCOSP
    16461652    !Config Desc =
    1647     !Config Def  = .true.
    1648     !Config Help =
    1649     !
    1650     ok_mensuelCOSP_omp = .true.
    1651     call getin('ok_mensuelCOSP',ok_mensuelCOSP_omp)
     1653    !Config Def  = .TRUE.
     1654    !Config Help =
     1655    !
     1656    ok_mensuelCOSP_omp = .TRUE.
     1657    CALL getin('ok_mensuelCOSP',ok_mensuelCOSP_omp)
    16521658
    16531659    !
    16541660    !Config Key  = ok_journeCOSP
    16551661    !Config Desc =
    1656     !Config Def  = .true.
    1657     !Config Help =
    1658     !
    1659     ok_journeCOSP_omp = .true.
    1660     call getin('ok_journeCOSP',ok_journeCOSP_omp)
     1662    !Config Def  = .TRUE.
     1663    !Config Help =
     1664    !
     1665    ok_journeCOSP_omp = .TRUE.
     1666    CALL getin('ok_journeCOSP',ok_journeCOSP_omp)
    16611667
    16621668    !
    16631669    !Config Key  = ok_hfCOSP
    16641670    !Config Desc =
    1665     !Config Def  = .false.
    1666     !Config Help =
    1667     !
    1668     ok_hfCOSP_omp = .false.
    1669     call getin('ok_hfCOSP',ok_hfCOSP_omp)
     1671    !Config Def  = .FALSE.
     1672    !Config Help =
     1673    !
     1674    ok_hfCOSP_omp = .FALSE.
     1675    CALL getin('ok_hfCOSP',ok_hfCOSP_omp)
    16701676
    16711677    !
    … …  
    16791685    !
    16801686    lonmin_ins_omp = 100.
    1681     call getin('lonmin_ins',lonmin_ins_omp)
     1687    CALL getin('lonmin_ins',lonmin_ins_omp)
    16821688    !
    16831689    !Config Key  = lonmax_ins
    … …  
    16871693    !
    16881694    lonmax_ins_omp = 130.
    1689     call getin('lonmax_ins',lonmax_ins_omp)
     1695    CALL getin('lonmax_ins',lonmax_ins_omp)
    16901696    !
    16911697    !Config Key  = latmin_ins
    … …  
    16951701    !
    16961702    latmin_ins_omp = -20.
    1697     call getin('latmin_ins',latmin_ins_omp)
     1703    CALL getin('latmin_ins',latmin_ins_omp)
    16981704    !
    16991705    !Config Key  = latmax_ins
    … …  
    17031709    !
    17041710    latmax_ins_omp = 20.
    1705     call getin('latmax_ins',latmax_ins_omp)
     1711    CALL getin('latmax_ins',latmax_ins_omp)
    17061712    !
    17071713    !Config Key  = ecrit_hf
    … …  
    17111717    !
    17121718    ecrit_hf_omp = 1./8.
    1713     call getin('ecrit_hf',ecrit_hf_omp)
     1719    CALL getin('ecrit_hf',ecrit_hf_omp)
    17141720    !
    17151721    !Config Key  = ecrit_ins
    … …  
    17191725    !
    17201726    ecrit_ins_omp = 1./48.
    1721     call getin('ecrit_ins',ecrit_ins_omp)
     1727    CALL getin('ecrit_ins',ecrit_ins_omp)
    17221728    !
    17231729    !Config Key  = ecrit_day
    … …  
    17271733    !
    17281734    ecrit_day_omp = 1.0
    1729     call getin('ecrit_day',ecrit_day_omp)
     1735    CALL getin('ecrit_day',ecrit_day_omp)
    17301736    !
    17311737    !Config Key  = ecrit_mth
    … …  
    17351741    !
    17361742    ecrit_mth_omp = 30.
    1737     call getin('ecrit_mth',ecrit_mth_omp)
     1743    CALL getin('ecrit_mth',ecrit_mth_omp)
    17381744    !
    17391745    !Config Key  = ecrit_tra
    … …  
    17431749    !
    17441750    ecrit_tra_omp = 0.
    1745     call getin('ecrit_tra',ecrit_tra_omp)
     1751    CALL getin('ecrit_tra',ecrit_tra_omp)
    17461752    !
    17471753    !Config Key  = ecrit_reg
    … …  
    17511757    !
    17521758    ecrit_reg_omp = 0.25   !4 fois par jour
    1753     call getin('ecrit_reg',ecrit_reg_omp)
     1759    CALL getin('ecrit_reg',ecrit_reg_omp)
    17541760    !
    17551761    !
    … …  
    17591765    !
    17601766    f_cdrag_ter_omp = 0.8
    1761     call getin('f_cdrag_ter',f_cdrag_ter_omp)
     1767    CALL getin('f_cdrag_ter',f_cdrag_ter_omp)
    17621768    !
    17631769    f_cdrag_oce_omp = 0.8
    1764     call getin('f_cdrag_oce',f_cdrag_oce_omp)
     1770    CALL getin('f_cdrag_oce',f_cdrag_oce_omp)
    17651771    !
    17661772
    17671773    ! Gustiness flags
    17681774    f_z0qh_oce_omp = 1.
    1769     call getin('f_z0qh_oce',f_z0qh_oce_omp)
     1775    CALL getin('f_z0qh_oce',f_z0qh_oce_omp)
    17701776    !
    17711777    f_qsat_oce_omp = 1.
    1772     call getin('f_qsat_oce',f_qsat_oce_omp)
     1778    CALL getin('f_qsat_oce',f_qsat_oce_omp)
    17731779    !
    17741780    f_gust_bl_omp = 0.
    1775     call getin('f_gust_bl',f_gust_bl_omp)
     1781    CALL getin('f_gust_bl',f_gust_bl_omp)
    17761782    !
    17771783    f_gust_wk_omp = 0.
    1778     call getin('f_gust_wk',f_gust_wk_omp)
     1784    CALL getin('f_gust_wk',f_gust_wk_omp)
    17791785    !
    17801786    !Config Key  = iflag_z0_oce
    … …  
    17841790    !
    17851791    iflag_z0_oce_omp=0
    1786     call getin('iflag_z0_oce',iflag_z0_oce_omp)
     1792    CALL getin('iflag_z0_oce',iflag_z0_oce_omp)
    17871793    !
    17881794    iflag_gusts_omp=0
    1789     call getin('iflag_gusts',iflag_gusts_omp)
     1795    CALL getin('iflag_gusts',iflag_gusts_omp)
    17901796    !
    17911797    min_wind_speed_omp = 1.
    1792     call getin('min_wind_speed',min_wind_speed_omp)
    1793 
    1794     z0m_seaice_omp = 0.002 ; call getin('z0m_seaice',z0m_seaice_omp)
    1795     z0h_seaice_omp = 0.002 ; call getin('z0h_seaice',z0h_seaice_omp)
     1798    CALL getin('min_wind_speed',min_wind_speed_omp)
     1799
     1800    z0m_seaice_omp = 0.002 ; CALL getin('z0m_seaice',z0m_seaice_omp)
     1801    z0h_seaice_omp = 0.002 ; CALL getin('z0h_seaice',z0h_seaice_omp)
    17961802
    17971803    f_rugoro_omp = 0.
    1798     call getin('f_rugoro',f_rugoro_omp)
     1804    CALL getin('f_rugoro',f_rugoro_omp)
    17991805
    18001806    z0min_omp = 0.000015
    1801     call getin('z0min',z0min_omp)
     1807    CALL getin('z0min',z0min_omp)
    18021808
    18031809
    … …  
    18101816    !
    18111817    supcrit1_omp = .540
    1812     call getin('supcrit1',supcrit1_omp)
     1818    CALL getin('supcrit1',supcrit1_omp)
    18131819
    18141820    !
    … …  
    18191825    !
    18201826    supcrit2_omp = .600
    1821     call getin('supcrit2',supcrit2_omp)
     1827    CALL getin('supcrit2',supcrit2_omp)
    18221828
    18231829    !
    … …  
    18341840    !
    18351841    iflag_mix_omp = 1
    1836     call getin('iflag_mix',iflag_mix_omp)
     1842    CALL getin('iflag_mix',iflag_mix_omp)
    18371843
    18381844!
    … …  
    18481854    !
    18491855    iflag_mix_adiab_omp = 0
    1850     call getin('iflag_mix_adiab',iflag_mix_adiab_omp)
     1856    CALL getin('iflag_mix_adiab',iflag_mix_adiab_omp)
    18511857
    18521858    !
    … …  
    18571863    !
    18581864    scut_omp = 0.95
    1859     call getin('scut',scut_omp)
     1865    CALL getin('scut',scut_omp)
    18601866
    18611867    !
    … …  
    18661872    !
    18671873    qqa1_omp = 1.0
    1868     call getin('qqa1',qqa1_omp)
     1874    CALL getin('qqa1',qqa1_omp)
    18691875
    18701876    !
    … …  
    18751881    !
    18761882    qqa2_omp = 0.0
    1877     call getin('qqa2',qqa2_omp)
     1883    CALL getin('qqa2',qqa2_omp)
    18781884
    18791885    !
    … …  
    18841890    !
    18851891    gammas_omp = 0.05
    1886     call getin('gammas',gammas_omp)
     1892    CALL getin('gammas',gammas_omp)
    18871893
    18881894    !
    … …  
    18931899    !
    18941900    Fmax_omp = 0.65
    1895     call getin('Fmax',Fmax_omp)
     1901    CALL getin('Fmax',Fmax_omp)
    18961902
    18971903    !
    … …  
    19021908    !
    19031909    tmax_fonte_cv_omp = 275.15
    1904     call getin('tmax_fonte_cv',tmax_fonte_cv_omp)
     1910    CALL getin('tmax_fonte_cv',tmax_fonte_cv_omp)
    19051911
    19061912    !
    … …  
    19111917    !
    19121918    alphas_omp = -5.
    1913     call getin('alphas',alphas_omp)
     1919    CALL getin('alphas',alphas_omp)
    19141920
    19151921    !Config key = ok_strato
    … …  
    19861992    !Config Key  = OK_LES                                               
    19871993    !Config Desc = Pour des sorties LES                                 
    1988     !Config Def  = .false.                                             
     1994    !Config Def  = .FALSE.                                             
    19891995    !Config Help = Pour creer le fichier histLES contenant les sorties 
    19901996    !              LES                                                 
    19911997    !                                                                   
    1992     ok_LES_omp = .false.                                             
    1993     call getin('OK_LES', ok_LES_omp)                                 
     1998    ok_LES_omp = .FALSE.                                             
     1999    CALL getin('OK_LES', ok_LES_omp)                                 
    19942000
    19952001    !Config Key  = callstats                                               
    19962002    !Config Desc = Pour des sorties callstats                                 
    1997     !Config Def  = .false.                                             
     2003    !Config Def  = .FALSE.                                             
    19982004    !Config Help = Pour creer le fichier stats contenant les sorties 
    19992005    !              stats                                                 
    20002006    !                                                                   
    2001     callstats_omp = .false.                                             
    2002     call getin('callstats', callstats_omp)                                 
     2007    callstats_omp = .FALSE.                                             
     2008    CALL getin('callstats', callstats_omp)                                 
    20032009    !
    20042010    !Config Key  = ecrit_LES
    … …  
    20102016    !
    20112017    ecrit_LES_omp = 1./8.
    2012     call getin('ecrit_LES', ecrit_LES_omp)
     2018    CALL getin('ecrit_LES', ecrit_LES_omp)
    20132019    !
    20142020    read_climoz = 0 ! default value
    2015     call getin('read_climoz', read_climoz)
     2021    CALL getin('read_climoz', read_climoz)
    20162022
    20172023    carbon_cycle_tr_omp=.FALSE.
    … …  
    20592065    nbapp_rad = nbapp_rad_omp
    20602066    iflag_con = iflag_con_omp
     2067    nbapp_cv = nbapp_cv_omp
    20612068    iflag_ener_conserv = iflag_ener_conserv_omp
    20622069    ok_conserv_q = ok_conserv_q_omp
    … …  
    21242131    t_coupl = t_coupl_omp
    21252132
    2126     ok_veget=.true.
     2133    ok_veget=.TRUE.
    21272134    type_veget=type_veget_omp
    2128     if (type_veget=='n' .or. type_veget=='bucket' .or. type_veget=='betaclim') &
    2129          then
    2130        ok_veget=.false.
    2131     endif
     2135    IF (type_veget=='n' .or. type_veget=='bucket' .or. type_veget=='betaclim') THEN
     2136       ok_veget=.FALSE.
     2137    ENDIF
    21322138    ! Martin
    21332139    ok_snow = ok_snow_omp
    … …  
    22262232    iflag_z0_oce=iflag_z0_oce_omp
    22272233
    2228 
    22292234    z0m_seaice=z0m_seaice_omp
    22302235    z0h_seaice=z0h_seaice_omp
    … …  
    22702275       WRITE(lunout,*)' ERROR version_ocean=',version_ocean,' not valid in coupled configuration'
    22712276       CALL abort_physic('conf_phys','version_ocean not valid',1)
    2272     END IF
     2277    ENDIF
    22732278
    22742279    IF (type_ocean=='slab' .AND. version_ocean=='xxxxxx') THEN
    … …  
    22782283       WRITE(lunout,*)' ERROR version_ocean=',version_ocean,' not valid with slab ocean'
    22792284       CALL abort_physic('conf_phys','version_ocean not valid',1)
    2280     END IF
     2285    ENDIF
    22812286
    22822287    !--test on radiative scheme
    … …  
    22952300       CALL abort_physic('conf_phys','choice iflag_rrtm not valid',1)
    22962301    ENDIF
     2302#ifdef CPP_StratAer
     2303    IF (iflag_rrtm .NE. 1) THEN
     2304       WRITE(lunout,*) ' ERROR iflag_rrtm<>1 but StratAer activated'
     2305       CALL abort_physic('conf_phys','iflag_rrtm not valid for StratAer',1)
     2306    ENDIF
     2307    IF (NSW .NE. 6) THEN
     2308       WRITE(lunout,*) ' ERROR NSW<>6 but StratAer activated'
     2309       CALL abort_physic('conf_phys','NSW not valid for StratAer',1)
     2310    ENDIF
     2311#endif
    22972312
    22982313    !--test on ocean surface albedo
    … …  
    23072322       IF ( flag_aerosol .EQ. 0 ) THEN
    23082323          CALL abort_physic('conf_phys','flag_aerosol=0 not compatible avec ok_ade ou ok_aie=.TRUE.',1)
    2309        END IF
     2324       ENDIF
    23102325       IF ( .NOT. new_aod .AND.  flag_aerosol .NE. 1) THEN
    23112326          CALL abort_physic('conf_phys','new_aod=.FALSE. not compatible avec flag_aerosol=1',1)
    2312        END IF
    2313     END IF
     2327       ENDIF
     2328    ENDIF
    23142329
    23152330    ! Flag_aerosol cannot be to zero if we are in coupled mode for aerosol
    … …  
    23842399    write(lunout,*)'nbapp_rad=',nbapp_rad
    23852400    write(lunout,*)'iflag_con=',iflag_con
     2401    write(lunout,*)'nbapp_cv=',nbapp_cv
    23862402    write(lunout,*)'iflag_ener_conserv=',iflag_ener_conserv
    23872403    write(lunout,*)'ok_conserv_q=',ok_conserv_q
    … …  
    25332549    !$OMP END MASTER
    25342550
    2535     return
    2536 
    2537   end subroutine conf_phys
    2538 
    2539 end module conf_phys_m
     2551    RETURN
     2552
     2553  END SUBROUTINE conf_phys
     2554
     2555END MODULE conf_phys_m
    25402556!
    25412557!#################################################################
    25422558!
    25432559
    2544 subroutine conf_interface(tau_calv)
    2545 
    2546   use IOIPSL
     2560SUBROUTINE conf_interface(tau_calv)
     2561
     2562  USE IOIPSL
    25472563  USE print_control_mod, ONLY: lunout
    2548   implicit none
     2564  IMPLICIT NONE
    25492565  ! Configuration de l'interace atm/surf
    25502566  !
    … …  
    25622578  tau_calv_omp = 360.*10.
    25632579  !$OMP MASTER
    2564   call getin('tau_calv',tau_calv_omp)
     2580  CALL getin('tau_calv',tau_calv_omp)
    25652581  !$OMP END MASTER
    25662582  !$OMP BARRIER
    … …  
    25742590  !$OMP END MASTER
    25752591
    2576   return
    2577 
    2578 end subroutine conf_interface
     2592  RETURN
     2593
     2594END SUBROUTINE conf_interface

  • LMDZ5/branches/testing/libf/phylmd/cosp/cosp_constants.F90

    r2594 r2720  
    3535#include "cosp_defs.h"
    3636MODULE MOD_COSP_CONSTANTS
    37 
    38     use netcdf, only: nf90_fill_real
    3937    IMPLICIT NONE
    4038
    … …  
    5452    ! Missing value
    5553    real,parameter :: R_UNDEF = -1.0E30
    56 !    real,parameter :: R_UNDEF = nf90_fill_real
    5754
    5855    ! Number of possible output variables
    59     integer,parameter :: N_OUT_LIST = 63
    60     integer,parameter :: N3D = 8
     56    integer,parameter :: N_OUT_LIST = 65
     57    integer,parameter :: N3D = 10
    6158    integer,parameter :: N2D = 14
    6259    integer,parameter :: N1D = 40
    … …  
    108105                   -31.5,-28.5,-25.5,-22.5,-19.5,-16.5,-13.5,-10.5, -7.5, -4.5, &
    109106                    -1.5,  1.5,  4.5,  7.5, 10.5, 13.5, 16.5, 19.5, 22.5, 25.5/)
    110     real,parameter,dimension(2,LIDAR_NTEMP) :: LIDAR_PHASE_TEMP_BNDS=reshape(source=&
    111                     (/-273.15,-90.,-90.,-87.,-87.,-84.,-84.,-81.,-81.,-78., &
     107    real,parameter,dimension(2,LIDAR_NTEMP) :: LIDAR_PHASE_TEMP_BNDS=reshape(source=(/-273.15,-90.,-90.,-87.,-87.,-84.,-84.,-81.,-81.,-78., &
    112108                   -78.,-75.,-75.,-72.,-72.,-69.,-69.,-66.,-66.,-63., &
    113109                   -63.,-60.,-60.,-57.,-57.,-54.,-54.,-51.,-51.,-48., &

  • LMDZ5/branches/testing/libf/phylmd/cosp/cosp_modis_simulator.F90

    r2435 r2720  
    22!   Author: Robert Pincus, Cooperative Institute for Research in the Environmental Sciences
    33! All rights reserved.
    4 ! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
     4! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
    55! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/cosp_modis_simulator.F90 $
    66!
    … …  
    6565     !
    6666     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_Cloud_Top_Pressure
     67     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffICE
     68     real, dimension(:, :, :), pointer :: Optical_Thickness_vs_ReffLIQ
    6769  end type COSP_MODIS
    6870 
    … …  
    115117       
    116118    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numModisPressureBins) :: &
    117        jointHistogram
     119         jointHistogram
     120    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffIceBins) :: &
     121         jointHistogram2
     122    real, dimension(count(gridBox%sunlit(:) > 0), numModisTauBins, numMODISReffLiqBins) :: &
     123         jointHistogram3
    118124   
    119125    integer, dimension(count(gridBox%sunlit(:) >  0)) :: sunlit
    … …  
    214220                                retrievedPhase(i, :), retrievedCloudTopPressure(i, :),      &
    215221                                retrievedTau(i, :), retrievedSize(i, :))
    216       end do
    217       call modis_L3_simulator(retrievedPhase,              &
    218                               retrievedCloudTopPressure,   &
    219                               retrievedTau, retrievedSize, &
    220                               cfTotal,         cfLiquid,         cfIce,         &
    221                               cfHigh,          cfMid,            cfLow,         &
    222                               meanTauTotal,    meanTauLiquid,    meanTauIce,    &
    223                               meanLogTauTotal, meanLogTauLiquid, meanLogTauIce, &
    224                                                meanSizeLiquid,   meanSizeIce,   &
    225                               meanCloudTopPressure,                             &
    226                                                meanLiquidWaterPath, meanIceWaterPath, &
    227                               jointHistogram)
     222     end do
     223     
     224      ! DJS2015: Call L3 modis simulator used by cospv2.0
     225     ! call modis_L3_simulator(retrievedPhase,              &
     226     !                         retrievedCloudTopPressure,   &
     227     !                         retrievedTau, retrievedSize, &
     228     !                         cfTotal,         cfLiquid,         cfIce,         &
     229     !                         cfHigh,          cfMid,            cfLow,         &
     230     !                         meanTauTotal,    meanTauLiquid,    meanTauIce,    &
     231     !                         meanLogTauTotal, meanLogTauLiquid, meanLogTauIce, &
     232     !                         meanSizeLiquid,   meanSizeIce,   &
     233     !                         meanCloudTopPressure,                             &
     234     !                         meanLiquidWaterPath, meanIceWaterPath, &
     235     !                         jointHistogram)
     236     call modis_column(nSunlit,nSubcols,retrievedPhase,retrievedCloudTopPressure,   &
     237                        retrievedTau,retrievedSize,cfTotal,cfLiquid,cfIce,cfHigh,    &
     238                        cfMid,cfLow,meanTauTotal,meanTauLiquid,meanTauIce,           &
     239                        meanLogTauTotal,meanLogTauLiquid,meanLogTauIce,              &
     240                        meanSizeLiquid,meanSizeIce,meanCloudTopPressure,             &
     241                        meanLiquidWaterPath, meanIceWaterPath,                       &
     242                        jointHistogram,jointHistogram2,jointHistogram3)
     243      ! DJS2015: END
     244     
    228245      !
    229246      ! Copy results into COSP structure
    … …  
    254271     
    255272      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(sunlit(:), 2:numModisTauBins+1, :) = jointHistogram(:, :, :)
     273      modisSim%Optical_Thickness_vs_ReffICE(sunlit(:),2:numModisTauBins+1,:)              = jointHistogram2(:, :, :)
     274      modisSim%Optical_Thickness_vs_ReffLIQ(sunlit(:),2:numModisTauBins+1,:)              = jointHistogram3(:, :, :)
    256275      !
    257276      ! Reorder pressure bins in joint histogram to go from surface to TOA
    258277      !
    259       modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:,:,:) = &
    260         modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, numModisPressureBins:1:-1)
     278      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:,:,:) = modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, numModisPressureBins:1:-1)
    261279      if(nSunlit < nPoints) then
    262280        !
    … …  
    288306 
    289307        modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(notSunlit(:), :, :) = R_UNDEF
     308        modisSim%Optical_Thickness_vs_ReffICE(notSunlit(:), :, :) = R_UNDEF
     309        modisSim%Optical_Thickness_vs_ReffLIQ(notSunlit(:), :, :) = R_UNDEF
    290310      end if
    291311    else
    … …  
    318338 
    319339      modisSim%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
     340      modisSim%Optical_Thickness_vs_ReffICE(:, :, :) = R_UNDEF
     341      modisSim%Optical_Thickness_vs_ReffLIQ(:, :, :) = R_UNDEF
    320342    end if
    321343
    … …  
    363385     
    364386    allocate(x%Optical_Thickness_vs_Cloud_Top_Pressure(nPoints, numModisTauBins+1, numModisPressureBins))
     387    allocate(x%Optical_Thickness_vs_ReffICE(nPoints, numModisTauBins+1, numModisReffIceBins))
     388    allocate(x%Optical_Thickness_vs_ReffLIQ(nPoints, numModisTauBins+1, numModisReffLiqBins))
    365389    x%Optical_Thickness_vs_Cloud_Top_Pressure(:, :, :) = R_UNDEF
    366390  END SUBROUTINE CONSTRUCT_COSP_MODIS
    … …  
    400424   
    401425    if(associated(x%Optical_Thickness_vs_Cloud_Top_Pressure)) deallocate(x%Optical_Thickness_vs_Cloud_Top_Pressure   )
     426    if(associated(x%Optical_Thickness_vs_ReffIce)) deallocate(x%Optical_Thickness_vs_ReffIce)
     427    if(associated(x%Optical_Thickness_vs_ReffLiq)) deallocate(x%Optical_Thickness_vs_ReffLiq)
    402428  END SUBROUTINE FREE_COSP_MODIS
    403429  ! -----------------------------------------------------
    … …  
    447473   
    448474    copy%Optical_Thickness_vs_Cloud_Top_Pressure(copy_start:copy_end, :, :) = &
    449                           orig%Optical_Thickness_vs_Cloud_Top_Pressure(orig_start:orig_end, :, :)
     475         orig%Optical_Thickness_vs_Cloud_Top_Pressure(orig_start:orig_end, :, :)
     476    copy%Optical_Thickness_vs_ReffIce(copy_start:copy_end, :, :) = &
     477         orig%Optical_Thickness_vs_ReffIce(orig_start:orig_end, :, :)
     478    copy%Optical_Thickness_vs_ReffLiq(copy_start:copy_end, :, :) = &
     479         orig%Optical_Thickness_vs_ReffLiq(orig_start:orig_end, :, :)
     480
    450481  END SUBROUTINE COSP_MODIS_CPSECTION
    451482  ! -----------------------------------------------------

  • LMDZ5/branches/testing/libf/phylmd/cosp/cosp_output_mod.F90

    r2669 r2720  
    99  USE MOD_COSP_TYPES
    1010  use MOD_COSP_Modis_Simulator, only : cosp_modis
     11  use mod_modis_sim, only : numMODISReffIceBins, reffICE_binCenters, &
     12                            numMODISReffLiqBins, reffLIQ_binCenters
    1113
    1214! cosp_output_mod
    … …  
    1719!$OMP THREADPRIVATE(cosp_outfilekeys, cosp_nidfiles)
    1820      INTEGER, DIMENSION(3), SAVE  :: nhoricosp,nvert,nvertmcosp,nvertcol,nvertbze, &
    19                                       nvertsratio,nvertisccp,nvertp,nverttemp,nvertmisr
     21                                      nvertsratio,nvertisccp,nvertp,nverttemp,nvertmisr, &
     22                                      nvertReffIce,nvertReffLiq
    2023      REAL, DIMENSION(3), SAVE                :: zoutm_cosp
    2124!$OMP THREADPRIVATE(nhoricosp, nvert,nvertmcosp,nvertcol,nvertsratio,nvertbze,nvertisccp,nvertp,zoutm_cosp,nverttemp,nvertmisr)
     25!$OMP THREADPRIVATE(nvertReffIce,nvertReffLiq)
    2226      REAL, SAVE                   :: zdtimemoy_cosp
    2327!$OMP THREADPRIVATE(zdtimemoy_cosp)
    … …  
    176180  TYPE(ctrl_outcosp), SAVE :: o_clmodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
    177181         "clmodis", "MODIS Cloud Area Fraction", "%", (/ ('', i=1, 3) /))
     182  TYPE(ctrl_outcosp), SAVE :: o_crimodis = ctrl_outcosp((/ .TRUE., .TRUE., .TRUE. /), &
     183         "crimodis", "Optical_Thickness_vs_ReffIce from Modis", "%", (/ ('',i=1, 3) /))         
     184  TYPE(ctrl_outcosp), SAVE :: o_crlmodis = ctrl_outcosp((/ .TRUE., .TRUE.,.TRUE. /), &
     185         "crlmodis", "Optical_Thickness_vs_ReffLiq from Modis", "%", (/ ('',i=1, 3) /))         
    178186
    179187! Rttovs simulator
    … …  
    325333!   CALL wxios_add_vaxis("dbze", DBZE_BINS, dbze_ax)
    326334!   CALL wxios_add_vaxis("scatratio", SR_BINS, sratio_ax)
     335   CALL wxios_add_vaxis("ReffIce", numMODISReffIceBins, reffICE_binCenters)
     336   CALL wxios_add_vaxis("ReffLiq", numMODISReffLiqBins, reffLIQ_binCenters)
     337
    327338#endif
    328339   
    … …  
    366377
    367378      CALL histvert(cosp_nidfiles(iff),"cth16","altitude","m",MISR_N_CTH,MISR_CTH,nvertmisr(iff))
     379 
     380      CALL histvert(cosp_nidfiles(iff),"ReffIce","Effective_particle_size_Ice","microns",numMODISReffIceBins, reffICE_binCenters, &
     381                    nvertReffIce(iff))                                         
     382     
     383      CALL histvert(cosp_nidfiles(iff),"ReffLiq","Effective_particle_size_Liq","microns",numMODISReffLiqBins, reffLIQ_binCenters, &                                 
     384                    nvertReffLiq(iff))
    368385
    369386!      CALL histvert(cosp_nidfiles(iff),"dbze","equivalent_reflectivity_factor","dBZ",DBZE_BINS,dbze_ax,nvertbze(iff))

  • LMDZ5/branches/testing/libf/phylmd/cosp/cosp_output_write_mod.F90

    r2594 r2720  
    372372 endif
    373373
     374    where(modis%Optical_Thickness_vs_ReffIce == R_UNDEF) &
     375          modis%Optical_Thickness_vs_ReffIce = Cosp_fill_value
     376
     377    where(modis%Optical_Thickness_vs_ReffLiq == R_UNDEF) &
     378          modis%Optical_Thickness_vs_ReffLiq = Cosp_fill_value
     379
     380    do icl=1,7
     381   CALL histwrite3d_cosp(o_crimodis, &
     382     modis%Optical_Thickness_vs_ReffIce(:,icl,:),nvertReffIce,icl)
     383   CALL histwrite3d_cosp(o_crlmodis, &
     384     modis%Optical_Thickness_vs_ReffLiq(:,icl,:),nvertReffLiq,icl)
     385    enddo
     386
    374387 IF(.NOT.cosp_varsdefined) THEN
    375388!$OMP MASTER
    … …  
    521534      ELSE IF (nvertsave.eq.nvertmisr(iff)) THEN
    522535          klevs=MISR_N_CTH
    523            nam_axvert="cth16"
     536          nam_axvert="cth16"
     537      ELSE IF (nvertsave.eq.nvertReffIce(iff)) THEN
     538          klevs= numMODISReffIceBins
     539          nam_axvert="ReffIce"
     540      ELSE IF (nvertsave.eq.nvertReffLiq(iff)) THEN
     541          klevs= numMODISReffLiqBins
     542          nam_axvert="ReffLiq"
    524543      ELSE
    525544           klevs=Nlevout

  • LMDZ5/branches/testing/libf/phylmd/cosp/cosp_types.F90

    r2435 r2720  
    5151                Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, &
    5252                Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, &
    53                 Liwpmodis,Lclmodis
     53                Liwpmodis,Lclmodis,Lcrimodis,Lcrlmodis
    5454
    5555     character(len=32) :: out_list(N_OUT_LIST)

  • LMDZ5/branches/testing/libf/phylmd/cosp/modis_simulator.F90

    r2435 r2720  
    22!   Author: Robert Pincus, Cooperative Institute for Research in the Environmental Sciences
    33! All rights reserved.
    4 ! $Revision: 88 $, $Date: 2013-11-13 15:08:38 +0100 (mer. 13 nov. 2013) $
     4! $Revision: 88 $, $Date: 2013-11-13 07:08:38 -0700 (Wed, 13 Nov 2013) $
    55! $URL: http://cfmip-obs-sim.googlecode.com/svn/stable/v1.4.0/MODIS_simulator/modis_simulator.F90 $
    66!
    … …  
    7979  real,    parameter :: re_water_min= 4., re_water_max= 30., re_ice_min= 5., re_ice_max= 90.
    8080  integer, parameter :: num_trial_res = 15             ! increase to make the linear pseudo-retrieval of size more accurate
    81   logical, parameter :: use_two_re_iterations = .false. ! do two retrieval iterations?
    82  
     81! DJS2015: Remove unused parameter
     82!  logical, parameter :: use_two_re_iterations = .false. ! do two retrieval iterations?
     83! DJS2015 END 
    8384  !
    8485  ! Precompute near-IR optical params vs size for retrieval scheme
    … …  
    125126    nominalPressureHistogramCenters = (nominalPressureHistogramBoundaries(1, :) + &
    126127                                       nominalPressureHistogramBoundaries(2, :) ) / 2.
     128  ! DJS2015 START: Add bin descriptions for joint-histograms of partice-sizes and optical depth. This is
     129  !                identical to what is done in COSPv.2.0.0 for histogram bin initialization.
     130  integer :: j
     131  integer,parameter :: &
     132       numMODISReffLiqBins = 6, & ! Number of bins for tau/ReffLiq joint-histogram
     133       numMODISReffIceBins = 6    ! Number of bins for tau/ReffICE joint-histogram
     134  real,parameter,dimension(numMODISReffLiqBins+1) :: &
     135       reffLIQ_binBounds = (/0., 8e-6, 1.0e-5, 1.3e-5, 1.5e-5, 2.0e-5, 3.0e-5/)
     136  real,parameter,dimension(numMODISReffIceBins+1) :: &
     137       reffICE_binBounds = (/0., 1.0e-5, 2.0e-5, 3.0e-5, 4.0e-5, 6.0e-5, 9.0e-5/)
     138  real,parameter,dimension(2,numMODISReffIceBins) :: &
     139       reffICE_binEdges = reshape(source=(/reffICE_binBounds(1),((reffICE_binBounds(k),  &
     140                                  l=1,2),k=2,numMODISReffIceBins),reffICE_binBounds(numMODISReffIceBins+1)/),  &
     141                                  shape = (/2,numMODISReffIceBins/))
     142  real,parameter,dimension(2,numMODISReffLiqBins) :: &
     143       reffLIQ_binEdges = reshape(source=(/reffLIQ_binBounds(1),((reffLIQ_binBounds(k),  &
     144                                  l=1,2),k=2,numMODISReffLiqBins),reffLIQ_binBounds(numMODISReffIceBins+1)/),  &
     145                                  shape = (/2,numMODISReffLiqBins/))             
     146  real,parameter,dimension(numMODISReffIceBins) :: &
     147       reffICE_binCenters = (reffICE_binEdges(1,:)+reffICE_binEdges(2,:))/2.
     148  real,parameter,dimension(numMODISReffLiqBins) :: &
     149       reffLIQ_binCenters = (reffLIQ_binEdges(1,:)+reffLIQ_binEdges(2,:))/2.
     150  ! DJS2015 END
     151
    127152  ! ------------------------------
    128153  ! There are two ways to call the MODIS simulator:
    … …  
    384409                               
    385410  end subroutine modis_L2_simulator_oneTau
     411
     412  ! ########################################################################################
     413  subroutine modis_column(nPoints,nSubCols,phase, cloud_top_pressure, optical_thickness, particle_size,      &
     414       Cloud_Fraction_Total_Mean,         Cloud_Fraction_Water_Mean,         Cloud_Fraction_Ice_Mean,        &
     415       Cloud_Fraction_High_Mean,          Cloud_Fraction_Mid_Mean,           Cloud_Fraction_Low_Mean,        &
     416       Optical_Thickness_Total_Mean,      Optical_Thickness_Water_Mean,      Optical_Thickness_Ice_Mean,     &
     417       Optical_Thickness_Total_MeanLog10, Optical_Thickness_Water_MeanLog10, Optical_Thickness_Ice_MeanLog10,&
     418       Cloud_Particle_Size_Water_Mean,    Cloud_Particle_Size_Ice_Mean,      Cloud_Top_Pressure_Total_Mean,  &
     419       Liquid_Water_Path_Mean,            Ice_Water_Path_Mean,                                               &   
     420       Optical_Thickness_vs_Cloud_Top_Pressure,Optical_Thickness_vs_ReffIce,Optical_Thickness_vs_ReffLiq)
     421   
     422    ! INPUTS
     423    integer,intent(in) :: &
     424         nPoints,                           & ! Number of horizontal gridpoints
     425         nSubCols                             ! Number of subcolumns
     426    integer,intent(in), dimension(:,:) ::  &
     427!ds    integer,intent(in), dimension(nPoints, nSubCols) ::  &
     428         phase                             
     429    real,intent(in),dimension(:,:) ::  &
     430!ds    real,intent(in),dimension(nPoints, nSubCols) ::  &
     431         cloud_top_pressure,                &
     432         optical_thickness,                 &
     433         particle_size
     434 
     435    ! OUTPUTS
     436    real,intent(inout),dimension(:)  ::   & !
     437!ds    real,intent(inout),dimension(nPoints)  ::   & !
     438         Cloud_Fraction_Total_Mean,         & !
     439         Cloud_Fraction_Water_Mean,         & !
     440         Cloud_Fraction_Ice_Mean,           & !
     441         Cloud_Fraction_High_Mean,          & !
     442         Cloud_Fraction_Mid_Mean,           & !
     443         Cloud_Fraction_Low_Mean,           & !
     444         Optical_Thickness_Total_Mean,      & !
     445         Optical_Thickness_Water_Mean,      & !
     446         Optical_Thickness_Ice_Mean,        & !
     447         Optical_Thickness_Total_MeanLog10, & !
     448         Optical_Thickness_Water_MeanLog10, & !
     449         Optical_Thickness_Ice_MeanLog10,   & !
     450         Cloud_Particle_Size_Water_Mean,    & !
     451         Cloud_Particle_Size_Ice_Mean,      & !
     452         Cloud_Top_Pressure_Total_Mean,     & !
     453         Liquid_Water_Path_Mean,            & !
     454         Ice_Water_Path_Mean                  !
     455    real,intent(inout),dimension(:,:,:) :: &
     456!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numPressureHistogramBins) :: &
     457         Optical_Thickness_vs_Cloud_Top_Pressure
     458    real,intent(inout),dimension(:,:,:) :: &   
     459!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numMODISReffIceBins) :: &   
     460         Optical_Thickness_vs_ReffIce
     461    real,intent(inout),dimension(:,:,:) :: &   
     462!ds    real,intent(inout),dimension(nPoints,numTauHistogramBins,numMODISReffLiqBins) :: &   
     463         Optical_Thickness_vs_ReffLiq         
     464
     465    ! LOCAL VARIABLES
     466    real, parameter :: &
     467         LWP_conversion = 2./3. * 1000. ! MKS units 
     468    integer :: i, j
     469    logical, dimension(nPoints,nSubCols) :: &
     470         cloudMask,      &
     471         waterCloudMask, &
     472         iceCloudMask,   &
     473         validRetrievalMask
     474    real,dimension(nPoints,nSubCols) :: &
     475         tauWRK,ctpWRK,reffIceWRK,reffLiqWRK
     476   
     477    ! ########################################################################################
     478    ! Include only those pixels with successful retrievals in the statistics
     479    ! ########################################################################################
     480    validRetrievalMask(1:nPoints,1:nSubCols) = particle_size(1:nPoints,1:nSubCols) > 0.
     481    cloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) /= phaseIsNone .and.       &
     482         validRetrievalMask(1:nPoints,1:nSubCols)
     483    waterCloudMask(1:nPoints,1:nSubCols) = phase(1:nPoints,1:nSubCols) == phaseIsLiquid .and. &
     484         validRetrievalMask(1:nPoints,1:nSubCols)
     485    iceCloudMask(1:nPoints,1:nSubCols)   = phase(1:nPoints,1:nSubCols) == phaseIsIce .and.    &
     486         validRetrievalMask(1:nPoints,1:nSubCols)
     487
     488    ! ########################################################################################
     489    ! Use these as pixel counts at first
     490    ! ########################################################################################
     491    Cloud_Fraction_Total_Mean(1:nPoints) = real(count(cloudMask,      dim = 2))
     492    Cloud_Fraction_Water_Mean(1:nPoints) = real(count(waterCloudMask, dim = 2))
     493    Cloud_Fraction_Ice_Mean(1:nPoints)   = real(count(iceCloudMask,   dim = 2))
     494    Cloud_Fraction_High_Mean(1:nPoints)  = real(count(cloudMask .and. cloud_top_pressure <=          &
     495                                           highCloudPressureLimit, dim = 2))
     496    Cloud_Fraction_Low_Mean(1:nPoints)   = real(count(cloudMask .and. cloud_top_pressure >           &
     497                                           lowCloudPressureLimit,  dim = 2))
     498    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Total_Mean(1:nPoints) - Cloud_Fraction_High_Mean(1:nPoints)&
     499                                           - Cloud_Fraction_Low_Mean(1:nPoints)
     500
     501    ! ########################################################################################
     502    ! Compute mean optical thickness.
     503    ! ########################################################################################
     504    Optical_Thickness_Total_Mean(1:nPoints) = sum(optical_thickness, mask = cloudMask,      dim = 2) / &
     505                                              Cloud_Fraction_Total_Mean(1:nPoints)
     506    Optical_Thickness_Water_Mean(1:nPoints) = sum(optical_thickness, mask = waterCloudMask, dim = 2) / &
     507                                              Cloud_Fraction_Water_Mean(1:nPoints)
     508    Optical_Thickness_Ice_Mean(1:nPoints)   = sum(optical_thickness, mask = iceCloudMask,   dim = 2) / &
     509                                              Cloud_Fraction_Ice_Mean(1:nPoints)
     510       
     511    ! ########################################################################################
     512    ! We take the absolute value of optical thickness here to satisfy compilers that complains
     513    ! when we evaluate the logarithm of a negative number, even though it's not included in
     514    ! the sum.
     515    ! ########################################################################################
     516    Optical_Thickness_Total_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = cloudMask, &
     517         dim = 2) / Cloud_Fraction_Total_Mean(1:nPoints)
     518    Optical_Thickness_Water_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = waterCloudMask,&
     519         dim = 2) / Cloud_Fraction_Water_Mean(1:nPoints)
     520    Optical_Thickness_Ice_MeanLog10(1:nPoints) = sum(log10(abs(optical_thickness)), mask = iceCloudMask,&
     521         dim = 2) / Cloud_Fraction_Ice_Mean(1:nPoints)
     522    Cloud_Particle_Size_Water_Mean(1:nPoints) = sum(particle_size, mask = waterCloudMask, dim = 2) / &
     523         Cloud_Fraction_Water_Mean(1:nPoints)
     524    Cloud_Particle_Size_Ice_Mean(1:nPoints) = sum(particle_size, mask = iceCloudMask,   dim = 2) / &
     525         Cloud_Fraction_Ice_Mean(1:nPoints)
     526    Cloud_Top_Pressure_Total_Mean(1:nPoints) = sum(cloud_top_pressure, mask = cloudMask, dim = 2) / &
     527         max(1, count(cloudMask, dim = 2))
     528    Liquid_Water_Path_Mean(1:nPoints) = LWP_conversion*sum(particle_size*optical_thickness, &
     529         mask=waterCloudMask,dim=2)/Cloud_Fraction_Water_Mean(1:nPoints)
     530    Ice_Water_Path_Mean(1:nPoints) = LWP_conversion * ice_density*sum(particle_size*optical_thickness,&
     531         mask=iceCloudMask,dim = 2) /Cloud_Fraction_Ice_Mean(1:nPoints)
     532
     533    ! ########################################################################################
     534    ! Normalize pixel counts to fraction. The first three cloud fractions have been set to -1
     535    ! in cloud-free areas, so set those places to 0.
     536    ! ########################################################################################
     537    Cloud_Fraction_High_Mean(1:nPoints)  = Cloud_Fraction_High_Mean(1:nPoints) /nSubcols
     538    Cloud_Fraction_Mid_Mean(1:nPoints)   = Cloud_Fraction_Mid_Mean(1:nPoints)  /nSubcols
     539    Cloud_Fraction_Low_Mean(1:nPoints)   = Cloud_Fraction_Low_Mean(1:nPoints)  /nSubcols
     540
     541    ! ########################################################################################
     542    ! Set clear-scenes to undefined
     543    ! ########################################################################################
     544    where (Cloud_Fraction_Total_Mean == 0)
     545       Optical_Thickness_Total_Mean      = R_UNDEF
     546       Optical_Thickness_Total_MeanLog10 = R_UNDEF
     547       Cloud_Top_Pressure_Total_Mean     = R_UNDEF
     548    endwhere
     549    where (Cloud_Fraction_Water_Mean == 0)
     550       Optical_Thickness_Water_Mean      = R_UNDEF
     551       Optical_Thickness_Water_MeanLog10 = R_UNDEF
     552       Cloud_Particle_Size_Water_Mean    = R_UNDEF
     553       Liquid_Water_Path_Mean            = R_UNDEF
     554    endwhere
     555    where (Cloud_Fraction_Ice_Mean == 0)
     556       Optical_Thickness_Ice_Mean        = R_UNDEF
     557       Optical_Thickness_Ice_MeanLog10   = R_UNDEF
     558       Cloud_Particle_Size_Ice_Mean      = R_UNDEF
     559       Ice_Water_Path_Mean               = R_UNDEF
     560    endwhere
     561    where (Cloud_Fraction_High_Mean == 0)  Cloud_Fraction_High_Mean = R_UNDEF
     562    where (Cloud_Fraction_Mid_Mean == 0)   Cloud_Fraction_Mid_Mean = R_UNDEF
     563    where (Cloud_Fraction_Low_Mean == 0)   Cloud_Fraction_Low_Mean = R_UNDEF
     564
     565    ! ########################################################################################
     566    ! Joint histogram 
     567    ! ########################################################################################
     568
     569    ! Loop over all points
     570    tauWRK(1:nPoints,1:nSubCols)     = optical_thickness(1:nPoints,1:nSubCols)
     571    ctpWRK(1:nPoints,1:nSubCols)     = cloud_top_pressure(1:nPoints,1:nSubCols)
     572    reffIceWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,iceCloudMask)
     573    reffLiqWRK(1:nPoints,1:nSubCols) = merge(particle_size,R_UNDEF,waterCloudMask)
     574    do j=1,nPoints
     575
     576       ! Fill clear and optically thin subcolumns with fill
     577       where(.not. cloudMask(j,1:nSubCols))
     578          tauWRK(j,1:nSubCols) = -999.
     579          ctpWRK(j,1:nSubCols) = -999.
     580       endwhere
     581       ! Joint histogram of tau/CTP
     582       call hist2D(tauWRK(j,1:nSubCols),ctpWRK(j,1:nSubCols),nSubCols,&
     583                   tauHistogramBoundaries,numTauHistogramBins,&
     584                   pressureHistogramBoundaries,numPressureHistogramBins,&
     585                   Optical_Thickness_vs_Cloud_Top_Pressure(j,1:numTauHistogramBins,1:numPressureHistogramBins))
     586       ! Joint histogram of tau/ReffICE
     587       call hist2D(tauWRK(j,1:nSubCols),reffIceWrk(j,1:nSubCols),nSubCols,               &
     588                   tauHistogramBoundaries,numTauHistogramBins,reffICE_binBounds,         &
     589                   numMODISReffIceBins, Optical_Thickness_vs_ReffIce(j,1:numTauHistogramBins,1:numMODISReffIceBins))
     590       ! Joint histogram of tau/ReffLIQ
     591       call hist2D(tauWRK(j,1:nSubCols),reffLiqWrk(j,1:nSubCols),nSubCols,               &
     592                   tauHistogramBoundaries,numTauHistogramBins,reffLIQ_binBounds,         &
     593                   numMODISReffLiqBins, Optical_Thickness_vs_ReffLiq(j,1:numTauHistogramBins,1:numMODISReffLiqBins))                   
     594
     595    enddo   
     596    Optical_Thickness_vs_Cloud_Top_Pressure(1:nPoints,1:numTauHistogramBins,1:numPressureHistogramBins) = &
     597         Optical_Thickness_vs_Cloud_Top_Pressure(1:nPoints,1:numTauHistogramBins,1:numPressureHistogramBins)/nSubCols
     598    Optical_Thickness_vs_ReffIce(1:nPoints,1:numTauHistogramBins,1:numMODISReffIceBins) = &
     599         Optical_Thickness_vs_ReffIce(1:nPoints,1:numTauHistogramBins,1:numMODISReffIceBins)/nSubCols
     600    Optical_Thickness_vs_ReffLiq(1:nPoints,1:numTauHistogramBins,1:numMODISReffLiqBins) = &
     601         Optical_Thickness_vs_ReffLiq(1:nPoints,1:numTauHistogramBins,1:numMODISReffLiqBins)/nSubCols
     602
     603  end subroutine modis_column
     604  ! ######################################################################################
     605  ! SUBROUTINE hist2D
     606  ! ######################################################################################
     607  subroutine hist2D(var1,var2,npts,bin1,nbin1,bin2,nbin2,jointHist)
     608    implicit none
     609   
     610    ! INPUTS
     611    integer, intent(in) :: &
     612         npts,  & ! Number of data points to be sorted
     613         nbin1, & ! Number of bins in histogram direction 1
     614         nbin2    ! Number of bins in histogram direction 2
     615    real,intent(in),dimension(npts) :: &
     616         var1,  & ! Variable 1 to be sorted into bins
     617         var2     ! variable 2 to be sorted into bins
     618    real,intent(in),dimension(nbin1+1) :: &
     619         bin1     ! Histogram bin 1 boundaries
     620    real,intent(in),dimension(nbin2+1) :: &
     621         bin2     ! Histogram bin 2 boundaries
     622    ! OUTPUTS
     623    real,intent(out),dimension(nbin1,nbin2) :: &
     624         jointHist
     625   
     626    ! LOCAL VARIABLES
     627    integer :: ij,ik
     628   
     629    do ij=2,nbin1+1
     630       do ik=2,nbin2+1
     631          jointHist(ij-1,ik-1)=count(var1 .ge. bin1(ij-1) .and. var1 .lt. bin1(ij) .and. &
     632               var2 .ge. bin2(ik-1) .and. var2 .lt. bin2(ik))       
     633       enddo
     634    enddo
     635  end subroutine hist2D
     636 
    386637  !------------------------------------------------------------------------------------------------
    387638  subroutine modis_L3_simulator(phase, cloud_top_pressure, optical_thickness, particle_size,            &
    … …  
    666917      ! If first retrieval works, can try 2nd iteration using greater re resolution
    667918      !
    668       if(use_two_re_iterations .and. retrieve_re > 0.) then
    669         re_min = retrieve_re - delta_re
    670         re_max = retrieve_re + delta_re
    671         delta_re = (re_max - re_min)/real(num_trial_res-1)
    672  
    673         trial_re(:) = re_min + delta_re * (/ (i - 1, i = 1, num_trial_res) /)
    674         g(:)  = get_g_nir(  phase, trial_re(:))
    675         w0(:) = get_ssa_nir(phase, trial_re(:))
    676         predicted_Refl_nir(:) = two_stream_reflectance(tau, g(:), w0(:))
    677         retrieve_re = interpolate_to_min(trial_re(:), predicted_Refl_nir(:), obs_Refl_nir)
    678       end if
     919! DJS2015: Remove unused piece of code     
     920!      if(use_two_re_iterations .and. retrieve_re > 0.) then
     921!        re_min = retrieve_re - delta_re
     922!        re_max = retrieve_re + delta_re
     923!        delta_re = (re_max - re_min)/real(num_trial_res-1)
     924! 
     925!        trial_re(:) = re_min + delta_re * (/ (i - 1, i = 1, num_trial_res) /)
     926!        g(:)  = get_g_nir(  phase, trial_re(:))
     927!        w0(:) = get_ssa_nir(phase, trial_re(:))
     928!        predicted_Refl_nir(:) = two_stream_reflectance(tau, g(:), w0(:))
     929!        retrieve_re = interpolate_to_min(trial_re(:), predicted_Refl_nir(:), obs_Refl_nir)
     930!      end if
     931! DJS2015 END
    679932    else
    680933      retrieve_re = re_fill
    … …  
    739992    real,    intent(in) :: re
    740993    real :: get_g_nir
    741    
    742     real, dimension(3), parameter :: ice_coefficients   = (/ 0.7432,  4.5563e-3, -2.8697e-5 /), &
    743                                small_water_coefficients = (/ 0.8027, -1.0496e-2,  1.7071e-3 /), &
    744                                  big_water_coefficients = (/ 0.7931,  5.3087e-3, -7.4995e-5 /)
    745    
    746     ! approx. fits from MODIS Collection 5 LUT scattering calculations
    747     if(phase == phaseIsLiquid) then
    748       if(re < 8.) then
    749         get_g_nir = fit_to_quadratic(re, small_water_coefficients)
    750         if(re < re_water_min) get_g_nir = fit_to_quadratic(re_water_min, small_water_coefficients)
    751       else
    752         get_g_nir = fit_to_quadratic(re,  big_water_coefficients)
    753         if(re > re_water_max) get_g_nir = fit_to_quadratic(re_water_max, big_water_coefficients)
    754       end if
     994
     995    real, dimension(3), parameter :: ice_coefficients         = (/ 0.7490, 6.5153e-3, -5.4136e-5 /), &
     996                                     small_water_coefficients = (/ 1.0364, -8.8800e-2, 7.0000e-3 /)
     997    real, dimension(4), parameter :: big_water_coefficients   = (/ 0.6035, 2.8993e-2, -1.1051e-3, 1.5134e-5 /)
     998
     999    ! approx. fits from MODIS Collection 6 LUT scattering calculations for 3.7 µm channel size retrievals
     1000    if(phase == phaseIsLiquid) then 
     1001       if(re < 7.) then
     1002          get_g_nir = fit_to_quadratic(re, small_water_coefficients)
     1003          if(re < re_water_min) get_g_nir = fit_to_quadratic(re_water_min, small_water_coefficients)
     1004       else
     1005          get_g_nir = fit_to_cubic(re, big_water_coefficients)
     1006          if(re > re_water_max) get_g_nir = fit_to_cubic(re_water_max, big_water_coefficients)
     1007       end if
    7551008    else
    756       get_g_nir = fit_to_quadratic(re, ice_coefficients)
     1009       get_g_nir = fit_to_quadratic(re, ice_coefficients)
    7571010      if(re < re_ice_min) get_g_nir = fit_to_quadratic(re_ice_min, ice_coefficients)
    7581011      if(re > re_ice_max) get_g_nir = fit_to_quadratic(re_ice_max, ice_coefficients)
    … …  
    7711024        ! Fits from Steve Platnick
    7721025        !
     1026        real, dimension(4), parameter :: ice_coefficients   = (/ 0.9625, -1.8069e-2, 3.3281e-4,-2.2865e-6/)
     1027        real, dimension(3), parameter :: water_coefficients = (/ 1.0044, -1.1397e-2, 1.3300e-4 /)
    7731028       
    774         real, dimension(4), parameter :: ice_coefficients   = (/ 0.9994, -4.5199e-3, 3.9370e-5, -1.5235e-7 /)
    775         real, dimension(3), parameter :: water_coefficients = (/ 1.0008, -2.5626e-3, 1.6024e-5 /)
    776        
    777         ! approx. fits from MODIS Collection 5 LUT scattering calculations
     1029        ! approx. fits from MODIS Collection 6 LUT scattering calculations
    7781030        if(phase == phaseIsLiquid) then
    7791031          get_ssa_nir = fit_to_quadratic(re, water_coefficients)

  • LMDZ5/branches/testing/libf/phylmd/cosp/read_cosp_output_nl.F90

    r2435 r2720  
    4141             Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, &
    4242             Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, &
    43              Liwpmodis,Lclmodis
     43             Liwpmodis,Lclmodis,Lcrimodis,Lcrlmodis
    4444
    4545  namelist/COSP_OUTPUT/Lradar_sim,Llidar_sim,Lisccp_sim,Lmodis_sim,Lmisr_sim,Lrttov_sim, &
    … …  
    5757             Lcltmodis,Lclwmodis,Lclimodis,Lclhmodis,Lclmmodis,Lcllmodis,Ltautmodis,Ltauwmodis,Ltauimodis,Ltautlogmodis, &
    5858             Ltauwlogmodis,Ltauilogmodis,Lreffclwmodis,Lreffclimodis,Lpctmodis,Llwpmodis, &
    59              Liwpmodis,Lclmodis
     59             Liwpmodis,Lclmodis,Lcrimodis,Lcrlmodis
    6060   
    6161  do i=1,N_OUT_LIST
    … …  
    137137  CALL bcast(Lclmodis)
    138138  CALL bcast(Ltbrttov)
     139  CALL bcast(Lcrimodis)
     140  CALL bcast(Lcrlmodis)
     141
    139142!$OMP BARRIER
    140143
    … …  
    223226    Liwpmodis=.false.
    224227    Lclmodis=.false.
     228    Lcrimodis=.false.
     229    Lcrlmodis=.false.
    225230  endif
    226231  if (Lmodis_sim) Lisccp_sim = .true.
    … …  
    381386  i = i+1
    382387  if (Lclmodis)         cfg%out_list(i) = 'clmodis'
     388  i = i+1
     389  if (Lcrimodis)         cfg%out_list(i) = 'crimodis'
     390  i = i+1
     391  if (Lcrlmodis)         cfg%out_list(i) = 'crlmodis'
    383392   
    384393  if (i /= N_OUT_LIST) then
    … …  
    459468  cfg%Liwpmodis=Liwpmodis
    460469  cfg%Lclmodis=Lclmodis
    461  
     470  cfg%Lcrimodis=Lcrimodis
     471  cfg%Lcrlmodis=Lcrlmodis
     472
    462473 END SUBROUTINE READ_COSP_OUTPUT_NL
    463474

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

    r2641 r2720  
    23542354
    23552355! ------------------------------------------------------
     2356IF (prt_level .GE. 10) print *,' ->cv3_unsat, iflag(1) ', iflag(1)
    23562357
    23572358! =============================
    … …  
    23592360! =============================
    23602361!  (loops up to nl+1)
     2362mp(:,:) = 0.
     2363rp(:,:) = 0.
     2364up(:,:) = 0.
     2365vp(:,:) = 0.
     2366water(:,:) = 0.
     2367evap(:,:) = 0.
     2368wt(:,:) = 0.
     2369ice(:,:) = 0.
     2370fondue(:,:) = 0.
     2371faci(:,:) = 0.
     2372b(:,:) = 0.
     2373sigd(:) = 0.
     2374!! RomP >>>
     2375wdtrainA(:,:) = 0.
     2376wdtrainM(:,:) = 0.
     2377!! RomP <<<
    23612378
    23622379  DO i = 1, nlp
    23632380    DO il = 1, ncum
    2364       mp(il, i) = 0.0
    23652381      rp(il, i) = rr(il, i)
    23662382      up(il, i) = u(il, i)
    23672383      vp(il, i) = v(il, i)
    23682384      wt(il, i) = 0.001
    2369       water(il, i) = 0.0
    2370       faci(il, i) = 0.0
    2371       ice(il, i) = 0.0
    2372       fondue(il, i) = 0.0
    2373       evap(il, i) = 0.0
    2374       b(il, i) = 0.0
    2375     END DO
    2376   END DO
    2377 !! RomP >>>
    2378   DO i = 1, nlp
    2379     DO il = 1, ncum
    2380       wdtrainA(il, i) = 0.0
    2381       wdtrainM(il, i) = 0.0
    2382     END DO
    2383   END DO
    2384 !! RomP <<<
     2385    END DO
     2386  END DO
    23852387
    23862388! ***  Set the fractionnal area sigd of precipitating downdraughts
    … …  
    24222424!!          lwork(il)=.TRUE.
    24232425!!          if(ep(il,inb(il)).lt.0.0001)lwork(il)=.FALSE.
    2424     lwork(il) = ep(il, inb(il)) >= 0.0001
     2426!jyg<
     2427!!    lwork(il) = ep(il, inb(il)) >= 0.0001
     2428    lwork(il) = ep(il, inb(il)) >= 0.0001 .AND. iflag(il) <= 2
    24252429  END DO
    24262430
    … …  
    27252729
    27262730      END IF !(i.le.inb(il) .and. lwork(il) .and. i.ne.1)
     2731      IF (prt_level .GE. 20) THEN
     2732        PRINT *,'cv3_unsat, mp hydrostatic ', i, mp(il,i)
     2733      ENDIF
    27272734    END DO
    27282735! ----------------------------------------------------------------
    … …  
    27712778          END IF
    27722779          mp(il, i) = max(0.0, mp(il,i))
     2780          IF (prt_level .GE. 20) THEN
     2781            PRINT *,'cv3_unsat, mp cubic ', i, mp(il,i)
     2782          ENDIF
    27732783
    27742784          IF (cvflag_ice) THEN

  • LMDZ5/branches/testing/libf/phylmd/dyn1d/1DUTILS.h

    r2641 r2720  
    5555
    5656!Config  Key  = prt_level
    57 !Config  Desc = niveau d'impressions de débogage
     57!Config  Desc = niveau d'impressions de debogage
    5858!Config  Def  = 0
    59 !Config  Help = Niveau d'impression pour le débogage
     59!Config  Help = Niveau d'impression pour le debogage
    6060!Config         (0 = minimum d'impression)
    6161!      prt_level = 0
    … …  
    118118!             use geostrophic wind ug=10m/s vg=0m/s. Duration of the case 53100s
    119119!             Radiation to be switched off
     120!         > 100 ==> forcing_case = .true. or forcing_case2 = .true.
     121!             initial profiles from case.nc file
    120122!
    121123       forcing_type = 0
    … …  
    134136        ENDIF
    135137
    136 !Paramètres de forçage
     138!Parametres de forcage
    137139!Config  Key  = tend_t
    138140!Config  Desc = forcage ou non par advection de T
    … …  
    303305       CALL getin('rugos',rugos)
    304306
     307!Config  Key  = rugosh
     308!Config  Desc = coefficient de frottement
     309!Config  Def  = rugos
     310!Config  Help = calcul du Cdrag
     311       rugosh = rugos
     312       CALL getin('rugosh',rugosh)
     313
     314
     315
     316!Config  Key  = snowmass
     317!Config  Desc = mass de neige de la surface en kg/m2
     318!Config  Def  = 0.0000
     319!Config  Help = snowmass
     320       snowmass = 0.0000
     321       CALL getin('snowmass',snowmass)
     322
    305323!Config  Key  = wtsurf et wqsurf
    306324!Config  Desc = ???
    … …  
    342360!Config  Key  = zpicinp
    343361!Config  Desc = denivellation orographie
    344 !Config  Def  = 300.
     362!Config  Def  = 0.
    345363!Config  Help =  input brise
    346        zpicinp = 300.
     364       zpicinp = 0.
    347365       CALL getin('zpicinp',zpicinp)
    348366!Config key = nudge_tsoil
    … …  
    378396       CALL getin('tau_soil_nudge',tau_soil_nudge)
    379397
     398!----------------------------------------------------------
     399! Param??tres de for??age pour les forcages communs:
     400! Pour les forcages communs: ces entiers valent 0 ou 1
     401! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
     402! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
     403! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
     404! forcages en omega, w, vent geostrophique ou ustar
     405! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
     406!----------------------------------------------------------
     407
     408!Config  Key  = tadv
     409!Config  Desc = forcage ou non par advection totale de T
     410!Config  Def  = false
     411!Config  Help = forcage ou non par advection totale de T
     412       tadv =0
     413       CALL getin('tadv',tadv)
     414
     415!Config  Key  = tadvv
     416!Config  Desc = forcage ou non par advection verticale de T
     417!Config  Def  = false
     418!Config  Help = forcage ou non par advection verticale de T
     419       tadvv =0
     420       CALL getin('tadvv',tadvv)
     421
     422!Config  Key  = tadvh
     423!Config  Desc = forcage ou non par advection horizontale de T
     424!Config  Def  = false
     425!Config  Help = forcage ou non par advection horizontale de T
     426       tadvh =0
     427       CALL getin('tadvh',tadvh)
     428
     429!Config  Key  = thadv
     430!Config  Desc = forcage ou non par advection totale de Theta
     431!Config  Def  = false
     432!Config  Help = forcage ou non par advection totale de Theta
     433       thadv =0
     434       CALL getin('thadv',thadv)
     435
     436!Config  Key  = thadvv
     437!Config  Desc = forcage ou non par advection verticale de Theta
     438!Config  Def  = false
     439!Config  Help = forcage ou non par advection verticale de Theta
     440       thadvv =0
     441       CALL getin('thadvv',thadvv)
     442
     443!Config  Key  = thadvh
     444!Config  Desc = forcage ou non par advection horizontale de Theta
     445!Config  Def  = false
     446!Config  Help = forcage ou non par advection horizontale de Theta
     447       thadvh =0
     448       CALL getin('thadvh',thadvh)
     449
     450!Config  Key  = qadv
     451!Config  Desc = forcage ou non par advection totale de Q
     452!Config  Def  = false
     453!Config  Help = forcage ou non par advection totale de Q
     454       qadv =0
     455       CALL getin('qadv',qadv)
     456
     457!Config  Key  = qadvv
     458!Config  Desc = forcage ou non par advection verticale de Q
     459!Config  Def  = false
     460!Config  Help = forcage ou non par advection verticale de Q
     461       qadvv =0
     462       CALL getin('qadvv',qadvv)
     463
     464!Config  Key  = qadvh
     465!Config  Desc = forcage ou non par advection horizontale de Q
     466!Config  Def  = false
     467!Config  Help = forcage ou non par advection horizontale de Q
     468       qadvh =0
     469       CALL getin('qadvh',qadvh)
     470
     471!Config  Key  = trad
     472!Config  Desc = forcage ou non par tendance radiative
     473!Config  Def  = false
     474!Config  Help = forcage ou non par tendance radiative
     475       trad =0
     476       CALL getin('trad',trad)
     477
     478!Config  Key  = forc_omega
     479!Config  Desc = forcage ou non par omega
     480!Config  Def  = false
     481!Config  Help = forcage ou non par omega
     482       forc_omega =0
     483       CALL getin('forc_omega',forc_omega)
     484
     485!Config  Key  = forc_w
     486!Config  Desc = forcage ou non par w
     487!Config  Def  = false
     488!Config  Help = forcage ou non par w
     489       forc_w =0
     490       CALL getin('forc_w',forc_w)
     491
     492!Config  Key  = forc_geo
     493!Config  Desc = forcage ou non par geo
     494!Config  Def  = false
     495!Config  Help = forcage ou non par geo
     496       forc_geo =0
     497       CALL getin('forc_geo',forc_geo)
     498
     499! Meme chose que ok_precr_ust
     500!Config  Key  = forc_ustar
     501!Config  Desc = forcage ou non par ustar
     502!Config  Def  = false
     503!Config  Help = forcage ou non par ustar
     504       forc_ustar =0
     505       CALL getin('forc_ustar',forc_ustar)
     506       IF (forc_ustar .EQ. 1) ok_prescr_ust=.true.
     507
     508!Config  Key  = nudging_u
     509!Config  Desc = forcage ou non par nudging sur u
     510!Config  Def  = false
     511!Config  Help = forcage ou non par nudging sur u
     512       nudging_u =0
     513       CALL getin('nudging_u',nudging_u)
     514
     515!Config  Key  = nudging_v
     516!Config  Desc = forcage ou non par nudging sur v
     517!Config  Def  = false
     518!Config  Help = forcage ou non par nudging sur v
     519       nudging_v =0
     520       CALL getin('nudging_v',nudging_v)
     521
     522!Config  Key  = nudging_w
     523!Config  Desc = forcage ou non par nudging sur w
     524!Config  Def  = false
     525!Config  Help = forcage ou non par nudging sur w
     526       nudging_w =0
     527       CALL getin('nudging_w',nudging_w)
     528
     529!Config  Key  = nudging_q
     530!Config  Desc = forcage ou non par nudging sur q
     531!Config  Def  = false
     532!Config  Help = forcage ou non par nudging sur q
     533       nudging_q =0
     534       CALL getin('nudging_q',nudging_q)
     535
     536!Config  Key  = nudging_t
     537!Config  Desc = forcage ou non par nudging sur t
     538!Config  Def  = false
     539!Config  Help = forcage ou non par nudging sur t
     540       nudging_t =0
     541       CALL getin('nudging_t',nudging_t)
    380542
    381543
    … …  
    395557      write(lunout,*)' zsurf = ', zsurf
    396558      write(lunout,*)' rugos = ', rugos
     559      write(lunout,*)' snowmass=', snowmass
    397560      write(lunout,*)' wtsurf = ', wtsurf
    398561      write(lunout,*)' wqsurf = ', wqsurf
    … …  
    406569      write(lunout,*)' Tsoil_nudge = ', Tsoil_nudge
    407570      write(lunout,*)' tau_soil_nudge = ', tau_soil_nudge
     571      write(lunout,*)' tadv =      ', tadv
     572      write(lunout,*)' tadvv =     ', tadvv
     573      write(lunout,*)' tadvh =     ', tadvh
     574      write(lunout,*)' thadv =     ', thadv
     575      write(lunout,*)' thadvv =    ', thadvv
     576      write(lunout,*)' thadvh =    ', thadvh
     577      write(lunout,*)' qadv =      ', qadv
     578      write(lunout,*)' qadvv =     ', qadvv
     579      write(lunout,*)' qadvh =     ', qadvh
     580      write(lunout,*)' trad =      ', trad
     581      write(lunout,*)' forc_omega = ', forc_omega
     582      write(lunout,*)' forc_w     = ', forc_w
     583      write(lunout,*)' forc_geo   = ', forc_geo
     584      write(lunout,*)' forc_ustar = ', forc_ustar
     585      write(lunout,*)' nudging_u  = ', nudging_u
     586      write(lunout,*)' nudging_v  = ', nudging_v
     587      write(lunout,*)' nudging_t  = ', nudging_t
     588      write(lunout,*)' nudging_q  = ', nudging_q
    408589      IF (forcing_type .eq.40) THEN
    409590        write(lunout,*) '--- Forcing type GCSS Old --- with:'
    … …  
    11061287!----------------------------------------------------------------------
    11071288!   Calcul de l'advection verticale (ascendance et subsidence) de
    1108 !   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
    1109 !   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou
     1289!   temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur
     1290!   a les memes caracteristiques que l'air de la colonne 1D (WTG) ou
    11101291!   sans WTG rajouter une advection horizontale
    11111292!---------------------------------------------------------------------- 
    … …  
    11801361!----------------------------------------------------------------------
    11811362!   Calcul de l'advection verticale (ascendance et subsidence) de
    1182 !   température et d'humidité. Hypothèse : ce qui rentre de l'extérieur
    1183 !   a les mêmes caractéristiques que l'air de la colonne 1D (WTG) ou
     1363!   temperature et d'humidite. Hypothese : ce qui rentre de l'exterieur
     1364!   a les memes caracteristiques que l'air de la colonne 1D (WTG) ou
    11841365!   sans WTG rajouter une advection horizontale
    11851366!---------------------------------------------------------------------- 
    … …  
    29343115       endif
    29353116       if (annee_ref.eq.1992 .and. day1.lt.day_ini_toga) then
    2936         print*,'TOGA-COARE a débuté le 1er Nov 1992 (jour julien=306)'
     3117        print*,'TOGA-COARE a debute le 1er Nov 1992 (jour julien=306)'
    29373118        print*,'Changer dayref dans run.def'
    29383119        stop
    … …  
    31413322
    31423323!======================================================================
     3324        SUBROUTINE interp_gabls4_time(day,day1,annee_ref                              &
     3325     &             ,year_ini_gabls4,day_ini_gabls4,nt_gabls4,dt_gabls4,nlev_gabls4    &
     3326     &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                          &
     3327     &             ,ug_prof,vg_prof,ht_prof,hq_prof,tg_prof)
     3328        implicit none
     3329
     3330!---------------------------------------------------------------------------------------
     3331! Time interpolation of a 2D field to the timestep corresponding to day
     3332!
     3333! day: current julian day
     3334! day1: first day of the simulation
     3335! nt_gabls4: total nb of data in the forcing (e.g. 37 for gabls4)
     3336! dt_gabls4: total time interval (in sec) between 2 forcing data (e.g. 60min. for gabls4)
     3337!---------------------------------------------------------------------------------------
     3338
     3339#include "compar1d.h"
     3340
     3341! inputs:
     3342        integer annee_ref
     3343        integer nt_gabls4,nlev_gabls4
     3344        integer year_ini_gabls4
     3345        real day, day1,day_ini_gabls4,dt_gabls4
     3346        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
     3347        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
     3348        real tg_gabls4(nt_gabls4), tg_prof
     3349! outputs:
     3350        real ug_prof(nlev_gabls4),vg_prof(nlev_gabls4)
     3351        real ht_prof(nlev_gabls4),hq_prof(nlev_gabls4)
     3352! local:
     3353        integer it_gabls41, it_gabls42,k
     3354        real timeit,time_gabls41,time_gabls42,frac
     3355
     3356
     3357
     3358! Check that initial day of the simulation consistent with gabls4 period:
     3359       if (forcing_type.eq.8 ) then
     3360       print *,'annee_ref=',annee_ref
     3361       print *,'day1=',day1
     3362       print *,'day_ini_gabls4=',day_ini_gabls4
     3363       if (annee_ref.ne.2009) then
     3364        print*,'Pour gabls4, annee_ref doit etre 2009'
     3365        print*,'Changer annee_ref dans run.def'
     3366        stop
     3367       endif
     3368       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4) then
     3369        print*,'gabls4 a debute le 11 dec 2009 (jour julien=345)'
     3370        print*,'Changer dayref dans run.def',day1,day_ini_gabls4
     3371        stop
     3372       endif
     3373       if (annee_ref.eq.2009 .and. day1.gt.day_ini_gabls4+2) then
     3374        print*,'gabls4 a fini le 12 dec 2009 (jour julien=346)'
     3375        print*,'Changer dayref ou nday dans run.def',day1,day_ini_gabls4
     3376        stop
     3377       endif
     3378       endif
     3379
     3380      timeit=(day-day_ini_gabls4)*86400
     3381       print *,'day,day_ini_gabls4=',day,day_ini_gabls4
     3382       print *,'nt_gabls4,dt,timeit=',nt_gabls4,dt_gabls4,timeit
     3383
     3384! Determine the closest observation times:
     3385       it_gabls41=INT(timeit/dt_gabls4)+1
     3386       it_gabls42=it_gabls41 + 1
     3387       time_gabls41=(it_gabls41-1)*dt_gabls4
     3388       time_gabls42=(it_gabls42-1)*dt_gabls4
     3389
     3390       if (it_gabls41 .ge. nt_gabls4) then
     3391        write(*,*) 'PB-stop: day, it_gabls41, it_gabls42, timeit: ',day,it_gabls41,it_gabls42,timeit/86400.
     3392        stop
     3393       endif
     3394
     3395! time interpolation:
     3396       frac=(time_gabls42-timeit)/(time_gabls42-time_gabls41)
     3397       frac=max(frac,0.0)
     3398
     3399
     3400       do k=1,nlev_gabls4
     3401        ug_prof(k) = ug_gabls4(k,it_gabls42)-frac*(ug_gabls4(k,it_gabls42)-ug_gabls4(k,it_gabls41))
     3402        vg_prof(k) = vg_gabls4(k,it_gabls42)-frac*(vg_gabls4(k,it_gabls42)-vg_gabls4(k,it_gabls41))
     3403        ht_prof(k) = ht_gabls4(k,it_gabls42)-frac*(ht_gabls4(k,it_gabls42)-ht_gabls4(k,it_gabls41))
     3404        hq_prof(k) = hq_gabls4(k,it_gabls42)-frac*(hq_gabls4(k,it_gabls42)-hq_gabls4(k,it_gabls41))
     3405        enddo
     3406        tg_prof=tg_gabls4(it_gabls42)-frac*(tg_gabls4(it_gabls42)-tg_gabls4(it_gabls41))
     3407        return
     3408        END
     3409
     3410!======================================================================
    31433411        SUBROUTINE interp_armcu_time(day,day1,annee_ref                    &
    31443412     &             ,year_ini_armcu,day_ini_armcu,nt_armcu,dt_armcu         &
    … …  
    36793947!=====================================================================
    36803948      subroutine read_dice(fich_dice,nlevel,ntime                         &
    3681      &     ,zz,pres,th,qv,u,v,o3                                          &
     3949     &     ,zz,pres,t,qv,u,v,o3                                          &
    36823950     &     ,shf,lhf,lwup,swup,tg,ustar,psurf,ug,vg                        &
    36833951     &     ,hadvt,hadvq,hadvu,hadvv,w,omega)
    … …  
    36893957
    36903958#include "netcdf.inc"
     3959#include "YOMCST.h"
    36913960
    36923961      integer ntime,nlevel
    … …  
    36963965      real*8 zz(nlevel)
    36973966
    3698       real*8 th(nlevel),pres(nlevel)
     3967      real*8 th(nlevel),pres(nlevel),t(nlevel)
    36993968      real*8 qv(nlevel),u(nlevel),v(nlevel),o3(nlevel)
    37003969      real*8 shf(ntime),lhf(ntime),lwup(ntime),swup(ntime),tg(ntime)
    … …  
    37023971      real*8 hadvt(nlevel,ntime),hadvq(nlevel,ntime),hadvu(nlevel,ntime)
    37033972      real*8 hadvv(nlevel,ntime),w(nlevel,ntime),omega(nlevel,ntime)
     3973      real*8 pzero
    37043974
    37053975      integer nid, ierr
    … …  
    37083978      integer var3didin(nbvar3d)
    37093979
     3980      pzero=100000.
    37103981      ierr = NF_OPEN(fich_dice,NF_NOWRITE,nid)
    37113982      if (ierr.NE.NF_NOERR) then
    … …  
    38824153         endif
    38834154!          write(*,*)'lecture th ok',th
     4155           do k=1,nlevel
     4156             t(k)=th(k)*(pres(k)/pzero)**rkappa
     4157           enddo
    38844158
    38854159#ifdef NC_DOUBLE
    … …  
    40954369         end subroutine read_dice
    40964370!=====================================================================
     4371      subroutine read_gabls4(fich_gabls4,nlevel,ntime,nsol                    &
     4372     &     ,zz,depth_sn,ug,vg,pf,th,t,qv,u,v,hadvt,hadvq,tg,tsnow,snow_dens)
     4373
     4374!program reading initial profils and forcings of the Gabls4 case study
     4375
     4376
     4377      implicit none
     4378
     4379#include "netcdf.inc"
     4380
     4381      integer ntime,nlevel,nsol
     4382      integer l,k
     4383      character*80 :: fich_gabls4
     4384      real*8 time(ntime)
     4385
     4386!  ATTENTION: visiblement quand on lit gabls4_driver.nc on recupere les donnees
     4387! dans un ordre inverse par rapport a la convention LMDZ
     4388! ==> il faut tout inverser  (MPL 20141024)
     4389! les variables indexees "_i" sont celles qui sont lues dans gabls4_driver.nc
     4390      real*8 zz_i(nlevel),th_i(nlevel),pf_i(nlevel),t_i(nlevel)
     4391      real*8 qv_i(nlevel),u_i(nlevel),v_i(nlevel),ug_i(nlevel,ntime),vg_i(nlevel,ntime)
     4392      real*8 hadvt_i(nlevel,ntime),hadvq_i(nlevel,ntime)
     4393
     4394      real*8 zz(nlevel),th(nlevel),pf(nlevel),t(nlevel)
     4395      real*8 qv(nlevel),u(nlevel),v(nlevel),ug(nlevel,ntime),vg(nlevel,ntime)
     4396      real*8 hadvt(nlevel,ntime),hadvq(nlevel,ntime)
     4397
     4398      real*8 depth_sn(nsol),tsnow(nsol),snow_dens(nsol)
     4399      real*8 tg(ntime)
     4400      integer nid, ierr
     4401      integer nbvar3d
     4402      parameter(nbvar3d=30)
     4403      integer var3didin(nbvar3d)
     4404
     4405      ierr = NF_OPEN(fich_gabls4,NF_NOWRITE,nid)
     4406      if (ierr.NE.NF_NOERR) then
     4407         write(*,*) 'ERROR: Pb opening forcings nc file '
     4408         write(*,*) NF_STRERROR(ierr)
     4409         stop ""
     4410      endif
     4411
     4412
     4413       ierr=NF_INQ_VARID(nid,"height",var3didin(1))
     4414         if(ierr/=NF_NOERR) then
     4415           write(*,*) NF_STRERROR(ierr)
     4416           stop 'height'
     4417         endif
     4418
     4419      ierr=NF_INQ_VARID(nid,"depth_sn",var3didin(2))
     4420         if(ierr/=NF_NOERR) then
     4421           write(*,*) NF_STRERROR(ierr)
     4422           stop 'depth_sn'
     4423      endif
     4424
     4425      ierr=NF_INQ_VARID(nid,"Ug",var3didin(3))
     4426         if(ierr/=NF_NOERR) then
     4427           write(*,*) NF_STRERROR(ierr)
     4428           stop 'Ug'
     4429      endif
     4430
     4431      ierr=NF_INQ_VARID(nid,"Vg",var3didin(4))
     4432         if(ierr/=NF_NOERR) then
     4433           write(*,*) NF_STRERROR(ierr)
     4434           stop 'Vg'
     4435      endif
     4436       ierr=NF_INQ_VARID(nid,"pf",var3didin(5))
     4437         if(ierr/=NF_NOERR) then
     4438           write(*,*) NF_STRERROR(ierr)
     4439           stop 'pf'
     4440         endif
     4441
     4442      ierr=NF_INQ_VARID(nid,"theta",var3didin(6))
     4443         if(ierr/=NF_NOERR) then
     4444           write(*,*) NF_STRERROR(ierr)
     4445           stop 'theta'
     4446         endif
     4447
     4448      ierr=NF_INQ_VARID(nid,"tempe",var3didin(7))
     4449         if(ierr/=NF_NOERR) then
     4450           write(*,*) NF_STRERROR(ierr)
     4451           stop 'tempe'
     4452         endif
     4453
     4454      ierr=NF_INQ_VARID(nid,"qv",var3didin(8))
     4455         if(ierr/=NF_NOERR) then
     4456           write(*,*) NF_STRERROR(ierr)
     4457           stop 'qv'
     4458         endif
     4459
     4460      ierr=NF_INQ_VARID(nid,"u",var3didin(9))
     4461         if(ierr/=NF_NOERR) then
     4462           write(*,*) NF_STRERROR(ierr)
     4463           stop 'u'
     4464         endif
     4465
     4466      ierr=NF_INQ_VARID(nid,"v",var3didin(10))
     4467         if(ierr/=NF_NOERR) then
     4468           write(*,*) NF_STRERROR(ierr)
     4469           stop 'v'
     4470         endif
     4471
     4472      ierr=NF_INQ_VARID(nid,"hadvT",var3didin(11))
     4473         if(ierr/=NF_NOERR) then
     4474           write(*,*) NF_STRERROR(ierr)
     4475           stop 'hadvt'
     4476         endif
     4477
     4478      ierr=NF_INQ_VARID(nid,"hadvQ",var3didin(12))
     4479         if(ierr/=NF_NOERR) then
     4480           write(*,*) NF_STRERROR(ierr)
     4481           stop 'hadvq'
     4482      endif
     4483
     4484      ierr=NF_INQ_VARID(nid,"Tsnow",var3didin(14))
     4485         if(ierr/=NF_NOERR) then
     4486           write(*,*) NF_STRERROR(ierr)
     4487           stop 'tsnow'
     4488      endif
     4489
     4490      ierr=NF_INQ_VARID(nid,"snow_density",var3didin(15))
     4491         if(ierr/=NF_NOERR) then
     4492           write(*,*) NF_STRERROR(ierr)
     4493           stop 'snow_density'
     4494      endif
     4495
     4496      ierr=NF_INQ_VARID(nid,"Tg",var3didin(16))
     4497         if(ierr/=NF_NOERR) then
     4498           write(*,*) NF_STRERROR(ierr)
     4499           stop 'Tg'
     4500      endif
     4501
     4502
     4503!dimensions lecture
     4504!      call catchaxis(nid,ntime,nlevel,time,z,ierr)
     4505 
     4506#ifdef NC_DOUBLE
     4507         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(1),zz_i)
     4508#else
     4509         ierr = NF_GET_VAR_REAL(nid,var3didin(1),zz_i)
     4510#endif
     4511         if(ierr/=NF_NOERR) then
     4512            write(*,*) NF_STRERROR(ierr)
     4513            stop "getvarup"
     4514         endif
     4515 
     4516#ifdef NC_DOUBLE
     4517         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(2),depth_sn)
     4518#else
     4519         ierr = NF_GET_VAR_REAL(nid,var3didin(2),depth_sn)
     4520#endif
     4521         if(ierr/=NF_NOERR) then
     4522            write(*,*) NF_STRERROR(ierr)
     4523            stop "getvarup"
     4524         endif
     4525 
     4526#ifdef NC_DOUBLE
     4527         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(3),ug_i)
     4528#else
     4529         ierr = NF_GET_VAR_REAL(nid,var3didin(3),ug_i)
     4530#endif
     4531         if(ierr/=NF_NOERR) then
     4532            write(*,*) NF_STRERROR(ierr)
     4533            stop "getvarup"
     4534         endif
     4535 
     4536#ifdef NC_DOUBLE
     4537         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(4),vg_i)
     4538#else
     4539         ierr = NF_GET_VAR_REAL(nid,var3didin(4),vg_i)
     4540#endif
     4541         if(ierr/=NF_NOERR) then
     4542            write(*,*) NF_STRERROR(ierr)
     4543            stop "getvarup"
     4544         endif
     4545 
     4546#ifdef NC_DOUBLE
     4547         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(5),pf_i)
     4548#else
     4549         ierr = NF_GET_VAR_REAL(nid,var3didin(5),pf_i)
     4550#endif
     4551         if(ierr/=NF_NOERR) then
     4552            write(*,*) NF_STRERROR(ierr)
     4553            stop "getvarup"
     4554         endif
     4555
     4556#ifdef NC_DOUBLE
     4557         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(6),th_i)
     4558#else
     4559         ierr = NF_GET_VAR_REAL(nid,var3didin(6),th_i)
     4560#endif
     4561         if(ierr/=NF_NOERR) then
     4562            write(*,*) NF_STRERROR(ierr)
     4563            stop "getvarup"
     4564         endif
     4565
     4566#ifdef NC_DOUBLE
     4567         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(7),t_i)
     4568#else
     4569         ierr = NF_GET_VAR_REAL(nid,var3didin(7),t_i)
     4570#endif
     4571         if(ierr/=NF_NOERR) then
     4572            write(*,*) NF_STRERROR(ierr)
     4573            stop "getvarup"
     4574         endif
     4575
     4576#ifdef NC_DOUBLE
     4577         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(8),qv_i)
     4578#else
     4579         ierr = NF_GET_VAR_REAL(nid,var3didin(8),qv_i)
     4580#endif
     4581         if(ierr/=NF_NOERR) then
     4582            write(*,*) NF_STRERROR(ierr)
     4583            stop "getvarup"
     4584         endif
     4585 
     4586#ifdef NC_DOUBLE
     4587         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(9),u_i)
     4588#else
     4589         ierr = NF_GET_VAR_REAL(nid,var3didin(9),u_i)
     4590#endif
     4591         if(ierr/=NF_NOERR) then
     4592            write(*,*) NF_STRERROR(ierr)
     4593            stop "getvarup"
     4594         endif
     4595 
     4596#ifdef NC_DOUBLE
     4597         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(10),v_i)
     4598#else
     4599         ierr = NF_GET_VAR_REAL(nid,var3didin(10),v_i)
     4600#endif
     4601         if(ierr/=NF_NOERR) then
     4602            write(*,*) NF_STRERROR(ierr)
     4603            stop "getvarup"
     4604         endif
     4605 
     4606#ifdef NC_DOUBLE
     4607         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(11),hadvt_i)
     4608#else
     4609         ierr = NF_GET_VAR_REAL(nid,var3didin(11),hadvt_i)
     4610#endif
     4611         if(ierr/=NF_NOERR) then
     4612            write(*,*) NF_STRERROR(ierr)
     4613            stop "getvarup"
     4614         endif
     4615 
     4616#ifdef NC_DOUBLE
     4617         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(12),hadvq_i)
     4618#else
     4619         ierr = NF_GET_VAR_REAL(nid,var3didin(12),hadvq_i)
     4620#endif
     4621         if(ierr/=NF_NOERR) then
     4622            write(*,*) NF_STRERROR(ierr)
     4623            stop "getvarup"
     4624         endif
     4625 
     4626#ifdef NC_DOUBLE
     4627         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(14),tsnow)
     4628#else
     4629         ierr = NF_GET_VAR_REAL(nid,var3didin(14),tsnow)
     4630#endif
     4631         if(ierr/=NF_NOERR) then
     4632            write(*,*) NF_STRERROR(ierr)
     4633            stop "getvarup"
     4634         endif
     4635 
     4636#ifdef NC_DOUBLE
     4637         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(15),snow_dens)
     4638#else
     4639         ierr = NF_GET_VAR_REAL(nid,var3didin(15),snow_dens)
     4640#endif
     4641         if(ierr/=NF_NOERR) then
     4642            write(*,*) NF_STRERROR(ierr)
     4643            stop "getvarup"
     4644         endif
     4645
     4646#ifdef NC_DOUBLE
     4647         ierr = NF_GET_VAR_DOUBLE(nid,var3didin(16),tg)
     4648#else
     4649         ierr = NF_GET_VAR_REAL(nid,var3didin(16),tg)
     4650#endif
     4651         if(ierr/=NF_NOERR) then
     4652            write(*,*) NF_STRERROR(ierr)
     4653            stop "getvarup"
     4654         endif
     4655
     4656! On remet les variables lues dans le bon ordre des niveaux (MPL 20141024)
     4657         do k=1,nlevel
     4658           zz(k)=zz_i(nlevel+1-k)
     4659           ug(k,:)=ug_i(nlevel+1-k,:)
     4660           vg(k,:)=vg_i(nlevel+1-k,:)
     4661           pf(k)=pf_i(nlevel+1-k)
     4662           print *,'pf=',pf(k)
     4663           th(k)=th_i(nlevel+1-k)
     4664           t(k)=t_i(nlevel+1-k)
     4665           qv(k)=qv_i(nlevel+1-k)
     4666           u(k)=u_i(nlevel+1-k)
     4667           v(k)=v_i(nlevel+1-k)
     4668           hadvt(k,:)=hadvt_i(nlevel+1-k,:)
     4669           hadvq(k,:)=hadvq_i(nlevel+1-k,:)
     4670         enddo
     4671         return
     4672 end subroutine read_gabls4
     4673!=====================================================================
     4674
    40974675!     Reads CIRC input files     
    40984676
    … …  
    43904968!
    43914969!  Cette formule remplace d_q = (1/tau) [rh_targ - rh] qsat(T_new)
    4392 !   qui n'était pas correcte.
     4970!   qui n'etait pas correcte.
    43934971!
    43944972            IF (tnew.LT.RTT) THEN
    … …  
    44655043      END
    44665044
     5045!=====================================================================
     5046       SUBROUTINE interp2_case_vertical(play,nlev_cas,plev_prof_cas                                    &
     5047     &         ,t_prof_cas,th_prof_cas,thv_prof_cas,thl_prof_cas                                       &
     5048     &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                              &
     5049     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                   &
     5050     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                &
     5051     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas &
     5052     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                 &
     5053!
     5054     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas                                        &
     5055     &         ,qv_mod_cas,ql_mod_cas,qi_mod_cas,u_mod_cas,v_mod_cas                                   &
     5056     &         ,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                                          &
     5057     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                      &
     5058     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas        &
     5059     &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
     5060 
     5061       implicit none
     5062 
     5063#include "dimensions.h"
     5064
     5065!-------------------------------------------------------------------------
     5066! Vertical interpolation of generic case forcing data onto mod_casel levels
     5067!-------------------------------------------------------------------------
     5068 
     5069       integer nlevmax
     5070       parameter (nlevmax=41)
     5071       integer nlev_cas,mxcalc
     5072!       real play(llm), plev_prof(nlevmax)
     5073!       real t_prof(nlevmax),q_prof(nlevmax)
     5074!       real u_prof(nlevmax),v_prof(nlevmax), w_prof(nlevmax)
     5075!       real ht_prof(nlevmax),vt_prof(nlevmax)
     5076!       real hq_prof(nlevmax),vq_prof(nlevmax)
     5077 
     5078       real play(llm), plev_prof_cas(nlev_cas)
     5079       real t_prof_cas(nlev_cas),th_prof_cas(nlev_cas),thv_prof_cas(nlev_cas),thl_prof_cas(nlev_cas)
     5080       real qv_prof_cas(nlev_cas),ql_prof_cas(nlev_cas),qi_prof_cas(nlev_cas)
     5081       real u_prof_cas(nlev_cas),v_prof_cas(nlev_cas)
     5082       real ug_prof_cas(nlev_cas),vg_prof_cas(nlev_cas), vitw_prof_cas(nlev_cas),omega_prof_cas(nlev_cas)
     5083       real du_prof_cas(nlev_cas),hu_prof_cas(nlev_cas),vu_prof_cas(nlev_cas)
     5084       real dv_prof_cas(nlev_cas),hv_prof_cas(nlev_cas),vv_prof_cas(nlev_cas)
     5085       real dt_prof_cas(nlev_cas),ht_prof_cas(nlev_cas),vt_prof_cas(nlev_cas),dtrad_prof_cas(nlev_cas)
     5086       real dth_prof_cas(nlev_cas),hth_prof_cas(nlev_cas),vth_prof_cas(nlev_cas)
     5087       real dq_prof_cas(nlev_cas),hq_prof_cas(nlev_cas),vq_prof_cas(nlev_cas)
     5088 
     5089       real t_mod_cas(llm),theta_mod_cas(llm),thv_mod_cas(llm),thl_mod_cas(llm)
     5090       real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
     5091       real u_mod_cas(llm),v_mod_cas(llm)
     5092       real ug_mod_cas(llm),vg_mod_cas(llm), w_mod_cas(llm),omega_mod_cas(llm)
     5093       real du_mod_cas(llm),hu_mod_cas(llm),vu_mod_cas(llm)
     5094       real dv_mod_cas(llm),hv_mod_cas(llm),vv_mod_cas(llm)
     5095       real dt_mod_cas(llm),ht_mod_cas(llm),vt_mod_cas(llm),dtrad_mod_cas(llm)
     5096       real dth_mod_cas(llm),hth_mod_cas(llm),vth_mod_cas(llm)
     5097       real dq_mod_cas(llm),hq_mod_cas(llm),vq_mod_cas(llm)
     5098 
     5099       integer l,k,k1,k2
     5100       real frac,frac1,frac2,fact
     5101 
     5102       do l = 1, llm
     5103       print *,'debut interp2, play=',l,play(l)
     5104       enddo
     5105!      do l = 1, nlev_cas
     5106!      print *,'debut interp2, plev_prof_cas=',l,play(l),plev_prof_cas(l)
     5107!      enddo
     5108
     5109       do l = 1, llm
     5110
     5111        if (play(l).ge.plev_prof_cas(nlev_cas)) then
     5112 
     5113        mxcalc=l
     5114        print *,'debut interp2, mxcalc=',mxcalc
     5115         k1=0
     5116         k2=0
     5117
     5118         if (play(l).le.plev_prof_cas(1)) then
     5119
     5120         do k = 1, nlev_cas-1
     5121          if (play(l).le.plev_prof_cas(k).and. play(l).gt.plev_prof_cas(k+1)) then
     5122            k1=k
     5123            k2=k+1
     5124          endif
     5125         enddo
     5126
     5127         if (k1.eq.0 .or. k2.eq.0) then
     5128          write(*,*) 'PB! k1, k2 = ',k1,k2
     5129          write(*,*) 'l,play(l) = ',l,play(l)/100
     5130         do k = 1, nlev_cas-1
     5131          write(*,*) 'k,plev_prof_cas(k) = ',k,plev_prof_cas(k)/100
     5132         enddo
     5133         endif
     5134
     5135         frac = (plev_prof_cas(k2)-play(l))/(plev_prof_cas(k2)-plev_prof_cas(k1))
     5136         t_mod_cas(l)= t_prof_cas(k2) - frac*(t_prof_cas(k2)-t_prof_cas(k1))
     5137         theta_mod_cas(l)= th_prof_cas(k2) - frac*(th_prof_cas(k2)-th_prof_cas(k1))
     5138         thv_mod_cas(l)= thv_prof_cas(k2) - frac*(thv_prof_cas(k2)-thv_prof_cas(k1))
     5139         thl_mod_cas(l)= thl_prof_cas(k2) - frac*(thl_prof_cas(k2)-thl_prof_cas(k1))
     5140         qv_mod_cas(l)= qv_prof_cas(k2) - frac*(qv_prof_cas(k2)-qv_prof_cas(k1))
     5141         ql_mod_cas(l)= ql_prof_cas(k2) - frac*(ql_prof_cas(k2)-ql_prof_cas(k1))
     5142         qi_mod_cas(l)= qi_prof_cas(k2) - frac*(qi_prof_cas(k2)-qi_prof_cas(k1))
     5143         u_mod_cas(l)= u_prof_cas(k2) - frac*(u_prof_cas(k2)-u_prof_cas(k1))
     5144         v_mod_cas(l)= v_prof_cas(k2) - frac*(v_prof_cas(k2)-v_prof_cas(k1))
     5145         ug_mod_cas(l)= ug_prof_cas(k2) - frac*(ug_prof_cas(k2)-ug_prof_cas(k1))
     5146         vg_mod_cas(l)= vg_prof_cas(k2) - frac*(vg_prof_cas(k2)-vg_prof_cas(k1))
     5147         w_mod_cas(l)= vitw_prof_cas(k2) - frac*(vitw_prof_cas(k2)-vitw_prof_cas(k1))
     5148         omega_mod_cas(l)= omega_prof_cas(k2) - frac*(omega_prof_cas(k2)-omega_prof_cas(k1))
     5149         du_mod_cas(l)= du_prof_cas(k2) - frac*(du_prof_cas(k2)-du_prof_cas(k1))
     5150         hu_mod_cas(l)= hu_prof_cas(k2) - frac*(hu_prof_cas(k2)-hu_prof_cas(k1))
     5151         vu_mod_cas(l)= vu_prof_cas(k2) - frac*(vu_prof_cas(k2)-vu_prof_cas(k1))
     5152         dv_mod_cas(l)= dv_prof_cas(k2) - frac*(dv_prof_cas(k2)-dv_prof_cas(k1))
     5153         hv_mod_cas(l)= hv_prof_cas(k2) - frac*(hv_prof_cas(k2)-hv_prof_cas(k1))
     5154         vv_mod_cas(l)= vv_prof_cas(k2) - frac*(vv_prof_cas(k2)-vv_prof_cas(k1))
     5155         dt_mod_cas(l)= dt_prof_cas(k2) - frac*(dt_prof_cas(k2)-dt_prof_cas(k1))
     5156         ht_mod_cas(l)= ht_prof_cas(k2) - frac*(ht_prof_cas(k2)-ht_prof_cas(k1))
     5157         vt_mod_cas(l)= vt_prof_cas(k2) - frac*(vt_prof_cas(k2)-vt_prof_cas(k1))
     5158         dth_mod_cas(l)= dth_prof_cas(k2) - frac*(dth_prof_cas(k2)-dth_prof_cas(k1))
     5159         hth_mod_cas(l)= hth_prof_cas(k2) - frac*(hth_prof_cas(k2)-hth_prof_cas(k1))
     5160         vth_mod_cas(l)= vth_prof_cas(k2) - frac*(vth_prof_cas(k2)-vth_prof_cas(k1))
     5161         dq_mod_cas(l)= dq_prof_cas(k2) - frac*(dq_prof_cas(k2)-dq_prof_cas(k1))
     5162         hq_mod_cas(l)= hq_prof_cas(k2) - frac*(hq_prof_cas(k2)-hq_prof_cas(k1))
     5163         vq_mod_cas(l)= vq_prof_cas(k2) - frac*(vq_prof_cas(k2)-vq_prof_cas(k1))
     5164     
     5165         else !play>plev_prof_cas(1)
     5166
     5167         k1=1
     5168         k2=2
     5169         print *,'interp2_vert, k1,k2=',plev_prof_cas(k1),plev_prof_cas(k2)
     5170         frac1 = (play(l)-plev_prof_cas(k2))/(plev_prof_cas(k1)-plev_prof_cas(k2))
     5171         frac2 = (play(l)-plev_prof_cas(k1))/(plev_prof_cas(k1)-plev_prof_cas(k2))
     5172         t_mod_cas(l)= frac1*t_prof_cas(k1) - frac2*t_prof_cas(k2)
     5173         theta_mod_cas(l)= frac1*th_prof_cas(k1) - frac2*th_prof_cas(k2)
     5174         thv_mod_cas(l)= frac1*thv_prof_cas(k1) - frac2*thv_prof_cas(k2)
     5175         thl_mod_cas(l)= frac1*thl_prof_cas(k1) - frac2*thl_prof_cas(k2)
     5176         qv_mod_cas(l)= frac1*qv_prof_cas(k1) - frac2*qv_prof_cas(k2)
     5177         ql_mod_cas(l)= frac1*ql_prof_cas(k1) - frac2*ql_prof_cas(k2)
     5178         qi_mod_cas(l)= frac1*qi_prof_cas(k1) - frac2*qi_prof_cas(k2)
     5179         u_mod_cas(l)= frac1*u_prof_cas(k1) - frac2*u_prof_cas(k2)
     5180         v_mod_cas(l)= frac1*v_prof_cas(k1) - frac2*v_prof_cas(k2)
     5181         ug_mod_cas(l)= frac1*ug_prof_cas(k1) - frac2*ug_prof_cas(k2)
     5182         vg_mod_cas(l)= frac1*vg_prof_cas(k1) - frac2*vg_prof_cas(k2)
     5183         w_mod_cas(l)= frac1*vitw_prof_cas(k1) - frac2*vitw_prof_cas(k2)
     5184         omega_mod_cas(l)= frac1*omega_prof_cas(k1) - frac2*omega_prof_cas(k2)
     5185         du_mod_cas(l)= frac1*du_prof_cas(k1) - frac2*du_prof_cas(k2)
     5186         hu_mod_cas(l)= frac1*hu_prof_cas(k1) - frac2*hu_prof_cas(k2)
     5187         vu_mod_cas(l)= frac1*vu_prof_cas(k1) - frac2*vu_prof_cas(k2)
     5188         dv_mod_cas(l)= frac1*dv_prof_cas(k1) - frac2*dv_prof_cas(k2)
     5189         hv_mod_cas(l)= frac1*hv_prof_cas(k1) - frac2*hv_prof_cas(k2)
     5190         vv_mod_cas(l)= frac1*vv_prof_cas(k1) - frac2*vv_prof_cas(k2)
     5191         dt_mod_cas(l)= frac1*dt_prof_cas(k1) - frac2*dt_prof_cas(k2)
     5192         ht_mod_cas(l)= frac1*ht_prof_cas(k1) - frac2*ht_prof_cas(k2)
     5193         vt_mod_cas(l)= frac1*vt_prof_cas(k1) - frac2*vt_prof_cas(k2)
     5194         dth_mod_cas(l)= frac1*dth_prof_cas(k1) - frac2*dth_prof_cas(k2)
     5195         hth_mod_cas(l)= frac1*hth_prof_cas(k1) - frac2*hth_prof_cas(k2)
     5196         vth_mod_cas(l)= frac1*vth_prof_cas(k1) - frac2*vth_prof_cas(k2)
     5197         dq_mod_cas(l)= frac1*dq_prof_cas(k1) - frac2*dq_prof_cas(k2)
     5198         hq_mod_cas(l)= frac1*hq_prof_cas(k1) - frac2*hq_prof_cas(k2)
     5199         vq_mod_cas(l)= frac1*vq_prof_cas(k1) - frac2*vq_prof_cas(k2)
     5200
     5201         endif ! play.le.plev_prof_cas(1)
     5202
     5203        else ! above max altitude of forcing file
     5204 
     5205!jyg
     5206         fact=20.*(plev_prof_cas(nlev_cas)-play(l))/plev_prof_cas(nlev_cas) !jyg
     5207         fact = max(fact,0.)                                           !jyg
     5208         fact = exp(-fact)                                             !jyg
     5209         t_mod_cas(l)= t_prof_cas(nlev_cas)                            !jyg
     5210         theta_mod_cas(l)= th_prof_cas(nlev_cas)                       !jyg
     5211         thv_mod_cas(l)= thv_prof_cas(nlev_cas)                        !jyg
     5212         thl_mod_cas(l)= thl_prof_cas(nlev_cas)                        !jyg
     5213         qv_mod_cas(l)= qv_prof_cas(nlev_cas)*fact                     !jyg
     5214         ql_mod_cas(l)= ql_prof_cas(nlev_cas)*fact                     !jyg
     5215         qi_mod_cas(l)= qi_prof_cas(nlev_cas)*fact                     !jyg
     5216         u_mod_cas(l)= u_prof_cas(nlev_cas)*fact                       !jyg
     5217         v_mod_cas(l)= v_prof_cas(nlev_cas)*fact                       !jyg
     5218         ug_mod_cas(l)= ug_prof_cas(nlev_cas)*fact                     !jyg
     5219         vg_mod_cas(l)= vg_prof_cas(nlev_cas)*fact                     !jyg
     5220         w_mod_cas(l)= 0.0                                             !jyg
     5221         du_mod_cas(l)= du_prof_cas(nlev_cas)*fact
     5222         hu_mod_cas(l)= hu_prof_cas(nlev_cas)*fact                     !jyg
     5223         vu_mod_cas(l)= vu_prof_cas(nlev_cas)*fact                     !jyg
     5224         dv_mod_cas(l)= dv_prof_cas(nlev_cas)*fact
     5225         hv_mod_cas(l)= hv_prof_cas(nlev_cas)*fact                     !jyg
     5226         vv_mod_cas(l)= vv_prof_cas(nlev_cas)*fact                     !jyg
     5227         dt_mod_cas(l)= dt_prof_cas(nlev_cas)
     5228         ht_mod_cas(l)= ht_prof_cas(nlev_cas)                          !jyg
     5229         vt_mod_cas(l)= vt_prof_cas(nlev_cas)                          !jyg
     5230         dth_mod_cas(l)= dth_prof_cas(nlev_cas)
     5231         hth_mod_cas(l)= hth_prof_cas(nlev_cas)                        !jyg
     5232         vth_mod_cas(l)= vth_prof_cas(nlev_cas)                        !jyg
     5233         dq_mod_cas(l)= dq_prof_cas(nlev_cas)*fact
     5234         hq_mod_cas(l)= hq_prof_cas(nlev_cas)*fact                     !jyg
     5235         vq_mod_cas(l)= vq_prof_cas(nlev_cas)*fact                     !jyg
     5236 
     5237        endif ! play
     5238 
     5239       enddo ! l
     5240
     5241!       do l = 1,llm
     5242!       print *,'t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l) ',
     5243!     $        l,t_mod_cas(l),q_mod_cas(l),ht_mod_cas(l),hq_mod_cas(l)
     5244!       enddo
     5245 
     5246          return
     5247          end
     5248!*****************************************************************************
     5249
     5250

  • LMDZ5/branches/testing/libf/phylmd/dyn1d/1D_decl_cases.h

    r2408 r2720  
    3333
    3434        real w_mod(llm), t_mod(llm),q_mod(llm)
    35         real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm)
     35        real u_mod(llm),v_mod(llm), ht_mod(llm),vt_mod(llm),ug_mod(llm),vg_mod(llm)
    3636        real hq_mod(llm),vq_mod(llm),qv_mod(llm),ql_mod(llm),qt_mod(llm)
    3737        real th_mod(llm)
    … …  
    9494
    9595!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     96!Declarations specifiques au cas GABLS4   (MPL 20141023)
     97        character*80 :: fich_gabls4
     98        integer nlev_gabls4, nt_gabls4, nsol_gabls4
     99        parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19) 
     100        integer year_ini_gabls4, day_ini_gabls4, mth_ini_gabls4
     101        real heure_ini_gabls4
     102        real day_ju_ini_gabls4   ! Julian day of gabls4 first day
     103        parameter (year_ini_gabls4=2009)
     104        parameter (mth_ini_gabls4=12)
     105        parameter (day_ini_gabls4=11)  ! 11 = 11 decembre 2009
     106        parameter (heure_ini_gabls4=0.) !0UTC en secondes
     107        real dt_gabls4
     108        parameter (dt_gabls4=3600.) ! 1 forcage ttes les heures
     109
     110!profils initiaux:
     111        real plev_gabls4(nlev_gabls4)
     112        real zz_gabls4(nlev_gabls4)
     113        real th_gabls4(nlev_gabls4),t_gabls4(nlev_gabls4),qv_gabls4(nlev_gabls4)
     114        real u_gabls4(nlev_gabls4), v_gabls4(nlev_gabls4)
     115        real depth_sn_gabls4(nsol_gabls4),tsnow_gabls4(nsol_gabls4),snow_dens_gabls4(nsol_gabls4)
     116        real t_gabi(nlev_gabls4),qv_gabi(nlev_gabls4)
     117        real u_gabi(nlev_gabls4), v_gabi(nlev_gabls4),ug_gabi(nlev_gabls4), vg_gabi(nlev_gabls4)
     118        real ht_gabi(nlev_gabls4),hq_gabi(nlev_gabls4),poub(nlev_gabls4)
     119       
     120!forcings
     121        real ht_gabls4(nlev_gabls4,nt_gabls4),hq_gabls4(nlev_gabls4,nt_gabls4)
     122        real ug_gabls4(nlev_gabls4,nt_gabls4),vg_gabls4(nlev_gabls4,nt_gabls4)
     123        real tg_gabls4(nt_gabls4)
     124        real ht_profg(nlev_gabls4),hq_profg(nlev_gabls4)
     125        real ug_profg(nlev_gabls4),vg_profg(nlev_gabls4)
     126        real tg_profg
     127         
     128!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     129
    96130!Declarations specifiques au cas DICE     (MPL 02072013)
    97131        character*80 :: fich_dice
    … …  
    112146       
    113147        real zz_dice(nlev_dice)
    114         real th_dice(nlev_dice),qv_dice(nlev_dice)
     148        real t_dice(nlev_dice),qv_dice(nlev_dice)
    115149        real u_dice(nlev_dice), v_dice(nlev_dice),o3_dice(nlev_dice)
    116150        real ht_dice(nlev_dice,nt_dice)
    … …  
    119153        real w_dice(nlev_dice,nt_dice),omega_dice(nlev_dice,nt_dice)
    120154        real o3_mod(llm),hu_mod(llm),hv_mod(llm)
    121         real th_dicei(nlev_dice),qv_dicei(nlev_dice)
     155        real t_dicei(nlev_dice),qv_dicei(nlev_dice)
    122156        real u_dicei(nlev_dice), v_dicei(nlev_dice),o3_dicei(nlev_dice)
    123157        real ht_dicei(nlev_dice)
    … …  
    209243        real thl_mod(llm),omega_mod(llm),o3mmr_mod(llm),tke_mod(llm)
    210244!vertical advection computation
    211         real d_t_z(llm), d_q_z(llm)
    212         real d_t_dyn_z(llm), d_q_dyn_z(llm)
     245        real d_t_z(llm),d_th_z(llm), d_q_z(llm)
     246        real d_t_dyn_z(llm),d_th_dyn_z(llm), d_q_dyn_z(llm)
    213247        real d_u_z(llm),d_v_z(llm)
    214248        real d_u_dyn(llm),d_v_dyn(llm)
    … …  
    244278
    245279        real w_mod_cas(llm), t_mod_cas(llm),q_mod_cas(llm)
     280        real theta_mod_cas(llm),thl_mod_cas(llm),thv_mod_cas(llm)
     281        real qv_mod_cas(llm),ql_mod_cas(llm),qi_mod_cas(llm)
    246282        real ug_mod_cas(llm),vg_mod_cas(llm)
    247283        real u_mod_cas(llm),v_mod_cas(llm)
     284        real omega_mod_cas(llm)
    248285        real ht_mod_cas(llm),vt_mod_cas(llm),dt_mod_cas(llm),dtrad_mod_cas(llm)
     286        real hth_mod_cas(llm),vth_mod_cas(llm),dth_mod_cas(llm)
    249287        real hq_mod_cas(llm),vq_mod_cas(llm),dq_mod_cas(llm)
    250288        real hu_mod_cas(llm),vu_mod_cas(llm),du_mod_cas(llm)
    … …  
    253291!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    254292
     293

  • LMDZ5/branches/testing/libf/phylmd/dyn1d/1D_interp_cases.h

    r2594 r2720  
    118118! vertical interpolation:
    119119      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice        &
    120      &         ,th_dice,qv_dice,u_dice,v_dice,o3_dice                   &
     120     &         ,t_dice,qv_dice,u_dice,v_dice,o3_dice                   &
    121121     &         ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd,omega_profd &
    122      &         ,th_mod,qv_mod,u_mod,v_mod,o3_mod                        &
     122     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                        &
    123123     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
    124124!     do l = 1, llm
    … …  
    192192      endif ! forcing_dice
    193193!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     194! Interpolation gabls4 forcing
     195!---------------------------------------------------------------------
     196      if (forcing_gabls4 ) then
     197
     198       if (prt_level.ge.1) then
     199        print*,'#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/dt_gabls4=',&
     200     &    day,day1,(day-day1)*86400.,(day-day1)*86400/dt_gabls4
     201       endif
     202
     203! time interpolation:
     204      CALL interp_gabls4_time(daytime,day1,annee_ref                                     &
     205     &             ,year_ini_gabls4,day_ju_ini_gabls4,nt_gabls4,dt_gabls4,nlev_gabls4  &
     206     &             ,ug_gabls4,vg_gabls4,ht_gabls4,hq_gabls4,tg_gabls4                            &
     207     &             ,ug_profg,vg_profg,ht_profg,hq_profg,tg_profg)
     208
     209        if (type_ts_forcing.eq.1) ts_cur = tg_prof ! SST used in read_tsurf1d
     210
     211! vertical interpolation:
     212! on re-utilise le programme interp_dice_vertical: les transformations sur
     213! plev_gabls4,th_gabls4,qv_gabls4,u_gabls4,v_gabls4 ne sont pas prises en compte.
     214! seules celles sur ht_profg,hq_profg,ug_profg,vg_profg sont prises en compte.
     215
     216      CALL interp_dice_vertical(play,nlev_gabls4,nt_gabls4,plev_gabls4         &
     217!    &         ,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,poub            &
     218     &         ,poub,poub,poub,poub,poub                             &
     219     &         ,ht_profg,hq_profg,ug_profg,vg_profg,poub,poub        &
     220     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                      &
     221     &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
     222
     223      do l = 1, llm
     224       ug(l)= ug_mod(l)
     225       vg(l)= vg_mod(l)
     226       d_th_adv(l)=ht_mod(l)
     227       d_q_adv(l,1)=hq_mod(l)
     228      enddo
     229
     230      endif ! forcing_gabls4
     231!---------------------------------------------------------------------
     232
    194233!---------------------------------------------------------------------
    195234!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    766805      enddo
    767806
     807! Faut-il multiplier par -1 ? (MPL 20160713)
     808      IF(ok_flux_surf) THEN
     809       fsens=sens_prof_cas
     810       flat=lat_prof_cas
     811      ENDIF
     812!
     813      IF (ok_prescr_ust) THEN
     814       ust=ustar_prof_cas
     815       print *,'ust=',ust
     816      ENDIF
    768817      endif ! forcing_case
    769818
    770819
    771820!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    772 
     821!---------------------------------------------------------------------
     822! Interpolation forcing standard case
     823!---------------------------------------------------------------------
     824      if (forcing_case2) then
     825
     826        print*,                                                             &
     827     & '#### ITAP,day,day1,(day-day1)*86400,(day-day1)*86400/pdt_cas=',     &
     828     &    daytime,day1,(daytime-day1)*86400.,                               &
     829     &    (daytime-day1)*86400/pdt_cas
     830
     831! time interpolation:
     832        CALL interp2_case_time(daytime,day1,annee_ref                                       &
     833!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
     834     &       ,nt_cas,nlev_cas                                                               &
     835     &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
     836     &       ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
     837     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
     838     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
     839     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
     840!
     841     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
     842     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
     843     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas    &
     844     &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
     845     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
     846     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
     847     &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
     848     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
     849
     850             ts_cur = ts_prof_cas
     851!            psurf=plev_prof_cas(1)
     852             psurf=ps_prof_cas
     853
     854! vertical interpolation:
     855      CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
     856     &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
     857     &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
     858     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                      &
     859     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
     860     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
     861     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
     862!
     863     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
     864     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
     865     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
     866     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
     867     &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
     868
     869
     870      DO l=1,llm
     871      teta(l)=temp(l)*(100000./play(l))**(rd/rcpd)
     872      ENDDO
     873!calcul de l'advection verticale a partir du omega
     874!Calcul des gradients verticaux
     875!initialisation
     876      d_t_z(:)=0.
     877      d_th_z(:)=0.
     878      d_q_z(:)=0.
     879      d_t_dyn_z(:)=0.
     880      d_th_dyn_z(:)=0.
     881      d_q_dyn_z(:)=0.
     882      DO l=2,llm-1
     883       d_t_z(l)=(temp(l+1)-temp(l-1))/(play(l+1)-play(l-1))
     884       d_th_z(l)=(teta(l+1)-teta(l-1))/(play(l+1)-play(l-1))
     885       d_q_z(l)=(q(l+1,1)-q(l-1,1))/(play(l+1)-play(l-1))
     886      ENDDO
     887      d_t_z(1)=d_t_z(2)
     888      d_th_z(1)=d_th_z(2)
     889      d_q_z(1)=d_q_z(2)
     890      d_t_z(llm)=d_t_z(llm-1)
     891      d_th_z(llm)=d_th_z(llm-1)
     892      d_q_z(llm)=d_q_z(llm-1)
     893
     894!Calcul de l advection verticale
     895      d_t_dyn_z(:)=w_mod_cas(:)*d_t_z(:)
     896      d_th_dyn_z(:)=w_mod_cas(:)*d_th_z(:)
     897      d_q_dyn_z(:)=w_mod_cas(:)*d_q_z(:)
     898
     899!wind nudging
     900      if (nudging_u.gt.0.) then
     901        do l=1,llm
     902           u(l)=u(l)+timestep*(u_mod_cas(l)-u(l))/(nudge_u)
     903        enddo
     904      else
     905        do l=1,llm
     906        ug(l) = u_mod_cas(l)
     907        enddo
     908      endif
     909
     910      if (nudging_v.gt.0.) then
     911        do l=1,llm
     912           v(l)=v(l)+timestep*(v_mod_cas(l)-v(l))/(nudge_v)
     913        enddo
     914      else
     915        do l=1,llm
     916        vg(l) = v_mod_cas(l)
     917        enddo
     918      endif
     919
     920      if (nudging_w.gt.0.) then
     921        do l=1,llm
     922           w(l)=w(l)+timestep*(w_mod_cas(l)-w(l))/(nudge_w)
     923        enddo
     924      else
     925        do l=1,llm
     926        w(l) = w_mod_cas(l)
     927        enddo
     928      endif
     929
     930!nudging of q and temp
     931      if (nudging_t.gt.0.) then
     932        do l=1,llm
     933           temp(l)=temp(l)+timestep*(t_mod_cas(l)-temp(l))/(nudge_t)
     934        enddo
     935      endif
     936      if (nudging_q.gt.0.) then
     937        do l=1,llm
     938           q(l,1)=q(l,1)+timestep*(q_mod_cas(l)-q(l,1))/(nudge_q)
     939        enddo
     940      endif
     941
     942      do l = 1, llm
     943       omega(l) = w_mod_cas(l)
     944       omega2(l)= omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     945       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     946
     947!calcul advection
     948!       if ((tend_u.eq.1).and.(tend_w.eq.0)) then
     949!          d_u_adv(l)=du_mod_cas(l)
     950!       else if ((tend_u.eq.1).and.(tend_w.eq.1)) then
     951!          d_u_adv(l)=hu_mod_cas(l)-d_u_dyn_z(l)
     952!       endif
     953!
     954!       if ((tend_v.eq.1).and.(tend_w.eq.0)) then
     955!          d_v_adv(l)=dv_mod_cas(l)
     956!       else if ((tend_v.eq.1).and.(tend_w.eq.1)) then
     957!          d_v_adv(l)=hv_mod_cas(l)-d_v_dyn_z(l)
     958!       endif
     959!
     960!-----------------------------------------------------
     961        if (tadv.eq.1 .or. tadvh.eq.1) then
     962           d_t_adv(l)=alpha*omega(l)/rcpd-dt_mod_cas(l)
     963        else if (tadvv.eq.1) then
     964! ATTENTION d_t_dyn_z pas calcule (voir twpice)
     965           d_t_adv(l)=alpha*omega(l)/rcpd-ht_mod_cas(l)-d_t_dyn_z(l)
     966        endif
     967        print *,'interp_case d_t_dyn_z=',d_t_dyn_z(l),d_q_dyn_z(l)
     968
     969! Verifier le signe !!
     970        if (thadv.eq.1 .or. thadvh.eq.1) then
     971           d_th_adv(l)=dth_mod_cas(l)
     972           print *,'dthadv=',d_th_adv(l)*86400.
     973        else if (thadvv.eq.1) then
     974           d_th_adv(l)=hth_mod_cas(l)-d_th_dyn_z(l)
     975        endif
     976 
     977! Verifier le signe !!
     978        if ((qadv.eq.1).and.(forc_w.eq.0)) then
     979           d_q_adv(l,1)=dq_mod_cas(l)
     980        else if ((qadvh.eq.1).and.(forc_w.eq.1)) then
     981           d_q_adv(l,1)=hq_mod_cas(l)-d_q_dyn_z(l)
     982        endif
     983         
     984        if (trad.eq.1) then
     985           tend_rayo=1
     986           dt_cooling(l) = dtrad_mod_cas(l)
     987!          print *,'dt_cooling=',dt_cooling(l)
     988        else
     989           dt_cooling(l) = 0.0
     990        endif
     991      enddo
     992
     993! Faut-il multiplier par -1 ? (MPL 20160713)
     994      IF(ok_flux_surf) THEN
     995       fsens=-1.*sens_prof_cas
     996       flat=-1.*lat_prof_cas
     997       print *,'1D_interp: sens,flat',fsens,flat
     998      ENDIF
     999!
     1000      IF (ok_prescr_ust) THEN
     1001       ust=ustar_prof_cas
     1002       print *,'ust=',ust
     1003      ENDIF
     1004      endif ! forcing_case2
     1005!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1006

  • LMDZ5/branches/testing/libf/phylmd/dyn1d/1D_read_forc_cases.h

    r2408 r2720  
    367367      fich_dice='dice_driver.nc'
    368368      call read_dice(fich_dice,nlev_dice,nt_dice                    &
    369      &     ,zz_dice,plev_dice,th_dice,qv_dice,u_dice,v_dice,o3_dice &
     369     &     ,zz_dice,plev_dice,t_dice,qv_dice,u_dice,v_dice,o3_dice &
    370370     &     ,shf_dice,lhf_dice,lwup_dice,swup_dice,tg_dice,ustar_dice&
    371371     &     ,psurf_dice,ug_dice,vg_dice,ht_dice,hq_dice              &
    … …  
    376376!champs initiaux:
    377377      do k=1,nlev_dice
    378          th_dicei(k)=th_dice(k)
     378         t_dicei(k)=t_dice(k)
    379379         qv_dicei(k)=qv_dice(k)
    380380         u_dicei(k)=u_dice(k)
    … …  
    405405
    406406      CALL interp_dice_vertical(play,nlev_dice,nt_dice,plev_dice       &
    407      &         ,th_dicei,qv_dicei,u_dicei,v_dicei,o3_dicei             &
     407     &         ,t_dicei,qv_dicei,u_dicei,v_dicei,o3_dicei             &
    408408     &         ,ht_dicei,hq_dicei,hu_dicei,hv_dicei,w_dicei,omega_dicei&
    409      &         ,th_mod,qv_mod,u_mod,v_mod,o3_mod                       &
     409     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                       &
    410410     &         ,ht_mod,hq_mod,hu_mod,hv_mod,w_mod,omega_mod,mxcalc)
    411411
    … …  
    425425      do l = 1, llm
    426426! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
    427        temp(l) = th_mod(l)*(play(l)/pzero)**rkappa
    428 !      temp(l) = t_mod(l)
     427!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa
     428       temp(l) = t_mod(l)
    429429       q(l,1) = qv_mod(l)
    430430       q(l,2) = 0.0
    … …  
    473473!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    474474!---------------------------------------------------------------------
     475! Forcing from GABLS4 experiment
     476!---------------------------------------------------------------------
     477
     478!!!! Si la temperature de surface n'est pas impos??e:
     479 
     480      if (forcing_gabls4) then
     481!read GABLS4 forcings
     482     
     483      fich_gabls4='gabls4_driver.nc'
     484     
     485       
     486      call read_gabls4(fich_gabls4,nlev_gabls4,nt_gabls4,nsol_gabls4,zz_gabls4,depth_sn_gabls4,ug_gabls4,vg_gabls4 &
     487     & ,plev_gabls4,th_gabls4,t_gabls4,qv_gabls4,u_gabls4,v_gabls4,ht_gabls4,hq_gabls4,tg_gabls4,tsnow_gabls4,snow_dens_gabls4)
     488
     489      write(*,*) 'Forcing GABLS4 lu'
     490
     491!champs initiaux:
     492      do k=1,nlev_gabls4
     493         t_gabi(k)=t_gabls4(k)
     494         qv_gabi(k)=qv_gabls4(k)
     495         u_gabi(k)=u_gabls4(k)
     496         v_gabi(k)=v_gabls4(k)
     497         poub(k)=0.
     498         ht_gabi(k)=ht_gabls4(k,1)
     499         hq_gabi(k)=hq_gabls4(k,1)
     500         ug_gabi(k)=ug_gabls4(k,1)
     501         vg_gabi(k)=vg_gabls4(k,1)
     502      enddo
     503 
     504      omega(:)=0.     
     505      omega2(:)=0.
     506      rho(:)=0.
     507! vertical interpolation using TOGA interpolation routine:
     508!      write(*,*)'avant interp vert', t_proftwp
     509!
     510!     CALL interp_dice_time(daytime,day1,annee_ref
     511!    i             ,year_ini_dice,day_ju_ini_dice,nt_dice,dt_dice
     512!    i             ,nlev_dice,shf_dice,lhf_dice,lwup_dice,swup_dice
     513!    i             ,tg_dice,ustar_dice,psurf_dice,ug_dice,vg_dice
     514!    i             ,ht_dice,hq_dice,hu_dice,hv_dice,w_dice,omega_dice
     515!    o             ,shf_prof,lhf_prof,lwup_prof,swup_prof,tg_prof
     516!    o             ,ustar_prof,psurf_prof,ug_profd,vg_profd
     517!    o             ,ht_profd,hq_profd,hu_profd,hv_profd,w_profd
     518!    o             ,omega_profd)
     519
     520      CALL interp_dice_vertical(play,nlev_gabls4,nt_gabls4,plev_gabls4       &
     521     &         ,t_gabi,qv_gabi,u_gabi,v_gabi,poub                  &
     522     &         ,ht_gabi,hq_gabi,ug_gabi,vg_gabi,poub,poub          &
     523     &         ,t_mod,qv_mod,u_mod,v_mod,o3_mod                    &
     524     &         ,ht_mod,hq_mod,ug_mod,vg_mod,w_mod,omega_mod,mxcalc)
     525
     526! Les forcages GABLS4 ont l air d etre en K/S quoiqu en dise le fichier gabls4_driver.nc !? MPL 20141024
     527!     ht_mod(:)=ht_mod(:)/86400.
     528!     hq_mod(:)=hq_mod(:)/86400.
     529
     530! initial and boundary conditions :
     531      write(*,*) 'SST initiale mxcalc: ',tsurf,mxcalc
     532      do l = 1, llm
     533! Ligne du dessous ?? decommenter si on lit theta au lieu de temp
     534!      temp(l) = th_mod(l)*(play(l)/pzero)**rkappa
     535       temp(l) = t_mod(l)
     536       q(l,1) = qv_mod(l)
     537       q(l,2) = 0.0
     538!      print *,'read_forc: l,temp,q=',l,temp(l),q(l,1)
     539       u(l) = u_mod(l)
     540       v(l) = v_mod(l)
     541       ug(l)=ug_mod(l)
     542       vg(l)=vg_mod(l)
     543       
     544!
     545!       tg=tsurf
     546!       
     547
     548       print *,'***** tsurf=',tsurf
     549       rho(l)  = play(l)/(rd*temp(l)*(1.+(rv/rd-1.)*q(l,1)))
     550!      omega(l) = w_mod(l)*(-rg*rho(l))
     551       omega(l) = omega_mod(l)
     552       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     553       
     554   
     555
     556       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     557!on applique le forcage total au premier pas de temps
     558!attention: signe different de toga
     559!      d_th_adv(l) = alpha*omega(l)/rcpd+ht_mod(l)
     560!forcage en th
     561       d_th_adv(l) = ht_mod(l)
     562       d_q_adv(l,1) = hq_mod(l)
     563       d_q_adv(l,2) = 0.0
     564       dt_cooling(l)=0.
     565      enddo     
     566
     567!--------------- Residus forcages du cas Dice (a supprimer) MPL 20141024---------------
     568! Le cas Dice doit etre force avec ustar mais on peut simplifier en forcant par
     569! le coefficient de trainee en surface cd**2=ustar*vent(k=1)
     570! On commence ici a stocker ustar dans cdrag puis on terminera le calcul dans pbl_surface
     571! MPL 05082013
     572!     ust=ustar_dice(1)
     573!     tg=tg_dice(1)
     574!     print *,'ust= ',ust
     575!     IF (tsurf .LE. 0.) THEN
     576!      tsurf= tg_dice(1)
     577!     ENDIF
     578!     psurf= psurf_dice(1)
     579!     solsw_in = (1.-albedo)/albedo*swup_dice(1)
     580!     sollw_in = (0.7*RSIGMA*temp(1)**4)-lwup_dice(1)
     581!     PRINT *,'1D_READ_FORC : solsw, sollw',solsw_in,sollw_in
     582!--------------------------------------------------------------------------------------
     583      endif !forcing_gabls4
     584
     585
     586
    475587! Forcing from Arm_Cu case                   
    476588! For this case, ifa_armcu.txt contains sensible, latent heat fluxes
    … …  
    797909      endif !forcing_case
    798910!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     911!---------------------------------------------------------------------
     912! Forcing from standard case :
     913!---------------------------------------------------------------------
     914
     915      if (forcing_case2) then
     916
     917         write(*,*),'avant call read2_1D_cas'
     918         call read2_1D_cas
     919         write(*,*) 'Forcing read'
     920
     921!Time interpolation for initial conditions using interpolation routine
     922         write(*,*) 'AVT 1ere INTERPOLATION: day,day1 = ',daytime,day1   
     923        CALL interp2_case_time(daytime,day1,annee_ref                                       &
     924!    &       ,year_ini_cas,day_ju_ini_cas,nt_cas,pdt_cas,nlev_cas                           &
     925     &       ,nt_cas,nlev_cas                                                               &
     926     &       ,ts_cas,ps_cas,plev_cas,t_cas,th_cas,thv_cas,thl_cas,qv_cas,ql_cas,qi_cas      &
     927     &       ,u_cas,v_cas,ug_cas,vg_cas,vitw_cas,omega_cas,du_cas,hu_cas,vu_cas             &
     928     &       ,dv_cas,hv_cas,vv_cas,dt_cas,ht_cas,vt_cas,dtrad_cas                           &
     929     &       ,dq_cas,hq_cas,vq_cas,dth_cas,hth_cas,vth_cas,lat_cas,sens_cas,ustar_cas       &
     930     &       ,uw_cas,vw_cas,q1_cas,q2_cas,tke_cas                                           &
     931!
     932     &       ,ts_prof_cas,plev_prof_cas,t_prof_cas,theta_prof_cas,thv_prof_cas  &
     933     &       ,thl_prof_cas,qv_prof_cas,ql_prof_cas,qi_prof_cas                              &
     934     &       ,u_prof_cas,v_prof_cas,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas    &
     935     &       ,du_prof_cas,hu_prof_cas,vu_prof_cas                                           &
     936     &       ,dv_prof_cas,hv_prof_cas,vv_prof_cas,dt_prof_cas,ht_prof_cas,vt_prof_cas       &
     937     &       ,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas                            &
     938     &       ,dth_prof_cas,hth_prof_cas,vth_prof_cas,lat_prof_cas                           &
     939     &       ,sens_prof_cas,ustar_prof_cas,uw_prof_cas,vw_prof_cas,q1_prof_cas,q2_prof_cas,tke_prof_cas)
     940
     941      do l = 1, nlev_cas
     942      print *,'apres 1ere interp: plev_cas, plev_prof_cas=',l,plev_cas(l,1),plev_prof_cas(l)
     943      enddo
     944
     945! vertical interpolation using interpolation routine:
     946!      write(*,*)'avant interp vert', t_prof
     947      CALL interp2_case_vertical(play,nlev_cas,plev_prof_cas                                              &
     948     &         ,t_prof_cas,theta_prof_cas,thv_prof_cas,thl_prof_cas                                          &
     949     &         ,qv_prof_cas,ql_prof_cas,qi_prof_cas,u_prof_cas,v_prof_cas                                 &
     950     &         ,ug_prof_cas,vg_prof_cas,vitw_prof_cas,omega_prof_cas                                      &
     951     &         ,du_prof_cas,hu_prof_cas,vu_prof_cas,dv_prof_cas,hv_prof_cas,vv_prof_cas                   &
     952     &         ,dt_prof_cas,ht_prof_cas,vt_prof_cas,dtrad_prof_cas,dq_prof_cas,hq_prof_cas,vq_prof_cas    &
     953     &         ,dth_prof_cas,hth_prof_cas,vth_prof_cas                                                    &
     954!
     955     &         ,t_mod_cas,theta_mod_cas,thv_mod_cas,thl_mod_cas,qv_mod_cas,ql_mod_cas,qi_mod_cas          &
     956     &         ,u_mod_cas,v_mod_cas,ug_mod_cas,vg_mod_cas,w_mod_cas,omega_mod_cas                         &
     957     &         ,du_mod_cas,hu_mod_cas,vu_mod_cas,dv_mod_cas,hv_mod_cas,vv_mod_cas                         &
     958     &         ,dt_mod_cas,ht_mod_cas,vt_mod_cas,dtrad_mod_cas,dq_mod_cas,hq_mod_cas,vq_mod_cas           &
     959     &         ,dth_mod_cas,hth_mod_cas,vth_mod_cas,mxcalc)
     960
     961!       write(*,*) 'Profil initial forcing case interpole',t_mod
     962
     963! initial and boundary conditions :
     964!      tsurf = ts_prof_cas
     965      ts_cur = ts_prof_cas
     966      psurf=plev_prof_cas(1)
     967      write(*,*) 'SST initiale: ',tsurf
     968      do l = 1, llm
     969       temp(l) = t_mod_cas(l)
     970       q(l,1) = qv_mod_cas(l)
     971       q(l,2) = ql_mod_cas(l)
     972       u(l) = u_mod_cas(l)
     973       ug(l)= u_mod_cas(l)
     974       v(l) = v_mod_cas(l)
     975       vg(l)= v_mod_cas(l)
     976       omega(l) = w_mod_cas(l)
     977       omega2(l)=omega(l)/rg*airefi ! flxmass_w calcule comme ds physiq
     978
     979       alpha = rd*temp(l)*(1.+(rv/rd-1.)*q(l,1))/play(l)
     980!on applique le forcage total au premier pas de temps
     981!attention: signe different de toga
     982       d_th_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
     983       d_t_adv(l) = alpha*omega(l)/rcpd+(ht_mod_cas(l)+vt_mod_cas(l))
     984!      d_q_adv(l,1) = (hq_mod_cas(l)+vq_mod_cas(l))
     985       d_q_adv(l,1) = dq_mod_cas(l)
     986       d_q_adv(l,2) = 0.0
     987!      d_u_adv(l) = (hu_mod_cas(l)+vu_mod_cas(l))
     988       d_u_adv(l) = du_mod_cas(l)
     989!      d_u_adv(l) = (hv_mod_cas(l)+vv_mod_cas(l))
     990       d_u_adv(l) = dv_mod_cas(l)
     991      enddo     
     992
     993! Faut-il multiplier par -1 ? (MPL 20160713)
     994       IF (ok_flux_surf) THEN
     995       fsens=-1.*sens_prof_cas
     996       flat=-1.*lat_prof_cas
     997       ENDIF
     998!
     999       IF (ok_prescr_ust) THEN
     1000       ust=ustar_prof_cas
     1001       print *,'ust=',ust
     1002       ENDIF
     1003
     1004      endif !forcing_case2
     1005!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1006

  • LMDZ5/branches/testing/libf/phylmd/dyn1d/compar1d.h

    r2408 r2720  
    99      real :: tsurf
    1010      real :: rugos
     11      real :: rugosh
    1112      real :: xqsol(1:2)
    1213      real :: qsurf
    … …  
    1415      real :: zsurf
    1516      real :: albedo
     17      real :: snowmass
    1618
    1719      real :: time
    … …  
    3032      logical :: ok_old_disvert
    3133
     34! Pour les forcages communs: ces entiers valent 0 ou 1
     35! tadv= advection tempe, tadvv= adv tempe verticale, tadvh= adv tempe horizontale
     36! idem pour l advection en theta
     37! qadv= advection q, qadvv= adv q verticale, qadvh= adv q horizontale
     38! trad= 0 (rayonnement actif) ou 1 (prescrit par tend_rad) ou adv (prescir et contenu dans les tadv)
     39! forcages en omega, w, vent geostrophique ou ustar
     40! Parametres de nudging en u,v,t,q valent 0 ou 1 ou le temps de nudging
     41
     42      integer :: tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh, trad
     43      integer :: forc_omega, forc_w, forc_geo, forc_ustar
     44      real    :: nudging_u, nudging_v, nudging_w, nudging_t, nudging_q
    3245      common/com_par1d/                                                 &
    33      & nat_surf,tsurf,rugos,                                            &
     46     & nat_surf,tsurf,rugos,rugosh,                                     &
    3447     & xqsol,qsurf,psurf,zsurf,albedo,time,time_ini,xlat,xlon,airefi,   &
    3548     & wtsurf,wqsurf,restart_runoff,xagesno,qsolinp,zpicinp,            &
    3649     & forcing_type,tend_u,tend_v,tend_w,tend_t,tend_q,tend_rayo,       &
    3750     & nudge_u,nudge_v,nudge_w,nudge_t,nudge_q,                         &
    38      & iflag_nudge,                                                     &
    39      & restart,ok_old_disvert
     51     & iflag_nudge,snowmass,                                            &
     52     & restart,ok_old_disvert,                                          &
     53     & tadv, tadvv, tadvh, qadv, qadvv, qadvh, thadv, thadvv, thadvh,   &
     54     & trad, forc_omega, forc_w, forc_geo, forc_ustar,                  &
     55     & nudging_u, nudging_v, nudging_t, nudging_q
    4056
    4157!$OMP THREADPRIVATE(/com_par1d/)
    … …  
    5066
    5167
     68

  • LMDZ5/branches/testing/libf/phylmd/dyn1d/lmdz1d.F90

    r2641 r2720  
    2121       zgam, zmax0, zmea, zpic, zsig, &
    2222       zstd, zthe, zval, ale_bl, ale_bl_trig, alp_bl
     23 
    2324   USE dimphy
    2425   USE surface_data, only : type_ocean,ok_veget
    … …  
    3132   USE indice_sol_mod
    3233   USE phyaqua_mod
    33    USE mod_1D_cases_read
     34!  USE mod_1D_cases_read
     35   USE mod_1D_cases_read2
    3436   USE mod_1D_amma_read
    3537   USE print_control_mod, ONLY: lunout, prt_level
    … …  
    131133        logical :: forcing_amma    = .false.
    132134        logical :: forcing_dice    = .false.
     135        logical :: forcing_gabls4  = .false.
     136
    133137        logical :: forcing_GCM2SCM = .false.
    134138        logical :: forcing_GCSSold = .false.
    … …  
    137141        logical :: forcing_fire    = .false.
    138142        logical :: forcing_case    = .false.
     143        logical :: forcing_case2   = .false.
    139144        integer :: type_ts_forcing ! 0 = SST constant; 1 = SST read from a file
    140145!                                                            (cf read_tsurf1d.F)
    … …  
    174179      real :: pzero=1.e5
    175180      real :: play (llm),zlay (llm),sig_s(llm),plev(llm+1)
    176       real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1),poub
     181      real :: playd(llm),zlayd(llm),ap_amma(llm+1),bp_amma(llm+1)
    177182
    178183!---------------------------------------------------------------------
    … …  
    189194      real :: du_phys(llm),dv_phys(llm),dt_phys(llm)
    190195      real :: dt_dyn(llm)
    191       real :: dt_cooling(llm),d_th_adv(llm),d_t_nudge(llm)
     196      real :: dt_cooling(llm),d_t_adv(llm),d_th_adv(llm),d_t_nudge(llm)
    192197      real :: d_u_nudge(llm),d_v_nudge(llm)
    193198      real :: du_adv(llm),dv_adv(llm)
    … …  
    322327!             Different stages: soil model alone, atm. model alone
    323328!             then both models coupled
     329!forcing_type = 8 ==> forcing_gabls4 = .true.
     330!             initial profiles and large scale forcings in gabls4_driver.nc
    324331!forcing_type >= 100 ==> forcing_case = .true.
    325332!             initial profiles and large scale forcings in cas.nc
    … …  
    327334!             101=cindynamo
    328335!             102=bomex
     336!forcing_type >= 100 ==> forcing_case2 = .true.
     337!             temporary flag while all the 1D cases are not whith the same cas.nc forcing file
     338!             103=arm_cu2 ie arm_cu with new forcing format
     339!             104=rico2 ie rico with new forcing format
    329340!forcing_type = 40 ==> forcing_GCSSold = .true.
    330341!             initial profile from GCSS file
    … …  
    363374      elseif (forcing_type .eq.7) THEN
    364375       forcing_dice = .true.
     376      elseif (forcing_type .eq.8) THEN
     377       forcing_gabls4 = .true.
    365378      elseif (forcing_type .eq.101) THEN ! Cindynamo starts 1-10-2011 0h
    366379       forcing_case = .true.
    … …  
    375388       mth_ini_cas=6
    376389       day_deb=24
     390       heure_ini_cas=0.
     391       pdt_cas=1800.         ! forcing frequency
     392      elseif (forcing_type .eq.103) THEN ! Arm_cu starts 21-6-1997 11h30
     393       forcing_case2 = .true.
     394       year_ini_cas=1997
     395       mth_ini_cas=6
     396       day_deb=21
     397       heure_ini_cas=11.5
     398       pdt_cas=1800.         ! forcing frequency
     399      elseif (forcing_type .eq.104) THEN ! rico starts 16-12-2004 0h
     400       forcing_case2 = .true.
     401       year_ini_cas=2004
     402       mth_ini_cas=12
     403       day_deb=16
    377404       heure_ini_cas=0.
    378405       pdt_cas=1800.         ! forcing frequency
    … …  
    449476      endif
    450477      print *,'fnday=',fnday
    451 
     478!     start_time doit etre en FRACTION DE JOUR
    452479      start_time=time_ini/24.
    453480
    454481! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
    455482      IF(forcing_type .EQ. 61) fnday=53100./86400.
     483      IF(forcing_type .EQ. 103) fnday=53100./86400.
    456484! Special case for amma which lasts less than one day : 64800s !! (MPL 20120216)
    457485      IF(forcing_type .EQ. 6) fnday=64800./86400.
    458486!     IF(forcing_type .EQ. 6) fnday=50400./86400.
     487 IF(forcing_type .EQ. 8 ) fnday=129600./86400.
    459488      annee_ref = anneeref
    460489      mois = 1
    … …  
    487516     & (year_ini_dice,mth_ini_dice,day_ini_dice,heure_ini_dice             &
    488517     & ,day_ju_ini_dice)
     518 ELSEIF (forcing_type .eq.8 ) THEN
     519! Convert the initial date of GABLS4 to Julian day
     520      call ymds2ju                                                         &
     521     & (year_ini_gabls4,mth_ini_gabls4,day_ini_gabls4,heure_ini_gabls4     &
     522     & ,day_ju_ini_gabls4)
    489523      ELSEIF (forcing_type .gt.100) THEN
    490524! Convert the initial date to Julian day
    … …  
    492526      print*,'time case',year_ini_cas,mth_ini_cas,day_ini_cas
    493527      call ymds2ju                                                         &
    494      & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas              &
     528     & (year_ini_cas,mth_ini_cas,day_ini_cas,heure_ini_cas*3600            &
    495529     & ,day_ju_ini_cas)
    496530      print*,'time case 2',day_ini_cas,day_ju_ini_cas
    … …  
    514548      ENDIF
    515549
     550      IF (forcing_type .gt.100) THEN
     551      daytime = day + heure_ini_cas/24. ! 1st day and initial time of the simulation
     552      ELSE
    516553      daytime = day + time_ini/24. ! 1st day and initial time of the simulation
     554      ENDIF
    517555! Print out the actual date of the beginning of the simulation :
    518556      call ju2ymds(daytime,year_print, month_print,day_print,sec_print)
    … …  
    699737
    700738        fder=0.
    701         snsrf(1,:)=0.        ! couverture de neige des sous surface
     739        snsrf(1,:)=snowmass ! masse de neige des sous surface
    702740        qsurfsrf(1,:)=qsurf ! humidite de l'air des sous surface
    703741        fevap=0.
    704742        z0m(1,:)=rugos     ! couverture de neige des sous surface
    705         z0h(1,:)=rugos     ! couverture de neige des sous surface
     743        z0h(1,:)=rugosh    ! couverture de neige des sous surface
    706744        agesno  = xagesno
    707745        tsoil(:,:,:)=tsurf
    … …  
    726764        print*,'avant phyredem'
    727765        pctsrf(1,:)=0.
    728         if (nat_surf.eq.0.) then
     766          if (nat_surf.eq.0.) then
    729767          pctsrf(1,is_oce)=1.
    730768          pctsrf(1,is_ter)=0.
    731         else
     769          pctsrf(1,is_lic)=0.
     770          pctsrf(1,is_sic)=0.
     771        else if (nat_surf .eq. 1) then
    732772          pctsrf(1,is_oce)=0.
    733773          pctsrf(1,is_ter)=1.
    734         end if
     774          pctsrf(1,is_lic)=0.
     775          pctsrf(1,is_sic)=0.
     776        else if (nat_surf .eq. 2) then
     777          pctsrf(1,is_oce)=0.
     778          pctsrf(1,is_ter)=0.
     779          pctsrf(1,is_lic)=1.
     780          pctsrf(1,is_sic)=0.
     781        else if (nat_surf .eq. 3) then
     782          pctsrf(1,is_oce)=0.
     783          pctsrf(1,is_ter)=0.
     784          pctsrf(1,is_lic)=0.
     785          pctsrf(1,is_sic)=1.
     786
     787     end if
     788
    735789
    736790        print*,'nat_surf,pctsrf(1,is_oce),pctsrf(1,is_ter)',nat_surf         &
    … …  
    10051059
    10061060       if (forcing_toga .or. forcing_GCSSold .or. forcing_twpice            &
    1007      &    .or.forcing_amma) then
     1061     &    .or.forcing_amma .or. forcing_type.eq.101) then
    10081062         fcoriolis=0.0 ; ug=0. ; vg=0.
    10091063       endif
    1010          if(forcing_rico) then
     1064
     1065       if(forcing_rico) then
    10111066          dt_cooling=0.
    1012         endif
     1067       endif
    10131068
    10141069      IF (prt_level >= 5) print*, 'fcoriolis, xlat,mxcalc ', &
    … …  
    11721227!#endif
    11731228
     1229

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

    r2687 r2720  
    1515  USE icefrac_lsc_mod ! compute ice fraction (JBM 3/14)
    1616  USE print_control_mod, ONLY: prt_level, lunout
     17  USE cloudth_mod
     18  USE ioipsl_getin_p_mod, ONLY : getin_p
    1719  IMPLICIT none
    1820  !======================================================================
    … …  
    145147  !$OMP THREADPRIVATE(appel1er)
    146148  !
     149! iflag_oldbug_fisrtilp=0 enleve le BUG par JYG : tglace_min -> tglace_max
     150! iflag_oldbug_fisrtilp=1 ajoute le BUG
     151  INTEGER,SAVE :: iflag_oldbug_fisrtilp=0 !=0 sans bug
     152  !$OMP THREADPRIVATE(iflag_oldbug_fisrtilp)
    147153  !---------------------------------------------------------------
    148154  !
    … …  
    188194  if (prt_level>9)write(lunout,*)'NUAGES4 A. JAM'
    189195  IF (appel1er) THEN
     196     CALL getin_p('iflag_oldbug_fisrtilp',iflag_oldbug_fisrtilp)
     197     write(lunout,*)' iflag_oldbug_fisrtilp =',iflag_oldbug_fisrtilp
    190198     !
    191199     WRITE(lunout,*) 'fisrtilp, ninter:', ninter
    … …  
    574582           if (iflag_cld_th>=5) then
    575583
    576               call cloudth(klon,klev,k,ztv, &
     584              if (iflag_cloudth_vert<=2) then
     585               call cloudth(klon,klev,k,ztv, &
    577586                   zq,zqta,fraca, &
    578587                   qcloud,ctot,zpspsk,paprs,ztla,zthl, &
    579588                   ratqs,zqs,t)
    580 
     589              elseif (iflag_cloudth_vert==3) then
     590               call cloudth_v3(klon,klev,k,ztv, &
     591                   zq,zqta,fraca, &
     592                   qcloud,ctot,zpspsk,paprs,ztla,zthl, &
     593                   ratqs,zqs,t)
     594              endif
    581595              do i=1,klon
    582596                 rneb(i,k)=ctot(i,k)
    … …  
    624638                    zdelta = MAX(0.,SIGN(1.,t_glace_min_old-Tbef(i)))
    625639                    else if (iflag_t_glace.ge.1) then
    626                     zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
    627 ! BUG corrige par JYG   zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
     640                       if (iflag_oldbug_fisrtilp.EQ.0) then
     641                          zdelta = MAX(0.,SIGN(1.,t_glace_max-Tbef(i)))
     642                       else
     643!avec bug : zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
     644                          zdelta = MAX(0.,SIGN(1.,t_glace_min-Tbef(i)))
     645                       endif
    628646                    endif
    629647                 endif

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

    r2408 r2720  
    120120
    121121   
    122     RDISS = 1. ! Diffusion parameter
     122    RDISS = 0.5 ! Diffusion parameter
    123123    ! ONLINE
    124124      RUWMAX=GWD_RANDO_RUWMAX
    … …  
    346346          ! No breaking (Eq.6)
    347347          ! Dissipation (Eq. 8)
    348           WWP(JW, :) = WWM(JW, :) * EXP(- 2. * RDISS * PR / (PH(:, LL + 1) &
     348          WWP(JW, :) = WWM(JW, :) * EXP(- 4. * RDISS * PR / (PH(:, LL + 1) &
    349349               + PH(:, LL)) * ((BV(:, LL + 1) + BV(:, LL)) / 2.)**3 &
    350350               / MAX(ABS(ZOP(JW, :) + ZOM(JW, :)) / 2., ZOISEC)**4 &

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

    r2594 r2720  
    66  USE assert_eq_m,       ONLY: assert_eq
    77  PRIVATE
    8   PUBLIC :: grid_noro, grid_noro0
     8  PUBLIC :: grid_noro, grid_noro0, read_noro
    99
    1010
    … …  
    7171! CORRELATIONS OF USN OROGRAPHY GRADIENTS         ! dim (imar+2*iext,jmdp+2)
    7272  REAL, ALLOCATABLE :: zxtzxusn(:,:), zytzyusn(:,:), zxtzyusn(:,:)
    73   REAL, ALLOCATABLE :: mask_tmp(:,:), zmea0(:,:)  ! dim (imar+1,jmar)
    74   REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imax,jmax)
    75   REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imax)
    76   REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmax)
     73  REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imar+1,jmar)
     74  REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imar+1)
     75  REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmar)
    7776  LOGICAL :: masque_lu
    7877  INTEGER :: i, ii, imdp, imar, iext
    7978  INTEGER :: j, jj, jmdp, jmar, nn
    80   REAL    :: xpi, zdeltax, zlenx, weighx, xincr,  zmeanor0
    81   REAL    :: rad, zdeltay, zleny, weighy, masque, zmeasud0
    82   REAL    :: zbordnor, zmeanor, zstdnor, zsignor, zweinor, zpicnor, zvalnor
    83   REAL    :: zbordsud, zmeasud, zstdsud, zsigsud, zweisud, zpicsud, zvalsud
    84   REAL    :: zbordest, zbordoue, xk, xl, xm, xp, xq, xw
     79  REAL    :: xpi, zdeltax, zlenx, weighx, xincr,  zweinor, xk, xl, xm
     80  REAL    :: rad, zdeltay, zleny, weighy, masque, zweisud, xp, xq, xw
     81
     82
     83
    8584!-------------------------------------------------------------------------------
    8685  imdp=assert_eq(SIZE(xd),SIZE(zd,1),TRIM(modname)//" imdp")
    … …  
    170169    DO jj = 1, jmar
    171170      DO j = 2,jmdp+1
    172         zlenx  =zleny  *COS(yusn(j))
     171        zlenx=zleny*COS(yusn(j))
    173172        zdeltax=zdeltay*COS(yusn(j))
    174         zbordnor=(xincr+c(jj)-yusn(j))*rad
    175         zbordsud=(xincr-d(jj)+yusn(j))*rad
    176         weighy=AMAX1(0.,AMIN1(zbordnor,zbordsud,zleny))
     173        weighy=(xincr+AMIN1(c(jj)-yusn(j),yusn(j)-d(jj)))*rad
     174        weighy=AMAX1(0.,AMIN1(weighy,zleny))
     175
    177176        IF(weighy==0.) CYCLE
    178177        DO i = 2, imdp+2*iext-1
    179           zbordest=(xusn(i)-a(ii)+xincr)*rad*COS(yusn(j))
    180           zbordoue=(b(ii)+xincr-xusn(i))*rad*COS(yusn(j))
    181           weighx=AMAX1(0.,AMIN1(zbordest,zbordoue,zlenx))
     178          weighx=(xincr+AMIN1(xusn(i)-a(ii),b(ii)-xusn(i)))*rad*COS(yusn(j))
     179          weighx=AMAX1(0.,AMIN1(weighx,zlenx))
     180
    182181          IF(weighx==0.) CYCLE
    183182          num_tot(ii,jj)=num_tot(ii,jj)+1.0
    … …  
    198197!--- COMPUTE PARAMETERS NEEDED BY LOTT & MILLER (1997) AND LOTT (1999) SSO SCHEME
    199198  IF(.NOT.masque_lu) THEN
    200     WHERE(weight(:,1:jmar-1)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
     199    WHERE(weight(:,:)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
    201200  END IF
    202   nn=COUNT(weight(:,1:jmar-1)==0.0)
     201  nn=COUNT(weight(:,:)==0.0)
    203202  IF(nn/=0) WRITE(lunout,*)'Problem with weight ; vanishing occurrences: ',nn
    204203  WHERE(weight(:,:)/=0.0)
    … …  
    224223!--- FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
    225224!-------------------------------------------------------------------------------
    226   ALLOCATE(zmea0(imar+1,jmar))
    227   zmea0(:,:)=zmea(:,:)                           ! GK211005 (CG) UNSMOOTHED TOPO
     225  zphi(:,:)=zmea(:,:)                           ! GK211005 (CG) UNSMOOTHED TOPO
     226
    228227  CALL MVA9(zmea);  CALL MVA9(zstd);  CALL MVA9(zpic);  CALL MVA9(zval)
    229228  CALL MVA9(zxtzx); CALL MVA9(zxtzy); CALL MVA9(zytzy)
    230229
    231230!--- MASK BASED ON GROUND MAXIMUM, 10% THRESHOLD. (SURFACE PARAMS MEANINGLESS)
    232   ALLOCATE(mask_tmp(imar+1,jmar)); mask_tmp(:,:)=0.0
    233   WHERE(mask>=0.1) mask_tmp = 1.
    234   WHERE(weight(:,:)/=0.0)
    235 !   zphi (:,:)= mask_tmp(:,:)*zmea (:,:) ! GK211005 (CG) not necessarly smoothed
    236     zphi (:,:)= mask_tmp(:,:)*zmea0(:,:)
    237     zmea0(:,:)= mask_tmp(:,:)*zmea0(:,:)
    238     zmea (:,:)= mask_tmp(:,:)*zmea (:,:)
    239     zpic (:,:)= mask_tmp(:,:)*zpic (:,:)
    240     zval (:,:)= mask_tmp(:,:)*zval (:,:)
    241     zstd (:,:)= mask_tmp(:,:)*zstd (:,:)
     231  WHERE(weight(:,:)==0.0.OR.mask<0.1)
     232    zphi(:,:)=0.0; zmea(:,:)=0.0; zpic(:,:)=0.0; zval(:,:)=0.0; zstd(:,:)=0.0
    242233  END WHERE
    243234  DO ii = 1, imar
    244235    DO jj = 1, jmar
    245       IF (weight(ii,jj)/=0.0) THEN
    246       !--- Coefficients K, L et M:
    247         xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
    248         xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
    249         xm=zxtzy(ii,jj)
    250         xp=xk-SQRT(xl**2+xm**2)
    251         xq=xk+SQRT(xl**2+xm**2)
    252         xw=1.e-8
    253         IF(xp<=xw) xp=0.
    254         IF(xq<=xw) xq=xw
    255         IF(ABS(xm)<=xw) xm=xw*SIGN(1.,xm)
    256       !--- SLOPE
    257         zsig(ii,jj)=SQRT(xq)*mask_tmp(ii,jj)
    258       !---ISOTROPY
    259         zgam(ii,jj)=xp/xq*mask_tmp(ii,jj)
    260       !--- THETA ANGLE
    261         zthe(ii,jj)=57.29577951*ATAN2(xm,xl)/2.*mask_tmp(ii,jj)
    262       END IF
     236      IF(weight(ii,jj)==0.0) CYCLE
     237    !--- Coefficients K, L et M:
     238      xk=(zxtzx(ii,jj)+zytzy(ii,jj))/2.
     239      xl=(zxtzx(ii,jj)-zytzy(ii,jj))/2.
     240      xm=zxtzy(ii,jj)
     241      xp=xk-SQRT(xl**2+xm**2)
     242      xq=xk+SQRT(xl**2+xm**2)
     243      xw=1.e-8
     244      IF(xp<=xw) xp=0.
     245      IF(xq<=xw) xq=xw
     246      IF(ABS(xm)<=xw) xm=xw*SIGN(1.,xm)
     247    !--- SLOPE, ANISOTROPY AND THETA ANGLE
     248      zsig(ii,jj)=SQRT(xq)
     249      zgam(ii,jj)=xp/xq
     250      zthe(ii,jj)=90.*ATAN2(xm,xl)/xpi
    263251    END DO
    264252  END DO
     253  WHERE(weight(:,:)==0.0.OR.mask<0.1)
     254    zsig(:,:)=0.0; zgam(:,:)=0.0; zthe(:,:)=0.0
     255  END WHERE
     256
    265257  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zmea)
    266258  WRITE(lunout,*)'  ST. DEV.:' ,MAXVAL(zstd)
    … …  
    271263  WRITE(lunout,*)'  val:'      ,MAXVAL(zval)
    272264     
    273 !--- Values at poles
    274   zmea0(imar+1,:)=zmea0(1,:)
    275   zmea (imar+1,:)=zmea (1,:)
    276   zphi (imar+1,:)=zphi (1,:)
    277   zpic (imar+1,:)=zpic (1,:)
    278   zval (imar+1,:)=zval (1,:)
    279   zstd (imar+1,:)=zstd (1,:)
    280   zsig (imar+1,:)=zsig (1,:)
    281   zgam (imar+1,:)=zgam (1,:)
    282   zthe (imar+1,:)=zthe (1,:)
    283 
    284   zweinor =SUM(weight(1:imar,   1),DIM=1)
    285   zweisud =SUM(weight(1:imar,jmar),DIM=1)
    286   zmeanor0=SUM(weight(1:imar,   1)*zmea0(1:imar,   1),DIM=1)
    287   zmeasud0=SUM(weight(1:imar,jmar)*zmea0(1:imar,jmar),DIM=1)
    288   zmeanor =SUM(weight(1:imar,   1)*zmea (1:imar,   1),DIM=1)
    289   zmeasud =SUM(weight(1:imar,jmar)*zmea (1:imar,jmar),DIM=1)
    290   zstdnor =SUM(weight(1:imar,   1)*zstd (1:imar,   1),DIM=1)
    291   zstdsud =SUM(weight(1:imar,jmar)*zstd (1:imar,jmar),DIM=1)
    292   zsignor =SUM(weight(1:imar,   1)*zsig (1:imar,   1),DIM=1)
    293   zsigsud =SUM(weight(1:imar,jmar)*zsig (1:imar,jmar),DIM=1)
    294   zpicnor =SUM(weight(1:imar,   1)*zpic (1:imar,   1),DIM=1)
    295   zpicsud =SUM(weight(1:imar,jmar)*zpic (1:imar,jmar),DIM=1)
    296   zvalnor =SUM(weight(1:imar,   1)*zval (1:imar,   1),DIM=1)
    297   zvalsud =SUM(weight(1:imar,jmar)*zval (1:imar,jmar),DIM=1)
    298 
    299   zmea(:,1)=zmeanor /zweinor; zmea(:,jmar)=zmeasud /zweisud
    300 !  zphi(:,1)=zmeanor0/zweinor; zphi(:,jmar)=zmeasud0/zweisud   TO COMMIT
    301   zphi(:,1)=zmeanor /zweinor; zphi(:,jmar)=zmeasud /zweisud
    302   zpic(:,1)=zpicnor /zweinor; zpic(:,jmar)=zpicsud /zweisud
    303   zval(:,1)=zvalnor /zweinor; zval(:,jmar)=zvalsud /zweisud
    304   zstd(:,1)=zstdnor /zweinor; zstd(:,jmar)=zstdsud /zweisud
    305   zsig(:,1)=zsignor /zweinor; zsig(:,jmar)=zsigsud /zweisud
    306   zgam(:,1)=1.;               zgam(:,jmar)=1.
    307   zthe(:,1)=0.;               zthe(:,jmar)=0.
     265!--- Values at redundant longitude
     266  zmea(imar+1,:)=zmea(1,:)
     267  zphi(imar+1,:)=zphi(1,:)
     268  zpic(imar+1,:)=zpic(1,:)
     269  zval(imar+1,:)=zval(1,:)
     270  zstd(imar+1,:)=zstd(1,:)
     271  zsig(imar+1,:)=zsig(1,:)
     272  zgam(imar+1,:)=zgam(1,:)
     273  zthe(imar+1,:)=zthe(1,:)
     274
     275!--- Values at north pole
     276  zweinor  =SUM(weight(1:imar,1))
     277  zmea(:,1)=SUM(weight(1:imar,1)*zmea(1:imar,1))/zweinor
     278  zphi(:,1)=SUM(weight(1:imar,1)*zphi(1:imar,1))/zweinor
     279  zpic(:,1)=SUM(weight(1:imar,1)*zpic(1:imar,1))/zweinor
     280  zval(:,1)=SUM(weight(1:imar,1)*zval(1:imar,1))/zweinor
     281  zstd(:,1)=SUM(weight(1:imar,1)*zstd(1:imar,1))/zweinor
     282  zsig(:,1)=SUM(weight(1:imar,1)*zsig(1:imar,1))/zweinor
     283  zgam(:,1)=1.; zthe(:,1)=0.
     284
     285!--- Values at south pole
     286  zweisud     =SUM(weight(1:imar,jmar),DIM=1)
     287  zmea(:,jmar)=SUM(weight(1:imar,jmar)*zmea(1:imar,jmar))/zweisud
     288  zphi(:,jmar)=SUM(weight(1:imar,jmar)*zphi(1:imar,jmar))/zweisud
     289  zpic(:,jmar)=SUM(weight(1:imar,jmar)*zpic(1:imar,jmar))/zweisud
     290  zval(:,jmar)=SUM(weight(1:imar,jmar)*zval(1:imar,jmar))/zweisud
     291  zstd(:,jmar)=SUM(weight(1:imar,jmar)*zstd(1:imar,jmar))/zweisud
     292  zsig(:,jmar)=SUM(weight(1:imar,jmar)*zsig(1:imar,jmar))/zweisud
     293  zgam(:,jmar)=1.; zthe(:,jmar)=0.
    308294
    309295END SUBROUTINE grid_noro
    … …  
    323309!-------------------------------------------------------------------------------
    324310! Arguments:
    325   REAL, INTENT(IN)   :: xd(:), yd(:) !--- INPUT  COORDINATES     (imdp) (jmdp)
    326   REAL, INTENT(IN)   :: zd(:,:)      !--- INPUT  FIELD           (imdp,jmdp)
    327   REAL, INTENT(IN)   :: x(:), y(:)   !--- OUTPUT COORDINATES     (imar+1) (jmar)
    328   REAL, INTENT(OUT)  :: zphi(:,:)    !--- GEOPOTENTIAL           (imar+1,jmar)
    329   REAL, INTENT(INOUT):: mask(:,:)    !--- MASK                   (imar+1,jmar)
     311  REAL, INTENT(IN)  :: xd(:), yd(:) !--- INPUT  COORDINATES     (imdp) (jmdp)
     312  REAL, INTENT(IN)  :: zd(:,:)      !--- INPUT  FIELD           (imdp,  jmdp)
     313  REAL, INTENT(IN)  :: x(:), y(:)   !--- OUTPUT COORDINATES     (imar+1) (jmar)
     314  REAL, INTENT(OUT) :: zphi(:,:)    !--- GEOPOTENTIAL           (imar+1,jmar)
     315  REAL, INTENT(OUT) :: mask(:,:)    !--- MASK                   (imar+1,jmar)
    330316!-------------------------------------------------------------------------------
    331317! Local variables:
    332318  CHARACTER(LEN=256) :: modname="grid_noro0"
    333319  REAL, ALLOCATABLE :: xusn(:), yusn(:)           ! dim (imdp+2*iext) (jmdp+2)
    334   REAL, ALLOCATABLE :: zusn(:,:)                  ! dim (imdp+2*iext,jmdp+2)
     320  REAL, ALLOCATABLE :: zusn(:,:)                  ! dim (imdp+2*iext,  jmdp+2)
    335321  REAL, ALLOCATABLE :: weight(:,:)                ! dim (imar+1,jmar)
    336   REAL, ALLOCATABLE :: mask_tmp(:,:), zmea(:,:)  ! dim (imar+1,jmar)
    337   REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imax,jmax)
    338   REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imax)
    339   REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmax)
     322  REAL, ALLOCATABLE :: num_tot(:,:), num_lan(:,:) ! dim (imar+1,jmar)
     323  REAL, ALLOCATABLE :: a(:), b(:)                 ! dim (imar+1)
     324  REAL, ALLOCATABLE :: c(:), d(:)                 ! dim (jmar)
     325
    340326  LOGICAL :: masque_lu
    341327  INTEGER :: i, ii, imdp, imar, iext
    342328  INTEGER :: j, jj, jmdp, jmar, nn
    343   REAL    :: xpi, zlenx, weighx, xincr,  zbordnor, zmeanor, zweinor, zbordest
    344   REAL    :: rad, zleny, weighy, masque, zbordsud, zmeasud, zweisud, zbordoue
     329  REAL    :: xpi, zlenx, zleny, weighx, weighy, xincr, masque, rad
     330
    345331!-------------------------------------------------------------------------------
    346332  imdp=assert_eq(SIZE(xd),SIZE(zd,1),TRIM(modname)//" imdp")
    … …  
    392378
    393379!--- INITIALIZATIONS:
    394   ALLOCATE(weight(imar+1,jmar)); weight(:,:)= 0.0
    395   ALLOCATE(zmea  (imar+1,jmar)); zmea  (:,:)= 0.0
     380  ALLOCATE(weight(imar+1,jmar)); weight(:,:)=0.0; zphi(:,:)=0.0
    396381
    397382!--- SUMMATION OVER GRIDPOINT AREA
    … …  
    403388    DO jj = 1, jmar
    404389      DO j = 2,jmdp+1
    405         zlenx  =zleny  *COS(yusn(j))
    406         zbordnor=(xincr+c(jj)-yusn(j))*rad
    407         zbordsud=(xincr-d(jj)+yusn(j))*rad
    408         weighy=AMAX1(0.,AMIN1(zbordnor,zbordsud,zleny))
    409         IF(weighy/=0) THEN
    410           DO i = 2, imdp+2*iext-1
    411             zbordest=(xusn(i)-a(ii)+xincr)*rad*COS(yusn(j))
    412             zbordoue=(b(ii)+xincr-xusn(i))*rad*COS(yusn(j))
    413             weighx=AMAX1(0.,AMIN1(zbordest,zbordoue,zlenx))
    414             IF(weighx/=0)THEN
    415               num_tot(ii,jj)=num_tot(ii,jj)+1.0
    416               IF(zusn(i,j)>=1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
    417               weight(ii,jj)=weight(ii,jj)+weighx*weighy
    418               zmea  (ii,jj)=zmea  (ii,jj)+zusn(i,j)*weighx*weighy !--- MEAN
    419             END IF
    420           END DO
    421         END IF
     390        zlenx=zleny*COS(yusn(j))
     391        weighy=(xincr+AMIN1(c(jj)-yusn(j),yusn(j)-d(jj)))*rad
     392        weighy=AMAX1(0.,AMIN1(weighy,zleny))
     393        IF(weighy/=0) CYCLE
     394        DO i = 2, imdp+2*iext-1
     395          weighx=(xincr+AMIN1(xusn(i)-a(ii),b(ii)-xusn(i)))*rad*COS(yusn(j))
     396          weighx=AMAX1(0.,AMIN1(weighx,zlenx))
     397          IF(weighx/=0) CYCLE
     398          num_tot(ii,jj)=num_tot(ii,jj)+1.0
     399          IF(zusn(i,j)>=1.)num_lan(ii,jj)=num_lan(ii,jj)+1.0
     400          weight(ii,jj)=weight(ii,jj)+weighx*weighy
     401          zphi  (ii,jj)=zphi  (ii,jj)+zusn(i,j)*weighx*weighy !--- MEAN
     402        END DO
    422403      END DO
    423404    END DO
    … …  
    426407!--- COMPUTE PARAMETERS NEEDED BY LOTT & MILLER (1997) AND LOTT (1999) SSO SCHEME
    427408  IF(.NOT.masque_lu) THEN
    428     WHERE(weight(:,1:jmar-1)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
     409    WHERE(weight(:,:)/=0.0) mask=num_lan(:,:)/num_tot(:,:)
    429410  END IF
    430   nn=COUNT(weight(:,1:jmar-1)==0.0)
     411  nn=COUNT(weight(:,:)==0.0)
    431412  IF(nn/=0) WRITE(lunout,*)'Problem with weight ; vanishing occurrences: ',nn
    432   WHERE(weight/=0.0) zmea(:,:)=zmea(:,:)/weight(:,:)
     413  WHERE(weight/=0.0) zphi(:,:)=zphi(:,:)/weight(:,:)
    433414
    434415!--- MASK BASED ON GROUND MAXIMUM, 10% THRESHOLD (<10%: SURF PARAMS MEANINGLESS)
    435   ALLOCATE(mask_tmp(imar+1,jmar)); mask_tmp(:,:)=0.0
    436   WHERE(mask>=0.1) mask_tmp = 1.
    437   WHERE(weight(:,:)/=0.0)
    438     zphi(:,:)=mask_tmp(:,:)*zmea(:,:)
    439     zmea(:,:)=mask_tmp(:,:)*zmea(:,:)
    440   END WHERE
     416  WHERE(weight(:,:)==0.0.OR.mask<0.1) zphi(:,:)=0.0
     417  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zphi)
     418
     419!--- Values at redundant longitude and at poles
     420  zphi(imar+1,:)=zphi(1,:)
     421  zphi(:,   1)=SUM(weight(1:imar,   1)*zphi(1:imar,   1))/SUM(weight(1:imar,   1))
     422  zphi(:,jmar)=SUM(weight(1:imar,jmar)*zphi(1:imar,jmar))/SUM(weight(1:imar,jmar))
     423
     424END SUBROUTINE grid_noro0
     425!
     426!-------------------------------------------------------------------------------
     427
     428
     429!-------------------------------------------------------------------------------
     430!
     431SUBROUTINE read_noro(x,y,fname,zphi,zmea,zstd,zsig,zgam,zthe,zpic,zval,mask)
     432!
     433!-------------------------------------------------------------------------------
     434! Purpose: Read parameters usually determined with grid_noro from a file.
     435!===============================================================================
     436  USE netcdf, ONLY: NF90_OPEN,  NF90_INQ_DIMID, NF90_INQUIRE_DIMENSION,        &
     437        NF90_NOERR, NF90_CLOSE, NF90_INQ_VARID, NF90_GET_VAR, NF90_STRERROR,   &
     438        NF90_NOWRITE
     439  IMPLICIT NONE
     440!-------------------------------------------------------------------------------
     441! Arguments:
     442  REAL, INTENT(IN)  :: x(:), y(:)    !--- OUTPUT COORDINATES     (imar+1) (jmar)
     443  CHARACTER(LEN=*), INTENT(IN) :: fname ! PARAMETERS FILE NAME
     444  REAL, INTENT(OUT) :: zphi(:,:)     !--- GEOPOTENTIAL           (imar+1,jmar)
     445  REAL, INTENT(OUT) :: zmea(:,:)     !--- MEAN OROGRAPHY         (imar+1,jmar)
     446  REAL, INTENT(OUT) :: zstd(:,:)     !--- STANDARD DEVIATION     (imar+1,jmar)
     447  REAL, INTENT(OUT) :: zsig(:,:)     !--- SLOPE                  (imar+1,jmar)
     448  REAL, INTENT(OUT) :: zgam(:,:)     !--- ANISOTROPY             (imar+1,jmar)
     449  REAL, INTENT(OUT) :: zthe(:,:)     !--- SMALL AXIS ORIENTATION (imar+1,jmar)
     450  REAL, INTENT(OUT) :: zpic(:,:)     !--- MAXIMUM ALTITUDE       (imar+1,jmar)
     451  REAL, INTENT(OUT) :: zval(:,:)     !--- MINIMUM ALTITUDE       (imar+1,jmar)
     452  REAL, INTENT(OUT) :: mask(:,:)     !--- MASK                   (imar+1,jmar)
     453!-------------------------------------------------------------------------------
     454! Local variables:
     455  CHARACTER(LEN=256) :: modname="read_noro"
     456  INTEGER :: imar, jmar, fid, did, vid
     457  LOGICAL :: masque_lu
     458  REAL :: xpi, d2r
     459!-------------------------------------------------------------------------------
     460  imar=assert_eq([SIZE(x),SIZE(zphi,1),SIZE(zmea,1),SIZE(zstd,1),SIZE(zsig,1), &
     461                          SIZE(zgam,1),SIZE(zthe,1),SIZE(zpic,1),SIZE(zval,1), &
     462                          SIZE(mask,1)],TRIM(modname)//" imar")-1
     463  jmar=assert_eq([SIZE(y),SIZE(zphi,2),SIZE(zmea,2),SIZE(zstd,2),SIZE(zsig,2), &
     464                          SIZE(zgam,2),SIZE(zthe,2),SIZE(zpic,2),SIZE(zval,2), &
     465                          SIZE(mask,2)],TRIM(modname)//" jmar")
     466  xpi=ACOS(-1.0); d2r=xpi/180.
     467  WRITE(lunout,*)"*** Orography parameters at sub-cell scale from file ***"
     468
     469!--- ARE WE USING A READ MASK ?
     470  masque_lu=ANY(mask/=-99999.); IF(.NOT.masque_lu) mask=0.0
     471  WRITE(lunout,*)'Masque lu: ',masque_lu
     472  CALL ncerr(NF90_OPEN(fname,NF90_NOWRITE,fid))
     473  CALL check_dim('x','longitude',x(1:imar))
     474  CALL check_dim('y','latitude' ,y(1:jmar))
     475  IF(.NOT.masque_lu) CALL get_fld('mask',mask)
     476  CALL get_fld('Zphi',zphi)
     477  CALL get_fld('Zmea',zmea)
     478  CALL get_fld('mu'  ,zstd)
     479  CALL get_fld('Zsig',zsig)
     480  CALL get_fld('Zgam',zgam)
     481  CALL get_fld('Zthe',zthe)
     482  zpic=zmea+2*zstd
     483  zval=MAX(0.,zmea-2.*zstd)
     484  CALL ncerr(NF90_CLOSE(fid))
    441485  WRITE(lunout,*)'  MEAN ORO:' ,MAXVAL(zmea)
    442 
    443 !--- Values at poles
    444   zphi(imar+1,:)=zphi(1,:)
    445 
    446   zweinor=SUM(weight(1:imar,   1),DIM=1)
    447   zweisud=SUM(weight(1:imar,jmar),DIM=1)
    448   zmeanor=SUM(weight(1:imar,   1)*zmea(1:imar,   1),DIM=1)
    449   zmeasud=SUM(weight(1:imar,jmar)*zmea(1:imar,jmar),DIM=1)
    450   zphi(:,1)=zmeanor/zweinor; zphi(:,jmar)=zmeasud/zweisud
    451 
    452 END SUBROUTINE grid_noro0
     486  WRITE(lunout,*)'  ST. DEV.:' ,MAXVAL(zstd)
     487  WRITE(lunout,*)'  PENTE:'    ,MAXVAL(zsig)
     488  WRITE(lunout,*)'  ANISOTROP:',MAXVAL(zgam)
     489  WRITE(lunout,*)'  ANGLE:'    ,MINVAL(zthe),MAXVAL(zthe)
     490  WRITE(lunout,*)'  pic:'      ,MAXVAL(zpic)
     491  WRITE(lunout,*)'  val:'      ,MAXVAL(zval)
     492
     493CONTAINS
     494
     495
     496SUBROUTINE get_fld(var,fld)
     497  CHARACTER(LEN=*), INTENT(IN)    :: var
     498  REAL,             INTENT(INOUT) :: fld(:,:)
     499  CALL ncerr(NF90_INQ_VARID(fid,var,vid),var)
     500  CALL ncerr(NF90_GET_VAR(fid,vid,fld(1:imar,:)),var)
     501  fld(imar+1,:)=fld(1,:)
     502END SUBROUTINE get_fld
     503
     504SUBROUTINE check_dim(dimd,nam,dimv)
     505  CHARACTER(LEN=*), INTENT(IN) :: dimd
     506  CHARACTER(LEN=*), INTENT(IN) :: nam
     507  REAL,             INTENT(IN) :: dimv(:)
     508  REAL, ALLOCATABLE :: tmp(:)
     509  INTEGER :: n
     510  CALL ncerr(NF90_INQ_DIMID(fid,dimd,did))
     511  CALL ncerr(NF90_INQUIRE_DIMENSION(fid,did,len=n)); ALLOCATE(tmp(n))
     512  CALL ncerr(NF90_INQ_VARID(fid,dimd,did))
     513  CALL ncerr(NF90_GET_VAR(fid,did,tmp))
     514  IF(MAXVAL(tmp)>xpi) tmp=tmp*d2r
     515  IF(n/=SIZE(dimv).OR.ANY(ABS(tmp-dimv)>1E-6)) THEN
     516    WRITE(lunout,*)'Problem with file "'//TRIM(fname)//'".'
     517    CALL abort_physic(modname,'Grid differs from LMDZ for '//TRIM(nam)//'.',1)
     518  END IF
     519END SUBROUTINE check_dim
     520
     521SUBROUTINE ncerr(ncres,var)
     522  IMPLICIT NONE
     523  INTEGER,          INTENT(IN) :: ncres
     524  CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: var
     525  CHARACTER(LEN=256) :: mess
     526  IF(ncres/=NF90_NOERR) THEN
     527    mess='Problem with file "'//TRIM(fname)//'"'
     528    IF(PRESENT(var)) mess=TRIM(mess)//' and variable "'//TRIM(var)//'"'
     529    WRITE(lunout,*)TRIM(mess)//'.'
     530    CALL abort_physic(modname,NF90_STRERROR(ncres),1)
     531  END IF
     532END SUBROUTINE ncerr
     533
     534END SUBROUTINE read_noro
    453535!
    454536!-------------------------------------------------------------------------------
    … …  
    494576END MODULE grid_noro_m
    495577
     578

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

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

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

    r2408 r2720  
    148148    USE netcdf
    149149    USE indice_sol_mod
     150    USE phys_cal_mod, ONLY : calend, year_len
     151    USE print_control_mod, ONLY: lunout, prt_level
    150152
    151153    IMPLICIT NONE
    … …  
    170172! Locals variables
    171173!****************************************************************************************
    172     INTEGER                                   :: nid, nvarid
     174    INTEGER                                   :: nid, nvarid, ndimid, nn
    173175    INTEGER                                   :: ii, ierr
    174176    INTEGER, DIMENSION(2)                     :: start, epais
    … …  
    178180    REAL, DIMENSION(klon_glo)                 :: alb_glo  ! albedo at global grid
    179181    CHARACTER(len=20)                         :: modname='limit_read_mod'     
     182    CHARACTER(LEN=99)                         :: abort_message, calendar, str
    180183
    181184! End declaration
    … …  
    207210! 1) Open the file limit.nc if it is the right moment to read, once a day.
    208211!    The file is read only by the master thread of the master mpi process(is_mpi_root)
     212!    Check by the way if the number of records is correct.
    209213!
    210214!****************************************************************************************
    … …  
    220224          IF (ierr /= NF90_NOERR) CALL abort_physic(modname,&
    221225               'Pb d''ouverture du fichier de conditions aux limites',1)
    222          
     226
     227          !--- WARNING IF CALENDAR IS KNOWN AND DOES NOT MATCH THE ONE OF LMDZ
     228          ierr=NF90_INQ_VARID(nid, 'TEMPS', nvarid)
     229          ierr=NF90_GET_ATT(nid, nvarid, 'calendar', calendar)
     230          IF(ierr==NF90_NOERR.AND.calendar/=calend.AND.prt_level>=1) THEN
     231             WRITE(lunout,*)'BEWARE: gcm and limit.nc calendars differ: '
     232             WRITE(lunout,*)'  '//TRIM(calend)//' for gcm'
     233             WRITE(lunout,*)'  '//TRIM(calendar)//' for limit.nc file'
     234          END IF
     235
     236          !--- ERROR IF FILE RECORDS NUMBER IS NOT EQUAL TO EXPECTED NUMBER OF DAYS
     237          ierr=NF90_INQUIRE(nid, UnlimitedDimID=ndimid)
     238          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
     239          CALL num2str(nn,str)
     240          abort_message='limit.nc records number ('//TRIM(str)//') does'//&
     241            ' not match year length ('
     242          CALL num2str(year_len,str)
     243          abort_message=TRIM(abort_message)//TRIM(str)//')'
     244          IF(nn/=year_len) CALL abort_physic(modname,abort_message,1)
     245
     246          !--- ERROR IF FILES AND LMDZ HORIZONTAL RESOLUTIONS DO NOT MATCH
     247          ierr=NF90_INQ_DIMID(nid, 'points_physiques', ndimid)
     248          ierr=NF90_INQUIRE_DIMENSION(nid, ndimid, len=nn)
     249          CALL num2str(nn,str)
     250          abort_message='limit.nc horizontal number of cells ('//TRIM(str)//') does'//&
     251            ' not match LMDZ klon_glo ('
     252          CALL num2str(klon_glo,str)
     253          abort_message=TRIM(abort_message)//TRIM(str)//')'
     254          IF(nn/=klon_glo) CALL abort_physic(modname,abort_message,1)
     255
    223256          ! La tranche de donnees a lire:
    224257          start(1) = 1
    … …  
    337370  END SUBROUTINE limit_read_tot
    338371
     372  !--------------------------------------------------------------------------------------
     373  SUBROUTINE num2str(n,str)
     374  !--------------------------------------------------------------------------------------
     375  ! Arguments:
     376    INTEGER,           INTENT(IN)  :: n
     377    CHARACTER(LEN=99), INTENT(OUT) :: str
     378  !--------------------------------------------------------------------------------------
     379  ! Local variables:
     380    INTEGER :: nn
     381  !--------------------------------------------------------------------------------------
     382    nn=n; str=''; DO WHILE(nn>0); str=CHAR(nn-10*(nn/10)-48)//TRIM(str); nn=nn/10; END DO
     383  END SUBROUTINE num2str
     384  !--------------------------------------------------------------------------------------
    339385
    340386END MODULE limit_read_mod

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

    r2258 r2720  
    33!
    44
    5 !     #########
    6 
    7 subroutine ocean_albedo(knon,zrmu0,knindex,pwind,SFRWL,alb_dir_new,alb_dif_new)
    8 
    9 
    10 !     ##################################################################
    11 !
     5SUBROUTINE ocean_albedo(knon,zrmu0,knindex,pwind,SFRWL,alb_dir_new,alb_dif_new)
     6!!
    127!!****  *ALBEDO_RS14* 
    138!!
    149!!    PURPOSE
    1510!!    -------
    16 !       computes the direct & diffuse albedo over open water
    17 !
    18 !     
     11!!     computes the direct & diffuse albedo over open water
     12!!     
    1913!!**  METHOD
    2014!!    ------
    21 !
     15!!
    2216!!    EXTERNAL
    2317!!    --------
    … …  
    2519!!    IMPLICIT ARGUMENTS
    2620!!    ------------------
    27 !!
    2821!!     
    2922!!    REFERENCE
    3023!!    ---------
    31 !!
    3224!!     
    3325!!    AUTHOR
    … …  
    3830!!    -------------
    3931!!      Original    03/2014
    40 !                   05/2014 R. Séférian & B. Decharme :: Adaptation to spectral
    41 !                   computation for diffuse and direct albedo
    42 !                   08/2014 S. Baek :: for wider wavelength range 200-4000nm and
    43 !                   adaptation to LMDZ + whitecap effect by Koepke + chrolophyll
    44 !                   map from climatology file
    45 !       
     32!!                  05/2014 R. Séférian & B. Decharme :: Adaptation to spectral
     33!!                  computation for diffuse and direct albedo
     34!!                  08/2014 S. Baek :: for wider wavelength range 200-4000nm and
     35!!                  adaptation to LMDZ + whitecap effect by Koepke + chrolophyll
     36!!                  map from climatology file
     37!!                  10/2016 O. Boucher :: some optimisation following R.
     38!!                  Seferian's work in the CNRM Model
     39!!       
    4640!-------------------------------------------------------------------------------
    4741!
    … …  
    5044!
    5145USE ocean_albedo_para
    52 use dimphy
    53 !LF USE PARKIND1  ,ONLY : JPIM     ,JPRB
    54 use phys_state_var_mod, only : chl_con
     46USE dimphy
     47USE phys_state_var_mod, ONLY : chl_con
    5548!
    5649!
    … …  
    6053!              -------------------------
    6154!
    62 
    6355include "clesphys.h"
    64 
    65 integer, intent(in) :: knon
    66 integer, dimension(klon), intent(in) :: knindex
    67 real, dimension(klon), intent(in) :: zrmu0,pwind
    68 real, dimension(klon,nsw), intent(out) ::  alb_dir_new,alb_dif_new
    69 real, dimension(6),intent(in) :: SFRWL
    70 
    71 
    72 !=== LOCAL VARIABLES
    73 
    74 REAL, parameter :: XPI=4.*atan(1.)
    75 
     56!
     57INTEGER, INTENT(IN) :: knon
     58INTEGER, DIMENSION(klon), INTENT(IN) :: knindex
     59REAL, DIMENSION(klon), INTENT(IN) :: zrmu0         !--cos(SZA) on full vector
     60REAL, DIMENSION(klon), INTENT(IN) :: pwind         !--wind speed on compressed vector
     61REAL, DIMENSION(6),INTENT(IN) :: SFRWL
     62REAL, DIMENSION(klon,nsw), INTENT(OUT) :: alb_dir_new, alb_dif_new
    7663!
    7764!*      0.2    declarations of local variables
    7865!              -------------------------
    7966!
    80 REAL, DIMENSION(klon)               :: ZCHL        ! surface chlorophyll
    81 REAL, DIMENSION(klon,NNWL)               :: ZDIR_ALB    ! direct  ocean surface albedo (spectral)
    82 REAL, DIMENSION(klon,NNWL)               :: ZSCA_ALB    ! diffuse ocean surface albedo (spectral)
    83 !
    84 INTEGER                         :: JI, JWL                  ! indexes
    85 REAL                            :: ZWL                      ! input parameter: wavelength and diffuse/direct fraction of light
    86 REAL:: ZSIG, ZREFM, ZXX2, ZR00, ZRR0, ZRRR                        ! computation variables
    87 REAL:: ZR22, ZUE, ZUE2, ZR11DF, ZALBT, ZFWC                       ! computation variables
    88 REAL:: ZCHLABS, ZAW, ZBW, ZAP, ZYLMD, ZBP550                      ! computation variables
    89 REAL:: ZBBP, ZNU, ZHB                                       ! computation variables
    90 REAL:: ZCOSZEN                                              ! Cosine of the zenith solar angle
    91 REAL:: ZR11, ZRW, ZRWDF, ZRDF                                   ! 4 components of the OSA
    92 ! new damping coefficient
    93 REAL:: ZDAMP     
    94 
     67REAL, DIMENSION(klon)           :: ZCHL        ! surface chlorophyll
     68REAL, DIMENSION(klon)           :: ZCOSZEN     ! Cosine of the zenith solar angle
     69!
     70INTEGER                         :: JWL, INU    ! indexes
     71INTEGER                         :: JI
     72REAL                            :: ZWL         ! input parameter: wavelength and diffuse/direct fraction of light
     73REAL:: ZCHLABS, ZAW, ZBW, ZREFM, ZYLMD, ZUE, ZUE2 ! scalar computation variables
     74!
     75REAL, DIMENSION(klon) :: ZAP, ZXX2, ZR00, ZRR0, ZRRR               ! computation variables
     76REAL, DIMENSION(klon) :: ZR22, ZR11DF                              ! computation variables
     77REAL, DIMENSION(klon) :: ZBBP, ZNU, ZHB                            ! computation variables
     78REAL, DIMENSION(klon) :: ZR11, ZRW, ZRWDF, ZRDF                    ! 4 components of the OSA
     79REAL, DIMENSION(klon) :: ZSIG, ZFWC, ZWORK1, ZWORK2, ZWORK3
    9580!
    96 REAL            :: ZWORK                           ! dummy variable
    97 !
    98 !LF REAL(KIND=JPRB) :: ZHOOK_HANDLE
    99 !
    100 !-------------------------------------------------------------------------------
    101 !
    102 !
    103 
    104 
    105 
    106 !
     81!--initialisations-------------
     82!
     83
     84IF (knon==0) RETURN ! A verifier pourquoi on en a besoin...
     85
    10786alb_dir_new(:,:) = 0.
    10887alb_dif_new(:,:) = 0.
    10988!
    110 ZDIR_ALB(:,:) = 0.
    111 ZSCA_ALB(:,:) = 0.
    112 !
    113 !
    114 
    115 !ZCHL(:) = CHL_CON!0.05 ! averaged global values for surface chlorophyll
    116 if(ok_chlorophyll)then
    117   do ji=1,knon
    118   ZCHL(ji)=CHL_CON(knindex(ji))
    119   enddo
    120 else
    121   ZCHL(:) = 0.05
    122 endif
    123 
    124 
    125 !
    126 DO JWL=1,NNWL           ! loop over the wavelength
    127 !
    128   DO JI=1,knon  ! loop over the grid points
    129 
    130 
    131     !---------------------------------------------------------------------------------
    132     ! 0- Compute baseline values
    133     !---------------------------------------------------------------------------------
     89! Initialisation of chlorophyll content
     90! ZCHL(:) = CHL_CON!0.05 ! averaged global values for surface chlorophyll
     91IF (ok_chlorophyll) THEN
     92  ZCHL(1:knon)=CHL_CON(knindex(1:knon))
     93ELSE
     94  ZCHL(1:knon) = 0.05
     95ENDIF
     96
     97! variables that do not depend on wavelengths
     98! loop over the grid points
     99! functions of chlorophyll content
     100ZWORK1(1:knon)= EXP(LOG(ZCHL(1:knon))*0.65)
     101ZWORK2(1:knon)= 0.416 * EXP(LOG(ZCHL(1:knon))*0.766)
     102ZWORK3(1:knon)= LOG10(ZCHL(1:knon))
     103! store the cosine of the solar zenith angle
     104ZCOSZEN(1:knon) = zrmu0(knindex(1:knon))
     105! Compute sigma derived from wind speed (Cox & Munk reflectance model)
     106ZSIG(1:knon)=SQRT(0.003+0.00512*PWIND(1:knon))
     107! original : correction for foam (Eq 16-17)
     108! has to be update once we have information from wave model (discussion with G. Madec)
     109ZFWC(1:knon)=3.97e-4*PWIND(1:knon)**1.59 ! Salisbury 2014 eq(2) at 37GHz, value in fraction
     110!
     111DO JWL=1,NNWL           ! loop over the wavelengths
     112  !
     113  !---------------------------------------------------------------------------------
     114  ! 0- Compute baseline values
     115  !---------------------------------------------------------------------------------
    134116   
    135     ! Get refractive index for the correspoding wavelength
    136     ZWL=XAKWL(JWL) !!!---------- wavelength value
    137     ZREFM= XAKREFM(JWL) !!!--------- refraction index value
     117  ! Get refractive index for the correspoding wavelength
     118  ZWL=XAKWL(JWL)      !!!--------- wavelength value
     119  ZREFM= XAKREFM(JWL) !!!--------- refraction index value
    138120 
    139 
    140     ! compute the cosine of the solar zenith angle
    141 !    ZCOSZEN = COS(XPI/2 - PZENITH(JI))
    142      ZCOSZEN = zrmu0(knindex(JI))
    143     ! Compute sigma derived from wind speed (Cox & Munk reflectance model)
    144     ZSIG=SQRT(0.003+0.00512*PWIND(JI))
    145 
    146    
    147     !---------------------------------------------------------------------------------
    148     ! 1- Compute direct surface albedo (ZR11)
    149     !---------------------------------------------------------------------------------
    150     !
    151     ZXX2=SQRT(1.0-(1.0-ZCOSZEN**2)/ZREFM**2)
    152     ZRR0=0.50*(((ZXX2-ZREFM*ZCOSZEN)/(ZXX2+ZREFM*ZCOSZEN))**2 +((ZCOSZEN-ZREFM*ZXX2)/(ZCOSZEN+ZREFM*ZXX2))**2)
    153     ZRRR=0.50*(((ZXX2-1.34*ZCOSZEN)/(ZXX2+1.34*ZCOSZEN))**2 +((ZCOSZEN-1.34*ZXX2)/(ZCOSZEN+1.34*ZXX2))**2)
    154     ZR11=ZRR0-(0.0152-1.7873*ZCOSZEN+6.8972*ZCOSZEN**2-8.5778*ZCOSZEN**3+4.071*ZSIG-7.6446*ZCOSZEN*ZSIG) &
    155         & * EXP(0.1643-7.8409*ZCOSZEN-3.5639*ZCOSZEN**2-2.3588*ZSIG+10.0538*ZCOSZEN*ZSIG)*ZRR0/ZRRR
    156     !
    157     !---------------------------------------------------------------------------------
    158     ! 2- Compute surface diffuse albedo (ZRDF)
    159     !---------------------------------------------------------------------------------
    160     ! Diffuse albedo from Jin et al., 2006 + estimation from diffuse fraction of
    161     ! light (relying later on AOD)
    162     ZRDF=-0.1482-0.012*ZSIG+0.1609*ZREFM-0.0244*ZSIG*ZREFM ! surface diffuse (Eq 5a-5b)
     121  !---------------------------------------------------------------------------------
     122  ! 1- Compute direct surface albedo (ZR11)
     123  !---------------------------------------------------------------------------------
     124  !
     125  ZXX2(1:knon)=SQRT(1.0-(1.0-ZCOSZEN(1:knon)**2)/ZREFM**2)
     126  ZRR0(1:knon)=0.50*(((ZXX2(1:knon)-ZREFM*ZCOSZEN(1:knon))/(ZXX2(1:knon)+ZREFM*ZCOSZEN(1:knon)))**2 +  &
     127               ((ZCOSZEN(1:knon)-ZREFM*ZXX2(1:knon))/(ZCOSZEN(1:knon)+ZREFM*ZXX2(1:knon)))**2)
     128  ZRRR(1:knon)=0.50*(((ZXX2(1:knon)-1.34*ZCOSZEN(1:knon))/(ZXX2(1:knon)+1.34*ZCOSZEN(1:knon)))**2 + &
     129               ((ZCOSZEN(1:knon)-1.34*ZXX2(1:knon))/(ZCOSZEN(1:knon)+1.34*ZXX2(1:knon)))**2)
     130  ZR11(1:knon)=ZRR0(1:knon)-(0.0152-1.7873*ZCOSZEN(1:knon)+6.8972*ZCOSZEN(1:knon)**2-8.5778*ZCOSZEN(1:knon)**3+ &
     131               4.071*ZSIG(1:knon)-7.6446*ZCOSZEN(1:knon)*ZSIG(1:knon)) *  &
     132               EXP(0.1643-7.8409*ZCOSZEN(1:knon)-3.5639*ZCOSZEN(1:knon)**2-2.3588*ZSIG(1:knon)+ &
     133               10.0538*ZCOSZEN(1:knon)*ZSIG(1:knon))*ZRR0(1:knon)/ZRRR(1:knon)
     134  !
     135  !---------------------------------------------------------------------------------
     136  ! 2- Compute surface diffuse albedo (ZRDF)
     137  !---------------------------------------------------------------------------------
     138  ! Diffuse albedo from Jin et al., 2006 + estimation from diffuse fraction of
     139  ! light (relying later on AOD). CNRM model has opted for Eq 5b
     140  ZRDF(1:knon)=-0.1482-0.012*ZSIG(1:knon)+0.1609*ZREFM-0.0244*ZSIG(1:knon)*ZREFM ! surface diffuse (Eq 5a)
     141  !!ZRDF(1:knon)=-0.1479+0.1502*ZREFM-0.0176*ZSIG(1:knon)*ZREFM   ! surface diffuse (Eq 5b)
     142 
     143  !---------------------------------------------------------------------------------
     144  ! *- Determine absorption and backscattering
     145  ! coefficients to determine reflectance below the surface (Ro) once for all
     146  !
     147  ! *.1- Absorption by chlorophyll
     148  ZCHLABS= XAKACHL(JWL)
     149  ! *.2- Absorption by seawater
     150  ZAW= XAKAW3(JWL)
     151  ! *.3- Backscattering by seawater
     152  ZBW= XAKBW(JWL)
     153  ! *.4- Backscattering by chlorophyll
     154  ZYLMD = EXP(0.014*(440.0-ZWL))
     155  ZAP(1:knon) = 0.06*ZCHLABS*ZWORK1(1:knon) +0.2*(XAW440+0.06*ZWORK1(1:knon))*ZYLMD
    163156   
    164     !---------------------------------------------------------------------------------
    165     ! *- Determine absorption and backscattering
    166     ! coefficients to determine reflectance below the surface (Ro) once for all
    167     !
    168     ! *.1- Absorption by chlorophyll
    169     ZCHLABS= XAKACHL(JWL)
    170     ! *.2- Absorption by seawater
    171     ZAW= XAKAW3(JWL)
    172     ! *.3- Backscattering by seawater
    173     ZBW= XAKBW(JWL)
    174     ! *.4- Backscattering by chlorophyll
    175     ZYLMD = EXP(0.014*(440.0-ZWL))
    176     ZWORK= EXP(LOG(ZCHL(JI))*0.65)
    177     ZAP = 0.06*ZCHLABS*ZWORK +0.2*(XAW440+0.06*ZWORK)*ZYLMD
    178     ZBP550 = 0.416 * EXP(LOG(ZCHL(JI))*0.766)
     157!!  WHERE ( ZCHL(1:knon) > 0.02 )
     158!!    ZNU(:)=MIN(0.0,0.5*(ZWORK3(:)-0.3))
     159!!    ZBBP(:)=(0.002+0.01*(0.5-0.25*ZWORK3(:))*(ZWL/550.)**ZNU(:))*ZWORK2(:)
     160!!  ELSEWHERE
     161!!    ZBBP(:)=0.019*(550./ZWL)*ZWORK2(:)       !ZBBPf=0.0113 at chl<=0.02
     162!!  ENDWHERE
     163
     164    do JI = 1, knon
     165      IF (ZCHL(JI) > 0.02) THEN
     166        ZNU(JI)=MIN(0.0,0.5*(ZWORK3(JI)-0.3))
     167        ZBBP(JI)=(0.002+0.01*(0.5-0.25*ZWORK3(JI))*(ZWL/550.)**ZNU(JI)) &
     168                  *ZWORK2(JI)
     169      ELSE
     170        ZBBP(JI)=0.019*(550./ZWL)*ZWORK2(JI)       !ZBBPf=0.0113 at chl<=0.02
     171      ENDIF
     172    ENDDO
     173
     174  ! Morel-Gentili(1991), Eq (12)
     175  ! ZHB=h/(h+2*ZBBPf*(1.-h))       
     176  ZHB(1:knon)=0.5*ZBW/(0.5*ZBW+ZBBP(1:knon))
    179177   
    180     IF ( ZCHL(JI) > 2. ) THEN
    181       ZNU=0.
    182     ELSE
    183       IF ( ZCHL(JI) > 0.02 ) THEN
    184         ZWORK=LOG10(ZCHL(JI))
    185         ZNU=0.5*(ZWORK-0.3)
    186         ZBBP=(0.002+0.01*(0.5-0.25*ZWORK)*(ZWL/550.)**ZNU)*ZBP550
    187       ELSE
    188         ZBBP=0.019*(550./ZWL)*ZBP550       !ZBBPf=0.0113 at chl<=0.02
    189       ENDIF
     178  !---------------------------------------------------------------------------------
     179  ! 3- Compute direct water-leaving albedo (ZRW)
     180  !---------------------------------------------------------------------------------
     181  ! Based on Morel & Gentilli 1991 parametrization
     182  ZR22(1:knon)=0.48168549-0.014894708*ZSIG(1:knon)-0.20703885*ZSIG(1:knon)**2
     183
     184  ! Use Morel 91 formula to compute the direct reflectance
     185  ! below the surface
     186  ZR00(1:knon)=(0.5*ZBW+ZBBP(1:knon))/(ZAW+ZAP(1:knon)) *  &
     187               (0.6279-0.2227*ZHB(1:knon)-0.0513*ZHB(1:knon)**2 + &
     188               (-0.3119+0.2465*ZHB(1:knon))*ZCOSZEN(1:knon))
     189  ZRW(1:knon)=ZR00(1:knon)*(1.-ZR22(1:knon))/(1.-ZR00(1:knon)*ZR22(1:knon))
     190
     191  !---------------------------------------------------------------------------------
     192  ! 4- Compute diffuse water-leaving albedo (ZRWDF)
     193  !---------------------------------------------------------------------------------
     194  ! as previous water-leaving computation but assumes a uniform incidence of
     195  ! shortwave at surface (ue)
     196  ZUE=0.676               ! equivalent u_unif for diffuse incidence
     197  ZUE2=SQRT(1.0-(1.0-ZUE**2)/ZREFM**2)
     198  ZRR0(1:knon)=0.50*(((ZUE2-ZREFM*ZUE)/(ZUE2+ZREFM*ZUE))**2 +((ZUE-ZREFM*ZUE2)/(ZUE+ZREFM*ZUE2))**2)
     199  ZRRR(1:knon)=0.50*(((ZUE2-1.34*ZUE)/(ZUE2+1.34*ZUE))**2 +((ZUE-1.34*ZUE2)/(ZUE+1.34*ZUE2))**2)
     200  ZR11DF(1:knon)=ZRR0(1:knon)-(0.0152-1.7873*ZUE+6.8972*ZUE**2-8.5778*ZUE**3+4.071*ZSIG(1:knon)-7.6446*ZUE*ZSIG(1:knon)) * &
     201                 EXP(0.1643-7.8409*ZUE-3.5639*ZUE**2-2.3588*ZSIG(1:knon)+10.0538*ZUE*ZSIG(1:knon))*ZRR0(1:knon)/ZRRR(1:knon)
     202
     203  ! Use Morel 91 formula to compute the diffuse
     204  ! reflectance below the surface
     205  ZR00(1:knon)=(0.5*ZBW+ZBBP(1:knon))/(ZAW+ZAP(1:knon))*(0.6279-0.2227*ZHB(1:knon)-0.0513*ZHB(1:knon)**2 + (-0.3119+0.2465*ZHB(1:knon))*ZUE)
     206  ZRWDF(1:knon)=ZR00(1:knon)*(1.-ZR22(1:knon))*(1.-ZR11DF(1:knon))/(1.-ZR00(1:knon)*ZR22(1:knon))
     207   
     208  ! get waveband index inu for each nsw band
     209  SELECT CASE(nsw)
     210  CASE(2)
     211    IF (JWL.LE.49) THEN       ! from 200  to 680 nm
     212     inu=1
     213    ELSE                      ! from 690  to 4000 nm
     214     inu=2
    190215    ENDIF
    191    
    192     ! Morel-Gentili(1991), Eq (12)
    193     ! ZHB=h/(h+2*ZBBPf*(1.-h))       
    194     ZHB=0.5*ZBW/(0.5*ZBW+ZBBP)
    195    
    196     !---------------------------------------------------------------------------------
    197     ! 3- Compute direct water-leaving albedo (ZRW)
    198     !---------------------------------------------------------------------------------
    199     ! Based on Morel & Gentilli 1991 parametrization
    200     ZR22=0.48168549-0.014894708*ZSIG-0.20703885*ZSIG**2
    201     ! Use Morel 91 formula to compute the direct reflectance
    202     ! below the surface
    203     ZR00=(0.5*ZBW+ZBBP)/(ZAW+ZAP) *(0.6279-0.2227*ZHB-0.0513*ZHB**2 + (-0.3119+0.2465*ZHB)*ZCOSZEN)
    204     ZRW=ZR00*(1.-ZR22)*(1.-ZR11)/(1.-ZR00*ZR22)
    205 
    206     ZRW=ZR00*(1.-ZR22)/(1.-ZR00*ZR22)
    207     !---------------------------------------------------------------------------------
    208     ! 4- Compute diffuse water-leaving albedo (ZRWDF)
    209     !---------------------------------------------------------------------------------
    210     ! as previous water-leaving computation but assumes a uniform incidence of
    211     ! shortwave at surface (ue)
    212     ZUE=0.676               ! equivalent u_unif for diffuse incidence
    213     ZUE2=SQRT(1.0-(1.0-ZUE**2)/ZREFM**2)
    214     ZRR0=0.50*(((ZUE2-ZREFM*ZUE)/(ZUE2+ZREFM*ZUE))**2 +((ZUE-ZREFM*ZUE2)/(ZUE+ZREFM*ZUE2))**2)
    215     ZRRR=0.50*(((ZUE2-1.34*ZUE)/(ZUE2+1.34*ZUE))**2 +((ZUE-1.34*ZUE2)/(ZUE+1.34*ZUE2))**2)
    216     ZR11DF=ZRR0-(0.0152-1.7873*ZUE+6.8972*ZUE**2-8.5778*ZUE**3+4.071*ZSIG-7.6446*ZUE*ZSIG) &
    217           & * EXP(0.1643-7.8409*ZUE-3.5639*ZUE**2-2.3588*ZSIG+10.0538*ZUE*ZSIG)*ZRR0/ZRRR
    218     ! Use Morel 91 formula to compute the diffuse
    219     ! reflectance below the surface
    220     ZR00=(0.5*ZBW+ZBBP)/(ZAW+ZAP) *(0.6279-0.2227*ZHB-0.0513*ZHB**2 + (-0.3119+0.2465*ZHB)*ZUE)
    221     ZRWDF=ZR00*(1.-ZR22)*(1.-ZR11DF)/(1.-ZR00*ZR22)
    222    
    223     ! original : correction for foam (Eq 16-17)
    224     ZFWC=3.97e-4*PWIND(JI)**(1.59) ! Salisbury 2014 eq(2) at 37GHz, value in fraction
    225     ! has to be update once we have information from wave model (discussion with G. Madec)
    226      
    227     ! --------------------------------------------------------------------
    228     !  *- OSA estimation
    229     ! --------------------------------------------------------------------
    230     ! partitionning direct and diffuse albedo
    231     !
    232 
    233     ! excluding diffuse albedo ZRW on ZDIR_ALB
    234       ZDIR_ALB(JI,JWL) =  XFRWL(JWL) *((1.-ZFWC) * (ZR11+ZRW) +ZFWC*XRWC(JWL))
    235       ZSCA_ALB(JI,JWL) =  XFRWL(JWL) *((1.-ZFWC) * (ZRDF+ZRWDF) + ZFWC*XRWC(JWL))
    236 
    237     !  print*,ji,ZFWC,ZDIR_ALB(JI,JWL),ZSCA_ALB(JI,JWL),pwind(ji)
    238     ENDDO ! end of the loop over grid points
     216  CASE(4)
     217    IF (JWL.LE.49) THEN       ! from 200  to 680 nm
     218     inu=1
     219    ELSE IF (JWL.LE.99) THEN  ! from 690  to 1180 nm
     220     inu=2
     221    ELSE IF (JWL.LE.218) THEN ! from 1190 to 2370 nm
     222     inu=3
     223    ELSE                      ! from 2380 to 4000 nm
     224     inu=4
     225    ENDIF
     226  CASE(6)
     227    IF (JWL.LE.5) THEN        ! from 200  to 240 nm
     228     inu=1
     229    ELSE IF (JWL.LE.24) THEN  ! from 250  to 430 nm
     230     inu=2
     231    ELSE IF (JWL.LE.49) THEN  ! from 440  to 680 nm
     232     inu=3
     233    ELSE IF (JWL.LE.99) THEN  ! from 690  to 1180 nm
     234     inu=4
     235    ELSE IF (JWL.LE.218) THEN ! from 1190 to 2370 nm
     236     inu=5
     237    ELSE                      ! from 2380 to 4000 nm
     238     inu=6
     239    ENDIF
     240  END SELECT
     241
     242  ! partitionning direct and diffuse albedo
     243  ! excluding diffuse albedo ZRW on ZDIR_ALB
     244
     245  !--direct
     246  alb_dir_new(1:knon,inu)=alb_dir_new(1:knon,inu) + &
     247                          ( XFRWL(JWL) * ((1.-ZFWC(1:knon)) * (ZR11(1:knon)+ZRW(1:knon))   + ZFWC(1:knon)*XRWC(JWL)) )/SFRWL(inu)
     248  !--diffuse
     249  alb_dif_new(1:knon,inu)=alb_dif_new(1:knon,inu) + &
     250                          ( XFRWL(JWL) * ((1.-ZFWC(1:knon)) * (ZRDF(1:knon)+ZRWDF(1:knon)) + ZFWC(1:knon)*XRWC(JWL)) )/SFRWL(inu)
    239251
    240252ENDDO ! ending loop over wavelengths
    241253
    242 
    243 ! integral for each nsw band
    244 
    245 select case(nsw)
    246 case(2)
    247   do ji=1,knon
    248    alb_dir_new(ji,1)=sum(zdir_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm
    249    alb_dir_new(ji,2)=sum(zdir_alb(ji,50:381))/SFRWL(2) ! from 690nm to 4000 nm
    250 
    251    alb_dif_new(ji,1)=sum(zsca_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm
    252    alb_dif_new(ji,2)=sum(zsca_alb(ji,50:381))/SFRWL(2) ! from 690nm to 4000 nm
    253   enddo
    254 case(4)
    255   do ji=1,knon
    256    alb_dir_new(ji,1)=sum(zdir_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm
    257    alb_dir_new(ji,2)=sum(zdir_alb(ji,50:99))/SFRWL(2) ! from 690nm to 1180 nm
    258    alb_dir_new(ji,3)=sum(zdir_alb(ji,100:218))/SFRWL(3) ! from 1190nm to 2370 nm
    259    alb_dir_new(ji,4)=sum(zdir_alb(ji,219:381))/SFRWL(4) ! from 2380nm to 4000 nm
    260 
    261    alb_dif_new(ji,1)=sum(zsca_alb(ji,1:49))/SFRWL(1) ! from 200nm to 680nm
    262    alb_dif_new(ji,2)=sum(zsca_alb(ji,50:99))/SFRWL(2) ! from 690nm to 1180 nm
    263    alb_dif_new(ji,3)=sum(zsca_alb(ji,100:218))/SFRWL(3) ! from 1190nm to 2370 nm
    264    alb_dif_new(ji,4)=sum(zsca_alb(ji,219:381))/SFRWL(4) ! from 2380nm to 4000 nm
    265   enddo
    266 case(6)
    267  do ji=1,knon
    268    alb_dir_new(ji,1)=sum(zdir_alb(ji,1:5))/SFRWL(1) ! from 200nm to 240nm
    269    alb_dir_new(ji,2)=sum(zdir_alb(ji,6:24))/SFRWL(2) ! from 250nm to 430 nm
    270    alb_dir_new(ji,3)=sum(zdir_alb(ji,25:49))/SFRWL(3) ! from 440nm to 680 nm
    271    alb_dir_new(ji,4)=sum(zdir_alb(ji,50:99))/SFRWL(4) ! from 690nm to 1180 nm
    272    alb_dir_new(ji,5)=sum(zdir_alb(ji,100:218))/SFRWL(5) ! from 1190nm to 2370 nm
    273    alb_dir_new(ji,6)=sum(zdir_alb(ji,219:381))/SFRWL(6) ! from 2380nm to 4000 nm
    274 
    275    alb_dif_new(ji,1)=sum(zsca_alb(ji,1:5))/SFRWL(1) ! from 200nm to 240nm
    276    alb_dif_new(ji,2)=sum(zsca_alb(ji,6:24))/SFRWL(2) ! from 250nm to 430 nm
    277    alb_dif_new(ji,3)=sum(zsca_alb(ji,25:49))/SFRWL(3) ! from 440nm to 680 nm
    278    alb_dif_new(ji,4)=sum(zsca_alb(ji,50:99))/SFRWL(4) ! from 690nm to 1180 nm
    279    alb_dif_new(ji,5)=sum(zsca_alb(ji,100:218))/SFRWL(5) ! from 1190nm to 2370 nm
    280    alb_dif_new(ji,6)=sum(zsca_alb(ji,219:381))/SFRWL(6) ! from 2380nm to 4000 nm
    281  enddo
    282 end select
    283 
    284 
    285 
    286 END subroutine ocean_albedo
    287 
     254END SUBROUTINE ocean_albedo

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

    r2669 r2720  
    179179       z0m, z0h,   agesno,  sollw,    solsw,         &
    180180       d_ts,      evap,    fluxlat,  t2m,           &
    181        wfbils,    wfbilo,    flux_t,   flux_u, flux_v,&
     181       wfbils,    wfbilo, wfevap, wfrain, wfsnow,   &
     182       flux_t,   flux_u, flux_v,                    &
    182183       dflux_t,   dflux_q,   zxsnow,                  &
    183184!jyg<
    … …  
    431432    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: t2m        ! temperature at 2 meter height
    432433    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfbils     ! heat balance at surface
    433     REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfbilo     ! water balance at surface
     434    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfbilo     ! water balance at surface weighted by srf
     435    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfevap     ! water balance (evap) at surface weighted by srf
     436    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfrain     ! water balance (rain) at surface weighted by srf
     437    REAL, DIMENSION(klon, nbsrf), INTENT(OUT)       :: wfsnow     ! water balance (snow) at surface weighted by srf
    434438    REAL, DIMENSION(klon, klev, nbsrf), INTENT(OUT) :: flux_t     ! sensible heat flux (CpT) J/m**2/s (W/m**2)
    435439                                                                  ! positve orientation downwards
    … …  
    845849 zt2m(:)=0. ; zq2m(:)=0. ; qsat2m(:)=0. ; rh2m(:)=0.
    846850 d_t(:,:)=0. ; d_t_diss(:,:)=0. ; d_q(:,:)=0. ; d_u(:,:)=0. ; d_v(:,:)=0.
    847  zcoefh(:,:,:)=0. ; zcoefm(:,:,:)=0.
    848851 zxsens_x(:)=0. ; zxsens_w(:)=0. ; zxfluxlat_x(:)=0. ; zxfluxlat_w(:)=0.
    849852 cdragh_x(:)=0. ; cdragh_w(:)=0. ; cdragm_x(:)=0. ; cdragm_w(:)=0.
    … …  
    865868 fluxlat(:,:)=0.
    866869 wfbils(:,:)=0. ; wfbilo(:,:)=0.
     870 wfevap(:,:)=0. ; wfrain(:,:)=0. ; wfsnow(:,:)=0.
    867871 flux_t(:,:,:)=0. ; flux_q(:,:,:)=0. ; flux_u(:,:,:)=0. ; flux_v(:,:,:)=0.
    868872 dflux_t(:)=0. ; dflux_q(:)=0.
    … …  
    20982102        CALL yamada_c(knon,dtime,ypaprs,ypplay &
    20992103    &   ,yu,yv,yt,y_d_u,y_d_v,y_d_t,ycdragm,ytke,ycoefm,ycoefh,ycoefq,y_d_t_diss,yustar &
    2100     &   ,iflag_pbl,nsrf)
     2104    &   ,iflag_pbl)
    21012105     ENDIF
    21022106!     print*,'yamada_c OK'
    … …  
    21162120    &   ,yu_x,yv_x,yt_x,y_d_u_x,y_d_v_x,y_d_t_x,ycdragm_x,ytke_x,ycoefm_x,ycoefh_x &
    21172121        ,ycoefq_x,y_d_t_diss_x,yustar_x &
    2118     &   ,iflag_pbl,nsrf)
     2122    &   ,iflag_pbl)
    21192123     ENDIF
    21202124!     print*,'yamada_c OK'
    … …  
    21332137    &   ,yu_w,yv_w,yt_w,y_d_u_w,y_d_v_w,y_d_t_w,ycdragm_w,ytke_w,ycoefm_w,ycoefh_w &
    21342138        ,ycoefq_w,y_d_t_diss_w,yustar_w &
    2135     &   ,iflag_pbl,nsrf)
     2139    &   ,iflag_pbl)
    21362140     ENDIF
    21372141!     print*,'yamada_c OK'
    … …  
    23212325!!!
    23222326       IF (iflag_split .eq.0) THEN
    2323         DO k = 2, klev
     2327        DO k = 1, klev
    23242328           DO j = 1, knon
    23252329              i = ni(j)
    … …  
    23342338
    23352339       ELSE
    2336         DO k = 2, klev
     2340        DO k = 1, klev
    23372341          DO j = 1, knon
    23382342            i = ni(j)
    … …  
    28232827          wfbils(i,nsrf) = ( solsw(i,nsrf) + sollw(i,nsrf) &
    28242828               + flux_t(i,1,nsrf) + fluxlat(i,nsrf) ) * pctsrf(i,nsrf)
    2825           wfbilo(i,nsrf) = (evap(i,nsrf) - (rain_f(i) + snow_f(i))) * &
    2826                pctsrf(i,nsrf)
     2829          wfbilo(i,nsrf) = (evap(i,nsrf)-(rain_f(i)+snow_f(i)))*pctsrf(i,nsrf)
     2830          wfevap(i,nsrf) = evap(i,nsrf)*pctsrf(i,nsrf)
     2831          wfrain(i,nsrf) = rain_f(i)*pctsrf(i,nsrf)
     2832          wfsnow(i,nsrf) = snow_f(i)*pctsrf(i,nsrf)
    28272833
    28282834          zxtsol(i)    = zxtsol(i)    + ts(i,nsrf)      * pctsrf(i,nsrf)

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

    r2641 r2720  
    2929      REAL, SAVE, ALLOCATABLE :: d_u_dyn(:,:), d_v_dyn(:,:)
    3030      !$OMP THREADPRIVATE(d_u_dyn, d_v_dyn)
    31 !!!!
    3231      REAL, SAVE, ALLOCATABLE :: d_tr_dyn(:,:,:)
    3332      !$OMP THREADPRIVATE(d_tr_dyn)
    34 !!!!
    3533      REAL, SAVE, ALLOCATABLE :: d_t_con(:,:),d_q_con(:,:)
    3634      !$OMP THREADPRIVATE(d_t_con,d_q_con)
    … …  
    5553      !$OMP THREADPRIVATE(d_t_ajs_x, d_q_ajs_x)
    5654!>nrlmd
    57       REAL, SAVE, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:)
    58       !$OMP THREADPRIVATE(d_t_eva,d_q_eva)
     55      REAL, SAVE, ALLOCATABLE :: d_t_eva(:,:),d_q_eva(:,:),d_ql_eva(:,:),d_qi_eva(:,:)
     56      !$OMP THREADPRIVATE(d_t_eva,d_q_eva,d_ql_eva,d_qi_eva)
    5957      REAL, SAVE, ALLOCATABLE :: d_t_lscst(:,:),d_q_lscst(:,:)
    6058      !$OMP THREADPRIVATE(d_t_lscst,d_q_lscst)
    … …  
    372370      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: fsolsw, wfbils, wfbilo
    373371!$OMP THREADPRIVATE(fsolsw, wfbils, wfbilo)
     372      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: wfevap, wfrain, wfsnow
     373!$OMP THREADPRIVATE(wfevap,wfrain,wfsnow)
    374374      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:)  :: t2m, fluxlat, fsollw,evap_pot
    375375!$OMP THREADPRIVATE(t2m, fluxlat, fsollw,evap_pot)
    … …  
    418418!$OMP THREADPRIVATE(sissnow,runoff,albsol3_lic)
    419419
     420#ifdef CPP_StratAer
     421! variables for strat. aerosol CK
     422      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: R2SO4
     423!$OMP THREADPRIVATE(R2SO4)
     424      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: DENSO4
     425!$OMP THREADPRIVATE(DENSO4)
     426      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: f_r_wet
     427!$OMP THREADPRIVATE(f_r_wet)
     428      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: sfluxaer
     429!$OMP THREADPRIVATE(sfluxaer)
     430      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: decfluxaer
     431!$OMP THREADPRIVATE(decfluxaer)
     432      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: mdw
     433!$OMP THREADPRIVATE(mdw)
     434      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulf_convert
     435!$OMP THREADPRIVATE(sulf_convert)
     436      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulf_nucl
     437!$OMP THREADPRIVATE(sulf_nucl)
     438      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sulf_cond_evap
     439!$OMP THREADPRIVATE(sulf_cond_evap)
     440      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ocs_convert
     441!$OMP THREADPRIVATE(ocs_convert)
     442      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SO2_backgr_tend
     443!$OMP THREADPRIVATE(SO2_backgr_tend)
     444      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: OCS_backgr_tend
     445!$OMP THREADPRIVATE(OCS_backgr_tend)
     446      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: OCS_lifetime
     447!$OMP THREADPRIVATE(OCS_lifetime)
     448      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: SO2_lifetime
     449!$OMP THREADPRIVATE(SO2_lifetime)
     450      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: alpha_bin
     451!$OMP THREADPRIVATE(alpha_bin)
     452      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: piz_bin
     453!$OMP THREADPRIVATE(piz_bin)
     454      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: cg_bin
     455!$OMP THREADPRIVATE(cg_bin)
     456      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_550
     457!$OMP THREADPRIVATE(tau_strat_550)
     458      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_550_lay
     459!$OMP THREADPRIVATE(tau_strat_550_lay)
     460      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tau_strat_1020
     461!$OMP THREADPRIVATE(tau_strat_1020)
     462      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: tausum_strat
     463!$OMP THREADPRIVATE(tausum_strat)
     464      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: sulf_dep_dry
     465!$OMP THREADPRIVATE(sulf_dep_dry)
     466      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: sulf_dep_wet
     467!$OMP THREADPRIVATE(sulf_dep_wet)
     468      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: surf_PM25_sulf
     469!$OMP THREADPRIVATE(surf_PM25_sulf)
     470      REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: p_tropopause
     471!$OMP THREADPRIVATE(p_tropopause)
     472      REAL, ALLOCATABLE, SAVE, DIMENSION(:,:) :: vsed_aer
     473!$OMP THREADPRIVATE(vsed_aer)
     474#endif
     475
    420476CONTAINS
    421477
    … …  
    456512      allocate(d_u_ajs(klon,klev),d_v_ajs(klon,klev))
    457513      allocate(d_t_eva(klon,klev),d_q_eva(klon,klev))
     514      allocate(d_ql_eva(klon,klev),d_qi_eva(klon,klev))
    458515      allocate(d_t_lscst(klon,klev),d_q_lscst(klon,klev))
    459516      allocate(d_t_lscth(klon,klev),d_q_lscth(klon,klev))
    … …  
    633690      ALLOCATE(fsollw(klon, nbsrf))
    634691      ALLOCATE(fsolsw(klon, nbsrf), wfbils(klon, nbsrf), wfbilo(klon, nbsrf))
     692      ALLOCATE(wfevap(klon, nbsrf), wfrain(klon,nbsrf), wfsnow(klon, nbsrf))
    635693      ALLOCATE(evap_pot(klon, nbsrf))
    636694
    … …  
    656714      ALLOCATE (sissnow(klon),runoff(klon),albsol3_lic(klon))
    657715
    658 
     716#ifdef CPP_StratAer
     717      ALLOCATE (R2SO4(klon,klev))
     718      ALLOCATE (DENSO4(klon,klev))
     719      ALLOCATE (f_r_wet(klon,klev))
     720      ALLOCATE (sfluxaer(klon))
     721      ALLOCATE (decfluxaer(klon,nbtr))
     722      ALLOCATE (mdw(nbtr))
     723      ALLOCATE (sulf_convert(klon,klev))
     724      ALLOCATE (sulf_nucl(klon,klev))
     725      ALLOCATE (sulf_cond_evap(klon,klev))
     726      ALLOCATE (ocs_convert(klon,klev))
     727      ALLOCATE (SO2_backgr_tend(klon,klev))
     728      ALLOCATE (OCS_backgr_tend(klon,klev))
     729      ALLOCATE (OCS_lifetime(klon,klev))
     730      ALLOCATE (SO2_lifetime(klon,klev))
     731      ALLOCATE (alpha_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave+nwave_lw,nbtr))
     732      ALLOCATE (piz_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave+nwave_lw,nbtr))
     733      ALLOCATE (cg_bin(nbands_sw_rrtm+nbands_lw_rrtm+nwave+nwave_lw,nbtr))
     734      ALLOCATE (tau_strat_550(klon,klev))
     735      ALLOCATE (tau_strat_550_lay(klon,klev))
     736      ALLOCATE (tau_strat_1020(klon,klev))
     737      ALLOCATE (tausum_strat(klon,3))
     738      ALLOCATE (sulf_dep_dry(klon))
     739      ALLOCATE (sulf_dep_wet(klon))
     740      ALLOCATE (surf_PM25_sulf(klon))
     741      ALLOCATE (p_tropopause(klon))
     742      ALLOCATE (vsed_aer(klon,klev))
     743#endif
    659744
    660745END SUBROUTINE phys_local_var_init
    … …  
    690775      deallocate(d_u_ajs,d_v_ajs)
    691776      deallocate(d_t_eva,d_q_eva)
     777      deallocate(d_ql_eva,d_qi_eva)
    692778      deallocate(d_t_lscst,d_q_lscst)
    693779      deallocate(d_t_lscth,d_q_lscth)
    … …  
    854940      DEALLOCATE(fsollw, evap_pot)
    855941      DEALLOCATE(fsolsw, wfbils, wfbilo)
     942      DEALLOCATE(wfevap,wfrain,wfsnow)
    856943
    857944      DEALLOCATE(pmflxr, pmflxs, prfl)
    … …  
    872959      DEALLOCATE (zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic)
    873960
     961#ifdef CPP_StratAer
     962! variables for strat. aerosol CK
     963      DEALLOCATE (R2SO4)
     964      DEALLOCATE (DENSO4)
     965      DEALLOCATE (f_r_wet)
     966      DEALLOCATE (sfluxaer)
     967      DEALLOCATE (decfluxaer)
     968      DEALLOCATE (mdw)
     969      DEALLOCATE (sulf_convert)
     970      DEALLOCATE (sulf_nucl)
     971      DEALLOCATE (sulf_cond_evap)
     972      DEALLOCATE (ocs_convert)
     973      DEALLOCATE (SO2_backgr_tend)
     974      DEALLOCATE (OCS_backgr_tend)
     975      DEALLOCATE (SO2_lifetime)
     976      DEALLOCATE (OCS_lifetime)
     977      DEALLOCATE (alpha_bin)
     978      DEALLOCATE (piz_bin)
     979      DEALLOCATE (cg_bin)
     980      DEALLOCATE (tau_strat_550)
     981      DEALLOCATE (tau_strat_550_lay)
     982      DEALLOCATE (tau_strat_1020)
     983      DEALLOCATE (tausum_strat)
     984      DEALLOCATE (sulf_dep_dry)
     985      DEALLOCATE (sulf_dep_wet)
     986      DEALLOCATE (surf_PM25_sulf)
     987      DEALLOCATE (p_tropopause)
     988      DEALLOCATE (vsed_aer)
     989#endif
     990
    874991END SUBROUTINE phys_local_var_end
    875992

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

    r2669 r2720  
    586586      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wbilo_sic',          &
    587587      "Bilan eau "//clnsurf(4),"kg/(m2*s)", (/ ('', i=1, 9) /)) /)
     588
     589  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_wevap_srf    = (/      &
     590      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wevap_ter',          &
     591      "Evap eau "//clnsurf(1),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     592      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wevap_lic',          &
     593      "Evap eau "//clnsurf(2),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     594      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wevap_oce',          &
     595      "Evap eau "//clnsurf(3),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     596      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wevap_sic',          &
     597      "Evap eau "//clnsurf(4),"kg/(m2*s)", (/ ('', i=1, 9) /)) /)
     598
     599  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_wrain_srf    = (/      &
     600      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wrain_ter',          &
     601      "Pluie eau "//clnsurf(1),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     602      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wrain_lic',          &
     603      "Pluie eau "//clnsurf(2),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     604      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wrain_oce',          &
     605      "Pluie eau "//clnsurf(3),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     606      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wrain_sic',          &
     607      "Pluie eau "//clnsurf(4),"kg/(m2*s)", (/ ('', i=1, 9) /)) /)
     608
     609  TYPE(ctrl_out), SAVE, DIMENSION(4) :: o_wsnow_srf    = (/      &
     610      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wsnow_ter',          &
     611      "Neige eau "//clnsurf(1),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     612      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wsnow_lic',          &
     613      "Neige eau "//clnsurf(2),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     614      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wsnow_oce',          &
     615      "Neige eau "//clnsurf(3),"kg/(m2*s)", (/ ('', i=1, 9) /)), &
     616      ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /),'wsnow_sic',          &
     617      "Neige eau "//clnsurf(4),"kg/(m2*s)", (/ ('', i=1, 9) /)) /)
    588618
    589619  TYPE(ctrl_out), SAVE :: o_cdrm = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    … …  
    11441174    'lcc', 'Cloud liquid fraction at top of cloud', '1', (/ ('', i=1, 9) /))
    11451175
     1176#ifdef CPP_StratAer
     1177  TYPE(ctrl_out), SAVE :: o_ext_strat_550 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1178    'ext_strat_550', 'Strat. aerosol extinction coefficient at 550 nm', '1/m', (/ ('', i=1, 9) /))
     1179  TYPE(ctrl_out), SAVE :: o_ext_strat_1020 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1180    'ext_strat_1020', 'Strat. aerosol extinction coefficient at 1020 nm', '1/m', (/ ('', i=1, 9) /))
     1181  TYPE(ctrl_out), SAVE :: o_tau_strat_550 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1182    'OD550_strat_only', 'Stratospheric Aerosol Optical depth at 550 nm ', '1', (/ ('', i=1, 9) /))
     1183  TYPE(ctrl_out), SAVE :: o_tau_strat_1020 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1184    'OD1020_strat_only', 'Stratospheric Aerosol Optical depth at 1020 nm ', '1', (/ ('', i=1, 9) /))
     1185  TYPE(ctrl_out), SAVE :: o_sulf_convert = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1186    'sulf_convert', 'SO2 mass flux converted to H2SO4', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1187  TYPE(ctrl_out), SAVE :: o_sulf_nucl = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1188    'sulf_nucl', 'H2SO4 nucleation mass flux', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1189  TYPE(ctrl_out), SAVE :: o_sulf_cond_evap = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1190    'sulf_cond_evap', 'H2SO4 condensation/evaporation mass flux', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1191  TYPE(ctrl_out), SAVE :: o_ocs_convert = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1192    'ocs_convert', 'OCS mass flux converted to SO2', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1193  TYPE(ctrl_out), SAVE :: o_R2SO4 = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1194    'R2SO4', 'H2SO4 mass fraction in aerosol', '%', (/ ('', i=1, 9) /))
     1195  TYPE(ctrl_out), SAVE :: o_OCS_lifetime = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1196    'OCS_lifetime', 'OCS lifetime', 's', (/ ('', i=1, 9) /))
     1197  TYPE(ctrl_out), SAVE :: o_SO2_lifetime = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1198    'SO2_lifetime', 'SO2 lifetime', 's', (/ ('', i=1, 9) /))
     1199  TYPE(ctrl_out), SAVE :: o_SO2_backgr_tend = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1200    'SO2_backgr_tend', 'SO2 background tendency', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1201  TYPE(ctrl_out), SAVE :: o_OCS_backgr_tend = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1202    'OCS_backgr_tend', 'OCS background tendency', 'kg(S)/m2/layer/s', (/ ('', i=1, 9) /))
     1203  TYPE(ctrl_out), SAVE :: o_vsed_aer = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1204    'vsed_aer', 'Strat. aerosol sedimentation velocity (mass-weighted)', 'm/s', (/ ('', i=1, 9) /))
     1205  TYPE(ctrl_out), SAVE :: o_f_r_wet = ctrl_out((/ 1, 6, 7, 10, 10, 10, 11, 11, 11 /), &
     1206    'f_r_wet', 'Conversion factor dry to wet aerosol radius', '-', (/ ('', i=1, 9) /))
     1207  TYPE(ctrl_out), SAVE :: o_sulf_dep_dry = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1208    'sulf_dep_dry', 'Sulfur dry deposition flux', 'kg(S)/m2/s', (/ ('', i=1, 9) /))
     1209  TYPE(ctrl_out), SAVE :: o_sulf_dep_wet = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1210    'sulf_dep_wet', 'Sulfur wet deposition flux', 'kg(S)/m2/s', (/ ('', i=1, 9) /))
     1211  TYPE(ctrl_out), SAVE :: o_surf_PM25_sulf = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1212    'surf_PM25_sulf', 'Sulfate PM2.5 concentration at the surface', 'ug/m3', (/ ('', i=1, 9) /))
     1213  TYPE(ctrl_out), SAVE :: o_p_tropopause = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1214    'p_tropopause', 'Tropopause pressure', 'Pa', (/ ('', i=1, 9) /))
     1215  TYPE(ctrl_out), SAVE :: o_sfluxaer = ctrl_out((/ 1, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1216    'sflux', 'Ground sedimentation flux of strat. particles', 'kg(S)/m2/s', (/ ('', i=1, 9) /))
     1217#endif
    11461218
    11471219!!!!!!!!!!!!!!!!!!!!!! 3D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    12041276  TYPE(ctrl_out), SAVE :: o_ep = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    12051277    'ep', 'ep', 'su', (/ ('', i=1, 9) /))
     1278  TYPE(ctrl_out), SAVE :: o_duphy = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1279    'duphy', 'Physics du', 'm/s2', (/ ('', i=1, 9) /))
    12061280  TYPE(ctrl_out), SAVE :: o_dtphy = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    12071281    'dtphy', 'Physics dT', 'K/s', (/ ('', i=1, 9) /))

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

    r2594 r2720  
    3232       new_aod, aerosol_couple, flag_aerosol_strat, &
    3333       pdtphys, paprs, pphis, pplay, lmax_th, ptconv, ptconvth, ivap, &
    34        d_t, qx, d_qx, zmasse, ok_sync)   
     34       d_u, d_t, qx, d_qx, zmasse, ok_sync)   
    3535
    3636    USE iophy
    … …  
    4141    USE mod_phys_lmdz_para
    4242    USE aero_mod, only : naero_spc,name_aero
    43         !Martin
     43    !Martin
    4444    USE surface_data, ONLY : ok_snow
    4545    USE phys_output_ctrlout_mod
    … …  
    6565    REAL, INTENT(IN)                            :: pdtphys
    6666    REAL, DIMENSION(klon), INTENT(IN)           :: pphis
    67     REAL, DIMENSION(klon, klev), INTENT(IN)     :: pplay, d_t
     67    REAL, DIMENSION(klon, klev), INTENT(IN)     :: pplay, d_u, d_t
    6868    REAL, DIMENSION(klon, klev+1), INTENT(IN)   :: paprs
    6969    REAL, DIMENSION(klon,klev,nqtot), INTENT(IN):: qx, d_qx
    … …  
    265265         CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
    266266         CALL ymds2ju(annee_ref, 1, day_ini, start_time*rday, zjulian_start)
    267      END IF
     267     ENDIF
    268268
    269269#ifdef CPP_XIOS
    … …  
    293293    WRITE(lunout,*)'Bp Hybrid = ',Bhyb(1:klev)
    294294    WRITE(lunout,*)'Alt approx des couches pour une haut d echelle de 8km = ',Alt(1:klev)
    295     !          endif
     295    !          ENDIF
    296296
    297297  ecrit_files(7) = ecrit_files(1)
    … …  
    302302
    303303       ! Calculate ecrit_files for all files
    304       IF ( chtimestep(iff).eq.'Default' ) then
     304      IF ( chtimestep(iff).eq.'Default' ) THEN
    305305          ! Par defaut ecrit_files = (ecrit_mensuel ecrit_jour ecrit_hf
    306306          ! ...)*86400.
    307307          ecrit_files(iff)=ecrit_files(iff)*86400.
    308       ELSE IF (chtimestep(iff).eq.'-1') then
     308      ELSE IF (chtimestep(iff).eq.'-1') THEN
    309309          PRINT*,'ecrit_files(',iff,') < 0 so IOIPSL work on different'
    310310          PRINT*,'months length'
    311311          ecrit_files(iff)=-1.
    312       else
     312      ELSE
    313313       CALL convers_timesteps(chtimestep(iff),dtime,ecrit_files(iff))
    314314      ENDIF
    … …  
    320320#ifdef CPP_XIOS
    321321!!! Ouverture de chaque fichier XIOS !!!!!!!!!!!
    322     IF (.not. ok_all_xml) then
    323       if (prt_level >= 10) then
     322    IF (.not. ok_all_xml) THEN
     323      IF (prt_level >= 10) THEN
    324324        print*,'phys_output_open: call wxios_add_file with phys_out_filenames(iff)=',trim(phys_out_filenames(iff))   
    325       endif
     325      ENDIF
    326326      CALL wxios_add_file(phys_out_filenames(iff),chtimestep(iff),lev_files(iff)) 
    327327    ENDIF
    328328
    329329!!! Declaration des axes verticaux de chaque fichier:
    330     if (prt_level >= 10) then
     330    IF (prt_level >= 10) THEN
    331331      print*,'phys_output_open: Declare vertical axes for each file'
    332     endif
    333    if (iff.le.6) then
     332    ENDIF
     333   IF (iff.le.6) THEN
    334334    CALL wxios_add_vaxis("presnivs", &
    335335            levmax(iff) - levmin(iff) + 1, presnivs(levmin(iff):levmax(iff)))
    … …  
    340340    CALL wxios_add_vaxis("Alt", &
    341341            levmax(iff) - levmin(iff) + 1, Alt)
    342    else
     342   ELSE
    343343    ! NMC files
    344344    CALL wxios_add_vaxis("plev", &
    345345            levmax(iff) - levmin(iff) + 1, rlevSTD(levmin(iff):levmax(iff)))
    346    endif
     346   ENDIF
    347347#endif
    348348
    … …  
    350350!!!!!!!!!!!!!!!!! Traitement dans le cas ou l'on veut stocker sur un domaine limite !!
    351351!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    352           IF (phys_out_regfkey(iff)) then
     352          IF (phys_out_regfkey(iff)) THEN
    353353             imin_ins=1
    354354             imax_ins=nbp_lon
    … …  
    357357
    358358             ! correction abderr       
    359              do i=1,nbp_lon
     359             DO i=1,nbp_lon
    360360                WRITE(lunout,*)'io_lon(i)=',io_lon(i)
    361361                IF (io_lon(i).le.phys_out_lonmin(iff)) imin_ins=i
    362362                IF (io_lon(i).le.phys_out_lonmax(iff)) imax_ins=i+1
    363              enddo
    364 
    365              do j=1,jjmp1
     363             ENDDO
     364
     365             DO j=1,jjmp1
    366366                WRITE(lunout,*)'io_lat(j)=',io_lat(j)
    367367                IF (io_lat(j).ge.phys_out_latmin(iff)) jmax_ins=j+1
    368368                IF (io_lat(j).ge.phys_out_latmax(iff)) jmin_ins=j
    369              enddo
     369             ENDDO
    370370
    371371             WRITE(lunout,*)'On stoke le fichier histoire numero ',iff,' sur ', &
    … …  
    382382!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    383383             !IM fichiers stations
    384           else IF (clef_stations(iff)) THEN
    385 
    386              if (prt_level >= 10) then
     384          ELSE IF (clef_stations(iff)) THEN
     385
     386             IF (prt_level >= 10) THEN
    387387             WRITE(lunout,*)'phys_output_open: iff=',iff,'  phys_out_filenames(iff)=',phys_out_filenames(iff)
    388              endif
     388             ENDIF
    389389             
    390390             CALL histbeg_phy_all(rlon,rlat,pim,tabij,ipt,jpt,plon,plat,plon_bounds,plat_bounds, &
    391391                  phys_out_filenames(iff), &
    392392                  itau_phy,zjulian,dtime,nhorim(iff),nid_files(iff))
    393           else
     393          ELSE
    394394             CALL histbeg_phy_all(phys_out_filenames(iff),itau_phy,zjulian,&
    395395                 dtime,nhorim(iff),nid_files(iff))
    396           endif
     396          ENDIF
    397397
    398398#ifndef CPP_IOIPSL_NO_OUTPUT
    399           if (iff.le.6) then
     399          IF (iff.le.6) THEN
    400400             CALL histvert(nid_files(iff), "presnivs", "Vertical levels", "Pa", & 
    401401               levmax(iff) - levmin(iff) + 1, &
    … …  
    411411               levmax(iff) - levmin(iff) + 1,Alt,nvertAlt(iff))
    412412
    413           else
     413          ELSE
    414414             CALL histvert(nid_files(iff), "plev", "pressure", "Pa", &
    415415               levmax(iff) - levmin(iff) + 1, &
    416416              rlevSTD(levmin(iff):levmax(iff)), nvertm(iff), "down")
    417           endif
     417          ENDIF
    418418#endif
    419419
    420420     ENDIF ! clef_files
    421421
    422 !CR: ajout d'une variable eau
    423 !      IF (nqtot>=3) THEN
    424 
    425422       IF (nqtot>=nqo+1) THEN
    426 !            DO iq=3,nqtot 
     423!
    427424            DO iq=nqo+1,nqtot
    428425            iiq=niadv(iq)
    429             o_trac(iq-nqo) = ctrl_out((/ 4, 5, 5, 5, 10, 10, 11, 11, 11 /), &
     426            o_trac(iq-nqo) = ctrl_out((/ 1, 5, 5, 5, 10, 10, 11, 11, 11 /), &
    430427                           tname(iiq),'Tracer '//ttext(iiq), "-",  &
    431428                           (/ '', '', '', '', '', '', '', '', '' /))
    … …  
    500497                              (/ '', '', '', '', '', '', '', '', '' /))
    501498
    502             o_trac_cum(iq-nqo) = ctrl_out((/ 3, 4, 10, 10, 10, 10, 11, 11, 11 /), &
     499            o_trac_cum(iq-nqo) = ctrl_out((/ 1, 4, 10, 10, 10, 10, 11, 11, 11 /), &
    503500                               'cum'//tname(iiq),&
    504501                               'Cumulated tracer '//ttext(iiq), "-", &
    … …  
    506503            ENDDO
    507504      ENDIF
    508 
    509505
    510506   ENDDO !  iff
    … …  
    519515    ecrit_ins = ecrit_files(6)
    520516
    521     if (prt_level >= 10) then
     517    IF (prt_level >= 10) THEN
    522518      WRITE(lunout,*)'swaero_diag=',swaero_diag
    523519      WRITE(lunout,*)'phys_output_open: ends here'
    524     endif
    525 
    526   end SUBROUTINE phys_output_open
    527 
    528 
     520    ENDIF
     521
     522  END SUBROUTINE phys_output_open
    529523
    530524  SUBROUTINE convers_timesteps(str,dtime,timestep)
    … …  
    548542    WRITE(lunout,*) "ipos = ", ipos
    549543    WRITE(lunout,*) "il = ", il
    550     if (ipos == 0) call abort_physic("convers_timesteps", "bad str", 1)
     544    IF (ipos == 0) CALL abort_physic("convers_timesteps", "bad str", 1)
    551545    read(str(1:ipos),*) ttt
    552546    WRITE(lunout,*)ttt
    … …  
    554548
    555549
    556     IF ( il == ipos ) then
     550    IF ( il == ipos ) THEN
    557551       type='day'
    558     endif
     552    ENDIF
    559553
    560554    IF ( type == 'day'.or.type == 'days'.or.type == 'jours'.or.type == 'jour' ) timestep = ttt * dayseconde
    561     IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) then
     555    IF ( type == 'mounths'.or.type == 'mth'.or.type == 'mois' ) THEN
    562556       WRITE(lunout,*)'annee_ref,day_ref mon_len',annee_ref,day_ref,mth_len
    563557       timestep = ttt * dayseconde * mth_len
    564     endif
     558    ENDIF
    565559    IF ( type == 'hours'.or.type == 'hr'.or.type == 'heurs') timestep = ttt * dayseconde / 24.
    566560    IF ( type == 'mn'.or.type == 'minutes'  ) timestep = ttt * 60.
    … …  
    575569
    576570END MODULE phys_output_mod
    577 
    578 

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

    r2669 r2720  
    66  USE phytrac_mod, ONLY : d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, &
    77       d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls,  &
    8        d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav
     8       d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav, flux_tr_dry
    99
    1010  ! Author: Abderrahmane IDELKADI (original include file)
    … …  
    1919       ok_ade, ok_aie, ivap, iliq, isol, new_aod, ok_sync, &
    2020       ptconv, read_climoz, clevSTD, ptconvth, &
    21        d_t, qx, d_qx, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)
     21       d_u, d_t, qx, d_qx, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc)
    2222
    2323    ! This subroutine does the actual writing of diagnostics that were
    2424    ! defined and initialised in phys_output_mod.F90
    2525
    26     USE dimphy, only: klon, klev, klevp1
     26    USE dimphy, ONLY: klon, klev, klevp1
     27    USE infotrac, ONLY: nbtr
    2728    USE mod_phys_lmdz_para, ONLY: is_north_pole_phy,is_south_pole_phy
    2829    USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
    29     USE time_phylmdz_mod, only: day_step_phy, start_time, itau_phy
    30     USE phys_output_ctrlout_mod, only: o_phis, o_aire, is_ter, is_lic, is_oce, &
     30    USE time_phylmdz_mod, ONLY: day_step_phy, start_time, itau_phy
     31    USE phys_output_ctrlout_mod, ONLY: o_phis, o_aire, is_ter, is_lic, is_oce, &
    3132         is_ave, is_sic, o_contfracATM, o_contfracOR, &
    3233         o_aireTER, o_flat, o_slp, o_ptstar, o_pt0, o_tsol, &
    … …  
    5960         o_sens_srf, o_lat_srf, o_flw_srf, &
    6061         o_fsw_srf, o_wbils_srf, o_wbilo_srf, &
     62         o_wevap_srf, o_wrain_srf, o_wsnow_srf, &
    6163         o_tke_srf, o_tke_max_srf,o_dltpbltke_srf, o_wstar, &
    6264         o_l_mixmin,o_l_mix, &
    … …  
    122124         o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
    123125         o_rnebls, o_rhum, o_ozone, o_ozone_light, &
    124          o_dtphy, o_dqphy, o_dqphy2d, o_dqlphy, o_dqlphy2d, &
     126         o_duphy, o_dtphy, o_dqphy, o_dqphy2d, o_dqlphy, o_dqlphy2d, &
    125127         o_dqsphy, o_dqsphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
    126128         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, &
    … …  
    162164         o_dtr_lessi_impa, o_dtr_lessi_nucl, &
    163165         o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, &
    164          o_dtr_ls, o_dtr_trsp, o_dtr_sscav, &
     166         o_dtr_ls, o_dtr_trsp, o_dtr_sscav, o_dtr_dry, &
    165167         o_dtr_sat, o_dtr_uscav, o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, &
    166168         o_ustr_gwd_hines,o_vstr_gwd_hines,o_ustr_gwd_rando,o_vstr_gwd_rando, &
    … …  
    181183         o_alt_tropo
    182184
    183 
    184     USE phys_state_var_mod, only: pctsrf, paire_ter, rain_fall, snow_fall, &
     185#ifdef CPP_StratAer
     186    USE phys_output_ctrlout_mod, ONLY:  &
     187         o_sulf_convert, o_sulf_nucl, o_sulf_cond_evap, o_ocs_convert, &
     188         o_sfluxaer, o_R2SO4, o_OCS_lifetime, o_SO2_lifetime, &
     189         o_OCS_backgr_tend, o_SO2_backgr_tend, o_sulf_dep_dry, o_sulf_dep_wet, &
     190         o_surf_PM25_sulf, o_ext_strat_550, o_tau_strat_550, &
     191         o_p_tropopause, o_vsed_aer, o_tau_strat_1020, o_ext_strat_1020, o_f_r_wet
     192#endif
     193
     194    USE phys_state_var_mod, ONLY: pctsrf, paire_ter, rain_fall, snow_fall, &
    185195         qsol, z0m, z0h, fevap, agesno, &
    186196         nday_rain, rain_con, snow_con, &
    … …  
    209219         vphiSTD, wTSTD, u2STD, v2STD, T2STD, missing_val_nf90
    210220
    211     USE phys_local_var_mod, only: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
     221    USE phys_local_var_mod, ONLY: zxfluxlat, slp, ptstar, pt0, zxtsol, zt2m, &
    212222         t2m_min_mon, t2m_max_mon, evap, &
    213223         l_mixmin,l_mix, &
    … …  
    218228         sissnow, runoff, albsol3_lic, evap_pot, &
    219229         t2m, fluxt, fluxlat, fsollw, fsolsw, &
    220          wfbils, wfbilo, cdragm, cdragh, cldl, cldm, &
     230         wfbils, wfbilo, wfevap, wfrain, wfsnow, &
     231         cdragm, cdragh, cldl, cldm, &
    221232         cldh, cldt, JrNt, cldljn, cldmjn, cldhjn, &
    222233         cldtjn, cldq, flwp, fiwp, ue, ve, uq, vq, &
    … …  
    271282         ep, epmax_diag ! epmax_cape
    272283
    273     USE phys_output_var_mod, only: vars_defined, snow_o, zfra_o, bils_diss, &
     284#ifdef CPP_StratAer
     285    USE phys_local_var_mod, ONLY:  &
     286         sulf_convert, sulf_nucl, sulf_cond_evap, ocs_convert, &
     287         sfluxaer, R2SO4, OCS_lifetime, SO2_lifetime, &
     288         OCS_backgr_tend, SO2_backgr_tend, sulf_dep_dry, sulf_dep_wet, &
     289         surf_PM25_sulf, tau_strat_550, p_tropopause, tausum_strat, &
     290         vsed_aer, tau_strat_1020, f_r_wet
     291#endif
     292
     293    USE phys_output_var_mod, ONLY: vars_defined, snow_o, zfra_o, bils_diss, &
    274294         bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, &
    275295         itau_con, nfiles, clef_files, nid_files, &
    … …  
    290310         alt_tropo
    291311
    292  
    293 
    294     USE ocean_slab_mod, only: nslay, tslab, slab_bils, slab_bilg, tice, &
     312    USE ocean_slab_mod, ONLY: nslay, tslab, slab_bils, slab_bilg, tice, &
    295313        seaice, slab_ekman,slab_hdiff, dt_ekman, dt_hdiff
    296     USE pbl_surface_mod, only: snow
    297     USE indice_sol_mod, only: nbsrf
    298     USE infotrac_phy, only: nqtot, nqo, type_trac
    299     USE geometry_mod, only: cell_area
    300     USE surface_data, only: type_ocean, version_ocean, ok_veget, ok_snow
    301 !    USE aero_mod, only: naero_spc
    302     USE aero_mod, only: naero_tot, id_STRAT_phy
    303     USE ioipsl, only: histend, histsync
    304     USE iophy, only: set_itau_iophy, histwrite_phy
    305     USE netcdf, only: nf90_fill_real
     314    USE pbl_surface_mod, ONLY: snow
     315    USE indice_sol_mod, ONLY: nbsrf
     316    USE infotrac_phy, ONLY: nqtot, nqo, type_trac, tname, niadv
     317    USE geometry_mod, ONLY: cell_area
     318    USE surface_data, ONLY: type_ocean, version_ocean, ok_veget, ok_snow
     319!    USE aero_mod, ONLY: naero_spc
     320    USE aero_mod, ONLY: naero_tot, id_STRAT_phy
     321    USE ioipsl, ONLY: histend, histsync
     322    USE iophy, ONLY: set_itau_iophy, histwrite_phy
     323    USE netcdf, ONLY: nf90_fill_real
    306324    USE print_control_mod, ONLY: prt_level,lunout
    307325
    … …  
    309327#ifdef CPP_XIOS
    310328    ! ug Pour les sorties XIOS
    311     USE xios, ONLY: xios_update_calendar
    312     USE wxios, only: wxios_closedef, missing_val
    313 #endif
    314     USE phys_cal_mod, only : mth_len
     329    USE xios
     330    USE wxios, ONLY: wxios_closedef, missing_val
     331#endif
     332    USE phys_cal_mod, ONLY : mth_len
    315333
    316334#ifdef CPP_RRTM
    … …  
    319337
    320338    IMPLICIT NONE
    321 
    322339
    323340    INCLUDE "clesphys.h"
    … …  
    336353    REAL, DIMENSION(klon,nlevSTD) :: zx_tmp_fi3d_STD
    337354    REAL, DIMENSION(klon) :: pphis
    338     REAL, DIMENSION(klon, klev) :: pplay, d_t
     355    REAL, DIMENSION(klon, klev) :: pplay, d_u, d_t
    339356    REAL, DIMENSION(klon, klev+1) :: paprs
    340357    REAL, DIMENSION(klon,klev,nqtot) :: qx, d_qx
    … …  
    347364    ! Local
    348365    INTEGER :: itau_w
    349     INTEGER :: i, iinit, iinitend=1, iff, iq, nsrf, k, ll, naero
     366    INTEGER :: i, iinit, iinitend=1, iff, iq, iiq, nsrf, k, ll, naero
    350367    REAL, DIMENSION (klon) :: zx_tmp_fi2d
    351368    REAL, DIMENSION (klon,klev) :: zx_tmp_fi3d, zpt_conv
    … …  
    362379    INTEGER ISW
    363380    CHARACTER*1 ch1
     381    CHARACTER*20 varname
     382
     383#ifdef CPP_XIOS
     384    TYPE(xios_fieldgroup) :: group_handle
     385    TYPE(xios_field) :: child
     386#endif
    364387
    365388    ! On calcul le nouveau tau:
    … …  
    368391    CALL set_itau_iophy(itau_w)
    369392
    370     IF(.NOT.vars_defined) THEN
     393    IF (.NOT.vars_defined) THEN
    371394       iinitend = 2
    372395    ELSE
    … …  
    374397    ENDIF
    375398
     399#ifdef CPP_XIOS
     400#ifdef CPP_StratAer
     401    IF (.NOT.vars_defined) THEN
     402          !On ajoute les variables 3D traceurs par l interface fortran
     403          CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
     404          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
     405          DO iq=nqo+1, nqtot
     406            iiq=niadv(iq)
     407            varname=trim(tname(iiq))
     408            WRITE (lunout,*) 'XIOS var=', nqo, iq, varname
     409            CALL xios_add_child(group_handle, child, varname)
     410            CALL xios_set_attr(child, name=varname, unit="kg kg-1")
     411            varname='d'//trim(tname(iiq))//'_vdf'
     412            CALL xios_add_child(group_handle, child, varname)
     413            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     414            varname='d'//trim(tname(iiq))//'_the'
     415            CALL xios_add_child(group_handle, child, varname)
     416            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     417            varname='d'//trim(tname(iiq))//'_con'
     418            CALL xios_add_child(group_handle, child, varname)
     419            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     420            varname='d'//trim(tname(iiq))//'_lessi_impa'
     421            CALL xios_add_child(group_handle, child, varname)
     422            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     423            varname='d'//trim(tname(iiq))//'_lessi_nucl'
     424            CALL xios_add_child(group_handle, child, varname)
     425            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     426            varname='d'//trim(tname(iiq))//'_insc'
     427            CALL xios_add_child(group_handle, child, varname)
     428            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     429            varname='d'//trim(tname(iiq))//'_bcscav'
     430            CALL xios_add_child(group_handle, child, varname)
     431            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     432            varname='d'//trim(tname(iiq))//'_evapls'
     433            CALL xios_add_child(group_handle, child, varname)
     434            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     435            varname='d'//trim(tname(iiq))//'_ls'
     436            CALL xios_add_child(group_handle, child, varname)
     437            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     438            varname='d'//trim(tname(iiq))//'_trsp'
     439            CALL xios_add_child(group_handle, child, varname)
     440            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     441            varname='d'//trim(tname(iiq))//'_sscav'
     442            CALL xios_add_child(group_handle, child, varname)
     443            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     444            varname='d'//trim(tname(iiq))//'_sat'
     445            CALL xios_add_child(group_handle, child, varname)
     446            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     447            varname='d'//trim(tname(iiq))//'_uscav'
     448            CALL xios_add_child(group_handle, child, varname)
     449            CALL xios_set_attr(child, name=varname, unit="kg kg-1 s-1")
     450          ENDDO
     451          !On ajoute les variables 2D traceurs par l interface fortran
     452          CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
     453          ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
     454          DO iq=nqo+1, nqtot
     455            iiq=niadv(iq)
     456            varname='cum'//trim(tname(iiq))
     457            WRITE (lunout,*) 'XIOS var=', iq, varname
     458            CALL xios_add_child(group_handle, child, varname)
     459            CALL xios_set_attr(child, name=varname, unit="kg m-2")
     460            varname='cumd'//trim(tname(iiq))//'_dry'
     461            CALL xios_add_child(group_handle, child, varname)
     462            CALL xios_set_attr(child, name=varname, unit="kg m-2 s-1")
     463          ENDDO
     464    ENDIF
     465#endif
     466#endif
     467
    376468    ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage:
    377469    DO iinit=1, iinitend
    … …  
    379471       !$OMP MASTER
    380472       IF (vars_defined) THEN
    381           if (prt_level >= 10) then
     473          IF (prt_level >= 10) then
    382474             write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w
    383           endif
     475          ENDIF
    384476!          CALL xios_update_calendar(itau_w)
    385477          CALL xios_update_calendar(itap)
    386        END IF
     478       ENDIF
    387479       !$OMP END MASTER
    388480       !$OMP BARRIER
    … …  
    393485
    394486       zx_tmp_fi2d = cell_area
    395        if (is_north_pole_phy) then
     487       IF (is_north_pole_phy) then
    396488         zx_tmp_fi2d(1) = cell_area(1)/nbp_lon
    397        endif
    398        if (is_south_pole_phy) then
     489       ENDIF
     490       IF (is_south_pole_phy) then
    399491         zx_tmp_fi2d(klon) = cell_area(klon)/nbp_lon
    400        endif
     492       ENDIf
    401493       CALL histwrite_phy(o_aire, zx_tmp_fi2d)
    402494
    … …  
    679771
    680772       DO nsrf = 1, nbsrf
     773
    681774          IF (vars_defined)             zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100.
    682775          CALL histwrite_phy(o_pourc_srf(nsrf), zx_tmp_fi2d)
    … …  
    713806          IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfbilo( 1 : klon, nsrf)
    714807          CALL histwrite_phy(o_wbilo_srf(nsrf), zx_tmp_fi2d)
     808          IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfevap( 1 : klon, nsrf)
     809          CALL histwrite_phy(o_wevap_srf(nsrf), zx_tmp_fi2d)
     810          IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfrain( 1 : klon, nsrf)
     811          CALL histwrite_phy(o_wrain_srf(nsrf), zx_tmp_fi2d)
     812          IF (vars_defined)         zx_tmp_fi2d(1 : klon) = wfsnow( 1 : klon, nsrf)
     813          CALL histwrite_phy(o_wsnow_srf(nsrf), zx_tmp_fi2d)
    715814
    716815          IF (iflag_pbl > 1) THEN
    … …  
    770869       CALL histwrite_phy(o_uq, uq)
    771870       CALL histwrite_phy(o_vq, vq)
    772        IF(iflag_con.GE.3) THEN ! sb
     871       IF (iflag_con.GE.3) THEN ! sb
    773872          CALL histwrite_phy(o_cape, cape)
    774873          CALL histwrite_phy(o_pbase, ema_pcb)
    775874          CALL histwrite_phy(o_ptop, ema_pct)
    776875          CALL histwrite_phy(o_fbase, ema_cbmf)
    777           if (iflag_con /= 30) then
     876          IF (iflag_con /= 30) THEN
    778877             CALL histwrite_phy(o_plcl, plcl)
    779878             CALL histwrite_phy(o_plfc, plfc)
    780879             CALL histwrite_phy(o_wbeff, wbeff)
    781           end if
     880          ENDIF
    782881
    783882          CALL histwrite_phy(o_cape_max, cape)
    … …  
    790889          CALL histwrite_phy(o_ftime_con, zx_tmp_fi2d)
    791890          IF (vars_defined) THEN
    792              IF(iflag_thermals>=1)THEN
     891             IF (iflag_thermals>=1)THEN
    793892                zx_tmp_fi3d=dnwd+dnwd0+upwd+fm_therm(:,1:klev)
    794893             ELSE
    … …  
    841940          DO k=1, nlevSTD
    842941             bb2=clevSTD(k)
    843              IF(bb2.EQ."850".OR.bb2.EQ."700".OR. &
     942             IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
    844943                  bb2.EQ."500".OR.bb2.EQ."200".OR. &
    845944                  bb2.EQ."100".OR. &
    … …  
    862961#endif
    863962#ifdef CPP_XIOS
    864   IF(ok_all_xml) THEN
     963  IF (ok_all_xml) THEN
    865964!XIOS  CALL xios_get_field_attr("u850",default_value=missing_val)
    866965!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    868967          DO k=1, nlevSTD
    869968             bb2=clevSTD(k)
    870              IF(bb2.EQ."850".OR.bb2.EQ."700".OR. &
     969             IF (bb2.EQ."850".OR.bb2.EQ."700".OR. &
    871970                bb2.EQ."500".OR.bb2.EQ."200".OR. &
    872971                bb2.EQ."100".OR. &
    … …  
    9851084          ELSE
    9861085              CALL histwrite_phy(o_tslab, tslab(:,1:nslay))
    987           END IF
     1086          ENDIF
    9881087          IF (version_ocean=='sicINT') THEN
    9891088              CALL histwrite_phy(o_slab_bilg, slab_bilg)
    9901089              CALL histwrite_phy(o_slab_tice, tice)
    9911090              CALL histwrite_phy(o_slab_sic, seaice)
    992           END IF
     1091          ENDIF
    9931092          IF (slab_hdiff) THEN
    9941093            IF (nslay.EQ.1) THEN
    … …  
    9971096            ELSE
    9981097                CALL histwrite_phy(o_slab_hdiff, dt_hdiff(:,1:nslay))
    999             END IF
    1000           END IF
     1098            ENDIF
     1099          ENDIF
    10011100          IF (slab_ekman.GT.0) THEN
    10021101            IF (nslay.EQ.1) THEN
    … …  
    10051104            ELSE
    10061105                CALL histwrite_phy(o_slab_ekman, dt_ekman(:,1:nslay))
    1007             END IF
    1008           END IF
     1106            ENDIF
     1107          ENDIF
    10091108       ENDIF !type_ocean == force/slab
    10101109       CALL histwrite_phy(o_weakinv, weak_inversion)
    … …  
    10851184          ENDIF
    10861185          IF (flag_aerosol.GT.0.OR.flag_aerosol_strat.GT.0) THEN
    1087 !             DO naero = 1, naero_spc
    1088 !--correction mini bug OB
    10891186             DO naero = 1, naero_tot
    1090                 CALL histwrite_phy(o_tausumaero(naero), &
    1091                      tausum_aero(:,2,naero) )
     1187                CALL histwrite_phy(o_tausumaero(naero),tausum_aero(:,2,naero))
    10921188             END DO
    10931189          ENDIF
    10941190          IF (flag_aerosol_strat.GT.0) THEN
    1095              CALL histwrite_phy(o_tausumaero_lw, &
    1096                   tausum_aero(:,6,id_STRAT_phy) )
    1097           ENDIF
    1098        ENDIF
     1191             CALL histwrite_phy(o_tausumaero_lw,tausum_aero(:,6,id_STRAT_phy))
     1192          ENDIF
     1193       ENDIF
     1194#ifdef CPP_StratAer
     1195       IF (type_trac=='coag') THEN
     1196          CALL histwrite_phy(o_sulf_convert, sulf_convert)
     1197          CALL histwrite_phy(o_sulf_nucl, sulf_nucl)
     1198          CALL histwrite_phy(o_sulf_cond_evap, sulf_cond_evap)
     1199          CALL histwrite_phy(o_ocs_convert, ocs_convert)
     1200          CALL histwrite_phy(o_R2SO4, R2SO4)
     1201          CALL histwrite_phy(o_OCS_lifetime, OCS_lifetime)
     1202          CALL histwrite_phy(o_SO2_lifetime, SO2_lifetime)
     1203          CALL histwrite_phy(o_OCS_backgr_tend, OCS_backgr_tend)
     1204          CALL histwrite_phy(o_SO2_backgr_tend, SO2_backgr_tend)
     1205          CALL histwrite_phy(o_sulf_dep_dry, sulf_dep_dry)
     1206          CALL histwrite_phy(o_sulf_dep_wet, sulf_dep_wet)
     1207          CALL histwrite_phy(o_surf_PM25_sulf, surf_PM25_sulf)
     1208          CALL histwrite_phy(o_p_tropopause, p_tropopause)
     1209          CALL histwrite_phy(o_sfluxaer, sfluxaer)
     1210          CALL histwrite_phy(o_vsed_aer, vsed_aer)
     1211          CALL histwrite_phy(o_f_r_wet, f_r_wet)
     1212          CALL histwrite_phy(o_ext_strat_550, tau_strat_550)
     1213          CALL histwrite_phy(o_ext_strat_1020, tau_strat_1020)
     1214          CALL histwrite_phy(o_tau_strat_550, tausum_strat(:,1))
     1215          CALL histwrite_phy(o_tau_strat_1020, tausum_strat(:,2))
     1216       ENDIF
     1217#endif
    10991218       IF (ok_ade) THEN
    11001219          CALL histwrite_phy(o_topswad, topswad_aero*swradcorr)
    … …  
    11071226          CALL histwrite_phy(o_sollwad0, sollwad0_aero)
    11081227          !====MS forcing diagnostics
    1109           if (new_aod) then
     1228          IF (new_aod) THEN
    11101229             zx_tmp_fi2d(:)=topsw_aero(:,1)*swradcorr(:)
    11111230             CALL histwrite_phy(o_swtoaas_nat,zx_tmp_fi2d)
    … …  
    11261245             CALL histwrite_phy(o_swsrfcs_ant,zx_tmp_fi2d)
    11271246             !cf
    1128              if (.not. aerosol_couple) then
     1247             IF (.not. aerosol_couple) THEN
    11291248                zx_tmp_fi2d(:)=topswcf_aero(:,1)*swradcorr(:)
    11301249                CALL histwrite_phy(o_swtoacf_nat,zx_tmp_fi2d)
    … …  
    11391258                zx_tmp_fi2d(:)=solswcf_aero(:,3)*swradcorr(:)
    11401259                CALL histwrite_phy(o_swsrfcf_zero,zx_tmp_fi2d)
    1141              endif
    1142           endif ! new_aod
     1260             ENDIF
     1261          ENDIF ! new_aod
    11431262          !====MS forcing diagnostics
    11441263       ENDIF
    … …  
    12141333       ENDIF
    12151334
     1335       CALL histwrite_phy(o_duphy, d_u)
     1336
    12161337       CALL histwrite_phy(o_dtphy, d_t)
    12171338
    … …  
    12501371       CALL histwrite_phy(o_alb2, albsol2)
    12511372       !FH Sorties pour la couche limite
    1252        if (iflag_pbl>1) then
     1373       IF (iflag_pbl>1) THEN
    12531374          zx_tmp_fi3d=0.
    12541375          IF (vars_defined) THEN
    1255              do nsrf=1,nbsrf
    1256                 do k=1,klev
     1376             DO nsrf=1,nbsrf
     1377                DO k=1,klev
    12571378                   zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) &
    12581379                        +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
    1259                 enddo
    1260              enddo
     1380                ENDDO
     1381             ENDDO
    12611382          ENDIF
    12621383          CALL histwrite_phy(o_tke, zx_tmp_fi3d)
    … …  
    13141435       CALL histwrite_phy(o_dqcon2d, zx_tmp_fi2d)
    13151436
    1316        IF(iflag_thermals.EQ.0) THEN
     1437       IF (iflag_thermals.EQ.0) THEN
    13171438          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys
    13181439          CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d)
    1319        ELSE IF(iflag_thermals.GE.1.AND.iflag_wake.EQ.1) THEN
     1440       ELSE IF (iflag_thermals.GE.1.AND.iflag_wake.EQ.1) THEN
    13201441          IF (vars_defined) THEN
    13211442             zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys + &
    … …  
    13391460!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13401461       ! Sorties specifiques a la separation thermiques/non thermiques
    1341        if (iflag_thermals>=1) then
    1342           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscth(1:klon,1:klev)/pdtphys
     1462       IF (iflag_thermals>=1) THEN
     1463          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscth(1:klon,1:klev)/pdtphys
    13431464          CALL histwrite_phy(o_dtlscth, zx_tmp_fi3d)
    1344           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscst(1:klon,1:klev)/pdtphys
     1465          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscst(1:klon,1:klev)/pdtphys
    13451466          CALL histwrite_phy(o_dtlscst, zx_tmp_fi3d)
    1346           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys
     1467          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys
    13471468          CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d)
    13481469          CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    13491470          CALL histwrite_phy(o_dqlscth2d, zx_tmp_fi2d)
    1350           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys
     1471          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys
    13511472          CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d)
    13521473          CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    … …  
    13551476          CALL histwrite_phy(o_plulst, plul_st)
    13561477          IF (vars_defined) THEN
    1357              do k=1,klev
    1358                 do i=1,klon
    1359                    if (ptconvth(i,k)) then
     1478             DO k=1,klev
     1479                DO i=1,klon
     1480                   IF (ptconvth(i,k)) THEN
    13601481                      zx_tmp_fi3d(i,k)=1.
    1361                    else
     1482                   ELSE
    13621483                      zx_tmp_fi3d(i,k)=0.
    1363                    endif
    1364                 enddo
    1365              enddo
     1484                   ENDIF
     1485                ENDDO
     1486             ENDDO
    13661487          ENDIF
    13671488          CALL histwrite_phy(o_ptconvth, zx_tmp_fi3d)
    … …  
    13721493          ENDIF
    13731494          CALL histwrite_phy(o_lmaxth, zx_tmp_fi2d)
    1374        endif ! iflag_thermals>=1
     1495       ENDIF ! iflag_thermals>=1
    13751496!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13761497       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)/pdtphys
    13771498       CALL histwrite_phy(o_dtvdf, zx_tmp_fi3d)
    1378        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_diss(1:klon,1:klev)/pdtphys
     1499       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_diss(1:klon,1:klev)/pdtphys
    13791500       CALL histwrite_phy(o_dtdis, zx_tmp_fi3d)
    13801501       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys
    … …  
    14261547          CALL histwrite_phy(o_dqthe2d, zx_tmp_fi2d)
    14271548       ENDIF !iflag_thermals
    1428        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
     1549       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
    14291550       CALL histwrite_phy(o_dtajs, zx_tmp_fi3d)
    1430        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
     1551       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
    14311552       CALL histwrite_phy(o_dqajs, zx_tmp_fi3d)
    14321553       CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
    14331554       CALL histwrite_phy(o_dqajs2d, zx_tmp_fi2d)
    1434        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys
     1555       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys
    14351556       CALL histwrite_phy(o_dtswr, zx_tmp_fi3d)
    1436        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_sw0(1:klon,1:klev)/pdtphys
     1557       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_sw0(1:klon,1:klev)/pdtphys
    14371558       CALL histwrite_phy(o_dtsw0, zx_tmp_fi3d)
    1438        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lwr(1:klon,1:klev)/pdtphys
     1559       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lwr(1:klon,1:klev)/pdtphys
    14391560       CALL histwrite_phy(o_dtlwr, zx_tmp_fi3d)
    1440        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lw0(1:klon,1:klev)/pdtphys
     1561       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lw0(1:klon,1:klev)/pdtphys
    14411562       CALL histwrite_phy(o_dtlw0, zx_tmp_fi3d)
    1442        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)/pdtphys
     1563       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)/pdtphys
    14431564       CALL histwrite_phy(o_dtec, zx_tmp_fi3d)
    1444        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_vdf(1:klon,1:klev)/pdtphys
     1565       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_vdf(1:klon,1:klev)/pdtphys
    14451566       CALL histwrite_phy(o_duvdf, zx_tmp_fi3d)
    1446        IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_vdf(1:klon,1:klev)/pdtphys
     1567       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_vdf(1:klon,1:klev)/pdtphys
    14471568       CALL histwrite_phy(o_dvvdf, zx_tmp_fi3d)
    14481569       IF (ok_orodr) THEN
    1449           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_oro(1:klon,1:klev)/pdtphys
     1570          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_oro(1:klon,1:klev)/pdtphys
    14501571          CALL histwrite_phy(o_duoro, zx_tmp_fi3d)
    1451           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_oro(1:klon,1:klev)/pdtphys
     1572          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_oro(1:klon,1:klev)/pdtphys
    14521573          CALL histwrite_phy(o_dvoro, zx_tmp_fi3d)
    1453           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_oro(1:klon,1:klev)/pdtphys
     1574          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_oro(1:klon,1:klev)/pdtphys
    14541575          CALL histwrite_phy(o_dtoro, zx_tmp_fi3d)
    14551576       ENDIF
    14561577       IF (ok_orolf) THEN
    1457           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_lif(1:klon,1:klev)/pdtphys
     1578          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_lif(1:klon,1:klev)/pdtphys
    14581579          CALL histwrite_phy(o_dulif, zx_tmp_fi3d)
    14591580
    1460           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_lif(1:klon,1:klev)/pdtphys
     1581          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_lif(1:klon,1:klev)/pdtphys
    14611582          CALL histwrite_phy(o_dvlif, zx_tmp_fi3d)
    14621583
    1463           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lif(1:klon,1:klev)/pdtphys
     1584          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lif(1:klon,1:klev)/pdtphys
    14641585          CALL histwrite_phy(o_dtlif, zx_tmp_fi3d)
    14651586       ENDIF
    … …  
    14681589          CALL histwrite_phy(o_du_gwd_hines, du_gwd_hines/pdtphys)
    14691590          CALL histwrite_phy(o_dv_gwd_hines, dv_gwd_hines/pdtphys)
    1470           IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys
     1591          IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys
    14711592          CALL histwrite_phy(o_dthin, zx_tmp_fi3d)
    14721593          CALL histwrite_phy(o_ustr_gwd_hines, zustr_gwd_hines)
    14731594          CALL histwrite_phy(o_vstr_gwd_hines, zvstr_gwd_hines)
    1474        end IF
    1475 
    1476        if (.not. ok_hines .and. ok_gwd_rando) then
     1595       ENDIF
     1596
     1597       IF (.not. ok_hines .and. ok_gwd_rando) THEN
    14771598          CALL histwrite_phy(o_du_gwd_front, du_gwd_front / pdtphys)
    14781599          CALL histwrite_phy(o_dv_gwd_front, dv_gwd_front / pdtphys)
    … …  
    14811602       ENDIF
    14821603
    1483        IF (ok_gwd_rando) then
     1604       IF (ok_gwd_rando) THEN
    14841605          CALL histwrite_phy(o_du_gwd_rando, du_gwd_rando / pdtphys)
    14851606          CALL histwrite_phy(o_dv_gwd_rando, dv_gwd_rando / pdtphys)
    … …  
    14881609          CALL histwrite_phy(o_east_gwstress, east_gwstress )
    14891610          CALL histwrite_phy(o_west_gwstress, west_gwstress )
    1490        end IF
    1491 
    1492        IF (ok_qch4) then
     1611       ENDIF
     1612
     1613       IF (ok_qch4) THEN
    14931614          CALL histwrite_phy(o_dqch4, d_q_ch4 / pdtphys)
    14941615       ENDIF
    … …  
    15161637       CALL histwrite_phy(o_rldcs, lwdn0)
    15171638
    1518        IF(vars_defined) THEN
     1639       IF (vars_defined) THEN
    15191640          zx_tmp_fi3d(1:klon,1:klev)=d_t(1:klon,1:klev)+ &
    15201641               d_t_dyn(1:klon,1:klev)
    … …  
    15221643       CALL histwrite_phy(o_tnt, zx_tmp_fi3d)
    15231644
    1524        IF(vars_defined) THEN
     1645       IF (vars_defined) THEN
    15251646          zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys + &
    15261647               d_t_lwr(1:klon,1:klev)/pdtphys
    15271648       ENDIF
    15281649       CALL histwrite_phy(o_tntr, zx_tmp_fi3d)
    1529        IF(vars_defined) THEN
     1650       IF (vars_defined) THEN
    15301651          zx_tmp_fi3d(1:klon,1:klev)= (d_t_lsc(1:klon,1:klev)+ &
    15311652               d_t_eva(1:klon,1:klev)+ &
    … …  
    15331654       ENDIF
    15341655       CALL histwrite_phy(o_tntscpbl, zx_tmp_fi3d)
    1535        IF(vars_defined) THEN
     1656       IF (vars_defined) THEN
    15361657          zx_tmp_fi3d(1:klon,1:klev)=d_qx(1:klon,1:klev,ivap)+ &
    15371658               d_q_dyn(1:klon,1:klev)
    15381659       ENDIF
    15391660       CALL histwrite_phy(o_tnhus, zx_tmp_fi3d)
    1540        IF(vars_defined) THEN
     1661       IF (vars_defined) THEN
    15411662          zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys+ &
    15421663               d_q_eva(1:klon,1:klev)/pdtphys
    … …  
    15441665       CALL histwrite_phy(o_tnhusscpbl, zx_tmp_fi3d)
    15451666       CALL histwrite_phy(o_evu, coefm(:,:,is_ave))
    1546        IF(vars_defined) THEN
     1667       IF (vars_defined) THEN
    15471668          zx_tmp_fi3d(1:klon,1:klev)=q_seri(1:klon,1:klev)+ &
    15481669               ql_seri(1:klon,1:klev)
    15491670       ENDIF
    15501671       CALL histwrite_phy(o_h2o, zx_tmp_fi3d)
    1551        if (iflag_con >= 3) then
    1552           IF(vars_defined) THEN
     1672       IF (iflag_con >= 3) THEN
     1673          IF (vars_defined) THEN
    15531674             zx_tmp_fi3d(1:klon,1:klev)=-1 * (dnwd(1:klon,1:klev)+ &
    15541675                  dnwd0(1:klon,1:klev))
    15551676          ENDIF
    15561677          CALL histwrite_phy(o_mcd, zx_tmp_fi3d)
    1557           IF(vars_defined) THEN
     1678          IF (vars_defined) THEN
    15581679             zx_tmp_fi3d(1:klon,1:klev)=upwd(1:klon,1:klev) + &
    15591680                  dnwd(1:klon,1:klev)+ dnwd0(1:klon,1:klev)
    15601681          ENDIF
    15611682          CALL histwrite_phy(o_dmc, zx_tmp_fi3d)
    1562        else if (iflag_con == 2) then
     1683       ELSE IF (iflag_con == 2) THEN
    15631684          CALL histwrite_phy(o_mcd,  pmfd)
    15641685          CALL histwrite_phy(o_dmc,  pmfu + pmfd)
    1565        end if
     1686       ENDIF
    15661687       CALL histwrite_phy(o_ref_liq, ref_liq)
    15671688       CALL histwrite_phy(o_ref_ice, ref_ice)
    1568        if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
     1689       IF (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
    15691690            RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
    15701691            RCFC12_per.NE.RCFC12_act) THEN
    1571           IF(vars_defined) zx_tmp_fi2d(:) = swupp(:,klevp1)*swradcorr(:)
     1692          IF (vars_defined) zx_tmp_fi2d(:) = swupp(:,klevp1)*swradcorr(:)
    15721693          CALL histwrite_phy(o_rsut4co2, zx_tmp_fi2d)
    1573           IF(vars_defined) zx_tmp_fi2d(:) = lwupp(:,klevp1)
     1694          IF (vars_defined) zx_tmp_fi2d(:) = lwupp(:,klevp1)
    15741695          CALL histwrite_phy(o_rlut4co2, zx_tmp_fi2d)
    1575           IF(vars_defined) zx_tmp_fi2d(:) = swup0p(:,klevp1)*swradcorr(:)
     1696          IF (vars_defined) zx_tmp_fi2d(:) = swup0p(:,klevp1)*swradcorr(:)
    15761697          CALL histwrite_phy(o_rsutcs4co2, zx_tmp_fi2d)
    1577           IF(vars_defined) zx_tmp_fi2d(:) = lwup0p(:,klevp1)
     1698          IF (vars_defined) zx_tmp_fi2d(:) = lwup0p(:,klevp1)
    15781699          CALL histwrite_phy(o_rlutcs4co2, zx_tmp_fi2d)
    15791700          DO k=1, klevp1
    … …  
    16151736          CALL histwrite_phy(o_va,vwriteSTD(:,:,iff-6),iff)
    16161737          CALL histwrite_phy(o_wap,wwriteSTD(:,:,iff-6),iff)
    1617           IF(vars_defined) THEN
     1738          IF (vars_defined) THEN
    16181739             DO k=1, nlevSTD
    16191740                DO i=1, klon
    1620                    IF(tnondef(i,k,iff-6).NE.missing_val) THEN
    1621                       IF(freq_outNMC(iff-6).LT.0) THEN
     1741                   IF (tnondef(i,k,iff-6).NE.missing_val) THEN
     1742                      IF (freq_outNMC(iff-6).LT.0) THEN
    16221743                         freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6)
    16231744                      ELSE
    … …  
    16321753          ENDIF
    16331754          CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD,iff)
    1634           IF(vars_defined) THEN
     1755          IF (vars_defined) THEN
    16351756             DO k=1, nlevSTD
    16361757                DO i=1, klon
    1637                    IF(O3sumSTD(i,k,iff-6).NE.missing_val) THEN
     1758                   IF (O3sumSTD(i,k,iff-6).NE.missing_val) THEN
    16381759                      zx_tmp_fi3d_STD(i,k) = O3sumSTD(i,k,iff-6) * 1.e+9
    16391760                   ELSE
    … …  
    16441765          ENDIF
    16451766          CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD,iff)
    1646           if (read_climoz == 2) THEN
    1647              IF(vars_defined) THEN
     1767          IF (read_climoz == 2) THEN
     1768             IF (vars_defined) THEN
    16481769                DO k=1, nlevSTD
    16491770                   DO i=1, klon
    1650                       IF(O3daysumSTD(i,k,iff-6).NE.missing_val) THEN
     1771                      IF (O3daysumSTD(i,k,iff-6).NE.missing_val) THEN
    16511772                         zx_tmp_fi3d_STD(i,k) = O3daysumSTD(i,k,iff-6) * 1.e+9
    16521773                      ELSE
    … …  
    16721793#endif
    16731794#ifdef CPP_XIOS
    1674   IF(ok_all_xml) THEN
     1795  IF (ok_all_xml) THEN
    16751796!      DO iff=7, nfiles
    16761797
    … …  
    16831804          CALL histwrite_phy(o_va,vlevSTD(:,:))
    16841805          CALL histwrite_phy(o_wap,wlevSTD(:,:))
    1685 !         IF(vars_defined) THEN
     1806!         IF (vars_defined) THEN
    16861807!            DO k=1, nlevSTD
    16871808!               DO i=1, klon
    1688 !                  IF(tnondef(i,k,3).NE.missing_val) THEN
    1689 !                     IF(freq_outNMC(iff-6).LT.0) THEN
     1809!                  IF (tnondef(i,k,3).NE.missing_val) THEN
     1810!                     IF (freq_outNMC(iff-6).LT.0) THEN
    16901811!                        freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6)
    16911812!                     ELSE
    … …  
    17001821!         ENDIF
    17011822!         CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD)
    1702           IF(vars_defined) THEN
     1823          IF (vars_defined) THEN
    17031824             DO k=1, nlevSTD
    17041825                DO i=1, klon
    1705                    IF(O3STD(i,k).NE.missing_val) THEN
     1826                   IF (O3STD(i,k).NE.missing_val) THEN
    17061827                      zx_tmp_fi3d_STD(i,k) = O3STD(i,k) * 1.e+9
    17071828                   ELSE
    … …  
    17121833          ENDIF
    17131834          CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD)
    1714           if (read_climoz == 2) THEN
    1715              IF(vars_defined) THEN
     1835          IF (read_climoz == 2) THEN
     1836             IF (vars_defined) THEN
    17161837                DO k=1, nlevSTD
    17171838                   DO i=1, klon
    1718                       IF(O3daySTD(i,k).NE.missing_val) THEN
     1839                      IF (O3daySTD(i,k).NE.missing_val) THEN
    17191840                         zx_tmp_fi3d_STD(i,k) = O3daySTD(i,k) * 1.e+9
    17201841                      ELSE
    … …  
    17251846             ENDIF
    17261847             CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD)
    1727           endif
     1848          ENDIF
    17281849          CALL histwrite_phy(o_uxv,uvSTD(:,:))
    17291850          CALL histwrite_phy(o_vxq,vqSTD(:,:))
    … …  
    17391860#endif
    17401861!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1741         IF (nqtot.GE.nqo+1) THEN
    1742             DO iq=nqo+1,nqtot
    1743               IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN
    1744 
    1745 !jyg<
    1746 !!             CALL histwrite_phy(o_trac(iq-nqo), qx(:,:,iq))
     1862       IF (nqtot.GE.nqo+1) THEN
     1863          DO iq=nqo+1, nqtot
     1864            IF (type_trac == 'lmdz' .OR. type_trac == 'repr' .OR. type_trac == 'coag') THEN
     1865             !--3D fields
    17471866             CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo))
    1748 !>jyg
    17491867             CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo))
    17501868             CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo))
    … …  
    17601878             CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo))
    17611879             CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo))
     1880             !--2D fields
     1881             CALL histwrite_phy(o_dtr_dry(iq-nqo), flux_tr_dry(:,iq-nqo))
    17621882             zx_tmp_fi2d=0.
    1763              IF(vars_defined) THEN
     1883             IF (vars_defined) THEN
    17641884                DO k=1,klev
    1765 !jyg<
    1766 !!                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*qx(:,k,iq)
    17671885                   zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo)
    1768 !>jyg
    17691886                ENDDO
    17701887             ENDIF
    17711888             CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d)
    1772              endif
    1773           ENDDO
    1774        ENDIF
    1775 
    1776        IF(.NOT.vars_defined) THEN
     1889            ENDIF
     1890          ENDDO
     1891       ENDIF
     1892
     1893       IF (.NOT.vars_defined) THEN
    17771894          !$OMP MASTER
    17781895#ifndef CPP_IOIPSL_NO_OUTPUT
    … …  
    17821899                ndex2d = 0
    17831900                ndex3d = 0
    1784 
    17851901             ENDIF ! clef_files
    17861902          ENDDO !  iff
    … …  
    17901906          CALL wxios_closedef()
    17911907#endif
    1792 
    17931908          !$OMP END MASTER
    17941909          !$OMP BARRIER
    17951910          vars_defined = .TRUE.
    17961911
    1797        END IF
    1798 
    1799     END DO
    1800 
    1801     IF(vars_defined) THEN
     1912       ENDIF !--.NOT.vars_defined
     1913
     1914    ENDDO
     1915
     1916    IF (vars_defined) THEN
    18021917       ! On synchronise les fichiers pour IOIPSL
    18031918#ifndef CPP_IOIPSL_NO_OUTPUT
    … …  
    18121927    ENDIF
    18131928
    1814 
    18151929  END SUBROUTINE phys_output_write
    18161930

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

    r2641 r2720  
    1717      INTEGER, PARAMETER :: napisccp=1
    1818      INTEGER, SAVE :: radpas
     19      INTEGER, SAVE :: cvpas
    1920      REAL, PARAMETER :: missing_val_nf90=nf90_fill_real
    2021!$OMP THREADPRIVATE(radpas)
     22!$OMP THREADPRIVATE(cvpas)
    2123      REAL, SAVE :: dtime, solaire_etat0
    2224!$OMP THREADPRIVATE(dtime, solaire_etat0)

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

    r2682 r2720  
    5454       d_t_ajs_x,d_q_ajs_x, &
    5555       !
    56        d_t_eva,d_q_eva, &
     56       d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
    5757       d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, &
    5858       d_t_lscst,d_q_lscst, &
    … …  
    174174       fsollw, evap_pot,  &
    175175       fsolsw, wfbils, wfbilo,  &
    176        
     176       wfevap, wfrain, wfsnow,  & 
    177177       pmflxr, pmflxs, prfl,  &
    178178       psfl, fraca, Vprecip,  &
    … …  
    219219#ifdef CPP_XIOS
    220220    USE wxios, ONLY: missing_val, missing_val_omp
    221     USE xios, ONLY: xios_get_field_attr
     221    USE xios, ONLY: xios_get_field_attr, xios_field_is_active
    222222#endif
    223223#ifdef REPROBUS
    … …  
    745745    REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
    746746    REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
    747 
    748     !
    749     !  REAL zxsnow(klon)
     747    !
    750748    REAL zxsnow_dummy(klon)
    751749    REAL zsav_tsol(klon)
    … …  
    763761    real zqsat(klon,klev)
    764762    !
    765     INTEGER i, k, iq, ig, j, nsrf, ll, l, iiq
     763    INTEGER i, k, iq, j, nsrf, ll, l
    766764    !
    767765    REAL t_coup
    … …  
    777775    REAL s_trmb1(klon), s_trmb2(klon)
    778776    REAL s_trmb3(klon)
     777
     778    ! La convection n'est pas calculee tous les pas, il faut donc
     779    !                      sauvegarder les sorties de la convection
     780    !ym      SAVE 
     781    !ym      SAVE 
     782    !ym      SAVE 
     783    !
     784    INTEGER itapcv
     785    SAVE itapcv
     786    !$OMP THREADPRIVATE(itapcv)
     787
    779788    !KE43
    780789    ! Variables locales pour la convection de K. Emanuel (sb):
    … …  
    884893    !IM 141004 END
    885894    !IM 190504 BEG
    886     INTEGER ij
    887895    !  INTEGER imp1jmp1
    888896    !  PARAMETER(imp1jmp1=(iim+1)*jjmp1)
    … …  
    893901    LOGICAL ok_msk
    894902    REAL msk(klon)
    895     !IM
    896     REAL airetot, pi
    897903    !ym A voir plus tard
    898904    !ym      REAL zm_wo(jjmp1, klev)
    … …  
    932938    !$OMP THREADPRIVATE(ok_sync)
    933939    real date0
    934     integer idayref
    935940
    936941    ! essai writephys
    … …  
    953958    DATA      ip_ebil/0/
    954959    !$OMP THREADPRIVATE(ip_ebil)
    955     INTEGER   if_ebil ! level for energy conserv. dignostics
    956     SAVE      if_ebil
    957     !$OMP THREADPRIVATE(if_ebil)
    958960    REAL q2m(klon,nbsrf)  ! humidite a 2m
    959961
    … …  
    10991101    ! en imposant la valeur de igout.
    11001102    !======================================================================d
    1101     if (prt_level.ge.1) then
     1103    IF (prt_level.ge.1) THEN
    11021104       igout=klon/2+1/klon
    11031105       write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    … …  
    11101112
    11111113       write(lunout,*) 'paprs, play, phi, u, v, t'
    1112        do k=1,klev
     1114       DO k=1,klev
    11131115          write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
    11141116               u(igout,k),v(igout,k),t(igout,k)
    1115        enddo
     1117       ENDDO
    11161118       write(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
    1117        do k=1,klev
     1119       DO k=1,klev
    11181120          write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
    1119        enddo
    1120     endif
     1121       ENDDO
     1122    ENDIF
    11211123
    11221124    !======================================================================
    11231125
    1124     if (first) then
     1126    IF (first) THEN
    11251127       !CR:nvelles variables convection/poches froides
    11261128
    11271129       print*, '================================================='
    11281130       print*, 'Allocation des variables locales et sauvegardees'
    1129        call phys_local_var_init
     1131       CALL phys_local_var_init
    11301132       !
    11311133       pasphys=pdtphys
    11321134       !     appel a la lecture du run.def physique
    1133        call conf_phys(ok_journe, ok_mensuel, &
     1135       CALL conf_phys(ok_journe, ok_mensuel, &
    11341136            ok_instan, ok_hf, &
    11351137            ok_LES, &
    … …  
    11451147            read_climoz, &
    11461148            alp_offset)
    1147        call phys_state_var_init(read_climoz)
    1148        call phys_output_var_init
     1149       CALL phys_state_var_init(read_climoz)
     1150       CALL phys_output_var_init
    11491151       print*, '================================================='
    11501152       !
    11511153       !CR: check sur le nb de traceurs de l eau
    1152        if ((iflag_ice_thermo.gt.0).and.(nqo==2)) then
     1154       IF ((iflag_ice_thermo.gt.0).and.(nqo==2)) THEN
    11531155          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
    11541156               '(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.'
    11551157          STOP
    1156        endif
     1158       ENDIF
    11571159
    11581160       dnwd0=0.0
    … …  
    11671169       first=.false.
    11681170
    1169     endif  ! first
     1171    ENDIF  ! first
    11701172
    11711173    !ym => necessaire pour iflag_con != 2   
    … …  
    11891191       DO i=1,klon
    11901192          zero_v(i)=0.
    1191        END DO
    1192     END IF
     1193       ENDDO
     1194    ENDIF
    11931195
    11941196    IF (debut) THEN
    … …  
    12041206    ENDIF
    12051207
    1206     if(prt_level.ge.1) print*,'CONVERGENCE PHYSIQUE THERM 1 '
     1208    IF (prt_level.ge.1) print *,'CONVERGENCE PHYSIQUE THERM 1 '
    12071209
    12081210
    … …  
    12481250       ELSE
    12491251          config_inca='none' ! default
    1250        END IF
     1252       ENDIF
    12511253
    12521254       IF (aerosol_couple .AND. (config_inca /= "aero" &
    … …  
    12821284       itap    = 0
    12831285       itaprad = 0
     1286       itapcv = 0
    12841287
    12851288       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    12871290       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    12881291
    1289        if (iflag_pbl>1) then
     1292       IF (iflag_pbl>1) THEN
    12901293          PRINT*, "Using method MELLOR&YAMADA"
    1291        endif
     1294       ENDIF
    12921295
    12931296       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    13071310          abort_message='nbre de pas de temps physique n est pas multiple ' &
    13081311               // 'de nbapp_rad'
     1312          CALL abort_physic(modname,abort_message,1)
     1313       ENDIF
     1314       IF (nbapp_cv .EQ. 0) nbapp_cv=86400./dtime
     1315       print *,'physiq, nbapp_cv ',nbapp_cv
     1316       IF (MOD(INT(86400./dtime),nbapp_cv).EQ.0) THEN
     1317          cvpas = NINT( 86400./dtime/nbapp_cv)
     1318       print *,'physiq, cvpas ',cvpas
     1319       ELSE
     1320          WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
     1321               'multiple de nbapp_cv'
     1322          WRITE(lunout,*) 'changer nbapp_cv ou alors commenter ce test ', &
     1323               'mais 1+1<>2'
     1324          abort_message='nbre de pas de temps physique n est pas multiple ' &
     1325               // 'de nbapp_cv'
    13091326          call abort_physic(modname,abort_message,1)
    13101327       ENDIF
    … …  
    13291346
    13301347
    1331 
    13321348       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    13331349       !
    … …  
    13521368               klon
    13531369          abort_message='nlon et klon ne sont pas coherents'
    1354           call abort_physic(modname,abort_message,1)
     1370          CALL abort_physic(modname,abort_message,1)
    13551371       ENDIF
    13561372       IF (nlev .NE. klev) THEN
    … …  
    13581374               klev
    13591375          abort_message='nlev et klev ne sont pas coherents'
    1360           call abort_physic(modname,abort_message,1)
     1376          CALL abort_physic(modname,abort_message,1)
    13611377       ENDIF
    13621378       !
    … …  
    13651381          WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
    13661382          abort_message='Nbre d appels au rayonnement insuffisant'
    1367           call abort_physic(modname,abort_message,1)
     1383          CALL abort_physic(modname,abort_message,1)
    13681384       ENDIF
    13691385       WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
    … …  
    13961412          !CR:04.12.07: initialisations poches froides
    13971413          ! Controle de ALE et ALP pour la fermeture convective (jyg)
    1398           if (iflag_wake>=1) then
     1414          IF (iflag_wake>=1) THEN
    13991415             CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
    14001416                  ,alp_bl_prescr, ale_bl_prescr)
    … …  
    14161432             d_s_wk(:) = 0.
    14171433             d_dens_wk(:) = 0.
    1418           endif
     1434          ENDIF
    14191435
    14201436          !        do i = 1,klon
    … …  
    14281444          OPEN(98,file='npCFMIP_param.data',status='old', &
    14291445               form='formatted',iostat=iostat)
    1430           if (iostat == 0) then
     1446          IF (iostat == 0) THEN
    14311447             READ(98,*,end=998) nCFMIP
    14321448998          CONTINUE
    … …  
    14351451             IF(nCFMIP.GT.npCFMIP) THEN
    14361452                print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
    1437                 call abort_physic("physiq", "", 1)
    1438              else
     1453                CALL abort_physic("physiq", "", 1)
     1454             ELSE
    14391455                print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
    14401456             ENDIF
    … …  
    14631479                  tabijGCM, lonGCM, latGCM, iGCM, jGCM)
    14641480             !
    1465           else
     1481          ELSE
    14661482             ALLOCATE(tabijGCM(0))
    14671483             ALLOCATE(lonGCM(0), latGCM(0))
    14681484             ALLOCATE(iGCM(0), jGCM(0))
    1469           end if
    1470        else
     1485          ENDIF
     1486       ELSE
    14711487          ALLOCATE(tabijGCM(0))
    14721488          ALLOCATE(lonGCM(0), latGCM(0))
    … …  
    14991515             zuthe(i)=0.
    15001516             zvthe(i)=0.
    1501              if(zstd(i).gt.10.)then
     1517             IF (zstd(i).gt.10.) THEN
    15021518                zuthe(i)=(1.-zgam(i))*cos(zthe(i))
    15031519                zvthe(i)=(1.-zgam(i))*sin(zthe(i))
    1504              endif
     1520             ENDIF
    15051521          ENDDO
    15061522       ENDIF
    … …  
    15241540       !=============================================================
    15251541
     1542#ifdef CPP_XIOS
     1543       !--setting up swaero_diag to TRUE in XIOS case
     1544       IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. &
     1545           xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. &
     1546           xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  &
     1547             (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. &
     1548                                 xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  &
     1549           !!!--for now these fields are not in the XML files so they are omitted
     1550           !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) &
     1551           swaero_diag=.TRUE.
     1552#endif
     1553
    15261554#ifdef CPP_IOIPSL
    15271555
    … …  
    15311559       ok_sync_omp=.false.
    15321560       CALL getin('ok_sync',ok_sync_omp)
    1533        call phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
     1561       CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
    15341562            iGCM,jGCM,lonGCM,latGCM, &
    15351563            jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
    … …  
    15401568            flag_aerosol_strat, pdtphys, paprs, pphis,  &
    15411569            pplay, lmax_th, ptconv, ptconvth, ivap,  &
    1542             d_t, qx, d_qx, zmasse, ok_sync_omp)
     1570            d_u, d_t, qx, d_qx, zmasse, ok_sync_omp)
    15431571       !$OMP END MASTER
    15441572       !$OMP BARRIER
    … …  
    16051633          CALL VTb(VTphysiq)
    16061634#endif
    1607        END IF
     1635       ENDIF
    16081636       !
    16091637       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    16111639       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    16121640
    1613        call iniradia(klon,klev,paprs(1,1:klev+1))
     1641       CALL iniradia(klon,klev,paprs(1,1:klev+1))
    16141642
    16151643       !$omp single
    1616        if (read_climoz >= 1) then
    1617           call open_climoz(ncid_climoz, press_climoz)
    1618        END IF
     1644       IF (read_climoz >= 1) THEN
     1645          CALL open_climoz(ncid_climoz, press_climoz)
     1646       ENDIF
    16191647       !$omp end single
    16201648       !
    … …  
    16971725       CALL Rtime(debut)
    16981726#endif
    1699     END IF
     1727    ENDIF
    17001728
    17011729
    … …  
    17571785          ql_seri(i,k) = qx(i,k,iliq)
    17581786          !CR: ATTENTION, on rajoute la variable glace
    1759           if (nqo.eq.2) then
     1787          IF (nqo.eq.2) THEN
    17601788             qs_seri(i,k) = 0.
    1761           else if (nqo.eq.3) then
     1789          ELSE IF (nqo.eq.3) THEN
    17621790             qs_seri(i,k) = qx(i,k,isol)
    1763           endif
     1791          ENDIF
    17641792       ENDDO
    17651793    ENDDO
    … …  
    18051833    ENDDO
    18061834    ! Initialize variables used for diagnostic purpose
    1807     if (flag_inhib_tend .ne. 0) call init_cmp_seri
    1808     !IM
    1809     IF (ip_ebil_phy.ge.1) THEN
    1810        ztit='after dynamic'
    1811        CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
    1812             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    1813             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    1814        !     Comme les tendances de la physique sont ajoute dans la dynamique,
    1815        !     on devrait avoir que la variation d'entalpie par la dynamique
    1816        !     est egale a la variation de la physique au pas de temps precedent.
    1817        !     Donc la somme de ces 2 variations devrait etre nulle.
    1818        call diagphy(cell_area,ztit,ip_ebil_phy &
    1819             , zero_v, zero_v, zero_v, zero_v, zero_v &
    1820             , zero_v, zero_v, zero_v, ztsol &
    1821             , d_h_vcol+d_h_vcol_phy, d_qt, 0. &
    1822             , fs_bound, fq_bound )
    1823     END IF
     1835    IF (flag_inhib_tend .ne. 0) CALL init_cmp_seri
    18241836
    18251837    ! Diagnostiquer la tendance dynamique
    … …  
    19321944      ELSE
    19331945        ro3i = int((days_elapsed + jh_cur - jh_1jan) / year_len * 360.) + 1   
    1934         if (ro3i == 361) ro3i = 360
    1935         if (read_climoz == 1) then
    1936            call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, &
     1946        IF (ro3i == 361) ro3i = 360
     1947        IF (read_climoz == 1) THEN
     1948           CALL regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, &
    19371949                press_in_edg=press_climoz, paprs=paprs, v3=wo)
    1938         else
     1950        ELSE
    19391951           ! read_climoz == 2
    1940            call regr_pr_av(ncid_climoz, (/"tro3         ", &
     1952           CALL regr_pr_av(ncid_climoz, (/"tro3         ", &
    19411953                "tro3_daylight"/), julien=ro3i, press_in_edg=press_climoz, &
    19421954                paprs=paprs, v3=wo)
    1943         end if
     1955        ENDIF
    19441956        ! Convert from mole fraction of ozone to column density of ozone in a
    19451957        ! cell, in kDU:
    1946         forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
     1958        FORALL (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
    19471959             * zmasse / dobson_u / 1e3
    19481960        ! (By regridding ozone values for LMDZ only once every 360th of
    … …  
    19561968    ! Re-evaporer l'eau liquide nuageuse
    19571969    !
    1958     DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
    1959        DO i = 1, klon
    1960           zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
    1961           !jyg<
    1962           !  Attention : Arnaud a propose des formules completement differentes
    1963           !                  A verifier !!!
    1964           zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
    1965           IF (iflag_ice_thermo .EQ. 0) THEN
    1966              zlsdcp=zlvdcp
    1967           ENDIF
    1968           !>jyg
    1969 
    1970           if (iflag_ice_thermo.eq.0) then   
    1971              !pas necessaire a priori
    1972 
    1973              zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
    1974              zb = MAX(0.0,ql_seri(i,k))
    1975              za = - MAX(0.0,ql_seri(i,k)) &
    1976                   * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
    1977              t_seri(i,k) = t_seri(i,k) + za
    1978              q_seri(i,k) = q_seri(i,k) + zb
    1979              ql_seri(i,k) = 0.0
    1980              d_t_eva(i,k) = za
    1981              d_q_eva(i,k) = zb
    1982 
    1983           else
    1984 
    1985              !CR: on r\'e-\'evapore eau liquide et glace
    1986 
    1987              !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
    1988              !        zb = MAX(0.0,ql_seri(i,k))
    1989              !        za = - MAX(0.0,ql_seri(i,k)) &
    1990              !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
    1991              zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
    1992              za = - MAX(0.0,ql_seri(i,k))*zlvdcp &
    1993                   - MAX(0.0,qs_seri(i,k))*zlsdcp
    1994              t_seri(i,k) = t_seri(i,k) + za
    1995              q_seri(i,k) = q_seri(i,k) + zb
    1996              ql_seri(i,k) = 0.0
    1997              !on \'evapore la glace
    1998              qs_seri(i,k) = 0.0
    1999              d_t_eva(i,k) = za
    2000              d_q_eva(i,k) = zb
    2001           endif
    2002 
    2003        ENDDO
    2004     ENDDO
    2005     !IM
    2006     IF (ip_ebil_phy.ge.2) THEN
    2007        ztit='after reevap'
    2008        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,1,dtime &
    2009             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2010             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2011        call diagphy(cell_area,ztit,ip_ebil_phy &
    2012             , zero_v, zero_v, zero_v, zero_v, zero_v &
    2013             , zero_v, zero_v, zero_v, ztsol &
    2014             , d_h_vcol, d_qt, d_ec &
    2015             , fs_bound, fq_bound )
    2016        !
    2017     END IF
    2018 
    2019     !
     1970     CALL reevap (klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, &
     1971   &         d_t_eva,d_q_eva,d_ql_eva,d_qi_eva)
     1972
     1973     CALL add_phys_tend &
     1974            (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,paprs,&
     1975               'eva',abortphy,flag_inhib_tend)
     1976
    20201977    !=========================================================================
    20211978    ! Calculs de l'orbite.
    … …  
    20241981
    20251982    ! !!   jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2026     call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
     1983    CALL ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
    20271984    day_since_equinox = (jD_cur + jH_cur) - jD_eq
    20281985    !
    20291986    !   choix entre calcul de la longitude solaire vraie ou valeur fixee a
    20301987    !   solarlong0
    2031     if (solarlong0<-999.) then
    2032        if (new_orbit) then
     1988    IF (solarlong0<-999.) THEN
     1989       IF (new_orbit) THEN
    20331990          ! calcul selon la routine utilisee pour les planetes
    2034           call solarlong(day_since_equinox, zlongi, dist)
    2035        else
     1991          CALL solarlong(day_since_equinox, zlongi, dist)
     1992       ELSE
    20361993          ! calcul selon la routine utilisee pour l'AR4
    20371994          CALL orbite(REAL(days_elapsed+1),zlongi,dist)
    2038        endif
    2039     else
     1995       ENDIF
     1996    ELSE
    20401997       zlongi=solarlong0  ! longitude solaire vraie
    20411998       dist=1.            ! distance au soleil / moyenne
    2042     endif
    2043     if(prt_level.ge.1)                                                &
    2044         write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
     1999    ENDIF
     2000
     2001    IF (prt_level.ge.1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
    20452002
    20462003
    … …  
    20522009    ! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
    20532010    ! non nul aux poles.
    2054     IF (abs(solarlong0-1000.)<1.e-4) then
    2055        call zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
     2011    IF (abs(solarlong0-1000.)<1.e-4) THEN
     2012       CALL zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
    20562013            latitude_deg,longitude_deg,rmu0,fract)
    20572014       JrNt = 1.0
    … …  
    21062063    ENDIF
    21072064
    2108     if (mydebug) then
    2109        call writefield_phy('u_seri',u_seri,nbp_lev)
    2110        call writefield_phy('v_seri',v_seri,nbp_lev)
    2111        call writefield_phy('t_seri',t_seri,nbp_lev)
    2112        call writefield_phy('q_seri',q_seri,nbp_lev)
    2113     endif
     2065    IF (mydebug) THEN
     2066       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     2067       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     2068       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     2069       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     2070    ENDIF
    21142071
    21152072    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    … …  
    21372094
    21382095
    2139     if (iflag_pbl/=0) then
     2096    IF (iflag_pbl/=0) THEN
    21402097
    21412098       !jyg+nrlmd<
    … …  
    22102167            z0m, z0h,     agesno,    fsollw,  fsolsw, &
    22112168            d_ts,      fevap,     fluxlat, t2m, &
    2212             wfbils,    wfbilo,    fluxt,   fluxu,  fluxv, &
     2169            wfbils, wfbilo, wfevap, wfrain, wfsnow, &
     2170            fluxt,   fluxu,  fluxv, &
    22132171            dsens,     devap,     zxsnow, &
    22142172            zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke, &
    … …  
    22452203       !--------------------------------------------------------------------
    22462204
    2247        if (mydebug) then
    2248           call writefield_phy('u_seri',u_seri,nbp_lev)
    2249           call writefield_phy('v_seri',v_seri,nbp_lev)
    2250           call writefield_phy('t_seri',t_seri,nbp_lev)
    2251           call writefield_phy('q_seri',q_seri,nbp_lev)
    2252        endif
    2253 
     2205       IF (mydebug) THEN
     2206          CALL writefield_phy('u_seri',u_seri,nbp_lev)
     2207          CALL writefield_phy('v_seri',v_seri,nbp_lev)
     2208          CALL writefield_phy('t_seri',t_seri,nbp_lev)
     2209          CALL writefield_phy('q_seri',q_seri,nbp_lev)
     2210       ENDIF
    22542211
    22552212       !albedo SB >>>
    … …  
    22582215       falb1=0.
    22592216       falb2=0.
    2260        select case(nsw)
    2261        case(2)
     2217       SELECT CASE(nsw)
     2218       CASE(2)
    22622219          albsol1=albsol_dir(:,1)
    22632220          albsol2=albsol_dir(:,2)
    22642221          falb1=falb_dir(:,1,:)
    22652222          falb2=falb_dir(:,2,:)
    2266        case(4)
     2223       CASE(4)
    22672224          albsol1=albsol_dir(:,1)
    22682225          albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3) &
    … …  
    22732230               +falb_dir(:,4,:)*SFRWL(4)
    22742231          falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
    2275        case(6)
     2232       CASE(6)
    22762233          albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2) &
    22772234               +albsol_dir(:,3)*SFRWL(3)
    … …  
    22862243               +falb_dir(:,6,:)*SFRWL(6)
    22872244          falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
    2288        end select
     2245       END SELECt
    22892246       !albedo SB <<<
    22902247
    … …  
    22922249       CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
    22932250            t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)
    2294 
    2295 
    2296        IF (ip_ebil_phy.ge.2) THEN
    2297           ztit='after surface_main'
    2298           CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    2299                , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2300                , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2301           call diagphy(cell_area,ztit,ip_ebil_phy &
    2302                , zero_v, zero_v, zero_v, zero_v, sens &
    2303                , evap  , zero_v, zero_v, ztsol &
    2304                , d_h_vcol, d_qt, d_ec &
    2305                , fs_bound, fq_bound )
    2306        END IF
    23072251
    23082252    ENDIF
    … …  
    23312275    ENDDO
    23322276
    2333     if (prt_level.ge.1) then
     2277    IF (prt_level.ge.1) THEN
    23342278       write(lunout,*) 'L   qsat (g/kg) avant clouds_gno'
    23352279       write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
    2336     endif
     2280    ENDIF
    23372281    !
    23382282    ! Appeler la convection (au choix)
    … …  
    23682312       DO i = 1, klon
    23692313          omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
    2370        END DO
    2371     END DO
    2372     if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
     2314       ENDDO
     2315    ENDDO
     2316
     2317    IF (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
    23732318         omega(igout, :)
     2319
     2320    !
     2321    ! Appel de la convection tous les "cvpas"
     2322    !
     2323    IF (MOD(itapcv,cvpas).EQ.0) THEN
    23742324
    23752325    IF (iflag_con.EQ.1) THEN
    … …  
    24042354       !ajout pour la parametrisation des poches froides: calcul de
    24052355       !t_w et t_x: si pas de poches froides, t_w=t_x=t_seri
    2406        if (iflag_wake>=1) then
    2407          do k=1,klev
    2408             do i=1,klon
    2409                 t_w(i,k) = t_seri(i,k) &
    2410                      +(1-wake_s(i))*wake_deltat(i,k)
    2411                 q_w(i,k) = q_seri(i,k) &
    2412                      +(1-wake_s(i))*wake_deltaq(i,k)
    2413                 t_x(i,k) = t_seri(i,k) &
    2414                      -wake_s(i)*wake_deltat(i,k)
    2415                 q_x(i,k) = q_seri(i,k) &
    2416                      -wake_s(i)*wake_deltaq(i,k)
    2417             enddo
    2418          enddo
    2419        else
    2420                 t_w(:,:) = t_seri(:,:)
     2356       IF (iflag_wake>=1) THEN
     2357         DO k=1,klev
     2358            DO i=1,klon
     2359                t_w(i,k) = t_seri(i,k) + (1-wake_s(i))*wake_deltat(i,k)
     2360                q_w(i,k) = q_seri(i,k) + (1-wake_s(i))*wake_deltaq(i,k)
     2361                t_x(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
     2362                q_x(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
     2363            ENDDO
     2364         ENDDO
     2365       ELSE
     2366               t_w(:,:) = t_seri(:,:)
    24212367                q_w(:,:) = q_seri(:,:)
    24222368                t_x(:,:) = t_seri(:,:)
    24232369                q_x(:,:) = q_seri(:,:)
    2424        endif
     2370       ENDIF
    24252371       !
    24262372       !jyg<
    … …  
    24912437          ELSE
    24922438             nbtr_tmp=nbtr
    2493           END IF
     2439          ENDIF
    24942440          !jyg   iflag_con est dans clesphys
    24952441          !c          CALL concvl (iflag_con,iflag_clos,
    … …  
    25242470          pmfu(:,:)=upwd(:,:)+dnwd(:,:)
    25252471
    2526           do i = 1, klon
    2527              if (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+1
    2528           enddo
     2472          DO i = 1, klon
     2473             IF (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+1
     2474          ENDDO
    25292475          !
    25302476          !jyg<
    … …  
    25782524       clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
    25792525       IF (iflag_cld_cv == 0) THEN
    2580           call clouds_gno &
     2526          CALL clouds_gno &
    25812527               (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
    25822528       ELSE
    2583           call clouds_bigauss &
     2529          CALL clouds_bigauss &
    25842530               (klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
    25852531       ENDIF
    … …  
    26012547          ema_pct(i)  = paprs(i,itop_con(i)+1)
    26022548
    2603           if (itop_con(i).gt.klev-3) then
    2604              if(prt_level >= 9) then
     2549          IF (itop_con(i).gt.klev-3) THEN
     2550             IF (prt_level >= 9) THEN
    26052551                write(lunout,*)'La convection monte trop haut '
    26062552                write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
    2607              endif
    2608           endif
     2553             ENDIF
     2554          ENDIF
    26092555       ENDDO
    26102556    ELSE IF (iflag_con.eq.0) THEN
    … …  
    26222568    ELSE
    26232569       WRITE(lunout,*) "iflag_con non-prevu", iflag_con
    2624        call abort_physic("physiq", "", 1)
     2570       CALL abort_physic("physiq", "", 1)
    26252571    ENDIF
    26262572
    … …  
    26282574    !    .              d_u_con, d_v_con)
    26292575
     2576    itapcv = 0
     2577    ENDIF !  (MOD(itapcv,cvpas).EQ.0)
     2578    itapcv = itapcv+1
     2579
    26302580    CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
    26312581         'convection',abortphy,flag_inhib_tend)
    … …  
    26332583    !-------------------------------------------------------------------------
    26342584
    2635     if (mydebug) then
    2636        call writefield_phy('u_seri',u_seri,nbp_lev)
    2637        call writefield_phy('v_seri',v_seri,nbp_lev)
    2638        call writefield_phy('t_seri',t_seri,nbp_lev)
    2639        call writefield_phy('q_seri',q_seri,nbp_lev)
    2640     endif
    2641 
    2642     !IM
    2643     IF (ip_ebil_phy.ge.2) THEN
    2644        ztit='after convect'
    2645        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    2646             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2647             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2648        call diagphy(cell_area,ztit,ip_ebil_phy &
    2649             , zero_v, zero_v, zero_v, zero_v, zero_v &
    2650             , zero_v, rain_con, snow_con, ztsol &
    2651             , d_h_vcol, d_qt, d_ec &
    2652             , fs_bound, fq_bound )
    2653     END IF
    2654     !
     2585    IF (mydebug) THEN
     2586       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     2587       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     2588       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     2589       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     2590    ENDIF
     2591
    26552592    IF (check) THEN
    26562593       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    … …  
    27012638    ! froides
    27022639    !
    2703     if (iflag_wake>=1) then
     2640    IF (iflag_wake>=1) THEN
     2641       !
     2642       !  Call wakes only when convection has been called
     2643       IF (itapcv .EQ. 1) THEN
     2644       !
    27042645       DO k=1,klev
    27052646          DO i=1,klon
    … …  
    27402681       !
    27412682       !calcul caracteristiques de la poche froide
    2742        call calWAKE (iflag_wake_tend, paprs, pplay, dtime, &
     2683       CALL calWAKE (iflag_wake_tend, paprs, pplay, dtime, &
    27432684            t_seri, q_seri, omega,  &
    27442685            dt_dwn, dq_dwn, M_dwn, M_up,  &
    … …  
    27552696            wake_spread, wake_Cstar, d_deltat_wk_gw,  &
    27562697            d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_wk)
     2698         !
     2699       ENDIF  ! (mod(itapcv,cvpas) .EQ. 1)
    27572700       !
    27582701       !-----------------------------------------------------------------------
    … …  
    27712714       ENDIF   ! (iflag_wake_tend .GT. 0.)
    27722715
    2773     endif  ! (iflag_wake>=1)
    2774     !
    2775     !===================================================================
    2776     !JYG
    2777     IF (ip_ebil_phy.ge.2) THEN
    2778        ztit='after wake'
    2779        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    2780             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2781             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2782        call diagphy(cell_area,ztit,ip_ebil_phy &
    2783             , zero_v, zero_v, zero_v, zero_v, zero_v &
    2784             , zero_v, zero_v, zero_v, ztsol &
    2785             , d_h_vcol, d_qt, d_ec &
    2786             , fs_bound, fq_bound )
    2787     END IF
    2788 
    2789     !      print*,'apres callwake iflag_cld_th=', iflag_cld_th
     2716    ENDIF  ! (iflag_wake>=1)
    27902717    !
    27912718    !===================================================================
    … …  
    27932720    !===================================================================
    27942721    !
    2795     call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
     2722    CALL stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
    27962723         ,seuil_inversion,weak_inversion,dthmin)
    27972724
    … …  
    28102737    !      detr_therm(:,:)=0.
    28112738    !
    2812     IF(prt_level>9)WRITE(lunout,*) &
     2739    IF (prt_level>9) WRITE(lunout,*) &
    28132740         'AVANT LA CONVECTION SECHE , iflag_thermals=' &
    28142741         ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
    2815     if(iflag_thermals<0) then
     2742    IF (iflag_thermals<0) THEN
    28162743       !  Rien
    28172744       !  ====
    2818        IF(prt_level>9)WRITE(lunout,*)'pas de convection seche'
    2819 
    2820 
    2821     else
     2745       IF (prt_level>9) WRITE(lunout,*)'pas de convection seche'
     2746
     2747
     2748    ELSE
    28222749
    28232750       !  Thermiques
    28242751       !  ==========
    2825        IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
     2752       IF (prt_level>9) WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
    28262753            ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
    28272754
    … …  
    28382765       !cc fin nrlmd le 10/04/2012
    28392766
    2840        if (iflag_thermals>=1) then
     2767       IF (iflag_thermals>=1) THEN
    28412768          !jyg<
    28422769          IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
    … …  
    28622789          ENDIF
    28632790          !>jyg
    2864           call calltherm(pdtphys &
     2791          CALL calltherm(pdtphys &
    28652792               ,pplay,paprs,pphi,weak_inversion &
    28662793                        ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
    … …  
    29282855          ! -------------------------------------------------------------------
    29292856
    2930           do i=1,klon
     2857          DO i=1,klon
    29312858             !           zmax_th(i)=pphi(i,lmax_th(i))/rg
    29322859             !CR:04/05/12:correction calcul zmax
    29332860             zmax_th(i)=zmax0(i)
    2934           enddo
    2935 
    2936        endif
    2937 
     2861          ENDDO
     2862
     2863       ENDIF
    29382864
    29392865       !  Ajustement sec
    … …  
    29442870       ! Dans le cas contraire, on demarre au niveau 1.
    29452871
    2946        if (iflag_thermals>=13.or.iflag_thermals<=0) then
    2947 
    2948           if(iflag_thermals.eq.0) then
    2949              IF(prt_level>9)WRITE(lunout,*)'ajsec'
     2872       IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN
     2873
     2874          IF (iflag_thermals.eq.0) THEN
     2875             IF (prt_level>9) WRITE(lunout,*)'ajsec'
    29502876             limbas(:)=1
    2951           else
     2877          ELSE
    29522878             limbas(:)=lmax_th(:)
    2953           endif
     2879          ENDIF
    29542880
    29552881          ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
    … …  
    29592885          ! non nulles numeriquement pour des mailles non concernees.
    29602886
    2961           if (iflag_thermals==0) then
     2887          IF (iflag_thermals==0) THEN
    29622888             ! Calling adjustment alone (but not the thermal plume model)
    29632889             CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
    29642890                  , d_t_ajsb, d_q_ajsb)
    2965           else if (iflag_thermals>0) then
     2891          ELSE IF (iflag_thermals>0) THEN
    29662892             ! Calling adjustment above the top of thermal plumes
    29672893             CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
    29682894                  , d_t_ajsb, d_q_ajsb)
    2969           endif
     2895          ENDIF
    29702896
    29712897          !--------------------------------------------------------------------
    … …  
    29782904          !---------------------------------------------------------------------
    29792905
    2980        endif
    2981 
    2982     endif
     2906       ENDIF
     2907
     2908    ENDIF
    29832909    !
    29842910    !===================================================================
    2985     !IM
    2986     IF (ip_ebil_phy.ge.2) THEN
    2987        ztit='after dry_adjust'
    2988        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    2989             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2990             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2991        call diagphy(cell_area,ztit,ip_ebil_phy &
    2992             , zero_v, zero_v, zero_v, zero_v, zero_v &
    2993             , zero_v, zero_v, zero_v, ztsol &
    2994             , d_h_vcol, d_qt, d_ec &
    2995             , fs_bound, fq_bound )
    2996     END IF
    2997 
    2998 
    2999     !-------------------------------------------------------------------------
    30002911    ! Computation of ratqs, the width (normalized) of the subrid scale
    30012912    ! water distribution
    … …  
    30732984       WRITE(lunout,*)"Precip=", zx_t
    30742985    ENDIF
    3075     !IM
    3076     IF (ip_ebil_phy.ge.2) THEN
    3077        ztit='after fisrt'
    3078        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    3079             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    3080             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3081        call diagphy(cell_area,ztit,ip_ebil_phy &
    3082             , zero_v, zero_v, zero_v, zero_v, zero_v &
    3083             , zero_v, rain_lsc, snow_lsc, ztsol &
    3084             , d_h_vcol, d_qt, d_ec &
    3085             , fs_bound, fq_bound )
    3086     END IF
    3087 
    3088     if (mydebug) then
    3089        call writefield_phy('u_seri',u_seri,nbp_lev)
    3090        call writefield_phy('v_seri',v_seri,nbp_lev)
    3091        call writefield_phy('t_seri',t_seri,nbp_lev)
    3092        call writefield_phy('q_seri',q_seri,nbp_lev)
    3093     endif
     2986
     2987    IF (mydebug) THEN
     2988       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     2989       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     2990       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     2991       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     2992    ENDIF
    30942993
    30952994    !
    … …  
    31063005       !     print*,'avant calcul de la pseudo precip '
    31073006       !     print*,'iflag_cld_th',iflag_cld_th
    3108        if (iflag_cld_th.eq.-1) then
     3007       IF (iflag_cld_th.eq.-1) THEN
    31093008          rain_tiedtke=rain_con
    3110        else
     3009       ELSE
    31113010          !       print*,'calcul de la pseudo precip '
    31123011          rain_tiedtke=0.
    31133012          !         print*,'calcul de la pseudo precip 0'
    3114           do k=1,klev
    3115              do i=1,klon
    3116                 if (d_q_con(i,k).lt.0.) then
     3013          DO k=1,klev
     3014             DO i=1,klon
     3015                IF (d_q_con(i,k).lt.0.) THEN
    31173016                   rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
    31183017                        *(paprs(i,k)-paprs(i,k+1))/rg
    3119                 endif
    3120              enddo
    3121           enddo
    3122        endif
     3018                ENDIF
     3019             ENDDO
     3020          ENDDO
     3021       ENDIF
    31233022       !
    31243023       !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
    … …  
    31443043       !  facttemps
    31453044       facteur = pdtphys *facttemps
    3146        do k=1,klev
    3147           do i=1,klon
     3045       DO k=1,klev
     3046          DO i=1,klon
    31483047             rnebcon(i,k)=rnebcon(i,k)*facteur
    3149              if (rnebcon0(i,k)*clwcon0(i,k).gt.rnebcon(i,k)*clwcon(i,k)) &
    3150                   then
     3048             IF (rnebcon0(i,k)*clwcon0(i,k).GT.rnebcon(i,k)*clwcon(i,k)) THEN
    31513049                rnebcon(i,k)=rnebcon0(i,k)
    31523050                clwcon(i,k)=clwcon0(i,k)
    3153              endif
    3154           enddo
    3155        enddo
     3051             ENDIF
     3052          ENDDO
     3053       ENDDO
    31563054
    31573055       !   On prend la somme des fractions nuageuses et des contenus en eau
    31583056
    3159        if (iflag_cld_th>=5) then
    3160 
    3161           do k=1,klev
     3057       IF (iflag_cld_th>=5) THEN
     3058
     3059          DO k=1,klev
    31623060             ptconvth(:,k)=fm_therm(:,k+1)>0.
    3163           enddo
    3164 
    3165           if (iflag_coupl==4) then
     3061          ENDDO
     3062
     3063          IF (iflag_coupl==4) THEN
    31663064
    31673065             ! Dans le cas iflag_coupl==4, on prend la somme des convertures
    31683066             ! convectives et lsc dans la partie des thermiques
    31693067             ! Le controle par iflag_coupl est peut etre provisoire.
    3170              do k=1,klev
    3171                 do i=1,klon
    3172                    if (ptconv(i,k).and.ptconvth(i,k)) then
     3068             DO k=1,klev
     3069                DO i=1,klon
     3070                   IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
    31733071                      cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
    31743072                      cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    3175                    else if (ptconv(i,k)) then
     3073                   ELSE IF (ptconv(i,k)) THEN
    31763074                      cldfra(i,k)=rnebcon(i,k)
    31773075                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
    3178                    endif
    3179                 enddo
    3180              enddo
    3181 
    3182           else if (iflag_coupl==5) then
    3183              do k=1,klev
    3184                 do i=1,klon
     3076                   ENDIF
     3077                ENDDO
     3078             ENDDO
     3079
     3080          ELSE IF (iflag_coupl==5) THEN
     3081             DO k=1,klev
     3082                DO i=1,klon
    31853083                   cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    31863084                   cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
    3187                 enddo
    3188              enddo
    3189 
    3190           else
     3085                ENDDO
     3086             ENDDO
     3087
     3088          ELSE
    31913089
    31923090             ! Si on est sur un point touche par la convection
    … …  
    31983096             ! definition des points sur lesquels ls thermiques sont actifs
    31993097
    3200              do k=1,klev
    3201                 do i=1,klon
    3202                    if (ptconv(i,k).and. .not. ptconvth(i,k)) then
     3098             DO k=1,klev
     3099                DO i=1,klon
     3100                   IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
    32033101                      cldfra(i,k)=rnebcon(i,k)
    32043102                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
    3205                    endif
    3206                 enddo
    3207              enddo
    3208 
    3209           endif
    3210 
    3211        else
     3103                   ENDIF
     3104                ENDDO
     3105             ENDDO
     3106
     3107          ENDIF
     3108
     3109       ELSE
    32123110
    32133111          ! Ancienne version
    32143112          cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
    32153113          cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
    3216        endif
     3114       ENDIF
    32173115
    32183116    ENDIF
    … …  
    32463144       snow_fall(i) = snow_con(i) + snow_lsc(i)
    32473145    ENDDO
    3248     !IM
    3249     IF (ip_ebil_phy.ge.2) THEN
    3250        ztit="after diagcld"
    3251        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    3252             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    3253             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3254        call diagphy(cell_area,ztit,ip_ebil_phy &
    3255             , zero_v, zero_v, zero_v, zero_v, zero_v &
    3256             , zero_v, zero_v, zero_v, ztsol &
    3257             , d_h_vcol, d_qt, d_ec &
    3258             , fs_bound, fq_bound )
    3259     END IF
    32603146    !
    32613147    ! Calculer l'humidite relative pour diagnostique
    … …  
    33153201       calday = REAL(days_elapsed + 1) + jH_cur
    33163202
    3317        call chemtime(itap+itau_phy-1, date0, dtime, itap)
     3203       CALL chemtime(itap+itau_phy-1, date0, dtime, itap)
    33183204       IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN
    33193205          CALL AEROSOL_METEO_CALC( &
    … …  
    33213207               prfl,psfl,pctsrf,cell_area, &
    33223208               latitude_deg,longitude_deg,u10m,v10m)
    3323        END IF
     3209       ENDIF
    33243210
    33253211       zxsnow_dummy(:) = 0.0
    … …  
    33643250       CALL VTb(VTphysiq)
    33653251#endif
    3366     END IF !type_trac = inca
     3252    ENDIF !type_trac = inca
    33673253
    33683254
    … …  
    33893275             IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
    33903276                abort_message='config_inca=aero et rrtm=1 impossible'
    3391                 call abort_physic(modname,abort_message,1)
     3277                CALL abort_physic(modname,abort_message,1)
    33923278             ELSE
    33933279                !
    … …  
    34243310                   abort_message='Only NSW=2 or 6 are possible with ' &
    34253311                        // 'aerosols and iflag_rrtm=1'
    3426                    call abort_physic(modname,abort_message,1)
     3312                   CALL abort_physic(modname,abort_message,1)
    34273313                ENDIF
    34283314
    … …  
    34343320                abort_message='You should compile with -rrtm if running ' &
    34353321                     // 'with iflag_rrtm=1'
    3436                 call abort_physic(modname,abort_message,1)
     3322                CALL abort_physic(modname,abort_message,1)
    34373323#endif
    34383324                !
    … …  
    34703356          ELSE
    34713357#ifdef CPP_RRTM
     3358#ifndef CPP_StratAer
     3359          !--prescribed strat aerosols
     3360          !--only in the case of non-interactive strat aerosols
    34723361            IF (flag_aerosol_strat.EQ.1) THEN
    34733362             CALL readaerosolstrato1_rrtm(debut)
    … …  
    34793368             CALL abort_physic(modname,abort_message,1)
    34803369            ENDIF
     3370#endif
    34813371#else
    34823372             abort_message='You should compile with -rrtm if running ' &
    … …  
    34863376          ENDIF
    34873377       ENDIF
     3378!
     3379#ifdef CPP_RRTM
     3380#ifdef CPP_StratAer
     3381       !--compute stratospheric mask
     3382       CALL stratosphere_mask(t_seri, pplay, latitude_deg)
     3383       !--interactive strat aerosols
     3384       CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
     3385#endif
     3386#endif
    34883387       !--fin STRAT AEROSOL
    34893388       !     
    … …  
    34953394          mass_solu_aero(:,:)    = ccm(:,:,1)
    34963395          mass_solu_aero_pi(:,:) = ccm(:,:,2)
    3497        END IF
     3396       ENDIF
    34983397
    34993398       IF (ok_newmicro) then
    … …  
    36043503       ENDIF
    36053504
    3606        if (mydebug) then
    3607           call writefield_phy('u_seri',u_seri,nbp_lev)
    3608           call writefield_phy('v_seri',v_seri,nbp_lev)
    3609           call writefield_phy('t_seri',t_seri,nbp_lev)
    3610           call writefield_phy('q_seri',q_seri,nbp_lev)
    3611        endif
     3505       IF (mydebug) THEN
     3506          CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3507          CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3508          CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3509          CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3510       ENDIF
    36123511
    36133512       !
    … …  
    36173516       IF (iflag_radia .ge. 2) THEN
    36183517          zsav_tsol (:) = zxtsol(:)
    3619           call perturb_radlwsw(zxtsol,iflag_radia)
     3518          CALL perturb_radlwsw(zxtsol,iflag_radia)
    36203519       ENDIF
    36213520
    … …  
    36253524               (kdlon,kflev,dist, rmu0, fract, solaire, &
    36263525               paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, &
    3627                wo(:, :, 1), &
     3526               size(wo,3), wo, &
    36283527               cldfrarad, cldemirad, cldtaurad, &
    36293528               heat,heat0,cool,cool0,albpla, &
    … …  
    36933592               ZSWFT0_i, ZFSDN0, ZFSUP0)
    36943593
    3695           !--OB 30/05/2016
     3594#ifndef CPP_XIOS
     3595          !--OB 30/05/2016 modified 21/10/2016
    36963596          !--here we return swaero_diag to FALSE
    36973597          !--and histdef will switch it back to TRUE if necessary
    36983598          !--this is necessary to get the right swaero at first step
     3599          !--but only in the case of no XIOS as XIOS is covered elsewhere
    36993600          IF (debut) swaero_diag = .FALSE.
     3601#endif
    37003602          !
    37013603          !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
    … …  
    37033605          !IM Par defaut on a les taux perturbes egaux aux taux actuels
    37043606          !
    3705           if (ok_4xCO2atm) then
    3706              if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
    3707                   RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
    3708                   RCFC12_per.NE.RCFC12_act) THEN
     3607          IF (ok_4xCO2atm) THEN
     3608             IF (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR.    &
     3609                 RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
     3610                 RCFC12_per.NE.RCFC12_act) THEN
    37093611                !
    37103612                RCO2 = RCO2_per
    … …  
    37743676          PRINT *,'>>>>           heat et cool mis a zero '
    37753677          PRINT *,'--------------------------------------------------'
    3776        END IF
     3678       ENDIF
    37773679       heat=0.
    37783680       cool=0.
    … …  
    37863688       lwdn=0.
    37873689       lwdn0=0.
    3788     END IF
     3690    ENDIF
    37893691
    37903692    !
    … …  
    37953697    radsol=solsw*swradcorr+sollw
    37963698
    3797     if (ok_4xCO2atm) then
     3699    IF (ok_4xCO2atm) THEN
    37983700       radsolp=solswp*swradcorr+sollwp
    3799     endif
     3701    ENDIF
    38003702
    38013703    !
    … …  
    38153717
    38163718    !
    3817     if (mydebug) then
    3818        call writefield_phy('u_seri',u_seri,nbp_lev)
    3819        call writefield_phy('v_seri',v_seri,nbp_lev)
    3820        call writefield_phy('t_seri',t_seri,nbp_lev)
    3821        call writefield_phy('q_seri',q_seri,nbp_lev)
    3822     endif
    3823 
    3824     !IM
    3825     IF (ip_ebil_phy.ge.2) THEN
    3826        ztit='after rad'
    3827        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    3828             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    3829             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3830        call diagphy(cell_area,ztit,ip_ebil_phy &
    3831             , topsw, toplw, solsw, sollw, zero_v &
    3832             , zero_v, zero_v, zero_v, ztsol &
    3833             , d_h_vcol, d_qt, d_ec &
    3834             , fs_bound, fq_bound )
    3835     END IF
    3836     !
    3837     !
     3719    IF (mydebug) THEN
     3720       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3721       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3722       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3723       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3724    ENDIF
     3725
    38383726    ! Calculer l'hydrologie de la surface
    38393727    !
    … …  
    39013789    ENDIF ! fin de test sur ok_orodr
    39023790    !
    3903     if (mydebug) then
    3904        call writefield_phy('u_seri',u_seri,nbp_lev)
    3905        call writefield_phy('v_seri',v_seri,nbp_lev)
    3906        call writefield_phy('t_seri',t_seri,nbp_lev)
    3907        call writefield_phy('q_seri',q_seri,nbp_lev)
    3908     endif
     3791    IF (mydebug) THEN
     3792       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3793       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3794       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3795       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3796    ENDIF
    39093797
    39103798    IF (ok_orolf) THEN
    … …  
    39853873    ENDIF
    39863874
    3987     if (ok_gwd_rando) then
    3988        call FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
     3875    IF (ok_gwd_rando) THEN
     3876       CALL FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
    39893877            rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
    39903878            du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
    … …  
    39993887               * (paprs(:, k)-paprs(:, k+1))/rg
    40003888       ENDDO
    4001     end if
     3889    ENDIF
    40023890
    40033891    ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
    40043892
    4005     if (mydebug) then
    4006        call writefield_phy('u_seri',u_seri,nbp_lev)
    4007        call writefield_phy('v_seri',v_seri,nbp_lev)
    4008        call writefield_phy('t_seri',t_seri,nbp_lev)
    4009        call writefield_phy('q_seri',q_seri,nbp_lev)
    4010     endif
     3893    IF (mydebug) THEN
     3894       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     3895       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     3896       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     3897       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     3898    ENDIF
    40113899
    40123900    DO i = 1, klon
    … …  
    40353923    ENDIF
    40363924    !IM cf. FLott END
    4037     !IM
    4038     IF (ip_ebil_phy.ge.2) THEN
    4039        ztit='after orography'
    4040        CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    4041             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    4042             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    4043        call diagphy(cell_area,ztit,ip_ebil_phy &
    4044             , zero_v, zero_v, zero_v, zero_v, zero_v &
    4045             , zero_v, zero_v, zero_v, ztsol &
    4046             , d_h_vcol, d_qt, d_ec &
    4047             , fs_bound, fq_bound )
    4048     END IF
    4049 
    40503925    !DC Calcul de la tendance due au methane
    40513926    IF(ok_qch4) THEN
    … …  
    40543929       CALL add_phys_tend(du0, dv0, dt0, d_q_ch4*dtime, dql0, dqi0, paprs, &
    40553930            'q_ch4', abortphy,flag_inhib_tend)
    4056     END IF
     3931    ENDIF
    40573932    !
    40583933    !
    … …  
    40733948          !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
    40743949          !     s        ref_liq,ref_ice
    4075           call phys_cosp(itap,dtime,freq_cosp, &
     3950          CALL phys_cosp(itap,dtime,freq_cosp, &
    40763951               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    40773952               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, &
    … …  
    41033978
    41043979  IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/dtime)).EQ.0) THEN
    4105   write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', &
    4106      & ok_airs, freq_airs
    4107   call simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
    4108      & map_prop_hc,map_prop_hist,&
    4109      & map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
    4110      & map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
    4111      & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
    4112      & map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
    4113      & map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
    4114      & map_ntot,map_hc,map_hist,&
    4115      & map_Cb,map_ThCi,map_Anv,&
    4116      & alt_tropo )
     3980     write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
     3981     CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
     3982        & map_prop_hc,map_prop_hist,&
     3983        & map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
     3984        & map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
     3985        & map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
     3986        & map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
     3987        & map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
     3988        & map_ntot,map_hc,map_hist,&
     3989        & map_Cb,map_ThCi,map_Anv,&
     3990        & alt_tropo )
    41173991  ENDIF
    41183992
    … …  
    41334007    ELSE
    41344008       sh_in(:,:) = qx(:,:,ivap)
    4135     END IF
     4009    ENDIF
    41364010
    41374011#ifdef CPP_Dust
    … …  
    41534027#else
    41544028
    4155     call phytrac ( &
     4029    CALL phytrac ( &
    41564030         itap,     days_elapsed+1,    jH_cur,   debut, &
    41574031         lafin,    dtime,     u, v,     t, &
    … …  
    41834057       IF (prt_level.ge.9) &
    41844058            print*,'Attention on met a 0 les thermiques pour phystoke'
    4185        call phystokenc ( &
     4059       CALL phystokenc ( &
    41864060            nlon,klev,pdtphys,longitude_deg,latitude_deg, &
    41874061            t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
    … …  
    42264100    t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
    42274101
    4228     !IM
    4229     IF (ip_ebil_phy.ge.1) THEN
    4230        ztit='after physic'
    4231        CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
    4232             , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    4233             , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    4234        !     Comme les tendances de la physique sont ajoute dans la dynamique,
    4235        !     on devrait avoir que la variation d'entalpie par la dynamique
    4236        !     est egale a la variation de la physique au pas de temps precedent.
    4237        !     Donc la somme de ces 2 variations devrait etre nulle.
    4238 
    4239        call diagphy(cell_area,ztit,ip_ebil_phy &
    4240             , topsw, toplw, solsw, sollw, sens &
    4241             , evap, rain_fall, snow_fall, ztsol &
    4242             , d_h_vcol, d_qt, d_ec &
    4243             , fs_bound, fq_bound )
    4244        !
    4245        d_h_vcol_phy=d_h_vcol
    4246        !
    4247     END IF
    4248     !
    42494102    !=======================================================================
    42504103    !   SORTIES
    … …  
    43084161       CALL VTb(VTphysiq)
    43094162#endif
    4310     END IF
     4163    ENDIF
    43114164
    43124165
    … …  
    43184171    ENDIF
    43194172    !
    4320     if (mydebug) then
    4321        call writefield_phy('u_seri',u_seri,nbp_lev)
    4322        call writefield_phy('v_seri',v_seri,nbp_lev)
    4323        call writefield_phy('t_seri',t_seri,nbp_lev)
    4324        call writefield_phy('q_seri',q_seri,nbp_lev)
    4325     endif
     4173    IF (mydebug) THEN
     4174       CALL writefield_phy('u_seri',u_seri,nbp_lev)
     4175       CALL writefield_phy('v_seri',v_seri,nbp_lev)
     4176       CALL writefield_phy('t_seri',t_seri,nbp_lev)
     4177       CALL writefield_phy('q_seri',q_seri,nbp_lev)
     4178    ENDIF
    43264179
    43274180    DO k = 1, klev
    … …  
    43334186          d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
    43344187          !CR: on ajoute le contenu en glace
    4335           if (nqo.eq.3) then
     4188          IF (nqo.eq.3) THEN
    43364189             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime
    4337           endif
     4190          ENDIF
    43384191       ENDDO
    43394192    ENDDO
    … …  
    44024255    !==========================================================================
    44034256
    4404     if (prt_level.ge.1) then
     4257    IF (prt_level.ge.1) THEN
    44054258       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    44064259       write(lunout,*) &
    … …  
    44114264            pctsrf(igout,is_sic)
    44124265       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
    4413        do k=1,klev
     4266       DO k=1,klev
    44144267          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
    44154268               d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
    44164269               d_t_eva(igout,k)
    4417        enddo
     4270       ENDDO
    44184271       write(lunout,*) 'cool,heat'
    4419        do k=1,klev
     4272       DO k=1,klev
    44204273          write(lunout,*) cool(igout,k),heat(igout,k)
    4421        enddo
     4274       ENDDO
    44224275
    44234276       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
    … …  
    44284281       !jyg!     enddo
    44294282       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    4430        do k=1,klev
     4283       DO k=1,klev
    44314284          write(lunout,*) d_t_vdf(igout,k), &
    44324285               d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    4433        enddo
     4286       ENDDO
    44344287       !>jyg
    44354288
    44364289       write(lunout,*) 'd_ps ',d_ps(igout)
    44374290       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
    4438        do k=1,klev
     4291       DO k=1,klev
    44394292          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
    44404293               d_qx(igout,k,1),d_qx(igout,k,2)
    4441        enddo
    4442     endif
    4443 
    4444     !==========================================================================
     4294       ENDDO
     4295    ENDIF
    44454296
    44464297    !============================================================
    … …  
    44834334    !=============================================================
    44844335
    4485     if (iflag_thermals>=1) then
     4336    IF (iflag_thermals>=1) THEN
    44864337       d_t_lscth=0.
    44874338       d_t_lscst=0.
    44884339       d_q_lscth=0.
    44894340       d_q_lscst=0.
    4490        do k=1,klev
    4491           do i=1,klon
    4492              if (ptconvth(i,k)) then
     4341       DO k=1,klev
     4342          DO i=1,klon
     4343             IF (ptconvth(i,k)) THEN
    44934344                d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    44944345                d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4495              else
     4346             ELSE
    44964347                d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    44974348                d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4498              endif
    4499           enddo
    4500        enddo
    4501 
    4502        do i=1,klon
     4349             ENDIF
     4350          ENDDO
     4351       ENDDO
     4352
     4353       DO i=1,klon
    45034354          plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
    45044355          plul_th(i)=prfl(i,1)+psfl(i,1)
    4505        enddo
    4506     endif
    4507 
     4356       ENDDO
     4357    ENDIF
    45084358
    45094359    !On effectue les sorties:
    … …  
    45214371         ok_ade, ok_aie, ivap, iliq, isol, new_aod,      &
    45224372         ok_sync, ptconv, read_climoz, clevSTD,          &
    4523          ptconvth, d_t, qx, d_qx, zmasse,                &
     4373         ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
    45244374         flag_aerosol, flag_aerosol_strat, ok_cdnc)
    45254375#endif
    4526 
    45274376
    45284377#ifndef CPP_XIOS
    … …  
    45574406       !         close(97)
    45584407       !$OMP MASTER
    4559        if (read_climoz >= 1) then
    4560           if (is_mpi_root) then
    4561              call nf95_close(ncid_climoz)
    4562           end if
    4563           deallocate(press_climoz) ! pointer
    4564        end if
     4408       IF (read_climoz >= 1) THEN
     4409          IF (is_mpi_root) THEN
     4410             CALL nf95_close(ncid_climoz)
     4411          ENDIF
     4412          DEALLOCATE(press_climoz) ! pointer
     4413       ENDIF
    45654414       !$OMP END MASTER
    45664415    ENDIF

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

    r2641 r2720  
    9797    USE tracreprobus_mod
    9898    USE indice_sol_mod
    99 
    10099    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    101100    USE print_control_mod, ONLY: lunout
    102101    USE aero_mod, ONLY : naero_grp
     102
     103#ifdef CPP_StratAer
     104    USE traccoag_mod
     105    USE phys_local_var_mod, ONLY: mdw, sulf_dep_dry, sulf_dep_wet
     106    USE infotrac, ONLY: nbtr_sulgas, id_SO2_strat, id_H2SO4_strat
     107    USE aerophys
     108#endif
    103109
    104110    IMPLICIT NONE
    … …  
    208214    !--------------
    209215    !
    210     !
    211216    REAL,DIMENSION(:),INTENT(IN)   :: cdragh          ! (klon) coeff drag pour T et Q
    212217    REAL,DIMENSION(:,:),INTENT(IN) :: coefh           ! (klon,klev) coeff melange CL (m**2/s)
    … …  
    215220    REAL,DIMENSION(:),INTENT(IN)   :: yu1             ! (klon) vents au premier niveau
    216221    REAL,DIMENSION(:),INTENT(IN)   :: yv1             ! (klon) vents au premier niveau
    217 
    218222    !
    219223    !Lessivage:
    … …  
    238242    REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
    239243
    240 
     244#ifdef CPP_StratAer
     245    REAL,DIMENSION(klon)           :: v_dep_dry !dry deposition velocity of stratospheric sulfate in m/s
     246#endif
    241247    ! Output argument
    242248    !----------------
    243249    REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
    244250    REAL,DIMENSION(klon,klev)                    :: sourceBE
     251
    245252    !=======================================================================================
    246253    !                        -- LOCAL VARIABLES --
    … …  
    267274    INTEGER                   :: itau_w      ! pas de temps ecriture = nstep + itau_phy
    268275    LOGICAL,PARAMETER         :: ok_sync=.TRUE.
    269 
    270276    !
    271277    ! Nature du traceur
    … …  
    369375    END DO
    370376
     377    DO it=1, nbtr
     378       DO i=1,klon
     379          d_tr_dry(i,it)=0.
     380          flux_tr_dry(i,it)=0.
     381       END DO
     382    END DO
     383
    371384    DO k = 1, klev
    372385       DO i = 1, klon
    … …  
    456469       CASE('repr')
    457470          source(:,:)=0.
     471#ifdef CPP_StratAer
     472       CASE('coag')
     473          source(:,:)=0.
     474          DO it= 1, nbtr_sulgas
     475            aerosol(it)=.FALSE.
     476            IF (it==id_H2SO4_strat) aerosol(it)=.TRUE.
     477          ENDDO
     478          DO it= nbtr_sulgas+1, nbtr
     479            aerosol(it)=.TRUE.
     480          ENDDO
     481#endif
    458482       END SELECT
    459483
    … …  
    504528                !--for now we do not scavenge in cvltr
    505529                flag_cvltr(it)=.false.
     530
     531#ifdef CPP_StratAer
     532             CASE('coag')
     533                IF (convscav.and.aerosol(it)) THEN
     534                   flag_cvltr(it)=.true.
     535                   ccntrAA(it) =ccntrAA_in   
     536                   ccntrENV(it)=ccntrENV_in
     537                   coefcoli(it)=coefcoli_in
     538                ELSE
     539                   flag_cvltr(it)=.false.
     540                ENDIF
     541#endif
     542
    506543             END SELECT
    507544          ENDDO
    … …  
    572609       ! Appel fait en fin de phytrac pour avoir les emissions modifiees par
    573610       ! la couche limite et la convection avant le calcul de la chimie
     611
    574612    CASE('repr')
    575613       !   -- CHIMIE REPROBUS --
    576 
    577614       CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
    578615            presnivs, xlat, xlon, pphis, pphi, &
    … …  
    580617            tr_seri)
    581618
     619#ifdef CPP_StratAer
     620    CASE('coag')
     621       !   --STRATOSPHERIC AER IN THE STRAT --
     622       CALL traccoag(pdtphys, gmtime, debutphy, julien, &
     623            presnivs, xlat, xlon, pphis, pphi, &
     624            t_seri, pplay, paprs, sh, rh , &
     625            tr_seri)
     626#endif
     627
    582628    END SELECT
    583629    !======================================================================
    … …  
    591637          IF (iflag_con.LT.2) THEN
    592638             !--pas de transport convectif
    593 
    594639             d_tr_cv(:,:,it)=0.
     640
    595641          ELSE IF (iflag_con.EQ.2) THEN
    596642             !--ancien transport convectif de Tiedtke
    … …  
    648694
    649695       END DO ! nbtr
     696
     697#ifdef CPP_StratAer
     698       IF (type_trac=='coag') THEN
     699         ! initialize wet deposition flux of sulfur
     700         sulf_dep_wet(:)=0.0
     701         ! compute wet deposition flux of sulfur (sum over gases and particles)
     702         ! and convert to kg(S)/m2/s
     703         DO i = 1, klon
     704         DO k = 1, klev
     705         DO it = 1, nbtr
     706         !do not include SO2 because most of it comes trom the troposphere
     707           IF (it==id_H2SO4_strat) THEN
     708             sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol) &
     709                            & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     710           ELSEIF (it.GT.nbtr_sulgas) THEN
     711             sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol)  &
     712                            & *dens_aer_dry*4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3 &
     713                            & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     714           ENDIF
     715         ENDDO
     716         ENDDO
     717         ENDDO
     718       ENDIF
     719#endif
    650720
    651721    END IF ! convection
    … …  
    692762       !  Injection during BL mixing
    693763       !
     764#ifdef CPP_StratAer
     765       IF (type_trac=='coag') THEN
     766
     767         ! initialize dry deposition flux of sulfur
     768         sulf_dep_dry(:)=0.0
     769
     770         ! compute dry deposition velocity as function of surface type (numbers
     771         ! from IPSL note 23, 2002)
     772         v_dep_dry(:) =  pctsrf(:,is_ter) * 2.5e-3 &
     773                     & + pctsrf(:,is_oce) * 0.5e-3 &
     774                     & + pctsrf(:,is_lic) * 2.5e-3 &
     775                     & + pctsrf(:,is_sic) * 2.5e-3
     776
     777         ! compute surface dry deposition flux
     778         zrho(:,1)=pplay(:,1)/t_seri(:,1)/RD
     779
     780         DO it=1, nbtr
     781          source(:,it) = - v_dep_dry(:) * tr_seri(:,1,it) * zrho(:,1)
     782         ENDDO
     783
     784       ENDIF
     785#endif
     786
    694787       DO it=1, nbtr
    695788          !
    … …  
    703796             tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it)
    704797             !
    705           END IF
     798#ifdef CPP_StratAer
     799             IF (type_trac=='coag') THEN
     800               ! compute dry deposition flux of sulfur (sum over gases and particles)
     801               IF (it==id_H2SO4_strat) THEN
     802                 sulf_dep_dry(:)=sulf_dep_dry(:)-source(:,it)*(mSatom/mH2SO4mol)
     803               ELSEIF (it.GT.nbtr_sulgas) THEN
     804                 sulf_dep_dry(:)=sulf_dep_dry(:)-source(:,it)*(mSatom/mH2SO4mol)*dens_aer_dry &
     805                                & *4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3
     806               ENDIF
     807             ENDIF
     808#endif
     809             !
     810          ENDIF
    706811          !
    707        END DO
     812       ENDDO
    708813       !
    709814    ELSE IF (iflag_vdf_trac==0) THEN
    … …  
    720825       !
    721826       ! Nothing happens
    722        !
    723827       d_tr_cl=0.
    724828       !
    … …  
    772876
    773877          END DO  !tr
     878
     879#ifdef CPP_StratAer
     880         IF (type_trac=='coag') THEN
     881           ! compute wet deposition flux of sulfur (sum over gases and
     882           ! particles) and convert to kg(S)/m2/s
     883           ! adding contribution of d_tr_ls to d_tr_cv (above)
     884           DO i = 1, klon
     885           DO k = 1, klev
     886           DO it = 1, nbtr
     887             IF (it==id_H2SO4_strat) THEN
     888               sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol) &
     889                              & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     890             ELSEIF (it.GT.nbtr_sulgas) THEN
     891               sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol)  &
     892                              & *dens_aer_dry*4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3 &
     893                              & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
     894             ENDIF
     895           ENDDO
     896           ENDDO
     897           ENDDO
     898         ENDIF
     899#endif
    774900
    775901       ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosol_optic_rrtm.F90

    r2669 r2720  
    2020
    2121  USE infotrac_phy
     22  USE YOMCST
    2223
    2324  IMPLICIT NONE
     25
    2426  include "clesphys.h"
    25   include "YOMCST.h"
    26 
    2727
    2828  ! Input arguments
    … …  
    104104     !--convert to ug m-3 unit for consistency with offline fields
    105105     !
    106      do i=1,nbtr
    107         select case(trim(solsym(i)))
    108            case ("ASBCM")
     106     DO i=1,nbtr
     107        SELECT CASE(trim(solsym(i)))
     108           CASE ("ASBCM")
    109109              id_ASBCM = i
    110            case ("ASPOMM")
     110           CASE ("ASPOMM")
    111111              id_ASPOMM = i
    112            case ("ASSO4M")
     112           CASE ("ASSO4M")
    113113              id_ASSO4M = i
    114            case ("ASMSAM")
     114           CASE ("ASMSAM")
    115115              id_ASMSAM = i
    116            case ("CSSO4M")
     116           CASE ("CSSO4M")
    117117              id_CSSO4M = i
    118            case ("CSMSAM")
     118           CASE ("CSMSAM")
    119119              id_CSMSAM = i
    120            case ("SSSSM")
     120           CASE ("SSSSM")
    121121              id_SSSSM = i
    122            case ("CSSSM")
     122           CASE ("CSSSM")
    123123              id_CSSSM = i
    124            case ("ASSSM")
     124           CASE ("ASSSM")
    125125              id_ASSSM = i
    126            case ("CIDUSTM")
     126           CASE ("CIDUSTM")
    127127              id_CIDUSTM = i
    128            case ("AIBCM")
     128           CASE ("AIBCM")
    129129              id_AIBCM = i
    130            case ("AIPOMM")
     130           CASE ("AIPOMM")
    131131              id_AIPOMM = i
    132            case ("ASNO3M")
     132           CASE ("ASNO3M")
    133133              id_ASNO3M = i
    134            case ("CSNO3M")
     134           CASE ("CSNO3M")
    135135              id_CSNO3M = i
    136            case ("CINO3M")
     136           CASE ("CINO3M")
    137137              id_CINO3M = i
    138            end select
    139      enddo
    140 
     138           END SELECT
     139     ENDDO
    141140
    142141     bcsol(:,:)        =   tr_seri(:,:,id_ASBCM)                         *zrho(:,:)*1.e9  ! ASBCM
    … …  
    171170     !
    172171     ! Read and interpolate sulfate
    173      IF ( flag_aerosol .EQ. 1 .OR. &
    174           flag_aerosol .EQ. 6 ) THEN
     172     IF ( flag_aerosol .EQ. 1 .OR. flag_aerosol .EQ. 6 ) THEN
    175173
    176174        CALL readaerosol_interp(id_ASSO4M_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, sulfacc, sulfacc_pi,loadso4)
    … …  
    178176        sulfacc(:,:) = 0. ; sulfacc_pi(:,:) = 0.
    179177        loadso4=0.
    180      END IF
     178     ENDIF
    181179
    182180     ! Read and interpolate bcsol and bcins
    183      IF ( flag_aerosol .EQ. 2 .OR. &
    184           flag_aerosol .EQ. 6 ) THEN
     181     IF ( flag_aerosol .EQ. 2 .OR. flag_aerosol .EQ. 6 ) THEN
    185182
    186183        ! Get bc aerosol distribution
    … …  
    192189        bcins(:,:) = 0. ; bcins_pi(:,:) = 0.
    193190        loadbc=0.
    194      END IF
    195 
     191     ENDIF
    196192
    197193     ! Read and interpolate pomsol and pomins
    198      IF ( flag_aerosol .EQ. 3 .OR. &
    199           flag_aerosol .EQ. 6 ) THEN
     194     IF ( flag_aerosol .EQ. 3 .OR. flag_aerosol .EQ. 6 ) THEN
    200195
    201196        CALL readaerosol_interp(id_ASPOMM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, pomsol, pomsol_pi, load_tmp3)
    … …  
    206201        pomins(:,:) = 0. ; pomins_pi(:,:) = 0.
    207202        loadoa=0.
    208      END IF
    209 
     203     ENDIF
    210204
    211205     ! Read and interpolate csssm, ssssm, assssm
    212      IF (flag_aerosol .EQ. 4 .OR. &
    213           flag_aerosol .EQ. 6 ) THEN
     206     IF (flag_aerosol .EQ. 4 .OR. flag_aerosol .EQ. 6 ) THEN
    214207
    215208        CALL readaerosol_interp(id_SSSSM_phy ,itap, pdtphys,rjourvrai, &
    … …  
    228221
    229222     ! Read and interpolate cidustm
    230      IF (flag_aerosol .EQ. 5 .OR.  &
    231           flag_aerosol .EQ. 6 ) THEN
     223     IF (flag_aerosol .EQ. 5 .OR. flag_aerosol .EQ. 6 ) THEN
    232224
    233225        CALL readaerosol_interp(id_CIDUSTM_phy, itap, pdtphys, rjourvrai, debut, pplay, paprs, t_seri, cidust, cidust_pi, loaddust)
    … …  
    299291     DO i = 1, klon
    300292        pdel(i,k) = paprs(i,k) - paprs (i,k+1)
    301      END DO
    302   END DO
     293     ENDDO
     294  ENDDO
    303295
    304296!--new aerosol properties

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato1_rrtm.F90

    r2594 r2720  
    22! $Id: readaerosolstrato1_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
    33!
    4 subroutine readaerosolstrato1_rrtm(debut)
    5 
    6     use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, &
     4SUBROUTINE readaerosolstrato1_rrtm(debut)
     5
     6    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    77                        nf95_inq_varid, nf95_open
    8     use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
     8    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    99
    1010    USE phys_cal_mod, ONLY : mth_cur
    … …  
    1717    USE aero_mod
    1818    USE dimphy
    19     USE YOERAD   , ONLY : NLW
    20 
    21     implicit none
    22 
    23     include "YOMCST.h"
     19    USE YOERAD, ONLY : NLW
     20    USE YOMCST
     21
     22    IMPLICIT NONE
    2423
    2524! Variable input
    26     logical debut
     25    LOGICAL debut
    2726
    2827! Variables locales
    29     integer n_lat   ! number of latitudes in the input data
    30     integer n_lon   ! number of longitudes in the input data
    31     integer n_lev   ! number of levels in the input data
    32     integer n_month ! number of months in the input data
    33     real, pointer:: latitude(:)
    34     real, pointer:: longitude(:)
    35     real, pointer:: time(:)
    36     real, pointer:: lev(:)
    37     integer k, band, wave, i
    38     integer, save :: mth_pre
    39 
    40     real, allocatable, dimension(:,:), save :: tau_aer_strat
     28    INTEGER n_lat   ! number of latitudes in the input data
     29    INTEGER n_lon   ! number of longitudes in the input data
     30    INTEGER n_lev   ! number of levels in the input data
     31    INTEGER n_month ! number of months in the input data
     32    REAL, POINTER:: latitude(:)
     33    REAL, POINTER:: longitude(:)
     34    REAL, POINTER:: time(:)
     35    REAL, POINTER:: lev(:)
     36    INTEGER k, band, wave, i
     37    INTEGER, SAVE :: mth_pre
     38
     39    REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: tau_aer_strat
    4140!$OMP THREADPRIVATE(tau_aer_strat)
    4241
    4342! Champs reconstitues
    44     real, allocatable:: tauaerstrat(:, :, :, :)
    45     real, allocatable:: tauaerstrat_mois(:, :, :)
    46     real, allocatable:: tauaerstrat_mois_glo(:, :)
    47 
    48     real, allocatable:: sum_tau_aer_strat(:)
     43    REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :)
     44    REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :)
     45    REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :)
     46
     47    REAL, ALLOCATABLE:: sum_tau_aer_strat(:)
    4948
    5049! For NetCDF:
    51     integer ncid_in  ! IDs for input files
    52     integer varid, ncerr
     50    INTEGER ncid_in  ! IDs for input files
     51    INTEGER varid, ncerr
    5352
    5453! Stratospheric aerosols optical properties
    5554! alpha_sw_strat over the 6 bands is normalised by the 550 nm extinction coefficient
    56     real, dimension(nbands_sw_rrtm) :: alpha_sw_strat, piz_sw_strat, cg_sw_strat
    57     data alpha_sw_strat/0.8545564, 0.8451642, 0.9821724, 0.8145110, 0.3073565, 7.7966176E-02/
    58     data cg_sw_strat   /0.6997170, 0.6810035, 0.7403592, 0.7562674, 0.6676504, 0.3478689/
    59     data piz_sw_strat  /0.9999998, 0.9999998, 1.000000000, 0.9999958, 0.9977155, 0.4510679/
     55    REAL, DIMENSION(nbands_sw_rrtm) :: alpha_sw_strat, piz_sw_strat, cg_sw_strat
     56    DATA alpha_sw_strat/0.8545564, 0.8451642, 0.9821724, 0.8145110, 0.3073565, 7.7966176E-02/
     57    DATA cg_sw_strat   /0.6997170, 0.6810035, 0.7403592, 0.7562674, 0.6676504, 0.3478689/
     58    DATA piz_sw_strat  /0.9999998, 0.9999998, 1.000000000, 0.9999958, 0.9977155, 0.4510679/
    6059!
    6160!--diagnostics AOD in the SW
    6261! alpha_sw_strat_wave is *not* normalised by the 550 nm extinction coefficient
    63     real, dimension(nwave_sw) :: alpha_sw_strat_wave
    64     data alpha_sw_strat_wave/3.708007,4.125824,4.136584,3.887478,3.507738/
     62    REAL, DIMENSION(nwave_sw) :: alpha_sw_strat_wave
     63    DATA alpha_sw_strat_wave/3.708007,4.125824,4.136584,3.887478,3.507738/
    6564!
    6665!--diagnostics AOD in the LW at 10 um (not normalised by the 550 nm ext coefficient
    67     real :: alpha_lw_strat_wave(nwave_lw)
    68     data alpha_lw_strat_wave/0.2746812/
    69 !
    70     real, dimension(nbands_lw_rrtm) :: alpha_lw_abs_rrtm
    71     data alpha_lw_abs_rrtm/   8.8340312E-02, 6.9856711E-02, 6.2652975E-02, 5.7188231E-02, &
     66    REAL :: alpha_lw_strat_wave(nwave_lw)
     67    DATA alpha_lw_strat_wave/0.2746812/
     68!
     69    REAL, DIMENSION(nbands_lw_rrtm) :: alpha_lw_abs_rrtm
     70    DATA alpha_lw_abs_rrtm/   8.8340312E-02, 6.9856711E-02, 6.2652975E-02, 5.7188231E-02, &
    7271                              6.3157059E-02, 5.5072524E-02, 5.0571125E-02, 0.1349073, &   
    7372                              0.1381676, 9.6506312E-02, 5.1312990E-02, 2.4256418E-02, &
    … …  
    237236    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
    238237
    239 end subroutine readaerosolstrato1_rrtm
     238END SUBROUTINE readaerosolstrato1_rrtm

  • LMDZ5/branches/testing/libf/phylmd/rrtm/readaerosolstrato2_rrtm.F90

    r2594 r2720  
    22! $Id: readaerosolstrato2_rrtm.F90 2526 2016-05-26 22:13:40Z oboucher $
    33!
    4 subroutine readaerosolstrato2_rrtm(debut)
    5 
    6     use netcdf95, only: nf95_close, nf95_gw_var, nf95_inq_dimid, &
     4SUBROUTINE readaerosolstrato2_rrtm(debut)
     5
     6    USE netcdf95, ONLY: nf95_close, nf95_gw_var, nf95_inq_dimid, &
    77                        nf95_inq_varid, nf95_open
    8     use netcdf, only: nf90_get_var, nf90_noerr, nf90_nowrite
     8    USE netcdf, ONLY: nf90_get_var, nf90_noerr, nf90_nowrite
    99
    1010    USE phys_cal_mod, ONLY : mth_cur
    … …  
    1717    USE aero_mod
    1818    USE dimphy
    19     USE YOERAD   , ONLY : NLW
    20 
    21     implicit none
    22 
    23     include "YOMCST.h"
     19    USE YOERAD, ONLY : NLW
     20    USE YOMCST
     21
     22    IMPLICIT NONE
     23
    2424    INCLUDE "clesphys.h"
    2525
    … …  
    2828
    2929! Variable input
    30     logical, intent(in) ::  debut
     30    LOGICAL, INTENT(IN) ::  debut
    3131
    3232! Variables locales
    33     integer n_lat   ! number of latitudes in the input data
    34     integer n_lon   ! number of longitudes
    35     integer n_lev   ! number of levels in the input data
    36     integer n_month ! number of months in the input data
    37     integer n_wav   ! number of wavelengths in the input data
    38     real, pointer:: latitude(:)
    39     real, pointer:: longitude(:)
    40     real, pointer:: time(:)
    41     real, pointer:: lev(:)
    42     real, pointer:: wav(:)
    43     integer i,k,wave,band
    44     integer, save :: mth_pre
    45 
    46     real, allocatable, dimension(:,:,:), save :: tau_aer_strat
    47     real, allocatable, dimension(:,:,:), save :: piz_aer_strat
    48     real, allocatable, dimension(:,:,:), save :: cg_aer_strat
    49     real, allocatable, dimension(:,:,:), save :: taulw_aer_strat
     33    INTEGER n_lat   ! number of latitudes in the input data
     34    INTEGER n_lon   ! number of longitudes
     35    INTEGER n_lev   ! number of levels in the input data
     36    INTEGER n_month ! number of months in the input data
     37    INTEGER n_wav   ! number of wavelengths in the input data
     38    REAL, POINTER:: latitude(:)
     39    REAL, POINTER:: time(:)
     40    REAL, POINTER:: lev(:)
     41    REAL, POINTER:: wav(:)
     42    INTEGER i,k,wave,band
     43    INTEGER, SAVE :: mth_pre
     44
     45    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: tau_aer_strat
     46    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: piz_aer_strat
     47    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: cg_aer_strat
     48    REAL, ALLOCATABLE, DIMENSION(:,:,:), SAVE :: taulw_aer_strat
    5049!$OMP THREADPRIVATE(tau_aer_strat,piz_aer_strat,cg_aer_strat,taulw_aer_strat)
    5150
    5251! Champs reconstitues
    53     real, allocatable:: tauaerstrat(:, :, :, :)
    54     real, allocatable:: pizaerstrat(:, :, :, :)
    55     real, allocatable:: cgaerstrat(:, :, :, :)
    56     real, allocatable:: taulwaerstrat(:, :, :, :)
    57 
    58     real, allocatable:: tauaerstrat_mois(:, :, :, :)
    59     real, allocatable:: pizaerstrat_mois(:, :, :, :)
    60     real, allocatable:: cgaerstrat_mois(:, :, :, :)
    61     real, allocatable:: taulwaerstrat_mois(:, :, :, :)
    62 
    63     real, allocatable:: tauaerstrat_mois_glo(:, :, :)
    64     real, allocatable:: pizaerstrat_mois_glo(:, :, :)
    65     real, allocatable:: cgaerstrat_mois_glo(:, :, :)
    66     real, allocatable:: taulwaerstrat_mois_glo(:, :, :)
     52    REAL, ALLOCATABLE:: tauaerstrat(:, :, :, :)
     53    REAL, ALLOCATABLE:: pizaerstrat(:, :, :, :)
     54    REAL, ALLOCATABLE:: cgaerstrat(:, :, :, :)
     55    REAL, ALLOCATABLE:: taulwaerstrat(:, :, :, :)
     56
     57    REAL, ALLOCATABLE:: tauaerstrat_mois(:, :, :, :)
     58    REAL, ALLOCATABLE:: pizaerstrat_mois(:, :, :, :)
     59    REAL, ALLOCATABLE:: cgaerstrat_mois(:, :, :, :)
     60    REAL, ALLOCATABLE:: taulwaerstrat_mois(:, :, :, :)
     61
     62    REAL, ALLOCATABLE:: tauaerstrat_mois_glo(:, :, :)
     63    REAL, ALLOCATABLE:: pizaerstrat_mois_glo(:, :, :)
     64    REAL, ALLOCATABLE:: cgaerstrat_mois_glo(:, :, :)
     65    REAL, ALLOCATABLE:: taulwaerstrat_mois_glo(:, :, :)
    6766
    6867! For NetCDF:
    69     integer ncid_in  ! IDs for input files
    70     integer varid, ncerr
     68    INTEGER ncid_in  ! IDs for input files
     69    INTEGER varid, ncerr
    7170
    7271!--------------------------------------------------------
    … …  
    343342    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
    344343
    345 end subroutine readaerosolstrato2_rrtm
     344END SUBROUTINE readaerosolstrato2_rrtm

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

    r2542 r2720  
    2828USE dimphy
    2929USE phys_local_var_mod, ONLY: stratomask
     30#ifdef CPP_StratAer
     31USE phys_local_var_mod, ONLY: p_tropopause
     32#endif
    3033
    3134IMPLICIT NONE
    … …  
    8992ENDDO
    9093
    91 !!--diagnostic not used for now
    92 !!p_tropopause(:)=tp(:)
     94!--this is only diagnosedd in the case of StratAer
     95!--but it could be useful to LMDz
     96#ifdef CPP_StratAer
     97p_tropopause(:)=tp(:)
     98#endif
    9399
    94100IF (ifil.gt.0) THEN

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

    r2542 r2720  
    104104!
    105105!******************************************************************************
    106     radsol(:) = 0.0
     106    radsol(1:klon) = 0.0 ! initialisation a priori inutile
    107107    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
    108108
    … …  
    118118! Si on suit les formulations par exemple de Tessel, on
    119119! a z0h=0.4*nu/u*, z0q=0.62*nu/u*, d'ou f_z0qh_oce=0.62/0.4=1.55
    120        cdragq(:)=cdragh(:)*                                      &
    121        log(z1lay(:)/z0h(:))/log(z1lay(:)/(f_z0qh_oce*z0h(:)))
     120       cdragq(1:knon)=cdragh(1:knon)*                                      &
     121       log(z1lay(1:knon)/z0h(1:knon))/log(z1lay(1:knon)/(f_z0qh_oce*z0h(1:knon)))
    122122    ELSE
    123        cdragq(:)=cdragh(:)
     123       cdragq(1:knon)=cdragh(1:knon)
    124124    ENDIF
    125125
    … …  
    169169!******************************************************************************
    170170    IF (type_ocean.NE.'slab') THEN
    171         lmt_bils(:)=0.
     171        lmt_bils(1:klon)=0.
    172172        DO i=1,knon
    173173           lmt_bils(knindex(i))=(swnet(i)+lwnet(i)+fluxsens(i)+fluxlat(i)) &
    … …  
    189189!--ad-hoc correction for model radiative balance tuning
    190190!--now outside alboc_cd routine
    191        alb_eau(:) = fmagic*alb_eau(:) + pmagic
    192        alb_eau=MIN(MAX(alb_eau,0.0),1.0)
     191       alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
     192       alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.0),1.0)
    193193!
    194194    ELSE
    … …  
    197197!--ad-hoc correction for model radiative balance tuning
    198198!--now outside alboc routine
    199        alb_eau(:) = fmagic*alb_eau(:) + pmagic
    200        alb_eau=MIN(MAX(alb_eau(i),0.04),0.60)
     199       alb_eau(1:klon) = fmagic*alb_eau(1:klon) + pmagic
     200       alb_eau(1:klon)=MIN(MAX(alb_eau(1:klon),0.04),0.60)
    201201!
    202202    ENDIF
    … …  
    209209!IM 09122015 next line corresponds to the old way of doing in LMDZ5A/IPSLCM5A versions
    210210!albedo for diffuse radiation is taken the same as for direct radiation
    211      alb_dif_new=alb_dir_new
     211     alb_dif_new(1:knon,:)=alb_dir_new(1:knon,:)
    212212!IM 09122015 end
    213213!
    … …  
    219219!
    220220!--ad-hoc correction for model radiative balance tuning
    221     alb_dir_new(:,:) = fmagic*alb_dir_new(:,:) + pmagic
    222     alb_dir_new=MIN(MAX(alb_dir_new,0.0),1.0)
    223     alb_dif_new=MIN(MAX(alb_dif_new,0.0),1.0)
     221    alb_dir_new(1:knon,:) = fmagic*alb_dir_new(1:knon,:) + pmagic
     222    alb_dif_new(1:knon,:) = fmagic*alb_dif_new(1:knon,:) + pmagic
     223    alb_dir_new(1:knon,:)=MIN(MAX(alb_dir_new(1:knon,:),0.0),1.0)
     224    alb_dif_new(1:knon,:)=MIN(MAX(alb_dif_new(1:knon,:),0.0),1.0)
    224225!
    225226ENDIF

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

    r2641 r2720  
    125125
    126126  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: p, pi
    127   REAL, DIMENSION (klon, klev+1),   INTENT(IN)          :: ph, omgb
     127  REAL, DIMENSION (klon, klev+1),   INTENT(IN)          :: ph
     128  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: omgb
    128129  REAL,                             INTENT(IN)          :: dtime
    129130  REAL, DIMENSION (klon, klev),     INTENT(IN)          :: te0, qe0
    … …  
    148149  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dtke, dqke
    149150  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: spread
    150   REAL, DIMENSION (klon, klev+1),   INTENT(OUT)         :: omgbdth, omg
     151  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: omgbdth, omg
    151152  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: dp_omgb, dp_deltomg
    152153  REAL, DIMENSION (klon, klev),     INTENT(OUT)         :: d_deltat_gw
    … …  
    161162
    162163  ! Variables à fixer
     164  INTEGER, SAVE                                         :: igout
     165  !$OMP THREADPRIVATE(igout)
    163166  REAL                                                  :: alon
    164167  LOGICAL, SAVE                                         :: first = .TRUE.
    … …  
    182185  REAL, DIMENSION (klon, klev)                          :: deltaqw0
    183186  REAL, DIMENSION (klon, klev)                          :: te, qe
    184   REAL, DIMENSION (klon)                                :: sigmaw0, sigmaw1
     187  REAL, DIMENSION (klon)                                :: sigmaw0
     188!!  REAL, DIMENSION (klon)                                :: sigmaw1
    185189
    186190  ! Variables pour les GW
    … …  
    228232  REAL, DIMENSION (klon, klev)                          :: the, thu
    229233
    230   REAL, DIMENSION (klon, klev+1)                        :: omgbw
     234  REAL, DIMENSION (klon, klev)                          :: omgbw
    231235  REAL, DIMENSION (klon)                                :: pupper
    232236  REAL, DIMENSION (klon)                                :: omgtop
    … …  
    250254
    251255  ! cc nrlmd
    252   REAL, DIMENSION (klon)                                :: death_rate, nat_rate
     256  REAL, DIMENSION (klon)                                :: death_rate
     257!!  REAL, DIMENSION (klon)                                :: nat_rate
    253258  REAL, DIMENSION (klon, klev)                          :: entr
    254259  REAL, DIMENSION (klon, klev)                          :: detr
    … …  
    296301
    297302 if (first) then
     303
     304  igout = klon/2+1/klon
     305
    298306  crep_upper = 0.9
    299307  crep_sol = 1.0
    … …  
    332340  delta_t_min = 0.2
    333341
    334   ! 1. - Save initial values and initialize tendencies
    335   ! --------------------------------------------------
    336 
    337   DO k = 1, klev
    338     DO i = 1, klon
    339       ppi(i, k) = pi(i, k)
    340       deltatw0(i, k) = deltatw(i, k)
    341       deltaqw0(i, k) = deltaqw(i, k)
    342       te(i, k) = te0(i, k)
    343       qe(i, k) = qe0(i, k)
    344       dtls(i, k) = 0.
    345       dqls(i, k) = 0.
    346       d_deltat_gw(i, k) = 0.
    347       d_te(i, k) = 0.
    348       d_qe(i, k) = 0.
    349       d_deltatw(i, k) = 0.
    350       d_deltaqw(i, k) = 0.
    351       ! IM 060508 beg
    352       d_deltatw2(i, k) = 0.
    353       d_deltaqw2(i, k) = 0.
    354       ! IM 060508 end
    355     END DO
    356   END DO
    357   DO i = 1, klon
    358    sigmaw_in(i) = sigmaw(i)
    359   END DO
     342  ! 1. - Save initial values, initialize tendencies, initialize output fields
     343  ! ------------------------------------------------------------------------
     344
     345!jyg<
     346!!  DO k = 1, klev
     347!!    DO i = 1, klon
     348!!      ppi(i, k) = pi(i, k)
     349!!      deltatw0(i, k) = deltatw(i, k)
     350!!      deltaqw0(i, k) = deltaqw(i, k)
     351!!      te(i, k) = te0(i, k)
     352!!      qe(i, k) = qe0(i, k)
     353!!      dtls(i, k) = 0.
     354!!      dqls(i, k) = 0.
     355!!      d_deltat_gw(i, k) = 0.
     356!!      d_te(i, k) = 0.
     357!!      d_qe(i, k) = 0.
     358!!      d_deltatw(i, k) = 0.
     359!!      d_deltaqw(i, k) = 0.
     360!!      ! IM 060508 beg
     361!!      d_deltatw2(i, k) = 0.
     362!!      d_deltaqw2(i, k) = 0.
     363!!      ! IM 060508 end
     364!!    END DO
     365!!  END DO
     366      ppi(:,:) = pi(:,:)
     367      deltatw0(:,:) = deltatw(:,:)
     368      deltaqw0(:,:) = deltaqw(:,:)
     369      te(:,:) = te0(:,:)
     370      qe(:,:) = qe0(:,:)
     371      dtls(:,:) = 0.
     372      dqls(:,:) = 0.
     373      d_deltat_gw(:,:) = 0.
     374      d_te(:,:) = 0.
     375      d_qe(:,:) = 0.
     376      d_deltatw(:,:) = 0.
     377      d_deltaqw(:,:) = 0.
     378      d_deltatw2(:,:) = 0.
     379      d_deltaqw2(:,:) = 0.
     380!!  DO i = 1, klon
     381!!   sigmaw_in(i) = sigmaw(i)
     382!!  END DO
     383   sigmaw_in(:) = sigmaw(:)
     384!>jyg
     385
    360386  ! sigmaw1=sigmaw
    361387  ! IF (sigd_con.GT.sigmaw1) THEN
    … …  
    378404    ktopw(i) = 0
    379405  END DO
    380 
     406!
     407!<jyg
     408dth(:,:) = 0.
     409tu(:,:) = 0.
     410qu(:,:) = 0.
     411dtke(:,:) = 0.
     412dqke(:,:) = 0.
     413spread(:,:) = 0.
     414omgbdth(:,:) = 0.
     415omg(:,:) = 0.
     416dp_omgb(:,:) = 0.
     417dp_deltomg(:,:) = 0.
     418hw(:) = 0.
     419wape(:) = 0.
     420fip(:) = 0.
     421gfl(:) = 0.
     422cstar(:) = 0.
     423ktopw(:) = 0
     424!
     425!  Vertical advection local variables
     426omgbw(:,:) = 0.
     427omgtop(:) = 0
     428dp_omgbw(:,:) = 0.
     429omgbdq(:,:) = 0.
     430!>jyg
     431!
     432  IF (prt_level>=10) THEN
     433    PRINT *, 'wake-1, sigmaw(igout) ', sigmaw(igout)
     434    PRINT *, 'wake-1, deltatw(igout,k) ', (k,deltatw(igout,k), k=1,klev)
     435    PRINT *, 'wake-1, deltaqw(igout,k) ', (k,deltaqw(igout,k), k=1,klev)
     436    PRINT *, 'wake-1, dowwdraughts, amdwn(igout,k) ', (k,amdwn(igout,k), k=1,klev)
     437    PRINT *, 'wake-1, dowwdraughts, dtdwn(igout,k) ', (k,dtdwn(igout,k), k=1,klev)
     438    PRINT *, 'wake-1, dowwdraughts, dqdwn(igout,k) ', (k,dqdwn(igout,k), k=1,klev)
     439    PRINT *, 'wake-1, updraughts, amup(igout,k) ', (k,amup(igout,k), k=1,klev)
     440    PRINT *, 'wake-1, updraughts, dta(igout,k) ', (k,dta(igout,k), k=1,klev)
     441    PRINT *, 'wake-1, updraughts, dqa(igout,k) ', (k,dqa(igout,k), k=1,klev)
     442  ENDIF
    381443
    382444  ! 2. - Prognostic part
    … …  
    570632  END DO
    571633
     634  IF (prt_level>=10) THEN
     635    PRINT *, 'wake-2, ptop_provis(igout), ptop(igout) ', ptop_provis(igout), ptop(igout)
     636  ENDIF
     637
    572638
    573639  ! -5/ Determination de ktop et kupper
    … …  
    611677    END DO
    612678  END DO
     679
     680  IF (prt_level>=10) THEN
     681    PRINT *, 'wake-3, ktop(igout), kupper(igout) ', ktop(igout), kupper(igout)
     682  ENDIF
    613683
    614684  ! -5/ Set deltatw & deltaqw to 0 above kupper
    … …  
    753823  END DO
    754824
     825  IF (prt_level>=10) THEN
     826    PRINT *, 'wake-4, sigmaw(igout), cstar(igout), wape(igout) ', &
     827                      sigmaw(igout), cstar(igout), wape(igout)
     828  ENDIF
     829
     830
    755831  ! C -----------------------------------------------------------------
    756832  ! Sub-time-stepping
    … …  
    769845      wk_adv(i) = ok_qx_qw(i) .AND. alpha(i) >= 1.
    770846    END DO
     847    IF (prt_level>=10) THEN
     848      PRINT *, 'wake-4.1, isubstep,wk_adv(igout),cstar(igout),wape(igout) ', &
     849                          isubstep,wk_adv(igout),cstar(igout),wape(igout)
     850    ENDIF
    771851
    772852    ! cc nrlmd   Ajout d'un recalcul de wdens dans le cas d'un entrainement
    … …  
    835915    ! calcul de la difference de vitesse verticale poche - zone non perturbee
    836916    ! IM 060208 differences par rapport au code initial; init. a 0 dp_deltomg
    837     ! IM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on
    838     ! definit
     917    ! IM 060208 et omg sur les niveaux de 1 a klev+1, alors que avant l'on definit
    839918    ! IM 060208 au niveau k=1..?
     919    !JYG 161013 Correction : maintenant omg est dimensionne a klev.
    840920    DO k = 1, klev
    841921      DO i = 1, klon
    … …  
    845925      END DO
    846926    END DO
    847     DO k = 1, klev + 1
     927    DO k = 1, klev
    848928      DO i = 1, klon
    849929        IF (wk_adv(i)) THEN !!! nrlmd
    … …  
    879959      END IF
    880960    END DO
     961
     962    IF (prt_level>=10) THEN
     963      PRINT *, 'wake-4.2, omg(igout,k) ', (k,omg(igout,k), k=1,klev)
     964      PRINT *, 'wake-4.2, omgtop(igout) ', omgtop(igout)
     965    ENDIF
    881966
    882967    ! -----------------
    … …  
    9261011      END DO
    9271012    END DO
     1013!!    print *,'omg(igout,k) ', (k,omg(igout,k),k=1,klev)
    9281014    ! cc nrlmd
    9291015    ! c      DO i=1,klon
    … …  
    9361022
    9371023
    938     DO k = 1, klev + 1
     1024    DO k = 1, klev
    9391025      DO i = 1, klon
    9401026        IF (wk_adv(i)) THEN
    … …  
    9451031    ! --    and its vertical gradient dp_omgbw
    9461032
    947     DO k = 1, klev
     1033    DO k = 1, klev-1
    9481034      DO i = 1, klon
    9491035        IF (wk_adv(i)) THEN
    … …  
    9511037        END IF
    9521038      END DO
     1039    END DO
     1040    DO i = 1, klon
     1041      IF (wk_adv(i)) THEN
     1042          dp_omgbw(i, klev) = 0.
     1043      END IF
    9531044    END DO
    9541045
    … …  
    10301121    END DO
    10311122
     1123    IF (prt_level>=10) THEN
     1124      PRINT *, 'wake-4.3, th1(igout,k) ', (k,th1(igout,k), k=1,klev)
     1125      PRINT *, 'wake-4.3, th2(igout,k) ', (k,th2(igout,k), k=1,klev)
     1126      PRINT *, 'wake-4.3, dth(igout,k) ', (k,dth(igout,k), k=1,klev)
     1127      PRINT *, 'wake-4.3, omgbdth(igout,k) ', (k,omgbdth(igout,k), k=1,klev)
     1128    ENDIF
     1129
    10321130    ! -----------------------------------------------------------------
    1033     DO k = 1, klev
     1131    DO k = 1, klev-1
    10341132      DO i = 1, klon
    10351133        IF (wk_adv(i) .AND. k<=kupper(i)-1) THEN
    … …  
    10431141             (1.-alpha_up(i,k))*omgbdth(i,k)- &
    10441142             alpha_up(i,k+1)*omgbdth(i,k+1))*ppi(i, k)
    1045           ! print*,'d_deltatw=',d_deltatw(i,k)
     1143!           print*,'d_deltatw=', k, d_deltatw(i,k)
    10461144
    10471145          d_deltaqw(i, k) = dtimesub/(ph(i,k)-ph(i,k+1))* &
    … …  
    10501148             (1.-alpha_up(i,k))*omgbdq(i,k)- &
    10511149             alpha_up(i,k+1)*omgbdq(i,k+1))
    1052           ! print*,'d_deltaqw=',d_deltaqw(i,k)
     1150!           print*,'d_deltaqw=', k, d_deltaqw(i,k)
    10531151
    10541152          ! and increment large scale tendencies
    … …  
    10801178    END DO
    10811179    ! ------------------------------------------------------------------
     1180
     1181    IF (prt_level>=10) THEN
     1182      PRINT *, 'wake-4.3, d_deltatw(igout,k) ', (k,d_deltatw(igout,k), k=1,klev)
     1183      PRINT *, 'wake-4.3, d_deltaqw(igout,k) ', (k,d_deltaqw(igout,k), k=1,klev)
     1184    ENDIF
    10821185
    10831186    ! Increment state variables
    … …  
    15051608  END DO ! end sub-timestep loop
    15061609
     1610  IF (prt_level>=10) THEN
     1611    PRINT *, 'wake-5, sigmaw(igout), cstar(igout), wape(igout) ', &
     1612                      sigmaw(igout), cstar(igout), wape(igout)
     1613  ENDIF
    15071614
    15081615
    … …  
    17611868    ! c     $          wape(i),wape2(i),ktopw(i),OK_qx_qw(i)
    17621869  END DO
     1870
     1871  IF (prt_level>=10) THEN
     1872    PRINT *, 'wake-6, wape wape2 ktopw OK_qx_qw =', &
     1873                      wape(igout),wape2(igout),ktopw(igout),OK_qx_qw(igout)
     1874  ENDIF
     1875
    17631876
    17641877  ! -----------------------------------------------------------------

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

    r2408 r2720  
    44      SUBROUTINE yamada_c(ngrid,timestep,plev,play &
    55     &   ,pu,pv,pt,d_u,d_v,d_t,cd,q2,km,kn,kq,d_t_diss,ustar &
    6      &   ,iflag_pbl,okiophys)
     6     &   ,iflag_pbl)
    77      USE dimphy, ONLY: klon, klev
    88      USE print_control_mod, ONLY: prt_level
     9      USE ioipsl_getin_p_mod, ONLY : getin_p
     10
    911      IMPLICIT NONE
    1012#include "YOMCST.h"
    … …  
    5052      REAL, DIMENSION(klon,klev) :: pu,pv,pt
    5153      REAL, DIMENSION(klon,klev) :: d_t_diss
    52       INTEGER okiophys
    5354
    5455      REAL timestep
    … …  
    6869      REAL unsdzdec(klon,klev+1)
    6970
    70       REAL km(klon,klev+1)
     71      REAL km(klon,klev)
    7172      REAL kmpre(klon,klev+1),tmp2
    7273      REAL mpre(klon,klev+1)
    73       REAL kn(klon,klev+1)
    74       REAL kq(klon,klev+1)
     74      REAL kn(klon,klev)
     75      REAL kq(klon,klev)
    7576      real ff(klon,klev+1),delta(klon,klev+1)
    7677      real aa(klon,klev+1),aa0,aa1
    … …  
    8485      data first,ipas/.false.,0/
    8586!$OMP THREADPRIVATE( first,ipas)
     87       INTEGER, SAVE :: iflag_tke_diff=0
     88!$OMP THREADPRIVATE(iflag_tke_diff)
     89
    8690
    8791      integer ig,k
    … …  
    119123REAL, DIMENSION(klon,klev) :: exner,masse
    120124REAL, DIMENSION(klon,klev+1) :: masseb,q2old,q2neg
     125      LOGICAL okiophys
    121126
    122127      frif(ri)=0.6588*(ri+0.1776-sqrt(ri*ri-0.3221*ri+0.03156))
    … …  
    128133
    129134
     135      okiophys=klon==1
    130136      if (firstcall) then
     137        CALL getin_p('iflag_tke_diff',iflag_tke_diff)
    131138        allocate(l0(klon))
    132 #ifdef IOPHYS
    133         call iophys_ini
     139#define IOPHYS
     140#ifdef IOPHYS
     141!        call iophys_ini
    134142#endif
    135143        firstcall=.false.
    136144      endif
    137145
    138 
    139 #ifdef IOPHYS
    140 if (okiophys==1) then
     146   IF (ngrid<=0) RETURN ! Bizarre : on n a pas ce probeleme pour coef_diff_turb
     147
     148#ifdef IOPHYS
     149if (okiophys) then
    141150call iophys_ecrit('q2i',klev,'q2 debut my','m2/s2',q2(:,1:klev))
    142151call iophys_ecrit('kmi',klev,'Kz debut my','m/s2',km(:,1:klev))
    … …  
    146155      nlay=klev
    147156      nlev=klev+1
     157
    148158
    149159!-------------------------------------------------------------------------
    … …  
    152162
    153163
    154    zu(:,:)=pu(:,:)+0.5*d_u(:,:)
    155    zv(:,:)=pv(:,:)+0.5*d_v(:,:)
    156    zt(:,:)=pt(:,:)+0.5*d_t(:,:)
     164   zalpha=0.5 ! Anciennement 0.5. Essayer de voir pourquoi ?
     165   zu(:,:)=pu(:,:)+zalpha*d_u(:,:)
     166   zv(:,:)=pv(:,:)+zalpha*d_v(:,:)
     167   zt(:,:)=pt(:,:)+zalpha*d_t(:,:)
     168
    157169   do k=1,klev
    158170      exner(:,k)=(play(:,k)/plev(:,1))**RKAPPA
    159171      masse(:,k)=(plev(:,k)-plev(:,k+1))/RG
     172      teta(:,k)=zt(:,k)/exner(:,k)
    160173   enddo
    161    teta(:,:)=zt(:,:)/exner(:,:)
    162174
    163175! Atmospheric mass at layer interfaces, where the TKE is computed
    … …  
    168180    enddo
    169181    masseb(:,:)=0.5*masseb(:,:)
    170 
    171 
    172182
    173183   zlev(:,1)=0.
    … …  
    202212
    203213#ifdef IOPHYS
    204 if (okiophys==1) then
     214if (okiophys) then
    205215      call iophys_ecrit('zlay',klev,'Geop','m',zlay)
    206216      call iophys_ecrit('teta',klev,'teta','K',teta)
    207217      call iophys_ecrit('temp',klev,'temp','K',zt)
    208218      call iophys_ecrit('pt',klev,'temp','K',pt)
     219      call iophys_ecrit('pu',klev,'u','m/s',pu)
     220      call iophys_ecrit('pv',klev,'v','m/s',pv)
    209221      call iophys_ecrit('d_u',klev,'d_u','m/s2',d_u)
    210222      call iophys_ecrit('d_v',klev,'d_v','m/s2',d_v)
    … …  
    213225      call iophys_ecrit('masse',klev,'masse','',masse)
    214226      call iophys_ecrit('masseb',klev,'masseb','',masseb)
    215       call iophys_ecrit('Cm2',klev,'m2 conserv','m/s',(dddu(:,1:klev)+dddv(:,1:klev))/(masseb(:,1:klev)*timestep))
    216       call iophys_ecrit('Cn2',klev,'m2 conserv','m/s',(rcpd*dddt(:,1:klev)/masseb(:,1:klev))/timestep)
    217       call iophys_ecrit('rifc',klev,'rif conservative','',rcpd*dddt(:,1:klev)/min(dddu(:,1:klev)+dddv(:,1:klev),-1.e-20))
    218227endif
    219228#endif
    … …  
    273282            rif(ig,k)=rifc
    274283         endif
    275          if(rif(ig,k).lt.0.16) then
     284         if(rif(ig,k)<0.16) then
    276285            alpha(ig,k)=falpha(rif(ig,k))
    277286            sm(ig,k)=fsm(rif(ig,k))
    … …  
    338347
    339348#ifdef IOPHYS
    340 if (okiophys==1) then
     349if (okiophys) then
    341350call iophys_ecrit('rif',klev,'Flux Richardson','m',rif(:,1:klev))
    342351call iophys_ecrit('m2',klev,'m2 ','m/s',m2(:,1:klev))
    343 call iophys_ecrit('Km2',klev,'m2 conserv','m/s',km(:,1:klev)*m2(:,1:klev))
     352call iophys_ecrit('Km2app',klev,'m2 conserv','m/s',km(:,1:klev)*m2(:,1:klev))
    344353call iophys_ecrit('Km',klev,'Km','m2/s',km(:,1:klev))
    345354endif
    … …  
    357366! Evolution of TKE under source terms K M2 and K N2
    358367   leff(:,:)=max(l(:,:),1.)
    359    IF (iflag_pbl==29) THEN
    360       km2(:,:)=km(:,:)*m2(:,:)
    361       kn2(:,:)=kn2(:,:)*rif(:,:)
    362    ELSEIF (iflag_pbl==25) THEN
    363       DO k=1,klev
    364          km2(:,k)=-0.5*(dddu(:,k)+dddv(:,k)+dddu(:,k+1)+dddv(:,k+1)) &
    365          &        /(masse(:,k)*timestep)
    366          kn2(:,k)=rcpd*0.5*(dddt(:,k)+dddt(:,k+1))/(masse(:,k)*timestep)
    367          leff(:,k)=0.5*(leff(:,k)+leff(:,k+1))
    368       ENDDO
    369       km2(:,klev+1)=0. ; kn2(:,klev+1)=0.
    370    ELSE
     368
     369!##################################################################
     370!#  IF (iflag_pbl==29) THEN
     371!#     STOP'Ne pas utiliser iflag_pbl=29'
     372!#     km2(:,:)=km(:,:)*m2(:,:)
     373!#     kn2(:,:)=kn2(:,:)*rif(:,:)
     374!#  ELSEIF (iflag_pbl==25) THEN
     375! VERSION AVEC LA TKE EN MILIEU DE COUCHE
     376!#     STOP'Ne pas utiliser iflag_pbl=25'
     377!#     DO k=1,klev
     378!#        km2(:,k)=-0.5*(dddu(:,k)+dddv(:,k)+dddu(:,k+1)+dddv(:,k+1)) &
     379!#        &        /(masse(:,k)*timestep)
     380!#        kn2(:,k)=rcpd*0.5*(dddt(:,k)+dddt(:,k+1))/(masse(:,k)*timestep)
     381!#        leff(:,k)=0.5*(leff(:,k)+leff(:,k+1))
     382!#     ENDDO
     383!#     km2(:,klev+1)=0. ; kn2(:,klev+1)=0.
     384!#  ELSE
     385!#################################################################
     386
    371387      km2(:,:)=-(dddu(:,:)+dddv(:,:))/(masseb(:,:)*timestep)
    372388      kn2(:,:)=rcpd*dddt(:,:)/(masseb(:,:)*timestep)
    373    ENDIF
     389!   ENDIF
    374390   q2neg(:,:)=q2(:,:)+timestep*(km2(:,:)-kn2(:,:))
    375391   q2(:,:)=min(max(q2neg(:,:),1.e-10),1.e4)
     392
     393 
     394#ifdef IOPHYS
     395if (okiophys) then
     396      call iophys_ecrit('km2',klev,'m2 conserv','m/s',km2(:,1:klev))
     397      call iophys_ecrit('kn2',klev,'n2 conserv','m/s',kn2(:,1:klev))
     398endif
     399#endif
    376400
    377401! Dissipation of TKE
    … …  
    379403   q2(:,:)=1./(1./sqrt(q2(:,:))+timestep/(2*leff(:,:)*b1))
    380404   q2(:,:)=q2(:,:)*q2(:,:)
    381    IF (iflag_pbl<=24) THEN
     405!  IF (iflag_pbl<=24) THEN
    382406      DO k=1,klev
    383407         d_t_diss(:,k)=(masseb(:,k)*(q2neg(:,k)-q2(:,k))+masseb(:,k+1)*(q2neg(:,k+1)-q2(:,k+1)))/(2.*rcpd*masse(:,k))
    384408      ENDDO
    385    ELSE IF (iflag_pbl<=27) THEN
    386       DO k=1,klev
    387          d_t_diss(:,k)=(q2neg(:,k)-q2(:,k))/rcpd
    388       ENDDO
    389    ENDIF
     409
     410!###################################################################
     411!  ELSE IF (iflag_pbl<=27) THEN
     412!     DO k=1,klev
     413!        d_t_diss(:,k)=(q2neg(:,k)-q2(:,k))/rcpd
     414!     ENDDO
     415!  ENDIF
    390416!  print*,'iflag_pbl ',d_t_diss
     417!###################################################################
    391418
    392419
    393420! Compuation of stability functions
    394    IF (iflag_pbl/=29) THEN
     421!   IF (iflag_pbl/=29) THEN
    395422      DO k=1,klev
    396423      DO ig=1,ngrid
    … …  
    409436      ENDDO
    410437      ENDDO
    411     ENDIF
     438!    ENDIF
    412439
    413440! Computation of turbulent diffusivities
    414    IF (25<=iflag_pbl.and.iflag_pbl<=28) THEN
    415      DO k=2,klev
    416         sqrtq(:,k)=sqrt(0.5*(q2(:,k)+q2(:,k-1)))
    417      ENDDO
    418    ELSE
    419      DO k=2,klev
    420         sqrtq(:,k)=sqrt(q2(:,k))
    421      ENDDO
    422    ENDIF
    423    DO k=2,klev
    424    DO ig=1,ngrid
    425       km(ig,k)=leff(ig,k)*sqrtq(ig,k)*sm(ig,k)
    426       kn(ig,k)=km(ig,k)*alpha(ig,k)
    427       kq(ig,k)=leff(ig,k)*zq*0.2
    428 !         print*,q2(ig,k),zq,km(ig,k)
     441!  IF (25<=iflag_pbl.and.iflag_pbl<=28) THEN
     442!    DO k=2,klev
     443!       sqrtq(:,k)=sqrt(0.5*(q2(:,k)+q2(:,k-1)))
     444!    ENDDO
     445!  ELSE
     446   kq(:,:)=0.
     447   DO k=1,klev
     448      ! Coefficient au milieu des couches pour diffuser la TKE
     449      kq(:,k)=0.5*leff(:,k)*sqrt(q2(:,k))*0.2
    429450   ENDDO
     451
     452#ifdef IOPHYS
     453if (okiophys) then
     454call iophys_ecrit('q2b',klev,'KTE inter','m2/s',q2(:,1:klev))
     455endif
     456#endif
     457
     458  IF (iflag_tke_diff==1) THEN
     459    CALL vdif_q2(timestep, RG, RD, ngrid, plev, pt, kq, q2)
     460  ENDIF
     461
     462   km(:,:)=0.
     463   kn(:,:)=0.
     464   DO k=1,klev
     465      km(:,k)=leff(:,k)*sqrt(q2(:,k))*sm(:,k)
     466      kn(:,k)=km(:,k)*alpha(:,k)
    430467   ENDDO
    431468
    432469
    433 
    434 #ifdef IOPHYS
    435 if (okiophys==1) then
     470#ifdef IOPHYS
     471if (okiophys) then
    436472call iophys_ecrit('mixingl',klev,'Mixing length','m',leff(:,1:klev))
    437473call iophys_ecrit('rife',klev,'Flux Richardson','m',rif(:,1:klev))
    … …  
    447483#endif
    448484
     485
    449486ENDIF
    450487
    … …  
    452489!  print*,'OK2'
    453490      RETURN
    454 !====================================================================
    455 !   Yamada 2.0
    456 !====================================================================
    457       if (iflag_pbl.eq.6) then
    458 
    459       do k=2,klev
    460          q2(:,k)=l(:,k)**2*zz(:,k)
    461       enddo
    462 
    463 
    464       else if (iflag_pbl.eq.7) then
    465 !====================================================================
    466 !   Yamada 2.Fournier
    467 !====================================================================
    468 
    469 !  Calcul de l,  km, au pas precedent
    470       do k=2,klev
    471                                                           do ig=1,ngrid
    472 !        print*,'SMML=',sm(ig,k),l(ig,k)
    473          delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
    474          kmpre(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
    475          mpre(ig,k)=sqrt(m2(ig,k))
    476 !        print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
    477                                                           enddo
    478       enddo
    479 
    480       do k=2,klev-1
    481                                                           do ig=1,ngrid
    482         m2cstat=max(alpha(ig,k)*n2(ig,k)+delta(ig,k)/b1,1.e-12)
    483         mcstat=sqrt(m2cstat)
    484 
    485 !        print*,'M2 L=',k,mpre(ig,k),mcstat
    486 !
    487 !  -----{puis on ecrit la valeur de q qui annule l'equation de m
    488 !        supposee en q3}
    489 !
    490         IF (k.eq.2) THEN
    491           kmcstat=1.E+0 / mcstat &
    492      &    *( unsdz(ig,k)*kmpre(ig,k+1) &
    493      &                        *mpre(ig,k+1) &
    494      &      +unsdz(ig,k-1) &
    495      &              *cd(ig) &
    496      &              *( sqrt(zu(ig,3)**2+zv(ig,3)**2) &
    497      &                -mcstat/unsdzdec(ig,k) &
    498      &                -mpre(ig,k+1)/unsdzdec(ig,k+1) )**2) &
    499      &      /( unsdz(ig,k)+unsdz(ig,k-1) )
    500         ELSE
    501           kmcstat=1.E+0 / mcstat &
    502      &    *( unsdz(ig,k)*kmpre(ig,k+1) &
    503      &                        *mpre(ig,k+1) &
    504      &      +unsdz(ig,k-1)*kmpre(ig,k-1) &
    505      &                          *mpre(ig,k-1) ) &
    506      &      /( unsdz(ig,k)+unsdz(ig,k-1) )
    507         ENDIF
    508 !       print*,'T2 L=',k,tmp2
    509         tmp2=kmcstat &
    510      &      /( sm(ig,k)/q2(ig,k) ) &
    511      &      /l(ig,k)
    512         q2(ig,k)=max(tmp2,1.e-12)**(2./3.)
    513 !       print*,'Q2 L=',k,q2(ig,k)
    514 !
    515                                                           enddo
    516       enddo
    517 
    518       else if (iflag_pbl==8.or.iflag_pbl==9) then
    519 !====================================================================
    520 !   Yamada 2.5 a la Didi
    521 !====================================================================
    522 
    523 
    524 !  Calcul de l,  km, au pas precedent
    525       do k=2,klev
    526                                                           do ig=1,ngrid
    527 !        print*,'SMML=',sm(ig,k),l(ig,k)
    528          delta(ig,k)=q2(ig,k)/(l(ig,k)**2*sm(ig,k))
    529          if (delta(ig,k).lt.1.e-20) then
    530 !     print*,'ATTENTION   L=',k,'   Delta=',delta(ig,k)
    531             delta(ig,k)=1.e-20
    532          endif
    533          km(ig,k)=l(ig,k)*sqrt(q2(ig,k))*sm(ig,k)
    534          aa0=(m2(ig,k)-alpha(ig,k)*n2(ig,k)-delta(ig,k)/b1)
    535          aa1=(m2(ig,k)*(1.-rif(ig,k))-delta(ig,k)/b1)
    536 ! abder      print*,'AA L=',k,aa0,aa1,aa1/max(m2(ig,k),1.e-20)
    537          aa(ig,k)=aa1*timestep/(delta(ig,k)*l(ig,k))
    538 !     print*,'0L=',k,l(ig,k),delta(ig,k),km(ig,k)
    539          qpre=sqrt(q2(ig,k))
    540 !        if (iflag_pbl.eq.8 ) then
    541             if (aa(ig,k).gt.0.) then
    542                q2(ig,k)=(qpre+aa(ig,k)*qpre*qpre)**2
    543             else
    544                q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
    545             endif
    546 !        else ! iflag_pbl=9
    547 !           if (aa(ig,k)*qpre.gt.0.9) then
    548 !              q2(ig,k)=(qpre*10.)**2
    549 !           else
    550 !              q2(ig,k)=(qpre/(1.-aa(ig,k)*qpre))**2
    551 !           endif
    552 !        endif
    553          q2(ig,k)=min(max(q2(ig,k),1.e-10),1.e4)
    554 !     print*,'Q2 L=',k,q2(ig,k),qpre*qpre
    555                                                           enddo
    556       enddo
    557 
    558       else if (iflag_pbl>=10) then
    559 
    560 !        print*,'Schema mixte D'
    561 !        print*,'Longueur ',l(:,:)
    562          do k=2,klev-1
    563             l(:,k)=max(l(:,k),1.)
    564             km(:,k)=l(:,k)*sqrt(q2(:,k))*sm(:,k)
    565             q2(:,k)=q2(:,k)+timestep*km(:,k)*m2(:,k)*(1.-rif(:,k))
    566             q2(:,k)=min(max(q2(:,k),1.e-10),1.e4)
    567             q2(:,k)=1./(1./sqrt(q2(:,k))+timestep/(2*l(:,k)*b1))
    568             q2(:,k)=q2(:,k)*q2(:,k)
    569          enddo
    570 
    571 
    572       else
    573          CALL abort_physic(modname,'Cas nom prevu dans yamada4',1)
    574 
    575       endif ! Fin du cas 8
    576 
    577 !     print*,'OK8'
    578 
    579 !====================================================================
    580 !   Calcul des coefficients de m�ange
    581 !====================================================================
    582       do k=2,klev
    583 !     print*,'k=',k
    584                                                           do ig=1,ngrid
    585 !abde      print*,'KML=',l(ig,k),q2(ig,k),sm(ig,k)
    586          zq=sqrt(q2(ig,k))
    587          km(ig,k)=l(ig,k)*zq*sm(ig,k)
    588          kn(ig,k)=km(ig,k)*alpha(ig,k)
    589          kq(ig,k)=l(ig,k)*zq*0.2
    590 !     print*,'KML=',km(ig,k),kn(ig,k)
    591                                                           enddo
    592       enddo
    593 
    594 ! Transport diffusif vertical de la TKE.
    595       if (iflag_pbl.ge.12) then
    596 !       print*,'YAMADA VDIF'
    597         q2(:,1)=q2(:,2)
    598         call vdif_q2(timestep,RG,RD,ngrid,plev,zt,kq,q2)
    599       endif
    600 
    601 !   Traitement des cas noctrunes avec l'introduction d'une longueur
    602 !   minilale.
    603 
    604 !====================================================================
    605 !   Traitement particulier pour les cas tres stables.
    606 !   D'apres Holtslag Boville.
    607 
    608       if (prt_level>1) THEN
    609        print*,'YAMADA4 0'
    610       endif !(prt_level>1) THEN
    611                                                           do ig=1,ngrid
    612       coriol(ig)=1.e-4
    613       pblhmin(ig)=0.07*ustar(ig)/max(abs(coriol(ig)),2.546e-5)
    614                                                           enddo
    615 
    616 !     print*,'pblhmin ',pblhmin
    617 !Test a remettre 21 11 02
    618 ! test abd 13 05 02      if(0.eq.1) then
    619       if(1==1) then
    620       if(iflag_pbl==8.or.iflag_pbl==10) then
    621 
    622       do k=2,klev
    623          do ig=1,ngrid
    624             if (teta(ig,2).gt.teta(ig,1)) then
    625                qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
    626                kmin=kap*zlev(ig,k)*qmin
    627             else
    628                kmin=-1. ! kmin n'est utilise que pour les SL stables.
    629             endif
    630             if (kn(ig,k).lt.kmin.or.km(ig,k).lt.kmin) then
    631 !               print*,'Seuil min Km K=',k,kmin,km(ig,k),kn(ig,k)
    632 !     s           ,sqrt(q2(ig,k)),pblhmin(ig),qmin/sm(ig,k)
    633                kn(ig,k)=kmin
    634                km(ig,k)=kmin
    635                kq(ig,k)=kmin
    636 !   la longueur de melange est suposee etre l= kap z
    637 !   K=l q Sm d'ou q2=(K/l Sm)**2
    638                q2(ig,k)=(qmin/sm(ig,k))**2
    639             endif
    640          enddo
    641       enddo
    642 
    643       else
    644 
    645       do k=2,klev
    646          do ig=1,ngrid
    647             if (teta(ig,2).gt.teta(ig,1)) then
    648                qmin=ustar(ig)*(max(1.-zlev(ig,k)/pblhmin(ig),0.))**2
    649                kmin=kap*zlev(ig,k)*qmin
    650             else
    651                kmin=-1. ! kmin n'est utilise que pour les SL stables.
    652             endif
    653             if (kn(ig,k).lt.kmin.or.km(ig,k).lt.kmin) then
    654 !               print*,'Seuil min Km K=',k,kmin,km(ig,k),kn(ig,k)
    655 !     s           ,sqrt(q2(ig,k)),pblhmin(ig),qmin/sm(ig,k)
    656                kn(ig,k)=kmin
    657                km(ig,k)=kmin
    658                kq(ig,k)=kmin
    659 !   la longueur de melange est suposee etre l= kap z
    660 !   K=l q Sm d'ou q2=(K/l Sm)**2
    661                sm(ig,k)=1.
    662                alpha(ig,k)=1.
    663                q2(ig,k)=min((qmin/sm(ig,k))**2,10.)
    664                zq=sqrt(q2(ig,k))
    665                km(ig,k)=l(ig,k)*zq*sm(ig,k)
    666                kn(ig,k)=km(ig,k)*alpha(ig,k)
    667                kq(ig,k)=l(ig,k)*zq*0.2
    668             endif
    669          enddo
    670       enddo
    671       endif
    672 
    673       endif
    674 
    675       if (prt_level>1) THEN
    676        print*,'YAMADA4 1'
    677       endif !(prt_level>1) THEN
    678 !   Diagnostique pour stokage
    679 
    680       if(1.eq.0)then
    681       rino=rif
    682       smyam(1:ngrid,1)=0.
    683       styam(1:ngrid,1)=0.
    684       lyam(1:ngrid,1)=0.
    685       knyam(1:ngrid,1)=0.
    686       w2yam(1:ngrid,1)=0.
    687       t2yam(1:ngrid,1)=0.
    688 
    689       smyam(1:ngrid,2:klev)=sm(1:ngrid,2:klev)
    690       styam(1:ngrid,2:klev)=sm(1:ngrid,2:klev)*alpha(1:ngrid,2:klev)
    691       lyam(1:ngrid,2:klev)=l(1:ngrid,2:klev)
    692       knyam(1:ngrid,2:klev)=kn(1:ngrid,2:klev)
    693 
    694 !   Estimations de w'2 et T'2 d'apres Abdela et McFarlane
    695 
    696       w2yam(1:ngrid,2:klev)=q2(1:ngrid,2:klev)*0.24 &
    697      &    +lyam(1:ngrid,2:klev)*5.17*kn(1:ngrid,2:klev) &
    698      &    *n2(1:ngrid,2:klev)/sqrt(q2(1:ngrid,2:klev))
    699 
    700       t2yam(1:ngrid,2:klev)=9.1*kn(1:ngrid,2:klev) &
    701      &    *dtetadz(1:ngrid,2:klev)**2 &
    702      &    /sqrt(q2(1:ngrid,2:klev))*lyam(1:ngrid,2:klev)
    703       endif
    704 
    705 !     print*,'OKFIN'
    706       first=.false.
    707       return
    708       end
     491      END

  • LMDZ5/branches/testing/makelmdz

    r2641 r2720  
    2929rrtm=false
    3030dust=false
     31strataer=false
    3132full=""
    3233
    … …  
    113114[-rrtm true/false]    : compile with/without rrtm package (default: false)
    114115[-dust true/false]    : compile with/without the dust package from Boucher et al. (default: false)
     116[-strataer true/false]    : compile with/without the strat aer package from Boucher et al. (default: false)
    115117[-parallel none/mpi/omp/mpi_omp] : parallelism (default: none) : mpi, openmp or mixted mpi_openmp
    116118[-g GRI]                   : grid configuration in dyn3d/GRI_xy.h  (default: reg, inclues a zoom)
    … …  
    180182          dust="$2" ; shift ; shift ;;
    181183     
     184      "-strataer")
     185          strataer="$2" ; shift ; shift ;;
     186     
    182187      "-mem")
    183188          paramem="mem" ; shift ;;
    … …  
    459464   CPP_KEY="$CPP_KEY CPP_Dust"
    460465   src_dirs="$src_dirs phy${physique}/Dust"
     466fi
     467
     468if [[ "$strataer" == "true" ]]
     469then
     470   CPP_KEY="$CPP_KEY CPP_StratAer"
     471   src_dirs="$src_dirs phy${physique}/StratAer"
    461472fi
    462473

  • LMDZ5/branches/testing/makelmdz_fcm

    r2641 r2720  
    2626rrtm=false
    2727dust=false
     28strataer=false
    2829chimie=false
    2930parallel=none
    … …  
    4849RRTM_PATH=$LMDGCM/.void_dir
    4950DUST_PATH=$LMDGCM/.void_dir
     51STRATAER_PATH=$LMDGCM/.void_dir
    5052SISVAT_PATH=$LMDGCM/.void_dir
    5153COSP_PATH=$LMDGCM/.void_dir
    … …  
    9092[-rrtm true/false]    : compile with/without rrtm package (default: false)
    9193[-dust true/false]    : compile with/without the dust package by Boucher and co (default: false)
     94[-strataer true/false]    : compile with/without the strat aer package by Boucher and co (default: false)
    9295[-parallel none/mpi/omp/mpi_omp] : parallelism (default: none) : mpi, openmp or mixted mpi_openmp
    9396[-g GRI]                   : grid configuration in dyn3d/GRI_xy.h  (default: reg, inclues a zoom)
    … …  
    144147      "-dust")
    145148          dust="$2" ; shift ; shift ;;
     149
     150      "-strataer")
     151          strataer="$2" ; shift ; shift ;;
    146152
    147153      "-chimie")
    … …  
    363369fi
    364370
     371if [[ "$strataer" == "true" ]]
     372then
     373   CPP_KEY="$CPP_KEY CPP_StratAer"
     374   STRATAER_PATH="$LIBFGCM/%PHYS/StratAer"
     375fi
     376
    365377if [[ $io == ioipsl ]]
    366378then
    … …  
    593605echo "%RRTM          $RRTM_PATH"     >> $config_fcm
    594606echo "%DUST          $DUST_PATH"     >> $config_fcm
     607echo "%STRATAER      $STRATAER_PATH" >> $config_fcm
    595608echo "%SISVAT        $SISVAT_PATH"   >> $config_fcm
    596609echo "%COSP          $COSP_PATH"     >> $config_fcm
Note: See TracChangeset for help on using the changeset viewer.