Changeset 2488


Ignore:
Timestamp:
Apr 3, 2016, 12:09:34 AM (8 years ago)
Author:
Laurent Fairhead
Message:

Merged trunk changes r2457:2487 into testing branch

Location:
LMDZ5/branches/testing
Files:
46 edited
5 copied

Legend:

Unmodified
Added
Removed

  • LMDZ5/branches/testing

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

    r2471 r2488  
    311311        <field id="OD550_AIBCM"    long_name="Aerosol Optical depth at 550 nm "    unit="1" />
    312312        <field id="OD550_AIPOMM"    long_name="Aerosol Optical depth at 550 nm "    unit="1" />
    313         <field id="OD550_STRAT"    long_name="Aerosol Optical depth at 550 nm "    unit="1" enabled="FALSE" />
     313        <field id="OD550_STRAT"    long_name="Aerosol Optical depth at 550 nm "    unit="1" enabled="TRUE" />
    314314        <field id="OD550_SO4"     long_name="Aerosol Optical depth at 550 nm "    unit="1" />
    315315        <field id="OD550_ASNO3M"     long_name="Aerosol Optical depth at 550 nm "    unit="1" />
    316316        <field id="OD550_CSNO3M"     long_name="Aerosol Optical depth at 550 nm "    unit="1" />
    317317        <field id="OD550_CINO3M"     long_name="Aerosol Optical depth at 550 nm "    unit="1" />
     318        <field id="OD_10um_STRAT" long_name="Stratospheric Aerosol Optical depth at 10 um" unit="-" />
    318319        <field id="od550aer"    long_name="Total aerosol optical depth at 550nm"    unit="-" />
    319320        <field id="od865aer"    long_name="Total aerosol optical depth at 870nm"    unit="-" />
    … …  
    379380        <field id="wake_h"    long_name="wake_h"    unit="-" />
    380381        <field id="wake_s"    long_name="wake_s"    unit="-" />
     382        <field id="epmax"    long_name="epmax en fn cape"    unit="su" />
    381383        <field id="plulth"    long_name="Rainfall therm."    unit="K/s" />
    382384        <field id="plulst"    long_name="Rainfall strat."    unit="K/s" />
    … …  
    389391        <field id="rsutcs4co2"    long_name="TOA Out CS SW in 4xCO2 atmosphere"    unit="W/m2" />
    390392        <field id="rlutcs4co2"    long_name="TOA Out CS LW in 4xCO2 atmosphere"    unit="W/m2" />
     393        <field id="dqphy2d"    long_name="Physics dQ"    unit="(kg/m2)/s" />
     394        <field id="dqdyn2d"    long_name="Dynamics dQ"    unit="(kg/m2)/s" />
     395        <field id="dqcon2d"    long_name="Convection dQ"    unit="(kg/m2)/s" />
     396        <field id="dqwak2d"    long_name="Wake dQ"    unit="(kg/m2)/s" />
     397        <field id="dqlsc2d"    long_name="Condensation dQ"    unit="(kg/m2)/s" />
     398        <field id="dqvdf2d"    long_name="Boundary-layer dQ"    unit="(kg/m2)/s" />
     399        <field id="dqeva2d"    long_name="Reevaporation dQ"    unit="(kg/m2)/s" />
     400        <field id="dqlscth2d"    long_name="dQ therm."    unit="(kg/m2)/s" />
     401        <field id="dqlscst2d"    long_name="dQ strat."    unit="(kg/m2)/s" />
     402        <field id="dqthe2d"    long_name="Thermal dQ"    unit="(kg/m2)/s" />
     403        <field id="dqajs2d"    long_name="Dry ajdust dQ"    unit="(kg/m2)/s" />
    391404    </field_group>
    392405
    … …  
    440453        <field id="ozone_daylight"    long_name="Daylight ozone mole fraction"    unit="-" />
    441454        <field id="upwd"    long_name="saturated updraft"    unit="kg/m2/s" />
     455        <field id="ep"    long_name="ep"    unit="su" />
    442456        <field id="dtphy"    long_name="Physics dT"    unit="K/s" />
    443457        <field id="dqphy"    long_name="Physics dQ"    unit="(kg/kg)/s" />

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

    r2408 r2488  
    371371                <field field_ref="wake_h" level="10" />
    372372                <field field_ref="wake_s" level="10" />
     373                <field field_ref="epmax" level="10" />
    373374                <field field_ref="plulth" level="10" />
    374375                <field field_ref="plulst" level="10" />
    … …  
    381382                <field field_ref="rsutcs4co2" level="10" />
    382383                <field field_ref="rlutcs4co2" level="10" />
     384                <field field_ref="dqphy2d" level="10" />
     385                <field field_ref="dqdyn2d" level="10" />
     386                <field field_ref="dqcon2d" level="10" />
     387                <field field_ref="dqwak2d" level="10" />
     388                <field field_ref="dqlsc2d" level="10" />
     389                <field field_ref="dqvdf2d" level="10" />
     390                <field field_ref="dqeva2d" level="10" />
     391                <field field_ref="dqlscth2d" level="10" />
     392                <field field_ref="dqlscst2d" level="10" />
     393                <field field_ref="dqthe2d" level="10" />
     394                <field field_ref="dqajs2d" level="10" />
    383395            </field_group>
    384396
    … …  
    418430                <field field_ref="ozone" level="10" />
    419431                <field field_ref="upwd" level="10" />
     432                <field field_ref="ep" level="10" />
    420433                <field field_ref="dtphy" level="10" />
    421434                <field field_ref="dqphy" level="10" />

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

    r2408 r2488  
    371371                <field field_ref="wake_h" level="5" />
    372372                <field field_ref="wake_s" level="5" />
     373                <field field_ref="epmax" level="10" />
    373374                <field field_ref="plulth" level="10" />
    374375                <field field_ref="plulst" level="10" />
    … …  
    381382                <field field_ref="rsutcs4co2" level="10" />
    382383                <field field_ref="rlutcs4co2" level="10" />
     384                <field field_ref="dqphy2d" level="10" />
     385                <field field_ref="dqdyn2d" level="10" />
     386                <field field_ref="dqcon2d" level="10" />
     387                <field field_ref="dqwak2d" level="10" />
     388                <field field_ref="dqlsc2d" level="10" />
     389                <field field_ref="dqvdf2d" level="10" />
     390                <field field_ref="dqeva2d" level="10" />
     391                <field field_ref="dqlscth2d" level="10" />
     392                <field field_ref="dqlscst2d" level="10" />
     393                <field field_ref="dqthe2d" level="10" />
     394                <field field_ref="dqajs2d" level="10" />
    383395            </field_group>
    384396
    … …  
    418430                <field field_ref="ozone" level="10" />
    419431                <field field_ref="upwd" level="10" />
     432                <field field_ref="ep" level="10" />
    420433                <field field_ref="dtphy" level="10" />
    421434                <field field_ref="dqphy" level="10" />

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

    r2408 r2488  
    371371                <field field_ref="wake_h" level="10" />
    372372                <field field_ref="wake_s" level="10" />
     373                <field field_ref="epmax" level="10" />
    373374                <field field_ref="plulth" level="10" />
    374375                <field field_ref="plulst" level="10" />
    … …  
    381382                <field field_ref="rsutcs4co2" level="10" />
    382383                <field field_ref="rlutcs4co2" level="10" />
     384                <field field_ref="dqphy2d" level="10" />
     385                <field field_ref="dqdyn2d" level="10" />
     386                <field field_ref="dqcon2d" level="10" />
     387                <field field_ref="dqwak2d" level="10" />
     388                <field field_ref="dqlsc2d" level="10" />
     389                <field field_ref="dqvdf2d" level="10" />
     390                <field field_ref="dqeva2d" level="10" />
     391                <field field_ref="dqlscth2d" level="10" />
     392                <field field_ref="dqlscst2d" level="10" />
     393                <field field_ref="dqthe2d" level="10" />
     394                <field field_ref="dqajs2d" level="10" />
    383395            </field_group>
    384396
    … …  
    418430                <field field_ref="ozone" level="10" />
    419431                <field field_ref="upwd" level="10" />
     432                <field field_ref="ep" level="10" />
    420433                <field field_ref="dtphy" level="10" />
    421434                <field field_ref="dqphy" level="10" />

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

    r2408 r2488  
    371371                <field field_ref="wake_h" level="10" />
    372372                <field field_ref="wake_s" level="10" />
     373                <field field_ref="epmax" level="10" />
    373374                <field field_ref="plulth" level="10" />
    374375                <field field_ref="plulst" level="10" />
    … …  
    381382                <field field_ref="rsutcs4co2" level="10" />
    382383                <field field_ref="rlutcs4co2" level="10" />
     384                <field field_ref="dqphy2d" level="10" />
     385                <field field_ref="dqdyn2d" level="10" />
     386                <field field_ref="dqcon2d" level="10" />
     387                <field field_ref="dqwak2d" level="10" />
     388                <field field_ref="dqlsc2d" level="10" />
     389                <field field_ref="dqvdf2d" level="10" />
     390                <field field_ref="dqeva2d" level="10" />
     391                <field field_ref="dqlscth2d" level="10" />
     392                <field field_ref="dqlscst2d" level="10" />
     393                <field field_ref="dqthe2d" level="10" />
     394                <field field_ref="dqajs2d" level="10" />
    383395            </field_group>
    384396
    … …  
    418430                <field field_ref="ozone" level="10" />
    419431                <field field_ref="upwd" level="10" />
     432                <field field_ref="ep" level="10" />
    420433                <field field_ref="dtphy" level="10" />
    421434                <field field_ref="dqphy" level="10" />

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

    r2435 r2488  
    371371                <field field_ref="wake_h" level="4" />
    372372                <field field_ref="wake_s" level="4" />
     373                <field field_ref="epmax" level="2" />
    373374                <field field_ref="plulth" level="10" />
    374375                <field field_ref="plulst" level="10" />
    … …  
    381382                <field field_ref="rsutcs4co2" level="5" />
    382383                <field field_ref="rlutcs4co2" level="5" />
     384                <field field_ref="dqphy2d" level="2" />
     385                <field field_ref="dqdyn2d" level="4" />
     386                <field field_ref="dqcon2d" level="4" />
     387                <field field_ref="dqwak2d" level="4" />
     388                <field field_ref="dqlsc2d" level="4" />
     389                <field field_ref="dqvdf2d" level="4" />
     390                <field field_ref="dqeva2d" level="4" />
     391                <field field_ref="dqlscth2d" level="10" />
     392                <field field_ref="dqlscst2d" level="10" />
     393                <field field_ref="dqthe2d" level="4" />
     394                <field field_ref="dqajs2d" level="4" />
    383395            </field_group>
    384396
    … …  
    418430                <field field_ref="ozone" level="2" />
    419431                <field field_ref="upwd" level="2" />
     432                <field field_ref="ep" level="2" />
    420433                <field field_ref="dtphy" level="2" />
    421434                <field field_ref="dqphy" level="2" />

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

    r2435 r2488  
    371371                <field field_ref="wake_h" level="10" />
    372372                <field field_ref="wake_s" level="10" />
     373                <field field_ref="epmax" level="10" />
    373374                <field field_ref="plulth" level="10" />
    374375                <field field_ref="plulst" level="10" />
    … …  
    381382                <field field_ref="rsutcs4co2" level="10" />
    382383                <field field_ref="rlutcs4co2" level="10" />
     384                <field field_ref="dqphy2d" level="10" />
     385                <field field_ref="dqdyn2d" level="10" />
     386                <field field_ref="dqcon2d" level="10" />
     387                <field field_ref="dqwak2d" level="10" />
     388                <field field_ref="dqlsc2d" level="10" />
     389                <field field_ref="dqvdf2d" level="10" />
     390                <field field_ref="dqeva2d" level="10" />
     391                <field field_ref="dqlscth2d" level="10" />
     392                <field field_ref="dqlscst2d" level="10" />
     393                <field field_ref="dqthe2d" level="10" />
     394                <field field_ref="dqajs2d" level="10" />
    383395            </field_group>
    384396
    … …  
    418430                <field field_ref="ozone" level="10" />
    419431                <field field_ref="upwd" level="10" />
     432                <field field_ref="ep" level="10" />
    420433                <field field_ref="dtphy" level="10" />
    421434                <field field_ref="dqphy" level="10" />

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

    r1910 r2488  
    33## Fichier de configuration general
    44##
     5INCLUDEDEF=gcm.def
     6INCLUDEDEF=vert.def
    57INCLUDEDEF=physiq.def
    6 INCLUDEDEF=gcm.def
     8INCLUDEDEF=convection.def
    79INCLUDEDEF=orchidee.def
    810INCLUDEDEF=output.def

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

    r2471 r2488  
    3333##  Avec ou sans strato
    3434ok_strato=y
    35 ok_hines=y
     35ok_hines=n
    3636#  Couche eponge dans les couches de pression plus faible que 100 fois la pression de la derniere couche
    3737iflag_top_bound=2

  • LMDZ5/branches/testing/libf/dyn3d/leapfrog.F

    r2408 r2488  
    686686               ENDIF
    687687               
     688!              ! Ehouarn: re-compute geopotential for outputs
     689               CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     690
    688691               IF (ok_dynzon) THEN
    689692#ifdef CPP_IOIPSL
    … …  
    821824               ENDIF
    822825
     826!              ! Ehouarn: re-compute geopotential for outputs
     827               CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     828
    823829               IF (ok_dynzon) THEN
    824830#ifdef CPP_IOIPSL

  • LMDZ5/branches/testing/libf/dyn3dmem/bilan_dyn_loc.F

    r1910 r2488  
    1616      USE mod_hallo
    1717      use misc_mod
    18       use write_field
     18      USE write_field_loc
    1919      IMPLICIT NONE
    2020
    … …  
    171171     
    172172      INTEGER :: bilan_dyn_domain_id
    173 
    174173
    175174c=====================================================================
    … …  
    216215      ALLOCATE(ndex3d(jjb_v:jje_v*llm))
    217216      ndex3d=0
    218       ALLOCATE(rlong(jjb_v:jje_v))
    219       ALLOCATE(rlatg(jjb_v:jje_v))
     217      ALLOCATE(rlong(1))
     218      ALLOCATE(rlatg(jjm))
    220219     
    221220!$OMP END MASTER
    … …  
    285284       
    286285      call histbeg(trim(infile),
    287      .             1, rlong(jjb:jje), jjn, rlatg(jjb:jje),
     286     .             1, rlong, jjn, rlatg(jjb:jje),
    288287     .             1, 1, 1, jjn,
    289288     .             tau0, zjulian, dt_cum, thoriid, fileid,
    … …  
    514513            enddo
    515514         enddo
    516 !$OMP END DO NOWAIT
    517       enddo
    518 
     515!$OMP ENDDO NOWAIT
     516!$OMP BARRIER
     517      enddo
    519518
    520519c    tendances
    … …  
    540539      CALL vitvert_loc(convm,w)
    541540!$OMP BARRIER
     541
    542542
    543543      jjb=jj_begin
    … …  
    618618!$OMP ENDDO NOWAIT
    619619         
    620      
    621620      IF (pole_sud) jje=jj_end-1
    622621!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    … …  
    626625      ENDDO
    627626!$OMP ENDDO NOWAIT
     627!$OMP BARRIER
    628628         
    629629      jjb=jj_begin
    … …  
    640640!$OMP ENDDO NOWAIT
    641641      enddo
    642  
     642
    643643c=====================================================================
    644644c   Transport méridien
    … …  
    657657        ENDDO
    658658!$OMP ENDDO NOWAIT
     659!$OMP BARRIER
    659660
    660661      call Register_Hallo_u(masse_cum,llm,1,1,1,1,Req)
    … …  
    684685      enddo
    685686!$OMP ENDDO NOWAIT
     687!$OMP BARRIER
    686688
    687689c     print*,'3OK'

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

    r2408 r2488  
    415415#ifdef CPP_IOIPSL
    416416  time_step = zdtvr
    417   IF (mpi_rank==0) then
    418417     if (ok_dyn_ins) then
    419418        ! initialize output file for instantaneous outputs
    … …  
    421420        t_ops =((1.0*iecri)/day_step) * daysec 
    422421        t_wrt = daysec ! iecri * daysec ! write output every t_wrt
    423         t_wrt = daysec ! iecri * daysec ! write output every t_wrt
    424         CALL inithist(day_ref,annee_ref,time_step, &
     422        CALL inithist_loc(day_ref,annee_ref,time_step, &
    425423             t_ops,t_wrt)
    426424     endif
    … …  
    432430        CALL initdynav_loc(day_ref,annee_ref,time_step,t_ops,t_wrt)
    433431     END IF
    434   ENDIF
    435432  dtav = iperiod*dtvr/daysec
    436433#endif

  • LMDZ5/branches/testing/libf/dyn3dmem/initdynav_loc.F

    r1910 r2488  
    154154
    155155      ddid=(/ 1,2 /)
    156       dsg=(/ iip1,jjp1 /)
     156      dsg=(/ iip1,jjm /)
    157157      dsl=(/ iip1,jjn /)
    158158      dpf=(/ 1,jjb /)
    … …  
    171171     
    172172! Grille U
     173
     174      do jj = 1, jjp1
     175        do ii = 1, iip1
     176          rlong(ii,jj) = rlonu(ii) * 180. / pi
     177          rlat(ii,jj) = rlatu(jj) * 180. / pi
     178        enddo
     179      enddo
    173180
    174181      jjb=jj_begin
    … …  
    209216C  Vents U
    210217C
     218      jjn=jj_nb
    211219      call histdef(histuaveid, 'u', 'vent u moyen ',
    212      .             'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiidu,
     220     .             'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
    213221     .             32, 'ave(X)', t_ops, t_wrt)
    214222
    … …  
    216224C  Vents V
    217225C
     226      if (pole_sud) jjn=jj_nb-1
    218227      call histdef(histvaveid, 'v', 'vent v moyen',
    219      .             'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiidv,
     228     .             'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
    220229     .             32, 'ave(X)', t_ops, t_wrt)
    221230
    … …  
    223232C  Temperature
    224233C
     234      jjn=jj_nb
    225235      call histdef(histaveid, 'temp', 'temperature moyenne', 'K',
    226      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     236     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    227237     .             32, 'ave(X)', t_ops, t_wrt)
    228238C
    … …  
    230240C
    231241      call histdef(histaveid, 'theta', 'temperature potentielle', 'K',
    232      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     242     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    233243     .             32, 'ave(X)', t_ops, t_wrt)
    234244
    … …  
    238248C
    239249      call histdef(histaveid, 'phi', 'geopotentiel moyen', '-',
    240      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     250     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    241251     .             32, 'ave(X)', t_ops, t_wrt)
    242252C
    … …  
    251261C  Masse
    252262C
    253       call histdef(histaveid, 'masse', 'masse', 'kg',
    254      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     263      call histdef(histaveid, 'masse', 'masse moyenne', 'kg',
     264     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    255265     .             32, 'ave(X)', t_ops, t_wrt)
    256266C
    … …  
    258268C
    259269      call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa',
    260      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    261      .             32, 'ave(X)', t_ops, t_wrt)
    262 C
    263 C  Pression au sol
     270     .             iip1, jjn, thoriid, 1, 1, 1, -99,
     271     .             32, 'ave(X)', t_ops, t_wrt)
     272C
     273C  Geopotentiel au sol
    264274C
    265275!      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
    … …  
    273283      call histend(histvaveid)
    274284#else
    275       write(lunout,*)'initdynav_p: Needs IOIPSL to function'
     285      write(lunout,*)'initdynav_loc: Needs IOIPSL to function'
    276286#endif
    277287! #endif of #ifdef CPP_IOIPSL
    278       return
    279288      end

  • LMDZ5/branches/testing/libf/dyn3dmem/inithist_loc.F

    r1910 r2488  
    153153
    154154      ddid=(/ 1,2 /)
    155       dsg=(/ iip1,jjp1 /)
     155      dsg=(/ iip1,jjm /)
    156156      dsl=(/ iip1,jjn /)
    157157      dpf=(/ 1,jjb /)
    … …  
    170170     
    171171! Grille U
     172
     173      do jj = 1, jjp1
     174        do ii = 1, iip1
     175          rlong(ii,jj) = rlonu(ii) * 180. / pi
     176          rlat(ii,jj) = rlatu(jj) * 180. / pi
     177        enddo
     178      enddo
    172179
    173180      jjb=jj_begin
    … …  
    210217C  Vents U
    211218C
    212       call histdef(histuid, 'u', 'vent u moyen ',
    213      .             'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiidu,
    214      .             32, 'ave(X)', t_ops, t_wrt)
     219      jjn=jj_nb
     220      call histdef(histuid, 'u', 'vent u',
     221     .             'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
     222     .             32, 'inst(X)', t_ops, t_wrt)
    215223
    216224C
    217225C  Vents V
    218226C
    219       call histdef(histvid, 'v', 'vent v moyen',
    220      .             'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiidv,
    221      .             32, 'ave(X)', t_ops, t_wrt)
     227      if (pole_sud) jjn=jj_nb-1
     228      call histdef(histvid, 'v', 'vent v',
     229     .             'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
     230     .             32, 'inst(X)', t_ops, t_wrt)
    222231
    223232C
    224233C  Temperature
    225234C
    226       call histdef(histid, 'temp', 'temperature moyenne', 'K',
    227      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    228      .             32, 'ave(X)', t_ops, t_wrt)
     235      jjn=jj_nb
     236      call histdef(histid, 'temp', 'temperature', 'K',
     237     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
     238     .             32, 'inst(X)', t_ops, t_wrt)
    229239C
    230240C  Temperature potentielle
    231241C
    232242      call histdef(histid, 'theta', 'temperature potentielle', 'K',
    233      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    234      .             32, 'ave(X)', t_ops, t_wrt)
     243     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
     244     .             32, 'inst(X)', t_ops, t_wrt)
    235245
    236246
    … …  
    238248C  Geopotentiel
    239249C
    240       call histdef(histid, 'phi', 'geopotentiel moyen', '-',
    241      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    242      .             32, 'ave(X)', t_ops, t_wrt)
     250      call histdef(histid, 'phi', 'geopotentiel', '-',
     251     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
     252     .             32, 'inst(X)', t_ops, t_wrt)
    243253C
    244254C  Traceurs
    … …  
    247257!          call histdef(histid, ttext(iq), ttext(iq), '-',
    248258!     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    249 !     .             32, 'ave(X)', t_ops, t_wrt)
     259!     .             32, 'inst(X)', t_ops, t_wrt)
    250260!        enddo
    251261C
    … …  
    253263C
    254264      call histdef(histid, 'masse', 'masse', 'kg',
    255      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    256      .             32, 'ave(X)', t_ops, t_wrt)
     265     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
     266     .             32, 'inst(X)', t_ops, t_wrt)
    257267C
    258268C  Pression au sol
    259269C
    260270      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
    261      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    262      .             32, 'ave(X)', t_ops, t_wrt)
    263 C
    264 C  Pression au sol
     271     .             iip1, jjn, thoriid, 1, 1, 1, -99,
     272     .             32, 'inst(X)', t_ops, t_wrt)
     273C
     274C  Geopotentiel au sol
    265275C
    266276!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
    267277!     .             iip1, jjn, thoriid, 1, 1, 1, -99,
    268 !     .             32, 'ave(X)', t_ops, t_wrt)
     278!     .             32, 'inst(X)', t_ops, t_wrt)
    269279C
    270280C  Fin
    … …  
    274284      call histend(histvid)
    275285#else
    276       write(lunout,*)'initdynav_p: Needs IOIPSL to function'
     286      write(lunout,*)'inithist_loc: Needs IOIPSL to function'
    277287#endif
    278288! #endif of #ifdef CPP_IOIPSL
    279       return
    280289      end

  • LMDZ5/branches/testing/libf/dyn3dmem/integrd_loc.F

    r2298 r2488  
    155155         write(lunout,*) " at node ij =", stop_it
    156156         ! since ij=j+(i-1)*jjp1 , we have
    157 !         j=modulo(stop_it,jjp1)
    158 !         i=1+(stop_it-j)/jjp1
    159 !         write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
    160 !     &                   " lat = ",rlatu(j)*180./pi, " deg"
     157          j=modulo(stop_it,jjp1)
     158          i=1+(stop_it-j)/jjp1
     159          write(lunout,*) " lon = ",rlonv(i)*180./pi, " deg",
     160     &                    " lat = ",rlatu(j)*180./pi, " deg"
    161161         call abort_gcm("integrd_loc", "negative surface pressure", 1)
    162162      ENDIF

  • LMDZ5/branches/testing/libf/dyn3dmem/leapfrog_loc.F

    r2408 r2488  
    16031603               ENDIF
    16041604
     1605              ! Ehouarn: re-compute geopotential for outputs
     1606c$OMP BARRIER
     1607c$OMP MASTER
     1608              CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
     1609c$OMP END MASTER
     1610c$OMP BARRIER
     1611
    16051612#ifdef CPP_IOIPSL
    16061613             IF (ok_dynzon) THEN
    … …  
    16381645#ifdef CPP_IOIPSL
    16391646             if (ok_dyn_ins) then
    1640                  CALL writehist_loc(itau,vcov,ucov,teta,phi,q,
     1647                 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q,
    16411648     &                              masse,ps,phis)
    16421649             endif
    … …  
    17501757
    17511758#ifdef CPP_IOIPSL
     1759              ! Ehouarn: re-compute geopotential for outputs
     1760c$OMP BARRIER
     1761c$OMP MASTER
     1762              CALL geopot_loc(ip1jmp1,teta,pk,pks,phis,phi)
     1763c$OMP END MASTER
     1764c$OMP BARRIER
     1765               
    17521766               IF (ok_dynzon) THEN
    17531767               CALL bilan_dyn_loc(2,dtvr*iperiod,dtvr*day_step*periodav,
    … …  
    17741788#ifdef CPP_IOIPSL
    17751789              if (ok_dyn_ins) then
    1776                  CALL writehist_loc(itau,vcov,ucov,teta,phi,q,
     1790                 CALL writehist_loc(itau,vcov,ucov,teta,pk,phi,q,
    17771791     &                              masse,ps,phis)
    17781792              endif ! of if (ok_dyn_ins)

  • LMDZ5/branches/testing/libf/dyn3dmem/writedynav_loc.F

    r1910 r2488  
    8989!$OMP MASTER
    9090        ALLOCATE(unat(ijb_u:ije_u,llm))
    91         ALLOCATE(vnat(ijb_u:ije_u,llm))
     91        ALLOCATE(vnat(ijb_v:ije_v,llm))
    9292        ALLOCATE(tm(ijb_u:ije_u,llm))
    9393        ALLOCATE(ndex2d(ijnb_u*llm))
    … …  
    127127C  Vents V
    128128C
    129 
     129      ije=ij_end
     130      if (pole_sud) jjn=jj_nb-1
     131      if (pole_sud) ije=ij_end-iip1
    130132!$OMP BARRIER
    131133!$OMP MASTER     
    … …  
    138140C  Temperature potentielle moyennee
    139141C
     142      ijb=ij_begin
     143      ije=ij_end
     144      jjn=jj_nb
    140145!$OMP MASTER     
    141146      call histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:),
    … …  
    186191!$OMP MASTER     
    187192       call histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:),
    188      .                iip1*jjn, ndexu)
     193     .                iip1*jjn*llm, ndexu)
    189194!$OMP END MASTER
    190195
    … …  
    203208C
    204209!$OMP MASTER     
    205        call histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
    206      .                 iip1*jjn, ndexu)
     210!       call histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
     211!     .                 iip1*jjn, ndex2d)
    207212!$OMP END MASTER
    208213
    … …  
    218223!$OMP END MASTER
    219224#else
    220       write(lunout,*)'writedynav_p: Needs IOIPSL to function'
     225      write(lunout,*)'writedynav_loc: Needs IOIPSL to function'
    221226#endif
    222227! #endif of #ifdef CPP_IOIPSL
    223       return
    224228      end

  • LMDZ5/branches/testing/libf/dyn3dmem/writehist_loc.F

    r1910 r2488  
    8989!$OMP MASTER
    9090        ALLOCATE(unat(ijb_u:ije_u,llm))
    91         ALLOCATE(vnat(ijb_u:ije_u,llm))
     91        ALLOCATE(vnat(ijb_v:ije_v,llm))
    9292        ALLOCATE(tm(ijb_u:ije_u,llm))
    9393        ALLOCATE(ndex2d(ijnb_u*llm))
    … …  
    127127C  Vents V
    128128C
    129 
     129      ije=ij_end
     130      if (pole_sud) jjn=jj_nb-1
     131      if (pole_sud) ije=ij_end-iip1
    130132!$OMP BARRIER
    131133!$OMP MASTER     
    … …  
    136138
    137139C
    138 C  Temperature potentielle moyennee
    139 C
     140C  Temperature potentielle
     141C
     142      ijb=ij_begin
     143      ije=ij_end
     144      jjn=jj_nb
    140145!$OMP MASTER     
    141146      call histwrite(histid, 'theta', itau_w, teta(ijb:ije,:),
    … …  
    144149
    145150C
    146 C  Temperature moyennee
     151C  Temperature
    147152C
    148153
    … …  
    186191!$OMP MASTER     
    187192       call histwrite(histid, 'masse', itau_w, masse(ijb:ije,:),
    188      .                iip1*jjn, ndexu)
     193     .                iip1*jjn*llm, ndexu)
    189194!$OMP END MASTER
    190195
    … …  
    194199C
    195200!$OMP MASTER     
    196 
    197201       call histwrite(histid, 'ps', itau_w, ps(ijb:ije),
    198202     .                 iip1*jjn, ndex2d)
    … …  
    203207C
    204208!$OMP MASTER     
    205        call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
    206      .                 iip1*jjn, ndexu)
     209!       call histwrite(histid, 'phis', itau_w, phis(ijb:ije),
     210!     .                 iip1*jjn, ndex2d)
    207211!$OMP END MASTER
    208212
    … …  
    218222!$OMP END MASTER
    219223#else
    220       write(lunout,*)'writedynav_p: Needs IOIPSL to function'
     224      write(lunout,*)'writehist_loc: Needs IOIPSL to function'
    221225#endif
    222226! #endif of #ifdef CPP_IOIPSL
    223       return
    224227      end

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

    r2471 r2488  
    180180     zzzcd=CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i)))
    181181     zcdn_m(i) = zzzcd*zzzcd
    182      zcdn_h(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0m(i))))
     182     zcdn_h(i) = zzzcd*(CKAP/LOG(1.+zgeop1(i)/(RG*z0h(i))))
    183183
    184184     IF (zri(i) .GT. 0.) THEN      ! situation stable

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

    r2408 r2488  
    1616                  evap, ep, epmlmMm, eplaMm, &                       ! RomP
    1717                  wdtrainA, wdtrainM, wght, qtc, sigt, &
    18                   tau_cld_cv, coefw_cld_cv)                           ! RomP+RL, AJ
     18                  tau_cld_cv, coefw_cld_cv, &                           ! RomP+RL, AJ
    1919!RomP <<<
     20                  epmax_diag) ! epmax_cape
    2021! **************************************************************
    2122! *
    … …  
    148149  REAL zx_t, zdelta, zx_qs, zcor
    149150  REAL tau_cld_cv, coefw_cld_cv
     151  REAL epmax_diag(klon) ! epmax_cape
    150152
    151153!   INTEGER iflag_mix
    … …  
    388390                   da, phi, mp, phi2, d1a, dam, sij, clw, elij, &       !RomP
    389391                   evap, ep, epmlmMm, eplaMm, &                         !RomP
    390                    wdtrainA, wdtrainM)                                  !RomP
     392                   wdtrainA, wdtrainM, &                                !RomP
     393                   epmax_diag) ! epmax_cape
    391394!           print *, 'cv_driver ->'      !jyg
    392395
    … …  
    425428                    clw, elij, evap, ep, epmlmMm, eplaMm, &             ! RomP+RL
    426429                    wdtrainA, wdtrainM, qtc, sigt, &
    427                     tau_cld_cv, coefw_cld_cv)                           ! RomP,AJ
     430                    tau_cld_cv, coefw_cld_cv, &                         ! RomP,AJ
    428431!AC!+!RomP+jyg
     432                    epmax_diag) ! epmax_cape
    429433  END IF
    430434! ------------------------------------------------------------------

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

    r2298 r2488  
    44!
    55      real epmax             ! 0.993
     6      real coef_epmax_cape             ! 0.993
    67!jyg<
    78      REAL  cvl_comp_threshold     ! 0.
    … …  
    1314
    1415!jyg<
    15 !!      common/comconema1/epmax,ok_adj_ema,iflag_clw,sig1feed,sig2feed
     16!!      common/comconema1/epmax,coef_epmax_cape,ok_adj_ema,iflag_clw,sig1feed,sig2feed
    1617!!      common/comconema2/iflag_cvl_sigd
    17       common/comconema1/epmax, cvl_comp_threshold, cvl_sig2feed
     18      common/comconema1/epmax,coef_epmax_cape, cvl_comp_threshold, cvl_sig2feed
    1819      common/comconema2/iflag_cvl_sigd, iflag_clw, ok_adj_ema
    1920!>jyg
    2021
    21 !      common/comconema/epmax,ok_adj_ema,iflag_clw
     22!      common/comconema/epmax,coef_epmax_cape,ok_adj_ema,iflag_clw
    2223!$OMP THREADPRIVATE(/comconema1/)
    2324!$OMP THREADPRIVATE(/comconema2/)

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

    r2471 r2488  
    155155    LOGICAL,SAVE :: ok_4xCO2atm_omp
    156156    REAL,SAVE :: epmax_omp
     157    REAL,SAVE :: coef_epmax_cape_omp
    157158    LOGICAL,SAVE :: ok_adj_ema_omp
    158159    INTEGER,SAVE :: iflag_clw_omp
    … …  
    812813    epmax_omp = .993
    813814    call getin('epmax', epmax_omp)
     815
     816    coef_epmax_cape_omp = 0.0   
     817    call getin('coef_epmax_cape', coef_epmax_cape_omp)       
    814818    !
    815819    !Config Key  = ok_adj_ema
    … …  
    19992003
    20002004    epmax = epmax_omp
     2005    coef_epmax_cape = coef_epmax_cape_omp
    20012006    ok_adj_ema = ok_adj_ema_omp
    20022007    iflag_clw = iflag_clw_omp
    … …  
    23032308    write(lunout,*)'iflag_bergeron=',iflag_bergeron
    23042309    write(lunout,*)' epmax = ', epmax
     2310    write(lunout,*)' coef_epmax_cape = ', coef_epmax_cape
    23052311    write(lunout,*)' ok_adj_ema = ', ok_adj_ema
    23062312    write(lunout,*)' iflag_clw = ', iflag_clw

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

    r2471 r2488  
    166166   CALL histwrite2d_cosp(o_clmcalipsoun,stlidar%cldlayerphase(:,2,3))
    167167   CALL histwrite2d_cosp(o_cltcalipsoun,stlidar%cldlayerphase(:,4,3))
    168    CALL histwrite3d_cosp(o_clcalipsoice,stlidar%lidarcldphase(:,:,3),nvert)
     168   CALL histwrite3d_cosp(o_clcalipsoun,stlidar%lidarcldphase(:,:,3),nvert)
    169169   CALL histwrite3d_cosp(o_clcalipsotmpun,stlidar%lidarcldtmp(:,:,4),nverttemp)
    170170

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

    r2435 r2488  
    164164
    165165  ! Cloud fractions from 1 to %
    166   if (cfg%Lclcalipso) then
    167     where(stlidar%lidarcld /= R_UNDEF) stlidar%lidarcld = stlidar%lidarcld*100.0
    168   endif
    169   if (cfg%Lcltcalipso.OR.cfg%Lcllcalipso.OR.cfg%Lclmcalipso.OR.cfg%Lclhcalipso) then
    170     where(stlidar%cldlayer /= R_UNDEF) stlidar%cldlayer = stlidar%cldlayer*100.0
    171   endif
    172   if (cfg%Lclcalipso2) then
    173     where(stradar%lidar_only_freq_cloud /= R_UNDEF) stradar%lidar_only_freq_cloud = stradar%lidar_only_freq_cloud*100.0
    174   endif
    175 
    176   if (cfg%Lcltcalipsoliq.OR.cfg%Lcllcalipsoliq.OR.cfg%Lclmcalipsoliq.OR.cfg%Lclhcalipsoliq.OR. &
    177       cfg%Lcltcalipsoice.OR.cfg%Lcllcalipsoice.OR.cfg%Lclmcalipsoice.OR.cfg%Lclhcalipsoice.OR. &
    178       cfg%Lcltcalipsoun.OR.cfg%Lcllcalipsoun.OR.cfg%Lclmcalipsoun.OR.cfg%Lclhcalipsoun ) then
    179     where(stlidar%cldlayerphase /= R_UNDEF) stlidar%cldlayerphase = stlidar%cldlayerphase*100.0
    180   endif
    181   if (cfg%Lclcalipsoliq.OR.cfg%Lclcalipsoice.OR.cfg%Lclcalipsoun) then
    182     where(stlidar%lidarcldphase /= R_UNDEF) stlidar%lidarcldphase = stlidar%lidarcldphase*100.0
    183   endif
    184   if (cfg%Lclcalipsotmp.OR.cfg%Lclcalipsotmpliq.OR.cfg%Lclcalipsotmpice.OR.cfg%Lclcalipsotmpun) then
    185     where(stlidar%lidarcldtmp /= R_UNDEF) stlidar%lidarcldtmp = stlidar%lidarcldtmp*100.0
    186   endif
    187 
    188   if (cfg%Lcltisccp) then
    189      where(isccp%totalcldarea /= R_UNDEF) isccp%totalcldarea = isccp%totalcldarea*100.0
    190 ! Test
    191 !     where(isccp%totalcldarea == R_UNDEF) isccp%totalcldarea = 0.
    192   endif 
    193   if (cfg%Lclisccp) then
    194     where(isccp%fq_isccp /= R_UNDEF) isccp%fq_isccp = isccp%fq_isccp*100.0
    195   endif
    196 
    197   if (cfg%LclMISR) then
    198     where(misr%fq_MISR /= R_UNDEF) misr%fq_MISR = misr%fq_MISR*100.0
    199   endif
    200 
    201   if (cfg%Lcltlidarradar) then
    202     where(stradar%radar_lidar_tcc /= R_UNDEF) stradar%radar_lidar_tcc = stradar%radar_lidar_tcc*100.0
    203   endif
     166!  if (cfg%Lclcalipso) then
     167!    where(stlidar%lidarcld /= R_UNDEF) stlidar%lidarcld = stlidar%lidarcld*100.0
     168!  endif
     169!  if (cfg%Lcltcalipso.OR.cfg%Lcllcalipso.OR.cfg%Lclmcalipso.OR.cfg%Lclhcalipso) then
     170!    where(stlidar%cldlayer /= R_UNDEF) stlidar%cldlayer = stlidar%cldlayer*100.0
     171!  endif
     172!  if (cfg%Lclcalipso2) then
     173!    where(stradar%lidar_only_freq_cloud /= R_UNDEF) stradar%lidar_only_freq_cloud = stradar%lidar_only_freq_cloud*100.0
     174!  endif
     175
     176!  if (cfg%Lcltcalipsoliq.OR.cfg%Lcllcalipsoliq.OR.cfg%Lclmcalipsoliq.OR.cfg%Lclhcalipsoliq.OR. &
     177!      cfg%Lcltcalipsoice.OR.cfg%Lcllcalipsoice.OR.cfg%Lclmcalipsoice.OR.cfg%Lclhcalipsoice.OR. &
     178!      cfg%Lcltcalipsoun.OR.cfg%Lcllcalipsoun.OR.cfg%Lclmcalipsoun.OR.cfg%Lclhcalipsoun ) then
     179!    where(stlidar%cldlayerphase /= R_UNDEF) stlidar%cldlayerphase = stlidar%cldlayerphase*100.0
     180!  endif
     181!  if (cfg%Lclcalipsoliq.OR.cfg%Lclcalipsoice.OR.cfg%Lclcalipsoun) then
     182!    where(stlidar%lidarcldphase /= R_UNDEF) stlidar%lidarcldphase = stlidar%lidarcldphase*100.0
     183!  endif
     184!  if (cfg%Lclcalipsotmp.OR.cfg%Lclcalipsotmpliq.OR.cfg%Lclcalipsotmpice.OR.cfg%Lclcalipsotmpun) then
     185!    where(stlidar%lidarcldtmp /= R_UNDEF) stlidar%lidarcldtmp = stlidar%lidarcldtmp*100.0
     186!  endif
     187
     188!  if (cfg%Lcltisccp) then
     189!     where(isccp%totalcldarea /= R_UNDEF) isccp%totalcldarea = isccp%totalcldarea*100.0
     190!  endif 
     191!  if (cfg%Lclisccp) then
     192!    where(isccp%fq_isccp /= R_UNDEF) isccp%fq_isccp = isccp%fq_isccp*100.0
     193!  endif
     194
     195!  if (cfg%LclMISR) then
     196!    where(misr%fq_MISR /= R_UNDEF) misr%fq_MISR = misr%fq_MISR*100.0
     197!  endif
     198
     199!  if (cfg%Lcltlidarradar) then
     200!    where(stradar%radar_lidar_tcc /= R_UNDEF) stradar%radar_lidar_tcc = stradar%radar_lidar_tcc*100.0
     201!  endif
    204202
    205203  if (cfg%Lclmodis) then
    … …  
    207205                                                      modis%Optical_Thickness_vs_Cloud_Top_Pressure*100.0
    208206  endif
    209   if (cfg%Lcltmodis) then
    210      where(modis%Cloud_Fraction_Total_Mean /= R_UNDEF) modis%Cloud_Fraction_Total_Mean = modis%Cloud_Fraction_Total_Mean*100.0
    211   endif
    212   if (cfg%Lclwmodis) then
    213      where(modis%Cloud_Fraction_Water_Mean /= R_UNDEF) modis%Cloud_Fraction_Water_Mean = modis%Cloud_Fraction_Water_Mean*100.0
    214   endif
    215   if (cfg%Lclimodis) then
    216      where(modis%Cloud_Fraction_Ice_Mean /= R_UNDEF) modis%Cloud_Fraction_Ice_Mean = modis%Cloud_Fraction_Ice_Mean*100.0
    217   endif
    218 
    219   if (cfg%Lclhmodis) then
    220      where(modis%Cloud_Fraction_High_Mean /= R_UNDEF) modis%Cloud_Fraction_High_Mean = modis%Cloud_Fraction_High_Mean*100.0
    221   endif
    222   if (cfg%Lclmmodis) then
    223      where(modis%Cloud_Fraction_Mid_Mean /= R_UNDEF) modis%Cloud_Fraction_Mid_Mean = modis%Cloud_Fraction_Mid_Mean*100.0
    224   endif
    225   if (cfg%Lcllmodis) then
    226      where(modis%Cloud_Fraction_Low_Mean /= R_UNDEF) modis%Cloud_Fraction_Low_Mean = modis%Cloud_Fraction_Low_Mean*100.0
    227   endif
     207!  if (cfg%Lcltmodis) then
     208!     where(modis%Cloud_Fraction_Total_Mean /= R_UNDEF) modis%Cloud_Fraction_Total_Mean = modis%Cloud_Fraction_Total_Mean*100.0
     209!  endif
     210!  if (cfg%Lclwmodis) then
     211!     where(modis%Cloud_Fraction_Water_Mean /= R_UNDEF) modis%Cloud_Fraction_Water_Mean = modis%Cloud_Fraction_Water_Mean*100.0
     212!  endif
     213!  if (cfg%Lclimodis) then
     214!     where(modis%Cloud_Fraction_Ice_Mean /= R_UNDEF) modis%Cloud_Fraction_Ice_Mean = modis%Cloud_Fraction_Ice_Mean*100.0
     215!  endif
     216
     217!  if (cfg%Lclhmodis) then
     218!     where(modis%Cloud_Fraction_High_Mean /= R_UNDEF) modis%Cloud_Fraction_High_Mean = modis%Cloud_Fraction_High_Mean*100.0
     219!  endif
     220!  if (cfg%Lclmmodis) then
     221!     where(modis%Cloud_Fraction_Mid_Mean /= R_UNDEF) modis%Cloud_Fraction_Mid_Mean = modis%Cloud_Fraction_Mid_Mean*100.0
     222!  endif
     223!  if (cfg%Lcllmodis) then
     224!     where(modis%Cloud_Fraction_Low_Mean /= R_UNDEF) modis%Cloud_Fraction_Low_Mean = modis%Cloud_Fraction_Low_Mean*100.0
     225!  endif
    228226
    229227  ! Change pressure from hPa to Pa.

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

    r2408 r2488  
    839839    q, qs, gz, p, h, tv, lv, pbase, buoybase, plcl, inb, tp, tvp, clw, hp, &
    840840    ep, sigp, buoy)
     841    ! epmax_cape: ajout arguments
    841842  IMPLICIT NONE
    842843
    … …  
    12421243  REAL dtmin(nloc, nd), sigold(nloc, nd)
    12431244
    1244 
    12451245  ! -------------------------------------------------------
    12461246  ! -- Initialization
    … …  
    13481348
    13491349  ! the interval on which cape is computed starts at pbase :
    1350 
    13511350  DO k = 1, nl
    13521351    DO i = 1, ncum
    … …  
    31463145    vprecip, evap, ep, sig, w0, ft, fq, fu, fv, ftra, inb, ma, upwd, dnwd, &
    31473146    dnwd0, qcondc, wd, cape, da, phi, mp, phi2, d1a, dam, sij, elij, clw, &
    3148     epmlmmm, eplamm, wdtraina, wdtrainm, iflag1, precip1, vprecip1, evap1, &
     3147    epmlmmm, eplamm, wdtraina, wdtrainm,epmax_diag, iflag1, precip1, vprecip1, evap1, &
    31493148    ep1, sig1, w01, ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, &
    31503149    dnwd01, qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1, &
    3151     elij1, clw1, epmlmmm1, eplamm1, wdtraina1, wdtrainm1)
     3150    elij1, clw1, epmlmmm1, eplamm1, wdtraina1, wdtrainm1,epmax_diag1) ! epmax_cape
    31523151  IMPLICIT NONE
    31533152
    … …  
    31703169  REAL wd(nloc), cape(nloc)
    31713170  REAL da(nloc, nd), phi(nloc, nd, nd), mp(nloc, nd)
     3171  REAL epmax_diag(nloc) ! epmax_cape
    31723172  ! RomP >>>
    31733173  REAL phi2(nloc, nd, nd)
    … …  
    31933193  REAL wd1(nloc), cape1(nloc)
    31943194  REAL da1(nloc, nd), phi1(nloc, nd, nd), mp1(nloc, nd)
     3195  REAL epmax_diag1(len) ! epmax_cape
    31953196  ! RomP >>>
    31963197  REAL phi21(len, nd, nd)
    … …  
    32113212    inb1(idcum(i)) = inb(i)
    32123213    cape1(idcum(i)) = cape(i)
     3214    epmax_diag1(idcum(i))=epmax_diag(i) ! epmax_cape
    32133215  END DO
    32143216
    … …  
    32693271END SUBROUTINE cv30_uncompress
    32703272
     3273        subroutine cv30_epmax_fn_cape(nloc,ncum,nd &
     3274                ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
     3275                ,epmax_diag)
     3276        implicit none
     3277
     3278        ! On fait varier epmax en fn de la cape
     3279        ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
     3280        ! qui en dépend
     3281        ! Toutes les autres variables fn de ep sont calculées plus bas.
     3282
     3283#include "cvthermo.h"
     3284#include "cv30param.h"
     3285#include "conema3.h"
     3286
     3287! inputs:
     3288      integer ncum, nd, nloc
     3289      integer icb(nloc), inb(nloc)
     3290      real cape(nloc)
     3291      real clw(nloc,nd),lv(nloc,nd),t(nloc,nd),h(nloc,nd)
     3292      integer nk(nloc)
     3293! inouts:
     3294      real ep(nloc,nd)
     3295      real hp(nloc,nd)
     3296! outputs ou local
     3297      real epmax_diag(nloc)
     3298! locals
     3299      integer i,k   
     3300      real hp_bak(nloc,nd)
     3301
     3302        ! on recalcule ep et hp
     3303       
     3304        if (coef_epmax_cape.gt.1e-12) then
     3305        do i=1,ncum
     3306           epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
     3307           do k=1,nl
     3308                ep(i,k)=ep(i,k)/epmax*epmax_diag(i)
     3309                ep(i,k)=amax1(ep(i,k),0.0)
     3310                ep(i,k)=amin1(ep(i,k),epmax_diag(i))
     3311           enddo
     3312        enddo
     3313
     3314! On recalcule hp:
     3315      do k=1,nl
     3316        do i=1,ncum
     3317          hp_bak(i,k)=hp(i,k)
     3318        enddo
     3319      enddo
     3320      do k=1,nlp
     3321        do i=1,ncum
     3322          hp(i,k)=h(i,k)
     3323        enddo
     3324      enddo
     3325      do k=minorig+1,nl
     3326       do i=1,ncum
     3327        if((k.ge.icb(i)).and.(k.le.inb(i)))then
     3328          hp(i,k)=h(i,nk(i))+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
     3329        endif
     3330       enddo
     3331      enddo !do k=minorig+1,n
     3332!     write(*,*) 'cv30_routines 6218: hp(1,20)=',hp(1,20)
     3333      do i=1,ncum 
     3334       do k=1,nl
     3335        if (abs(hp_bak(i,k)-hp(i,k)).gt.0.01) then
     3336           write(*,*) 'i,k=',i,k
     3337           write(*,*) 'coef_epmax_cape=',coef_epmax_cape
     3338           write(*,*) 'epmax_diag(i)=',epmax_diag(i)
     3339           write(*,*) 'ep(i,k)=',ep(i,k)
     3340           write(*,*) 'hp(i,k)=',hp(i,k)
     3341           write(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
     3342           write(*,*) 'h(i,k)=',h(i,k)
     3343           write(*,*) 'nk(i)=',nk(i)
     3344           write(*,*) 'h(i,nk(i))=',h(i,nk(i))
     3345           write(*,*) 'lv(i,k)=',lv(i,k)
     3346           write(*,*) 't(i,k)=',t(i,k)
     3347           write(*,*) 'clw(i,k)=',clw(i,k)
     3348           write(*,*) 'cpd,cpv=',cpd,cpv
     3349           stop
     3350        endif
     3351       enddo !do k=1,nl
     3352      enddo !do i=1,ncum 
     3353      endif !if (coef_epmax_cape.gt.1e-12) then
     3354
     3355      return
     3356      end subroutine cv30_epmax_fn_cape
     3357
     3358

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

    r2435 r2488  
    77SUBROUTINE cv3_param(nd, k_upper, delt)
    88
     9  USE ioipsl_getin_p_mod, ONLY : getin_p
    910  use mod_phys_lmdz_para
    1011  IMPLICIT NONE
    … …  
    3940  INTEGER, INTENT(IN)              :: k_upper
    4041  REAL, INTENT(IN)                 :: delt ! timestep (seconds)
    41 
    4242
    4343! Local variables
    … …  
    6565
    6666  IF (first) THEN
    67 
    6867! -- "microphysical" parameters:
    69     sigdz = 0.01
    70     spfac = 0.15
    71     pbcrit = 150.0
    72     ptcrit = 500.0
    7368! IM beg: ajout fis. reglage ep
    74     flag_epkeorig = 1
    75     elcrit = 0.0003
    76     tlcrit = -55.0
     69! CR+JYG: shedding coefficient (used when iflag_mix_adiab=1)
    7770! IM lu dans physiq.def via conf_phys.F90     epmax  = 0.993
    7871
    7972    omtrain = 45.0 ! used also for snow (no disctinction rain/snow)
    80 
    8173! -- misc:
    82 
    8374    dtovsh = -0.2 ! dT for overshoot
    84     dpbase = -40. ! definition cloud base (400m above LCL)
    8575! cc      dttrig = 5.   ! (loose) condition for triggering
    8676    dttrig = 10. ! (loose) condition for triggering
    87     flag_wb = 1
    88     wbmax = 6. ! (m/s) adiab updraught speed at LFC (used in cv3p1_closure)
    89 
    90 ! -- rate of approach to quasi-equilibrium:
    91 
    9277    dtcrit = -2.0
    93     tau = 8000.
    94 
    9578! -- end of convection
    96 
    97     tau_stop = 15000.
    98     ok_convstop = .False.
    99 
    100     ok_intermittent = .False.
    101 
    10279! -- interface cloud parameterization:
    103 
    10480    delta = 0.01 ! cld
    105 
    10681! -- interface with boundary-layer (gust factor): (sb)
    107 
    10882    betad = 10.0 ! original value (from convect 4.3)
    10983
    110    !$OMP MASTER
    111     OPEN (99, FILE='conv_param.data', STATUS='old', FORM='formatted', ERR=9999)
    112     READ (99, *, END=9998) dpbase
    113     READ (99, *, END=9998) pbcrit
    114     READ (99, *, END=9998) ptcrit
    115     READ (99, *, END=9998) sigdz
    116     READ (99, *, END=9998) spfac
    117     READ (99, *, END=9998) tau
    118     READ (99, *, END=9998) flag_wb
    119     READ (99, *, END=9998) wbmax
    120     READ (99, *, END=9998) ok_convstop
    121     READ (99, *, END=9998) tau_stop
    122     READ (99, *, END=9998) ok_intermittent
    123 9998 CONTINUE
    124     CLOSE (99)
    125 9999 CONTINUE
     84! Var interm pour le getin
     85     dpbase=-40.
     86     CALL getin_p('dpbase',dpbase)
     87     pbcrit=150.0
     88     CALL getin_p('pbcrit',pbcrit)
     89     ptcrit=500.0
     90     CALL getin_p('ptcrit',ptcrit)
     91     sigdz=0.01
     92     CALL getin_p('sigdz',sigdz)
     93     spfac=0.15
     94     CALL getin_p('spfac',spfac)
     95     tau=8000.
     96     CALL getin_p('tau',tau)
     97     flag_wb=1
     98     CALL getin_p('flag_wb',flag_wb)
     99     wbmax=6.
     100     CALL getin_p('wbmax',wbmax)
     101     ok_convstop=.False.
     102     CALL getin_p('ok_convstop',ok_convstop)
     103     tau_stop=15000.
     104     CALL getin_p('tau_stop',tau_stop)
     105     ok_intermittent=.False.
     106     CALL getin_p('ok_intermittent',ok_intermittent)
     107     coef_peel=0.25
     108     CALL getin_p('coef_peel',coef_peel)
     109
     110     flag_epKEorig=1
     111     CALL getin_p('flag_epKEorig',flag_epKEorig)
     112     elcrit=0.0003
     113     CALL getin_p('elcrit',elcrit)
     114     tlcrit=-55.0
     115     CALL getin_p('tlcrit',tlcrit)
     116
    126117    WRITE (*, *) 'dpbase=', dpbase
    127118    WRITE (*, *) 'pbcrit=', pbcrit
    … …  
    130121    WRITE (*, *) 'spfac=', spfac
    131122    WRITE (*, *) 'tau=', tau
    132     WRITE (*, *) 'flag_wb =', flag_wb
    133     WRITE (*, *) 'wbmax =', wbmax
    134     WRITE (*, *) 'ok_convstop =', ok_convstop
    135     WRITE (*, *) 'tau_stop =', tau_stop
    136     WRITE (*, *) 'ok_intermittent =', ok_intermittent
    137 
    138 ! IM Lecture du fichier ep_param.data
    139     OPEN (79, FILE='ep_param.data', STATUS='old', FORM='formatted', ERR=7999)
    140     READ (79, *, END=7998) flag_epkeorig
    141     READ (79, *, END=7998) elcrit
    142     READ (79, *, END=7998) tlcrit
    143 7998 CONTINUE
    144     CLOSE (79)
    145 7999 CONTINUE
    146     WRITE (*, *) 'flag_epKEorig', flag_epkeorig
     123    WRITE (*, *) 'flag_wb=', flag_wb
     124    WRITE (*, *) 'wbmax=', wbmax
     125    WRITE (*, *) 'ok_convstop=', ok_convstop
     126    WRITE (*, *) 'tau_stop=', tau_stop
     127    WRITE (*, *) 'ok_intermittent=', ok_intermittent
     128    WRITE (*, *) 'coef_peel=', coef_peel
     129
     130    WRITE (*, *) 'flag_epKEorig=', flag_epKEorig
    147131    WRITE (*, *) 'elcrit=', elcrit
    148132    WRITE (*, *) 'tlcrit=', tlcrit
    149 ! IM end: ajout fis. reglage ep
    150   !$OMP END MASTER
    151 
    152    CALL bcast(dpbase)
    153    CALL bcast(pbcrit)
    154    CALL bcast(ptcrit)
    155    CALL bcast(sigdz)
    156    CALL bcast(spfac)
    157    CALL bcast(tau)
    158    CALL bcast(flag_wb)
    159    CALL bcast(wbmax)
    160    CALL bcast(ok_convstop)
    161    CALL bcast(tau_stop)
    162    CALL bcast(ok_intermittent)
    163 
    164    CALL bcast(flag_epkeorig)
    165    CALL bcast(elcrit)
    166    CALL bcast(tlcrit)
    167 
    168133    first = .FALSE.
    169 
    170134  END IF ! (first)
    171135
    … …  
    41784142                          ft, fq, fu, fv, ftra, &
    41794143                          Ma, upwd, dnwd, dnwd0, qcondc, wd, cape, &
     4144                          epmax_diag, & ! epmax_cape
    41804145                          iflag1, &
    41814146                          precip1, sig1, w01, &
    41824147                          ft1, fq1, fu1, fv1, ftra1, &
    4183                           Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1)
     4148                          Ma1, upwd1, dnwd1, dnwd01, qcondc1, wd1, cape1, &
     4149                          epmax_diag1) ! epmax_cape
    41844150  IMPLICIT NONE
    41854151
    … …  
    41984164  REAL qcondc(nloc, nd)
    41994165  REAL wd(nloc), cape(nloc)
     4166  REAL epmax_diag(nloc)
    42004167
    42014168!outputs:
    … …  
    42094176  REAL qcondc1(nloc, nd)
    42104177  REAL wd1(nloc), cape1(nloc)
     4178  REAL epmax_diag1(len) ! epmax_cape
    42114179
    42124180!local variables:
    … …  
    42184186    wd1(idcum(i)) = wd(i)
    42194187    cape1(idcum(i)) = cape(i)
     4188    epmax_diag1(idcum(i))=epmax_diag(i) ! epmax_cape
    42204189  END DO
    42214190
    … …  
    42524221  RETURN
    42534222END SUBROUTINE cv3_uncompress
     4223
     4224
     4225        subroutine cv3_epmax_fn_cape(nloc,ncum,nd &
     4226                 , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac &
     4227                 , pbase, p, ph, tv, buoy, sig, w0,iflag &
     4228                 , epmax_diag)
     4229        implicit none
     4230
     4231        ! On fait varier epmax en fn de la cape
     4232        ! Il faut donc recalculer ep, et hp qui a déjà été calculé et
     4233        ! qui en dépend
     4234        ! Toutes les autres variables fn de ep sont calculées plus bas.
     4235
     4236  include "cvthermo.h"
     4237  include "cv3param.h" 
     4238  include "conema3.h"
     4239  include "cvflag.h"
     4240
     4241! inputs:
     4242      INTEGER, INTENT (IN)                               :: ncum, nd, nloc
     4243      INTEGER, DIMENSION (nloc), INTENT (IN)             :: icb, inb, nk
     4244      REAL, DIMENSION (nloc), INTENT (IN)                :: hnk,pbase
     4245      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: t, lv, lf, tv, h
     4246      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: clw, buoy,frac
     4247      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig,w0
     4248      INTEGER, DIMENSION (nloc), INTENT (IN)             :: iflag(nloc)
     4249      REAL, DIMENSION (nloc, nd), INTENT (IN)            :: p
     4250      REAL, DIMENSION (nloc, nd+1), INTENT (IN)          :: ph
     4251! inouts:
     4252      REAL, DIMENSION (nloc, nd), INTENT (INOUT)         :: ep,hp 
     4253! outputs
     4254      REAL, DIMENSION (nloc), INTENT (OUT)           :: epmax_diag
     4255
     4256! local
     4257      integer i,k   
     4258!      real hp_bak(nloc,nd)
     4259!      real ep_bak(nloc,nd)
     4260      real m_loc(nloc,nd)
     4261      real sig_loc(nloc,nd)
     4262      real w0_loc(nloc,nd)
     4263      integer iflag_loc(nloc)
     4264      real cape(nloc)
     4265       
     4266        if (coef_epmax_cape.gt.1e-12) then
     4267
     4268        ! il faut calculer la cape: on fait un calcule simple car tant qu'on ne
     4269        ! connait pas ep, on ne connait pas les mélanges, ddfts etc... qui sont
     4270        ! necessaires au calcul de la cape dans la nouvelle physique
     4271       
     4272!        write(*,*) 'cv3_routines check 4303'
     4273        do i=1,ncum
     4274        do k=1,nd
     4275          sig_loc(i,k)=sig(i,k)
     4276          w0_loc(i,k)=w0(i,k)
     4277          iflag_loc(i)=iflag(i)
     4278!          ep_bak(i,k)=ep(i,k)
     4279        enddo ! do k=1,nd
     4280        enddo !do i=1,ncum
     4281
     4282!        write(*,*) 'cv3_routines check 4311'
     4283!        write(*,*) 'nl=',nl
     4284        CALL cv3_closure(nloc, ncum, nd, icb, inb, & ! na->nd
     4285          pbase, p, ph, tv, buoy, &
     4286          sig_loc, w0_loc, cape, m_loc,iflag_loc)
     4287
     4288!        write(*,*) 'cv3_routines check 4316'
     4289!        write(*,*) 'ep(1,:)=',ep(1,:)
     4290        do i=1,ncum
     4291           epmax_diag(i)=epmax-coef_epmax_cape*sqrt(cape(i))
     4292           epmax_diag(i)=amax1(epmax_diag(i),0.0)
     4293!           write(*,*) 'i,icb,inb,cape,epmax_diag=', &
     4294!                i,icb(i),inb(i),cape(i),epmax_diag(i)
     4295           do k=1,nl
     4296                ep(i,k)=ep(i,k)/epmax*epmax_diag(i)
     4297                ep(i,k)=amax1(ep(i,k),0.0)
     4298                ep(i,k)=amin1(ep(i,k),epmax_diag(i))
     4299           enddo
     4300        enddo
     4301 !       write(*,*) 'ep(1,:)=',ep(1,:)
     4302
     4303      !write(*,*) 'cv3_routines check 4326'
     4304! On recalcule hp:
     4305!      do k=1,nl
     4306!        do i=1,ncum
     4307!         hp_bak(i,k)=hp(i,k)
     4308!       enddo
     4309!      enddo
     4310      do k=1,nl
     4311        do i=1,ncum
     4312          hp(i,k)=h(i,k)
     4313        enddo
     4314      enddo
     4315
     4316  IF (cvflag_ice) THEN
     4317
     4318      do k=minorig+1,nl
     4319       do i=1,ncum
     4320        if((k.ge.icb(i)).and.(k.le.inb(i)))then
     4321          hp(i, k) = hnk(i) + (lv(i,k)+(cpd-cpv)*t(i,k)+frac(i,k)*lf(i,k))* &
     4322                              ep(i, k)*clw(i, k)
     4323        endif
     4324       enddo
     4325      enddo !do k=minorig+1,n
     4326  ELSE !IF (cvflag_ice) THEN
     4327
     4328      DO k = minorig + 1, nl
     4329       DO i = 1, ncum
     4330        IF ((k>=icb(i)) .AND. (k<=inb(i))) THEN
     4331          hp(i,k)=hnk(i)+(lv(i,k)+(cpd-cpv)*t(i,k))*ep(i,k)*clw(i,k)
     4332        endif
     4333       enddo
     4334      enddo !do k=minorig+1,n
     4335
     4336  ENDIF !IF (cvflag_ice) THEN     
     4337      !write(*,*) 'cv3_routines check 4345'
     4338!      do i=1,ncum 
     4339!       do k=1,nl
     4340!        if ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-1).or. &
     4341!            ((abs(hp_bak(i,k)-hp(i,k))/hp_bak(i,k).gt.1e-4).and. &
     4342!            (ep(i,k)-ep_bak(i,k).lt.1e-4))) then
     4343!           write(*,*) 'i,k=',i,k
     4344!           write(*,*) 'coef_epmax_cape=',coef_epmax_cape
     4345!           write(*,*) 'epmax_diag(i)=',epmax_diag(i)
     4346!           write(*,*) 'ep(i,k)=',ep(i,k)
     4347!           write(*,*) 'ep_bak(i,k)=',ep_bak(i,k)
     4348!           write(*,*) 'hp(i,k)=',hp(i,k)
     4349!           write(*,*) 'hp_bak(i,k)=',hp_bak(i,k)
     4350!           write(*,*) 'h(i,k)=',h(i,k)
     4351!           write(*,*) 'nk(i)=',nk(i)
     4352!           write(*,*) 'h(i,nk(i))=',h(i,nk(i))
     4353!           write(*,*) 'lv(i,k)=',lv(i,k)
     4354!           write(*,*) 't(i,k)=',t(i,k)
     4355!           write(*,*) 'clw(i,k)=',clw(i,k)
     4356!           write(*,*) 'cpd,cpv=',cpd,cpv
     4357!           stop
     4358!        endif
     4359!       enddo !do k=1,nl
     4360!      enddo !do i=1,ncum 
     4361      endif !if (coef_epmax_cape.gt.1e-12) then
     4362      !write(*,*) 'cv3_routines check 4367'
     4363
     4364      return
     4365      end subroutine cv3_epmax_fn_cape
     4366
     4367
     4368

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

    r2408 r2488  
    1313                           wdtrainA, wdtrainM, &                                ! RomP
    1414                           qtc, sigt,          &
    15                          
     15                           epmax_diag, & ! epmax_cape
    1616                           iflag1, kbas1, ktop1, &
    1717                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
    … …  
    2626                           clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &        ! RomP
    2727                           wdtrainA1, wdtrainM1, &                              ! RomP
    28                            qtc1, sigt1)
     28                           qtc1, sigt1, &
     29                           epmax_diag1) ! epmax_cape
    2930
    3031  ! **************************************************************
    … …  
    5253  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: sig, w0
    5354  REAL, DIMENSION (nloc), INTENT (IN)                :: ptop2
     55  REAL, DIMENSION (nloc), INTENT (IN)                :: epmax_diag
    5456  REAL, DIMENSION (nloc, nd), INTENT (IN)            :: ft, fq, fu, fv
    5557  REAL, DIMENSION (nloc, nd, ntra), INTENT (IN)      :: ftra
    … …  
    8688  REAL, DIMENSION (len), INTENT (OUT)                :: wbeff1
    8789  REAL, DIMENSION (len, nd), INTENT (OUT)            :: sig1, w01
     90  REAL, DIMENSION (len), INTENT (OUT)                :: epmax_diag1 ! epmax_cape
    8891  REAL, DIMENSION (len), INTENT (OUT)                :: ptop21
    8992  REAL, DIMENSION (len, nd), INTENT (OUT)            :: ft1, fq1, fu1, fv1
    … …  
    144147      supmax01(idcum(i)) = supmax0(i)
    145148      asupmaxmin1(idcum(i)) = asupmaxmin(i)
     149      epmax_diag1(idcum(i)) = epmax_diag(i)
    146150    END DO
    147151   

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

    r2435 r2488  
    8282  REAL mad(nloc, nd), me(nloc, nd), betalim(nloc, nd), beta_coef(nloc, nd)
    8383  REAL med(nloc, nd), md(nloc,nd)
    84   REAL coef_peel
    85   PARAMETER (coef_peel=0.25)
     84!jyg<
     85! coef_peel is now in the common cv3_param
     86!!  REAL coef_peel
     87!!  PARAMETER (coef_peel=0.25)
     88!>jyg
    8689
    8790  REAL sigmax

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

    r2435 r2488  
    8989  REAL, DIMENSION (nloc, nd)                         :: mad, me, betalim, beta_coef
    9090  REAL, DIMENSION (nloc, nd)                         :: med, md
    91   REAL                                               :: coef_peel
    92   PARAMETER (coef_peel=0.25)
     91!jyg<
     92! coef_peel is now in the common cv3_param
     93!!  REAL                                               :: coef_peel
     94!!  PARAMETER (coef_peel=0.25)
     95!>jyg
    9396
    9497  REAL                                               :: sigmax

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

    r2435 r2488  
    130130        Qent(i, k, j) = rr(i, j)
    131131        uent(i, k, j) = u(i, j)
    132         vent(i, k, j) = v(i, j)
     132        vent(i, k, j) = v(i, j) 
    133133        elij(i, k, j) = 0.0
    134134        hent(i, k, j) = 0.0
    … …  
    143143  Sij(1:ncum, 1:nd, 1:nd) = 0.0
    144144!AC!
     145!ym
     146  Sigij(1:ncum, 1:nd, 1:nd) = 0.0
     147!ym
    145148
    146149!jyg!  DO k = 1, ntra

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

    r2435 r2488  
    1414      real pbcrit, ptcrit
    1515      real elcrit, tlcrit
     16      real coef_peel
    1617      real omtrain
    1718      real dtovsh, dpbase, dttrig
    … …  
    2526                      ,pbcrit, ptcrit &
    2627                      ,elcrit, tlcrit &
     28                      ,coef_peel &
    2729                      ,omtrain &
    2830                      ,dtovsh, dpbase, dttrig &

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

    r2408 r2488  
    88                                                                        ! RomP
    99    evap1, ep1, epmlmmm1, eplamm1, & ! RomP
    10     wdtraina1, wdtrainm1) ! RomP
     10    wdtraina1, wdtrainm1, & ! RomP
     11    epmax_diag1) ! epmax_cape
    1112
    1213  USE dimphy
    … …  
    144145  REAL epmlmmm1(len, nd, nd), eplamm1(len, nd)
    145146  ! RomP <<<
     147  REAL epmax_diag1 (len) ! epmax_cape     
    146148
    147149  ! -------------------------------------------------------------------
    … …  
    341343  REAL sigd(nloc)
    342344  ! RomP <<<
     345  REAL epmax_diag(nloc) ! epmax_cape
    343346
    344347  nent(:, :) = 0
    … …  
    402405  wd1(:) = 0.0
    403406  cape1(:) = 0.0
     407  epmax_diag1(:) = 0.0 ! epmax_cape
     408
    404409
    405410  IF (iflag_con==30) THEN
    … …  
    554559      CALL cv30_closure(nloc, ncum, nd, icb, inb & ! na->nd
    555560        , pbase, p, ph, tv, buoy, sig, w0, cape, m)
     561
     562      ! epmax_cape
     563      call cv30_epmax_fn_cape(nloc,ncum,nd &
     564                ,cape,ep,hp,icb,inb,clw,nk,t,h,lv &
     565                ,epmax_diag)
     566        ! on écrase ep et recalcule hp
    556567    END IF
    557568
    … …  
    560571        cpn, iflag, cbmf)
    561572    END IF
     573   
    562574
    563575    ! -------------------------------------------------------------------
    … …  
    643655        da, phi, mp, phi2, d1a, dam, sij & !RomP
    644656        , elij, clw, epmlmmm, eplamm & !RomP
    645         , wdtraina, wdtrainm &     !RomP
     657        , wdtraina, wdtrainm,epmax_diag &     !RomP
    646658        , iflag1, precip1, vprecip1, evap1, ep1, sig1, w01 & !RomP
    647659        , ft1, fq1, fu1, fv1, ftra1, inb1, ma1, upwd1, dnwd1, dnwd01, &
    648660        qcondc1, wd1, cape1, da1, phi1, mp1, phi21, d1a1, dam1, sij1 & !RomP
    649661        , elij1, clw1, epmlmmm1, eplamm1 & !RomP
    650         , wdtraina1, wdtrainm1) !RomP
     662        , wdtraina1, wdtrainm1,epmax_diag1) !RomP
    651663    END IF
    652664

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

    r2435 r2488  
    2727                      clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, &        ! RomP, RL
    2828                      wdtrainA1, wdtrainM1, qtc1, sigt1, tau_cld_cv, &
    29                       coefw_cld_cv)                                        ! RomP, AJ
     29                      coefw_cld_cv, &                                      ! RomP, AJ
     30                      epmax_diag1)  ! epmax_cape
    3031! **************************************************************
    3132! *
    … …  
    259260  REAL, DIMENSION (len, nd), INTENT (OUT)            :: d1a1, dam1
    260261! RomP <<<
     262  REAL, DIMENSION (len ), INTENT (OUT)               :: epmax_diag1     
    261263
    262264! -------------------------------------------------------------------
    … …  
    524526  REAL d1a(len, nd), dam(len, nd)
    525527! RomP <<<
     528  REAL epmax_diag(nloc) ! epmax_cape
    526529
    527530  LOGICAL, SAVE :: first = .TRUE.
    … …  
    892895    END IF
    893896
     897    ! epmax_cape
     898    ! on recalcule ep et hp   
     899    call cv3_epmax_fn_cape(nloc,ncum,nd &
     900                , ep,hp,icb,inb,clw,nk,t,h,hnk,lv,lf,frac &
     901                , pbase, p, ph, tv, buoy, sig, w0,iflag &
     902                , epmax_diag)
     903
    894904! -------------------------------------------------------------------
    895905! --- MIXING(1)   (if iflag_mix .ge. 1)
    … …  
    11281138                           clw, elij, evap, ep, epmlmMm, eplaMm, &       ! RomP
    11291139                           wdtrainA, wdtrainM, &                         ! RomP
    1130                            qtc, sigt, &
     1140                           qtc, sigt, epmax_diag, & ! epmax_cape
    11311141                           iflag1, kbas1, ktop1, &
    11321142                           precip1, cbmf1, plcl1, plfc1, wbeff1, sig1, w01, ptop21, &
    … …  
    11411151                           clw1, elij1, evap1, ep1, epmlmMm1, eplaMm1, & ! RomP
    11421152                           wdtrainA1, wdtrainM1,                       & ! RomP
    1143                            qtc1, sigt1)
     1153                           qtc1, sigt1, epmax_diag1) ! epmax_cape
    11441154    END IF
    11451155

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

    r2471 r2488  
    440440      print *,'fnday=',fnday
    441441
     442      start_time=time_ini/24.
     443
    442444! Special case for arm_cu which lasts less than one day : 53100s !! (MPL 20111026)
    443445      IF(forcing_type .EQ. 61) fnday=53100./86400.

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

    r2435 r2488  
    124124  REAL dzfice(klon)
    125125  REAL zsolid
     126!!!!
     127!  Variables pour Bergeron
     128  REAL zcp, coef1, DeltaT
     129  REAL zqpreci(klon), zqprecl(klon)
    126130  !
    127131  LOGICAL appel1er
    … …  
    457461
    458462!CR ATTENTION: deplacement de la fonte de la glace
    459            zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2
     463!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
     464!!!        zmelt = ((zt(i)-273.15)/(ztfondue-273.15))**2  !!!!!!!!! jyg
     465!jyg : Bug !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! jyg
     466           zmelt = ((zt(i)-273.15)/(ztfondue-273.15))             ! jyg
    460467           zmelt = MIN(MAX(zmelt,0.),1.)
    461468           zrfl(i)=zrfl(i)+zmelt*zifl(i)
    … …  
    907914              radliq(i,k) = radliq(i,k) + zoliq(i)/REAL(ninter+1)
    908915           ENDIF
    909         ENDDO
    910      ENDDO
    911      !
    912          IF (.NOT. ice_thermo) THEN
     916        ENDDO  ! i = 1,klon
     917     ENDDO     ! n = 1,ninter
     918     !
     919     IF (.NOT. ice_thermo) THEN
    913920       DO i = 1, klon
    914921         IF (rneb(i,k).GT.0.0) THEN
    … …  
    919926       ENDDO
    920927     ELSE
     928!
     929!CR&JYG<
     930! On prend en compte l'effet Bergeron dans les flux de precipitation :
     931! Si T < 0 C, alors les precipitations liquides sont converties en glace, ce qui
     932! provoque un accroissement de temperature DeltaT. L'effet de DeltaT sur le condensat
     933! et les precipitations est grossierement pris en compte en linearisant les equations
     934! et en approximant le processus de precipitation liquide par un processus a seuil.
     935! On fait l'hypothese que le condensat nuageux n'est pas modifié dans cette opération.
     936! Le condensat precipitant liquide est supprime (dans la limite DeltaT<273-T).
     937! Le condensat precipitant solide est augmente.
     938! La vapeur d'eau est augmentee.
     939!
     940       IF ((iflag_bergeron .EQ. 2)) THEN
     941         DO i = 1, klon
     942           IF (rneb(i,k) .GT. 0.0) THEN
     943             zqpreci(i)=(zcond(i)-zoliq(i))*zfice(i)
     944             zqprecl(i)=(zcond(i)-zoliq(i))*(1.-zfice(i))
     945             zcp=RCPD*(1.0+RVTMP2*(zq(i)+zcond(i)))
     946             coef1 = RLMLT*zdqs(i)/RLVTT
     947             DeltaT = max( min( RTT-zt(i), RLMLT*zqprecl(i)/zcp/(1.+coef1) ) , 0.)
     948             zqpreci(i) = zqpreci(i) + zcp/RLMLT*DeltaT
     949             zqprecl(i) = max( zqprecl(i) - zcp/RLMLT*(1.+coef1)*DeltaT, 0. )
     950             zcond(i)   = max( zcond(i)   - zcp/RLVTT*zdqs(i)*DeltaT, 0. )
     951             zq(i)      = zq(i)      + zcp/RLVTT*zdqs(i)*DeltaT
     952             zt(i)      = zt(i)      + DeltaT
     953           ENDIF  ! rneb(i,k) .GT. 0.0
     954         ENDDO
     955         DO i = 1, klon
     956           IF (rneb(i,k).GT.0.0) THEN
     957             d_ql(i,k) = (1-zfice(i))*zoliq(i)
     958             d_qi(i,k) = zfice(i)*zoliq(i)
     959             zrfl(i) = zrfl(i)+ zqprecl(i) &
     960                 *(paprs(i,k)-paprs(i,k+1))/(RG*dtime)
     961             zifl(i) = zifl(i)+ zqpreci(i) &
     962                      *(paprs(i,k)-paprs(i,k+1))/(RG*dtime) 
     963           ENDIF                     
     964         ENDDO
     965!!
     966       ELSE  ! iflag_bergeron
     967!>CR&JYG
     968!!
    921969       DO i = 1, klon
    922970         IF (rneb(i,k).GT.0.0) THEN
    … …  
    940988
    941989!CR : on prend en compte l'effet Bergeron dans les flux de precipitation
    942            if ((iflag_bergeron.eq.1).and.(zt(i).LT.273.15)) then
     990           IF ((iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)) THEN
    943991              zsolid = zrfl(i)
    944992              zifl(i) = zifl(i)+zrfl(i)
    … …  
    946994              zt(i)=zt(i)+zsolid*(RG*dtime)/(paprs(i,k)-paprs(i,k+1)) &
    947995                      *(RLSTT-RLVTT)/RCPD/(1.0+RVTMP2*zq(i))
    948            endif
     996           ENDIF  ! (iflag_bergeron .EQ. 1) .AND. (zt(i) .LT. 273.15)
    949997!RC   
    950998
    951          ENDIF                      
     999         ENDIF ! rneb(i,k).GT.0.0
    9521000       ENDDO
    953      ENDIF
     1001
     1002       ENDIF  ! iflag_bergeron .EQ. 2
     1003     ENDIF  ! .NOT. ice_thermo
    9541004
    9551005!CR: la fonte est faite au debut

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

    r2160 r2488  
    3030     ! l'intialisation des aerosols. Momentannement, on passe un point de
    3131     ! grille du profil de pression.
    32      CALL surayolmd(pres(klev+1)) ! initialiser le rayonnement RRTM
     32     CALL surayolmd          ! initialiser le rayonnement RRTM
    3333     PRINT *, 'iniradia: apres surayolmd '
    3434  endif

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

    r2408 r2488  
    342342      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: dnwd, dnwd0, upwd, omega
    343343!$OMP THREADPRIVATE(dnwd, dnwd0, upwd, omega)
     344      REAL,ALLOCATABLE,SAVE,DIMENSION(:) :: epmax_diag ! epmax_cape
     345!$OMP THREADPRIVATE(epmax_diag)
     346      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: ep ! epmax_cape
     347!$OMP THREADPRIVATE(ep)
    344348!      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: coefh, coefm, lambda_th
    345349      REAL,ALLOCATABLE,SAVE,DIMENSION(:,:) :: lambda_th
    … …  
    560564!      ALLOCATE(upwd(klon, klev), omega(klon, klev), coefh(klon, klev))
    561565      ALLOCATE(upwd(klon, klev), omega(klon, klev))
     566      ALLOCATE(epmax_diag(klon)) ! epmax_cape
     567      ALLOCATE(ep(klon,klev)) ! epmax_cape
    562568!      ALLOCATE(coefm(klon, klev), lambda_th(klon, klev), cldemi(klon, klev))
    563569      ALLOCATE(lambda_th(klon, klev), cldemi(klon, klev))
    … …  
    761767!      DEALLOCATE(upwd, omega, coefh)
    762768      DEALLOCATE(upwd, omega)
     769      DEALLOCATE(epmax_diag)
     770      DEALLOCATE(ep)
    763771!      DEALLOCATE(coefm, lambda_th, cldemi)
    764772      DEALLOCATE(lambda_th, cldemi)

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

    r2408 r2488  
    982982  TYPE(ctrl_out), SAVE :: o_upwd = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    983983    'upwd', 'saturated updraft', 'kg/m2/s', (/ ('', i=1, 9) /))
     984  TYPE(ctrl_out), SAVE :: o_epmax_diag = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     985    'epmax', 'epmax en fn cape', 'su', (/ ('', i=1, 9) /))
     986  TYPE(ctrl_out), SAVE :: o_ep = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     987    'ep', 'ep', 'su', (/ ('', i=1, 9) /))
    984988  TYPE(ctrl_out), SAVE :: o_dtphy = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    985989    'dtphy', 'Physics dT', 'K/s', (/ ('', i=1, 9) /))
    986990  TYPE(ctrl_out), SAVE :: o_dqphy = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    987991    'dqphy', 'Physics dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     992  TYPE(ctrl_out), SAVE :: o_dqphy2d = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     993    'dqphy2d', 'Physics dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    988994  TYPE(ctrl_out), SAVE :: o_pr_con_l = ctrl_out((/ 2, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    989995    'pr_con_l', 'Convective precipitation lic', ' ', (/ ('', i=1, 9) /))
    … …  
    10631069  TYPE(ctrl_out), SAVE :: o_dqdyn = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    10641070    'dqdyn', 'Dynamics dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1071  TYPE(ctrl_out), SAVE :: o_dqdyn2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1072    'dqdyn2d', 'Dynamics dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    10651073  TYPE(ctrl_out), SAVE :: o_dudyn = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    10661074    'dudyn', 'Dynamics dU', 'm/s2', (/ ('', i=1, 9) /))
    … …  
    10751083  TYPE(ctrl_out), SAVE :: o_dqcon = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    10761084    'dqcon', 'Convection dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1085  TYPE(ctrl_out), SAVE :: o_dqcon2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1086    'dqcon2d', 'Convection dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    10771087  TYPE(ctrl_out), SAVE :: o_dtwak = ctrl_out((/ 4, 5, 10, 10, 10, 10, 11, 11, 11 /), &
    10781088    'dtwak', 'Wake dT', 'K/s', (/ ('', i=1, 9) /))
    10791089  TYPE(ctrl_out), SAVE :: o_dqwak = ctrl_out((/ 4, 5, 10, 10, 10, 10, 11, 11, 11 /), &
    10801090    'dqwak', 'Wake dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1091  TYPE(ctrl_out), SAVE :: o_dqwak2d = ctrl_out((/ 4, 5, 10, 10, 10, 10, 11, 11, 11 /), &
     1092    'dqwak2d', 'Wake dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    10811093  TYPE(ctrl_out), SAVE :: o_wake_h = ctrl_out((/ 4, 5, 10, 10, 10, 10, 11, 11, 11 /), &
    10821094    'wake_h', 'wake_h', '-', (/ ('', i=1, 9) /))
    … …  
    11051117  TYPE(ctrl_out), SAVE :: o_dqlsc = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11061118    'dqlsc', 'Condensation dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1119  TYPE(ctrl_out), SAVE :: o_dqlsc2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1120    'dqlsc2d', 'Condensation dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    11071121  TYPE(ctrl_out), SAVE :: o_beta_prec = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11081122    'beta_prec', 'LS Conversion rate to prec', '(kg/kg)/s', (/ ('', i=1, 9) /))
    … …  
    11131127  TYPE(ctrl_out), SAVE :: o_dqvdf = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11141128    'dqvdf', 'Boundary-layer dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1129  TYPE(ctrl_out), SAVE :: o_dqvdf2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1130    'dqvdf2d', 'Boundary-layer dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    11151131  TYPE(ctrl_out), SAVE :: o_dteva = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11161132    'dteva', 'Reevaporation dT', 'K/s', (/ ('', i=1, 9) /))
    11171133  TYPE(ctrl_out), SAVE :: o_dqeva = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11181134    'dqeva', 'Reevaporation dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1135  TYPE(ctrl_out), SAVE :: o_dqeva2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1136    'dqeva2d', 'Reevaporation dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    11191137
    11201138!!!!!!!!!!!!!!!! Specifique thermiques
    11211139  TYPE(ctrl_out), SAVE :: o_dqlscth = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11221140    'dqlscth', 'dQ therm.', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1141  TYPE(ctrl_out), SAVE :: o_dqlscth2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1142    'dqlscth2d', 'dQ therm.', '(kg/m2)/s', (/ ('', i=1, 9) /))
    11231143  TYPE(ctrl_out), SAVE :: o_dqlscst = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11241144    'dqlscst', 'dQ strat.', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1145  TYPE(ctrl_out), SAVE :: o_dqlscst2d = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1146    'dqlscst2d', 'dQ strat.', '(kg/m2)/s', (/ ('', i=1, 9) /))
    11251147  TYPE(ctrl_out), SAVE :: o_dtlscth = ctrl_out((/ 10, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11261148    'dtlscth', 'dQ therm.', 'K/s', (/ ('', i=1, 9) /))
    … …  
    11681190  TYPE(ctrl_out), SAVE :: o_dqthe = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11691191    'dqthe', 'Thermal dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1192  TYPE(ctrl_out), SAVE :: o_dqthe2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1193    'dqthe2d', 'Thermal dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    11701194  TYPE(ctrl_out), SAVE :: o_dtajs = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11711195    'dtajs', 'Dry adjust. dT', 'K/s', (/ ('', i=1, 9) /))
    11721196  TYPE(ctrl_out), SAVE :: o_dqajs = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11731197    'dqajs', 'Dry adjust. dQ', '(kg/kg)/s', (/ ('', i=1, 9) /))
     1198  TYPE(ctrl_out), SAVE :: o_dqajs2d = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
     1199    'dqajs2d', 'Dry adjust. dQ', '(kg/m2)/s', (/ ('', i=1, 9) /))
    11741200  TYPE(ctrl_out), SAVE :: o_dtswr = ctrl_out((/ 4, 10, 10, 10, 10, 10, 11, 11, 11 /), &
    11751201    'dtswr', 'SW radiation dT', 'K/s', (/ ('', i=1, 9) /))

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

    r2435 r2488  
    3737         o_psol, o_mass, o_qsurf, o_qsol, &
    3838         o_precip, o_ndayrain, o_plul, o_pluc, &
    39          o_snow, o_msnow, o_fsnow, o_evap, &
     39         o_snow, o_msnow, o_fsnow, o_evap, o_ep,o_epmax_diag, & ! epmax_cape
    4040         o_tops, o_tops0, o_topl, o_topl0, &
    4141         o_SWupTOA, o_SWupTOAclr, o_SWdnTOA, &
    … …  
    6565         o_ue, o_ve, o_uq, o_vq, o_cape, o_pbase, &
    6666         o_ptop, o_fbase, o_plcl, o_plfc, &
    67          o_wbeff, o_cape_max, o_upwd, o_Ma, &
     67         o_wbeff, o_cape_max, o_upwd, o_ep,o_epmax_diag, o_Ma, &
    6868         o_dnwd, o_dnwd0, o_ftime_con, o_mc, &
    6969         o_prw, o_s_pblh, o_s_pblt, o_s_lcl, &
    … …  
    7979         o_ale, o_alp, o_cin, o_WAPE, o_wake_h, &
    8080         o_wake_s, o_wake_deltat, o_wake_deltaq, &
    81          o_wake_omg, o_dtwak, o_dqwak, o_Vprecip, &
     81         o_wake_omg, o_dtwak, o_dqwak, o_dqwak2d, o_Vprecip, &
    8282         o_ftd, o_fqd, o_wdtrainA, o_wdtrainM, &
    8383         o_n2, o_s2, o_proba_notrig, &
    … …  
    120120         o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, &
    121121         o_rnebls, o_rhum, o_ozone, o_ozone_light, &
    122          o_dtphy, o_dqphy, o_albe_srf, o_z0m_srf, o_z0h_srf, &
     122         o_dtphy, o_dqphy, o_dqphy2d, o_albe_srf, o_z0m_srf, o_z0h_srf, &
    123123         o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, &
    124124         o_tke_max, o_kz, o_kz_max, o_clwcon, &
    125          o_dtdyn, o_dqdyn, o_dudyn, o_dvdyn, &
     125         o_dtdyn, o_dqdyn, o_dqdyn2d, o_dudyn, o_dvdyn, &
    126126         o_dtcon, o_tntc, o_ducon, o_dvcon, &
    127          o_dqcon, o_tnhusc, o_tnhusc, o_dtlsc, &
    128          o_dtlschr, o_dqlsc, o_beta_prec, &
    129          o_dtlscth, o_dtlscst, o_dqlscth, &
    130          o_dqlscst, o_plulth, o_plulst, &
     127         o_dqcon, o_dqcon2d, o_tnhusc, o_tnhusc, o_dtlsc, &
     128         o_dtlschr, o_dqlsc, o_dqlsc2d, o_beta_prec, &
     129         o_dtlscth, o_dtlscst, o_dqlscth, o_dqlscth2d, &
     130         o_dqlscst, o_dqlscst2d, o_plulth, o_plulst, &
    131131         o_ptconvth, o_lmaxth, o_dtvdf, &
    132          o_dtdis, o_dqvdf, o_dteva, o_dqeva, &
     132         o_dtdis, o_dqvdf, o_dqvdf2d, o_dteva, o_dqeva, o_dqeva2d, &
    133133         o_ptconv, o_ratqs, o_dtthe, &
    134134         o_duthe, o_dvthe, o_ftime_th, &
    135135         o_f_th, o_e_th, o_w_th, o_q_th, &
    136136         o_a_th, o_d_th, o_f0_th, o_zmax_th, &
    137          o_dqthe, o_dtajs, o_dqajs, o_dtswr, &
     137         o_dqthe, o_dqthe2d, o_dtajs, o_dqajs, o_dqajs2d, o_dtswr, &
    138138         o_dtsw0, o_dtlwr, o_dtlw0, o_dtec, &
    139139         o_duvdf, o_dvvdf, o_duoro, o_dvoro, &
    … …  
    249249         dv_gwd_rando, dv_gwd_front, &
    250250         east_gwstress, west_gwstress, &
    251          d_q_ch4, pmfd, pmfu, ref_liq, ref_ice, rhwriteSTD
     251         d_q_ch4, pmfd, pmfu, ref_liq, ref_ice, rhwriteSTD, &
     252         ep, epmax_diag ! epmax_cape
    252253
    253254    USE phys_output_var_mod, only: vars_defined, snow_o, zfra_o, bils_diss, &
    … …  
    428429       CALL histwrite_phy(o_precip, zx_tmp_fi2d)
    429430       CALL histwrite_phy(o_ndayrain, nday_rain)
     431
     432       ! epmax_cape:
     433!       CALL histwrite_phy(o_epmax_diag, epmax_diag)
     434       CALL histwrite_phy(o_ep, ep)
    430435
    431436       IF (vars_defined) THEN
    … …  
    810815             IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_wake(1:klon,1:klev)/pdtphys
    811816             CALL histwrite_phy(o_dqwak, zx_tmp_fi3d)
     817             CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     818             CALL histwrite_phy(o_dqwak2d, zx_tmp_fi2d)
    812819          ENDIF ! iflag_wake>=1
    813820          CALL histwrite_phy(o_ftd, ftd)
    … …  
    10581065       CALL histwrite_phy(o_dtphy, d_t)
    10591066       CALL histwrite_phy(o_dqphy,  d_qx(:,:,ivap))
     1067       CALL water_int(klon,klev,d_qx(:,:,ivap),zmasse,zx_tmp_fi2d)
     1068       CALL histwrite_phy(o_dqphy2d,  zx_tmp_fi2d)
    10601069       DO nsrf=1, nbsrf
    10611070          IF (vars_defined) zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf)
    … …  
    10951104       CALL histwrite_phy(o_dtdyn, d_t_dyn)
    10961105       CALL histwrite_phy(o_dqdyn, d_q_dyn)
     1106       CALL water_int(klon,klev,d_q_dyn,zmasse,zx_tmp_fi2d)
     1107       CALL histwrite_phy(o_dqdyn2d,zx_tmp_fi2d)
    10971108       CALL histwrite_phy(o_dudyn, d_u_dyn)
    10981109       CALL histwrite_phy(o_dvdyn, d_v_dyn)
    … …  
    11221133       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys
    11231134       CALL histwrite_phy(o_dqcon, zx_tmp_fi3d)
     1135       CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1136       CALL histwrite_phy(o_dqcon2d, zx_tmp_fi2d)
    11241137
    11251138       IF(iflag_thermals.EQ.0) THEN
    … …  
    11421155       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys
    11431156       CALL histwrite_phy(o_dqlsc, zx_tmp_fi3d)
     1157       CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1158       CALL histwrite_phy(o_dqlsc2d, zx_tmp_fi2d)
    11441159       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=beta_prec(1:klon,1:klev)
    11451160       CALL histwrite_phy(o_beta_prec, zx_tmp_fi3d)
    … …  
    11531168          IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys
    11541169          CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d)
     1170          CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1171          CALL histwrite_phy(o_dqlscth2d, zx_tmp_fi2d)
    11551172          IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys
    11561173          CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d)
     1174          CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1175          CALL histwrite_phy(o_dqlscst2d, zx_tmp_fi2d)
    11571176          CALL histwrite_phy(o_plulth, plul_th)
    11581177          CALL histwrite_phy(o_plulst, plul_st)
    … …  
    11831202       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys
    11841203       CALL histwrite_phy(o_dqvdf, zx_tmp_fi3d)
     1204       CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1205       CALL histwrite_phy(o_dqvdf2d, zx_tmp_fi2d)
    11851206       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_eva(1:klon,1:klev)/pdtphys
    11861207       CALL histwrite_phy(o_dteva, zx_tmp_fi3d)
    11871208       IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_eva(1:klon,1:klev)/pdtphys
    11881209       CALL histwrite_phy(o_dqeva, zx_tmp_fi3d)
     1210       CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1211       CALL histwrite_phy(o_dqeva2d, zx_tmp_fi2d)
    11891212       zpt_conv = 0.
    11901213       WHERE (ptconv) zpt_conv = 1.
    … …  
    12221245          ENDIF
    12231246          CALL histwrite_phy(o_dqthe, zx_tmp_fi3d)
     1247          CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1248          CALL histwrite_phy(o_dqthe2d, zx_tmp_fi2d)
    12241249       ENDIF !iflag_thermals
    12251250       IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys
    … …  
    12271252       IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys
    12281253       CALL histwrite_phy(o_dqajs, zx_tmp_fi3d)
     1254       CALL water_int(klon,klev,zx_tmp_fi3d,zmasse,zx_tmp_fi2d)
     1255       CALL histwrite_phy(o_dqajs2d, zx_tmp_fi2d)
    12291256       IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys
    12301257       CALL histwrite_phy(o_dtswr, zx_tmp_fi3d)

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

    r2471 r2488  
    55MODULE physiq_mod
    66
    7 IMPLICIT NONE
     7  IMPLICIT NONE
    88
    99CONTAINS
    1010
    11 SUBROUTINE physiq (nlon,nlev, &
    12      debut,lafin,pdtphys_, &
    13      paprs,pplay,pphi,pphis,presnivs, &
    14      u,v,rot,t,qx, &
    15      flxmass_w, &
    16      d_u, d_v, d_t, d_qx, d_ps)
    17 
    18   USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
    19        histwrite, ju2ymds, ymds2ju, getin
    20   USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
    21   USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, year_cur, &
    22        mth_cur,jD_cur, jH_cur, jD_ref
    23   USE write_field_phy
    24   USE dimphy
    25   USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac
    26   USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo
    27   USE mod_phys_lmdz_para
    28   USE iophy
    29   USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
    30   USE phystokenc_mod, ONLY: offline, phystokenc
    31   USE time_phylmdz_mod, only: raz_date, day_step_phy, update_time
    32   USE vampir
    33   USE pbl_surface_mod, ONLY : pbl_surface
    34   USE change_srf_frac_mod
    35   USE surface_data,     ONLY : type_ocean, ok_veget, ok_snow
    36   USE phys_local_var_mod ! Variables internes non sauvegardees de la physique
    37   USE phys_state_var_mod ! Variables sauvegardees de la physique
    38   USE phys_output_var_mod ! Variables pour les ecritures des sorties
    39   USE phys_output_write_mod
    40   USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
    41   USE phys_output_mod
    42   USE phys_output_ctrlout_mod
    43   USE iophy
    44   use open_climoz_m, only: open_climoz ! ozone climatology from a file
    45   use regr_pr_av_m, only: regr_pr_av
    46   use netcdf95, only: nf95_close
    47   !IM for NMC files
    48   !     use netcdf, only: nf90_fill_real
    49   use netcdf
    50   use mod_phys_lmdz_mpi_data, only: is_mpi_root
    51   USE aero_mod
    52   use ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
    53   use conf_phys_m, only: conf_phys
    54   use radlwsw_m, only: radlwsw
    55   use phyaqua_mod, only: zenang_an
    56   USE time_phylmdz_mod, only: day_step_phy, annee_ref, day_ref, itau_phy, &
    57                               start_time, pdtphys, day_ini
    58   USE tracinca_mod, ONLY: config_inca
     11  SUBROUTINE physiq (nlon,nlev, &
     12       debut,lafin,pdtphys_, &
     13       paprs,pplay,pphi,pphis,presnivs, &
     14       u,v,rot,t,qx, &
     15       flxmass_w, &
     16       d_u, d_v, d_t, d_qx, d_ps)
     17
     18    USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
     19         histwrite, ju2ymds, ymds2ju, getin
     20    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
     21    USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
     22         year_cur, mth_cur,jD_cur, jH_cur, jD_ref
     23    USE write_field_phy
     24    USE dimphy
     25    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac
     26    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo
     27    USE mod_phys_lmdz_para
     28    USE iophy
     29    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
     30    USE phystokenc_mod, ONLY: offline, phystokenc
     31    USE time_phylmdz_mod, only: raz_date, day_step_phy, update_time
     32    USE vampir
     33    USE pbl_surface_mod, ONLY : pbl_surface
     34    USE change_srf_frac_mod
     35    USE surface_data,     ONLY : type_ocean, ok_veget, ok_snow
     36    USE phys_local_var_mod ! Variables internes non sauvegardees de la physique
     37    USE phys_state_var_mod ! Variables sauvegardees de la physique
     38    USE phys_output_var_mod ! Variables pour les ecritures des sorties
     39    USE phys_output_write_mod
     40    USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
     41    USE phys_output_mod
     42    USE phys_output_ctrlout_mod
     43    USE iophy
     44    use open_climoz_m, only: open_climoz ! ozone climatology from a file
     45    use regr_pr_av_m, only: regr_pr_av
     46    use netcdf95, only: nf95_close
     47    !IM for NMC files
     48    !     use netcdf, only: nf90_fill_real
     49    use netcdf
     50    use mod_phys_lmdz_mpi_data, only: is_mpi_root
     51    USE aero_mod
     52    use ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
     53    use conf_phys_m, only: conf_phys
     54    use radlwsw_m, only: radlwsw
     55    use phyaqua_mod, only: zenang_an
     56    USE time_phylmdz_mod, only: day_step_phy, annee_ref, day_ref, itau_phy, &
     57         start_time, pdtphys, day_ini
     58    USE tracinca_mod, ONLY: config_inca
    5959#ifdef CPP_XIOS
    60   USE wxios, ONLY: missing_val, missing_val_omp
    61   USE xios, ONLY: xios_get_field_attr
     60    USE wxios, ONLY: missing_val, missing_val_omp
     61    USE xios, ONLY: xios_get_field_attr
    6262#endif
    6363#ifdef REPROBUS
    64   USE CHEM_REP, ONLY : Init_chem_rep_xjour
     64    USE CHEM_REP, ONLY : Init_chem_rep_xjour
    6565#endif
    66   USE indice_sol_mod
    67   USE phytrac_mod, ONLY : phytrac
     66    USE indice_sol_mod
     67    USE phytrac_mod, ONLY : phytrac
    6868
    6969#ifdef CPP_RRTM
    70   USE YOERAD   , ONLY : NRADLP
     70    USE YOERAD   , ONLY : NRADLP
    7171#endif
    72   USE ioipsl_getin_p_mod, ONLY : getin_p
    73 
    74 
    75   !IM stations CFMIP
    76   USE CFMIP_point_locations
    77   use FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
    78   use ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
    79 
    80   IMPLICIT none
    81   !>======================================================================
    82   !!
    83   !! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
    84   !!
    85   !! Objet: Moniteur general de la physique du modele
    86   !!AA      Modifications quant aux traceurs :
    87   !!AA                  -  uniformisation des parametrisations ds phytrac
    88   !!AA                  -  stockage des moyennes des champs necessaires
    89   !!AA                     en mode traceur off-line
    90   !!======================================================================
    91   !!   CLEFS CPP POUR LES IO
    92   !!   =====================
     72    USE ioipsl_getin_p_mod, ONLY : getin_p
     73
     74
     75    !IM stations CFMIP
     76    USE CFMIP_point_locations
     77    use FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
     78    use ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
     79
     80    IMPLICIT none
     81    !>======================================================================
     82    !!
     83    !! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
     84    !!
     85    !! Objet: Moniteur general de la physique du modele
     86    !!AA      Modifications quant aux traceurs :
     87    !!AA                  -  uniformisation des parametrisations ds phytrac
     88    !!AA                  -  stockage des moyennes des champs necessaires
     89    !!AA                     en mode traceur off-line
     90    !!======================================================================
     91    !!   CLEFS CPP POUR LES IO
     92    !!   =====================
    9393#define histNMC
    94   !!======================================================================
    95   !!    modif   ( P. Le Van ,  12/10/98 )
    96   !!
    97   !!  Arguments:
    98   !!
    99   !! nlon----input-I-nombre de points horizontaux
    100   !! nlev----input-I-nombre de couches verticales, doit etre egale a klev
    101   !! debut---input-L-variable logique indiquant le premier passage
    102   !! lafin---input-L-variable logique indiquant le dernier passage
    103   !! jD_cur       -R-jour courant a l'appel de la physique (jour julien)
    104   !! jH_cur       -R-heure courante a l'appel de la physique (jour julien)
    105   !! pdtphys-input-R-pas d'integration pour la physique (seconde)
    106   !! paprs---input-R-pression pour chaque inter-couche (en Pa)
    107   !! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
    108   !! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
    109   !! pphis---input-R-geopotentiel du sol
    110   !! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
    111   !! u-------input-R-vitesse dans la direction X (de O a E) en m/s
    112   !! v-------input-R-vitesse Y (de S a N) en m/s
    113   !! t-------input-R-temperature (K)
    114   !! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
    115   !! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
    116   !! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
    117   !! flxmass_w -input-R- flux de masse verticale
    118   !! d_u-----output-R-tendance physique de "u" (m/s/s)
    119   !! d_v-----output-R-tendance physique de "v" (m/s/s)
    120   !! d_t-----output-R-tendance physique de "t" (K/s)
    121   !! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
    122   !! d_ps----output-R-tendance physique de la pression au sol
    123   !!======================================================================
    124   integer jjmp1
    125 !  parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
    126 !  integer iip1
    127 !  parameter (iip1=iim+1)
    128 
    129   include "regdim.h"
    130   include "dimsoil.h"
    131   include "clesphys.h"
    132   include "thermcell.h"
    133   !======================================================================
    134   LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE
    135   PARAMETER (ok_cvl=.TRUE.)
    136   LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
    137   PARAMETER (ok_gust=.FALSE.)
    138   integer iflag_radia     ! active ou non le rayonnement (MPL)
    139   save iflag_radia
    140   !$OMP THREADPRIVATE(iflag_radia)
    141   !======================================================================
    142   LOGICAL check ! Verifier la conservation du modele en eau
    143   PARAMETER (check=.FALSE.)
    144   LOGICAL ok_stratus ! Ajouter artificiellement les stratus
    145   PARAMETER (ok_stratus=.FALSE.)
    146   !======================================================================
    147   REAL amn, amx
    148   INTEGER igout
    149   !======================================================================
    150   ! Clef controlant l'activation du cycle diurne:
    151   ! en attente du codage des cles par Fred
    152         INTEGER iflag_cycle_diurne
    153         PARAMETER (iflag_cycle_diurne=1)
    154   !======================================================================
    155   ! Modele thermique du sol, a activer pour le cycle diurne:
    156   !cc      LOGICAL soil_model
    157   !cc      PARAMETER (soil_model=.FALSE.)
    158   !======================================================================
    159   ! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
    160   ! le calcul du rayonnement est celle apres la precipitation des nuages.
    161   ! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
    162   ! la condensation et la precipitation. Cette cle augmente les impacts
    163   ! radiatifs des nuages.
    164   !cc      LOGICAL new_oliq
    165   !cc      PARAMETER (new_oliq=.FALSE.)
    166   !======================================================================
    167   ! Clefs controlant deux parametrisations de l'orographie:
    168   !c      LOGICAL ok_orodr
    169   !cc      PARAMETER (ok_orodr=.FALSE.)
    170   !cc      LOGICAL ok_orolf
    171   !cc      PARAMETER (ok_orolf=.FALSE.)
    172   !======================================================================
    173   LOGICAL ok_journe ! sortir le fichier journalier
    174   save ok_journe
    175   !$OMP THREADPRIVATE(ok_journe)
    176   !
    177   LOGICAL ok_mensuel ! sortir le fichier mensuel
    178   save ok_mensuel
    179   !$OMP THREADPRIVATE(ok_mensuel)
    180   !
    181   LOGICAL ok_instan ! sortir le fichier instantane
    182   save ok_instan
    183   !$OMP THREADPRIVATE(ok_instan)
    184   !
    185   LOGICAL ok_LES ! sortir le fichier LES
    186   save ok_LES                           
    187   !$OMP THREADPRIVATE(ok_LES)                 
    188   !
    189   LOGICAL callstats ! sortir le fichier stats
    190   save callstats                           
    191   !$OMP THREADPRIVATE(callstats)                 
    192   !
    193   LOGICAL ok_region ! sortir le fichier regional
    194   PARAMETER (ok_region=.FALSE.)
    195   !======================================================================
    196   real seuil_inversion
    197   save seuil_inversion
    198   !$OMP THREADPRIVATE(seuil_inversion)
    199   integer iflag_ratqs
    200   save iflag_ratqs
    201   !$OMP THREADPRIVATE(iflag_ratqs)
    202   real facteur
    203 
    204   REAL wmax_th(klon)
    205   REAL tau_overturning_th(klon)
    206 
    207   integer lmax_th(klon)
    208   integer limbas(klon)
    209   real ratqscth(klon,klev)
    210   real ratqsdiff(klon,klev)
    211   real zqsatth(klon,klev)
    212 
    213   !======================================================================
    214   !
    215   INTEGER ivap          ! indice de traceurs pour vapeur d'eau
    216   PARAMETER (ivap=1)
    217   INTEGER iliq          ! indice de traceurs pour eau liquide
    218   PARAMETER (iliq=2)
    219 !CR: on ajoute la phase glace
    220   INTEGER isol          ! indice de traceurs pour eau glace
    221   PARAMETER (isol=3)
    222   !
    223   !
    224   ! Variables argument:
    225   !
    226   INTEGER nlon
    227   INTEGER nlev
    228   REAL,INTENT(IN) :: pdtphys_
    229 ! NB: pdtphys to be used in physics is in time_phylmdz_mod
    230   LOGICAL debut, lafin
    231   REAL paprs(klon,klev+1)
    232   REAL pplay(klon,klev)
    233   REAL pphi(klon,klev)
    234   REAL pphis(klon)
    235   REAL presnivs(klev)
    236   REAL znivsig(klev)
    237   real pir
    238 
    239   REAL u(klon,klev)
    240   REAL v(klon,klev)
    241 
    242   REAL, intent(in):: rot(klon, klev)
    243   ! relative vorticity, in s-1, needed for frontal waves
    244 
    245   REAL t(klon,klev),thetal(klon,klev)
    246   ! thetal: ligne suivante a decommenter si vous avez les fichiers     MPL 20130625
    247   ! fth_fonctions.F90 et parkind1.F90
    248   ! sinon thetal=theta
    249   !     REAL fth_thetae,fth_thetav,fth_thetal
    250   REAL qx(klon,klev,nqtot)
    251   REAL flxmass_w(klon,klev)
    252   REAL d_u(klon,klev)
    253   REAL d_v(klon,klev)
    254   REAL d_t(klon,klev)
    255   REAL d_qx(klon,klev,nqtot)
    256   REAL d_ps(klon)
    257   ! Variables pour le transport convectif
    258   real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
    259   real wght_cvfd(klon,klev)
     94    !!======================================================================
     95    !!    modif   ( P. Le Van ,  12/10/98 )
     96    !!
     97    !!  Arguments:
     98    !!
     99    !! nlon----input-I-nombre de points horizontaux
     100    !! nlev----input-I-nombre de couches verticales, doit etre egale a klev
     101    !! debut---input-L-variable logique indiquant le premier passage
     102    !! lafin---input-L-variable logique indiquant le dernier passage
     103    !! jD_cur       -R-jour courant a l'appel de la physique (jour julien)
     104    !! jH_cur       -R-heure courante a l'appel de la physique (jour julien)
     105    !! pdtphys-input-R-pas d'integration pour la physique (seconde)
     106    !! paprs---input-R-pression pour chaque inter-couche (en Pa)
     107    !! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
     108    !! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
     109    !! pphis---input-R-geopotentiel du sol
     110    !! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
     111    !! u-------input-R-vitesse dans la direction X (de O a E) en m/s
     112    !! v-------input-R-vitesse Y (de S a N) en m/s
     113    !! t-------input-R-temperature (K)
     114    !! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
     115    !! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
     116    !! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
     117    !! flxmass_w -input-R- flux de masse verticale
     118    !! d_u-----output-R-tendance physique de "u" (m/s/s)
     119    !! d_v-----output-R-tendance physique de "v" (m/s/s)
     120    !! d_t-----output-R-tendance physique de "t" (K/s)
     121    !! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
     122    !! d_ps----output-R-tendance physique de la pression au sol
     123    !!======================================================================
     124    integer jjmp1
     125    !  parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
     126    !  integer iip1
     127    !  parameter (iip1=iim+1)
     128
     129    include "regdim.h"
     130    include "dimsoil.h"
     131    include "clesphys.h"
     132    include "thermcell.h"
     133    !======================================================================
     134    LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE
     135    PARAMETER (ok_cvl=.TRUE.)
     136    LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
     137    PARAMETER (ok_gust=.FALSE.)
     138    integer iflag_radia     ! active ou non le rayonnement (MPL)
     139    save iflag_radia
     140    !$OMP THREADPRIVATE(iflag_radia)
     141    !======================================================================
     142    LOGICAL check ! Verifier la conservation du modele en eau
     143    PARAMETER (check=.FALSE.)
     144    LOGICAL ok_stratus ! Ajouter artificiellement les stratus
     145    PARAMETER (ok_stratus=.FALSE.)
     146    !======================================================================
     147    REAL amn, amx
     148    INTEGER igout
     149    !======================================================================
     150    ! Clef controlant l'activation du cycle diurne:
     151    ! en attente du codage des cles par Fred
     152    INTEGER iflag_cycle_diurne
     153    PARAMETER (iflag_cycle_diurne=1)
     154    !======================================================================
     155    ! Modele thermique du sol, a activer pour le cycle diurne:
     156    !cc      LOGICAL soil_model
     157    !cc      PARAMETER (soil_model=.FALSE.)
     158    !======================================================================
     159    ! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
     160    ! le calcul du rayonnement est celle apres la precipitation des nuages.
     161    ! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
     162    ! la condensation et la precipitation. Cette cle augmente les impacts
     163    ! radiatifs des nuages.
     164    !cc      LOGICAL new_oliq
     165    !cc      PARAMETER (new_oliq=.FALSE.)
     166    !======================================================================
     167    ! Clefs controlant deux parametrisations de l'orographie:
     168    !c      LOGICAL ok_orodr
     169    !cc      PARAMETER (ok_orodr=.FALSE.)
     170    !cc      LOGICAL ok_orolf
     171    !cc      PARAMETER (ok_orolf=.FALSE.)
     172    !======================================================================
     173    LOGICAL ok_journe ! sortir le fichier journalier
     174    save ok_journe
     175    !$OMP THREADPRIVATE(ok_journe)
     176    !
     177    LOGICAL ok_mensuel ! sortir le fichier mensuel
     178    save ok_mensuel
     179    !$OMP THREADPRIVATE(ok_mensuel)
     180    !
     181    LOGICAL ok_instan ! sortir le fichier instantane
     182    save ok_instan
     183    !$OMP THREADPRIVATE(ok_instan)
     184    !
     185    LOGICAL ok_LES ! sortir le fichier LES
     186    save ok_LES                           
     187    !$OMP THREADPRIVATE(ok_LES)                 
     188    !
     189    LOGICAL callstats ! sortir le fichier stats
     190    save callstats                           
     191    !$OMP THREADPRIVATE(callstats)                 
     192    !
     193    LOGICAL ok_region ! sortir le fichier regional
     194    PARAMETER (ok_region=.FALSE.)
     195    !======================================================================
     196    real seuil_inversion
     197    save seuil_inversion
     198    !$OMP THREADPRIVATE(seuil_inversion)
     199    integer iflag_ratqs
     200    save iflag_ratqs
     201    !$OMP THREADPRIVATE(iflag_ratqs)
     202    real facteur
     203
     204    REAL wmax_th(klon)
     205    REAL tau_overturning_th(klon)
     206
     207    integer lmax_th(klon)
     208    integer limbas(klon)
     209    real ratqscth(klon,klev)
     210    real ratqsdiff(klon,klev)
     211    real zqsatth(klon,klev)
     212
     213    !======================================================================
     214    !
     215    INTEGER ivap          ! indice de traceurs pour vapeur d'eau
     216    PARAMETER (ivap=1)
     217    INTEGER iliq          ! indice de traceurs pour eau liquide
     218    PARAMETER (iliq=2)
     219    !CR: on ajoute la phase glace
     220    INTEGER isol          ! indice de traceurs pour eau glace
     221    PARAMETER (isol=3)
     222    !
     223    !
     224    ! Variables argument:
     225    !
     226    INTEGER nlon
     227    INTEGER nlev
     228    REAL,INTENT(IN) :: pdtphys_
     229    ! NB: pdtphys to be used in physics is in time_phylmdz_mod
     230    LOGICAL debut, lafin
     231    REAL paprs(klon,klev+1)
     232    REAL pplay(klon,klev)
     233    REAL pphi(klon,klev)
     234    REAL pphis(klon)
     235    REAL presnivs(klev)
     236    REAL znivsig(klev)
     237    real pir
     238
     239    REAL u(klon,klev)
     240    REAL v(klon,klev)
     241
     242    REAL, intent(in):: rot(klon, klev)
     243    ! relative vorticity, in s-1, needed for frontal waves
     244
     245    REAL t(klon,klev),thetal(klon,klev)
     246    ! thetal: ligne suivante a decommenter si vous avez les fichiers
     247    !     MPL 20130625
     248    ! fth_fonctions.F90 et parkind1.F90
     249    ! sinon thetal=theta
     250    !     REAL fth_thetae,fth_thetav,fth_thetal
     251    REAL qx(klon,klev,nqtot)
     252    REAL flxmass_w(klon,klev)
     253    REAL d_u(klon,klev)
     254    REAL d_v(klon,klev)
     255    REAL d_t(klon,klev)
     256    REAL d_qx(klon,klev,nqtot)
     257    REAL d_ps(klon)
     258    ! Variables pour le transport convectif
     259    real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
     260    real wght_cvfd(klon,klev)
    260261#ifndef CPP_XIOS
    261   REAL, SAVE :: missing_val
     262    REAL, SAVE :: missing_val
    262263#endif
    263   ! Variables pour le lessivage convectif
    264   ! RomP >>>
    265   real phi2(klon,klev,klev)
    266   real d1a(klon,klev),dam(klon,klev)
    267   real ev(klon,klev),ep(klon,klev)
    268   real clw(klon,klev),elij(klon,klev,klev)
    269   real epmlmMm(klon,klev,klev),eplaMm(klon,klev)
    270   ! RomP <<<
    271   !IM definition dynamique o_trac dans phys_output_open
    272   !      type(ctrl_out) :: o_trac(nqtot)
    273 
    274   ! variables a une pression donnee
    275   !
    276   include "declare_STDlev.h"
    277   !
    278   !
    279   include "radopt.h"
    280   !
    281   !
    282 
    283 
    284   INTEGER debug
    285   INTEGER n
    286   !ym      INTEGER npoints
    287   !ym      PARAMETER(npoints=klon)
    288   !
    289   INTEGER nregISCtot
    290   PARAMETER(nregISCtot=1)
    291   !
    292   ! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties sur 1 region rectangulaire
    293   ! y compris pour 1 point
    294   ! imin_debut : indice minimum de i; nbpti : nombre de points en direction i (longitude)
    295   ! jmin_debut : indice minimum de j; nbptj : nombre de points en direction j (latitude)
    296   INTEGER imin_debut, nbpti
    297   INTEGER jmin_debut, nbptj
    298   !IM: region='3d' <==> sorties en global
    299   CHARACTER*3 region
    300   PARAMETER(region='3d')
    301   logical ok_hf
    302   !
    303   save ok_hf
    304   !$OMP THREADPRIVATE(ok_hf)
    305 
    306   INTEGER,PARAMETER :: longcles=20
    307   REAL,SAVE :: clesphy0(longcles)
    308   !$OMP THREADPRIVATE(clesphy0)
    309   !
    310   ! Variables propres a la physique
    311   INTEGER itap
    312   SAVE itap                   ! compteur pour la physique
    313   !$OMP THREADPRIVATE(itap)
    314 
    315   INTEGER, SAVE :: abortphy=0   ! Reprere si on doit arreter en fin de phys
    316   !$OMP THREADPRIVATE(abortphy)
    317   !
    318   REAL,save ::  solarlong0
    319   !$OMP THREADPRIVATE(solarlong0)
    320 
    321   !
    322   !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
    323   !
    324   !IM 141004     REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
    325   REAL zulow(klon),zvlow(klon)
    326   !
    327   INTEGER igwd,idx(klon),itest(klon)
    328   !
    329   !      REAL,allocatable,save :: run_off_lic_0(:)
    330 !!$OMP THREADPRIVATE(run_off_lic_0)
    331   !ym      SAVE run_off_lic_0
    332   !KE43
    333   ! Variables liees a la convection de K. Emanuel (sb):
    334   !
    335   REAL bas, top             ! cloud base and top levels
    336   SAVE bas
    337   SAVE top
    338   !$OMP THREADPRIVATE(bas, top)
    339   !------------------------------------------------------------------
    340   ! Upmost level reached by deep convection and related variable (jyg)
    341   !
    342   INTEGER izero
    343   INTEGER k_upper_cv
    344   !------------------------------------------------------------------
    345   !
    346   !=================================================================================================
    347   !CR04.12.07: on ajoute les nouvelles variables du nouveau schema de convection avec poches froides
    348   ! Variables li\'ees \`a la poche froide (jyg)
    349 
    350   REAL mip(klon,klev)  ! mass flux shed by the adiab ascent at each level
    351   !
    352   REAL wape_prescr, fip_prescr
    353   INTEGER it_wape_prescr
    354   SAVE wape_prescr, fip_prescr, it_wape_prescr
    355   !$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)
    356   !
    357   ! variables supplementaires de concvl
    358   REAL Tconv(klon,klev)
    359   REAL sij(klon,klev,klev)
    360 
    361   real, save :: alp_bl_prescr=0.
    362   real, save :: ale_bl_prescr=0.
    363 
    364   real, save :: ale_max=1000.
    365   real, save :: alp_max=2.
    366 
    367   real, save :: wake_s_min_lsp=0.1
    368 
    369   !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
    370   !$OMP THREADPRIVATE(ale_max,alp_max)
    371   !$OMP THREADPRIVATE(wake_s_min_lsp)
    372 
    373 
    374   real ok_wk_lsp(klon)
    375 
    376   !RC
    377   ! Variables li\'ees \`a la poche froide (jyg et rr)
    378   ! Version diagnostique pour l'instant : pas de r\'etroaction sur la convection
    379 
    380   REAL t_wake(klon,klev),q_wake(klon,klev) ! wake pour la convection
    381 
    382   REAL wake_dth(klon,klev)        ! wake : temp pot difference
    383 
    384   REAL wake_d_deltat_gw(klon,klev)! wake : delta T tendency due to Gravity Wave (/s)
    385   REAL wake_omgbdth(klon,klev)    ! Wake : flux of Delta_Theta transported by LS omega
    386   REAL wake_dp_omgb(klon,klev)    ! Wake : vertical gradient of large scale omega
    387   REAL wake_dtKE(klon,klev)       ! Wake : differential heating (wake - unpertubed) CONV
    388   REAL wake_dqKE(klon,klev)       ! Wake : differential moistening (wake - unpertubed) CONV
    389   REAL wake_dtPBL(klon,klev)      ! Wake : differential heating (wake - unpertubed) PBL
    390   REAL wake_dqPBL(klon,klev)      ! Wake : differential moistening (wake - unpertubed) PBL
    391   REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev)
    392   REAL wake_dp_deltomg(klon,klev) ! Wake : gradient vertical de wake_omg
    393   REAL wake_spread(klon,klev)     ! spreading term in wake_delt
    394   !
    395   !pourquoi y'a pas de save??
    396   !
    397   INTEGER wake_k(klon)            ! Wake sommet
    398   !
    399   REAL t_undi(klon,klev)               ! temperature moyenne dans la zone non perturbee
    400   REAL q_undi(klon,klev)               ! humidite moyenne dans la zone non perturbee
    401   !
    402   !jyg<
    403   !cc      REAL wake_pe(klon)              ! Wake potential energy - WAPE
    404   !>jyg
    405 
    406   REAL wake_gfl(klon)             ! Gust Front Length
    407   REAL wake_dens(klon)
    408   !
    409   !
    410   REAL dt_dwn(klon,klev)
    411   REAL dq_dwn(klon,klev)
    412   REAL wdt_PBL(klon,klev)
    413   REAL udt_PBL(klon,klev)
    414   REAL wdq_PBL(klon,klev)
    415   REAL udq_PBL(klon,klev)
    416   REAL M_dwn(klon,klev)
    417   REAL M_up(klon,klev)
    418   REAL dt_a(klon,klev)
    419   REAL dq_a(klon,klev)
    420   REAL d_t_adjwk(klon,klev)                !jyg
    421   REAL d_q_adjwk(klon,klev)                !jyg
    422   LOGICAL,SAVE :: ok_adjwk=.FALSE.
    423   !$OMP THREADPRIVATE(ok_adjwk)
    424   REAL, dimension(klon) :: www
    425   REAL, SAVE :: alp_offset
    426   !$OMP THREADPRIVATE(alp_offset)
    427 
    428 !!!
    429 !=================================================================
    430 !         PROVISOIRE : DECOUPLAGE PBL/WAKE
    431 !         --------------------------------
    432       REAL wake_deltat_sav(klon,klev)
    433       REAL wake_deltaq_sav(klon,klev)
    434 !=================================================================
    435 
    436   !
    437   !RR:fin declarations poches froides
    438   !=======================================================================================================
    439 
    440   REAL ztv(klon,klev),ztva(klon,klev)
    441   REAL zpspsk(klon,klev)
    442   REAL ztla(klon,klev),zqla(klon,klev)
    443   REAL zthl(klon,klev)
    444 
    445   !cc nrlmd le 10/04/2012
    446 
    447   !--------Stochastic Boundary Layer Triggering: ALE_BL--------
    448   !---Propri\'et\'es du thermiques au LCL
    449   real zlcl_th(klon)                                     ! Altitude du LCL calcul\'e continument (pcon dans thermcell_main.F90)
    450   real fraca0(klon)                                      ! Fraction des thermiques au LCL
    451   real w0(klon)                                          ! Vitesse des thermiques au LCL
    452   real w_conv(klon)                                      ! Vitesse verticale de grande \'echelle au LCL
    453   real tke0(klon,klev+1)                                 ! TKE au d\'ebut du pas de temps
    454   real therm_tke_max0(klon)                              ! TKE dans les thermiques au LCL
    455   real env_tke_max0(klon)                                ! TKE dans l'environnement au LCL
    456 
    457   !---D\'eclenchement stochastique
    458   integer :: tau_trig(klon)
    459 
    460   REAL,SAVE :: random_notrig_max=1.
    461   !$OMP THREADPRIVATE(random_notrig_max)
    462 
    463   !--------Statistical Boundary Layer Closure: ALP_BL--------
    464   !---Profils de TKE dans et hors du thermique
    465   real therm_tke_max(klon,klev)                          ! Profil de TKE dans les thermiques
    466   real env_tke_max(klon,klev)                            ! Profil de TKE dans l'environnement
    467 
    468 
    469   !cc fin nrlmd le 10/04/2012
    470 
    471   ! Variables locales pour la couche limite (al1):
    472   !
    473   !Al1      REAL pblh(klon)           ! Hauteur de couche limite
    474   !Al1      SAVE pblh
    475   !34EK
    476   !
    477   ! Variables locales:
    478   !
    479   !AA
    480   !AA  Pour phytrac
    481   REAL u1(klon)             ! vents dans la premiere couche U
    482   REAL v1(klon)             ! vents dans la premiere couche V
    483 
    484   !@$$      LOGICAL offline           ! Controle du stockage ds "physique"
    485   !@$$      PARAMETER (offline=.false.)
    486   !@$$      INTEGER physid
    487   REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
    488   REAL frac_nucl(klon,klev) ! idem (nucleation)
    489   ! RomP >>>
    490   REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
    491   ! RomP <<<
    492 
    493   REAL          :: calday
    494 
    495   !IM cf FH pour Tiedtke 080604
    496   REAL rain_tiedtke(klon),snow_tiedtke(klon)
    497   !
    498   !IM 050204 END
    499   REAL devap(klon) ! evaporation et sa derivee
    500   REAL dsens(klon) ! chaleur sensible et sa derivee
    501 
    502   !
    503   ! Conditions aux limites
    504   !
    505   !
    506   REAL :: day_since_equinox
    507   ! Date de l'equinoxe de printemps
    508   INTEGER, parameter :: mth_eq=3, day_eq=21
    509   REAL :: jD_eq
    510 
    511   LOGICAL, parameter :: new_orbit = .true.
    512 
    513   !
    514   INTEGER lmt_pas
    515   SAVE lmt_pas                ! frequence de mise a jour
    516   !$OMP THREADPRIVATE(lmt_pas)
    517   real zmasse(klon, nbp_lev),exner(klon, nbp_lev)
    518   !     (column-density of mass of air in a cell, in kg m-2)
    519   real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
    520 
    521   !IM sorties
    522   REAL un_jour
    523   PARAMETER(un_jour=86400.)
    524   INTEGER itapm1 !pas de temps de la physique du(es) mois precedents
    525   SAVE itapm1    !mis a jour le dernier pas de temps du mois en cours
    526   !$OMP THREADPRIVATE(itapm1)
    527   !======================================================================
    528   !
    529   ! Declaration des procedures appelees
    530   !
    531   EXTERNAL angle     ! calculer angle zenithal du soleil
    532   EXTERNAL alboc     ! calculer l'albedo sur ocean
    533   EXTERNAL ajsec     ! ajustement sec
    534   EXTERNAL conlmd    ! convection (schema LMD)
    535   !KE43
    536   EXTERNAL conema3  ! convect4.3
    537   EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
    538   !AA
    539   ! JBM (3/14) fisrtilp_tr not loaded
    540   ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
    541   !                          ! stockage des coefficients necessaires au
    542   !                          ! lessivage OFF-LINE et ON-LINE
    543   EXTERNAL hgardfou  ! verifier les temperatures
    544   EXTERNAL nuage     ! calculer les proprietes radiatives
    545   !C      EXTERNAL o3cm      ! initialiser l'ozone
    546   EXTERNAL orbite    ! calculer l'orbite terrestre
    547   EXTERNAL phyetat0  ! lire l'etat initial de la physique
    548   EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
    549   EXTERNAL suphel    ! initialiser certaines constantes
    550   EXTERNAL transp    ! transport total de l'eau et de l'energie
    551   !IM
    552   EXTERNAL haut2bas  !variables de haut en bas
    553   EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
    554   EXTERNAL undefSTD      !somme les valeurs definies d'1 var a 1 niveau de pression
    555   !     EXTERNAL moy_undefSTD  !moyenne d'1 var a 1 niveau de pression
    556   !     EXTERNAL moyglo_aire   !moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)
    557   !                            !par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)
    558   !
    559   !
    560 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    561   ! Local variables
    562 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    563   !
    564   REAL rhcl(klon,klev)    ! humiditi relative ciel clair
    565   REAL dialiq(klon,klev)  ! eau liquide nuageuse
    566   REAL diafra(klon,klev)  ! fraction nuageuse
    567   REAL cldliq(klon,klev)  ! eau liquide nuageuse
    568   !
    569   !XXX PB
    570   REAL fluxq(klon,klev, nbsrf)   ! flux turbulent d'humidite
    571   !
    572   REAL zxfluxt(klon, klev)
    573   REAL zxfluxq(klon, klev)
    574   REAL zxfluxu(klon, klev)
    575   REAL zxfluxv(klon, klev)
    576 
    577   ! Le rayonnement n'est pas calcule tous les pas, il faut donc
    578   !                      sauvegarder les sorties du rayonnement
    579   !ym      SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
    580   !ym      SAVE  sollwdownclr, toplwdown, toplwdownclr
    581   !ym      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0
    582   !
    583   INTEGER itaprad
    584   SAVE itaprad
    585   !$OMP THREADPRIVATE(itaprad)
    586   !
    587   REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
    588   REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
    589 
    590   !
    591   !  REAL zxsnow(klon)
    592   REAL zxsnow_dummy(klon)
    593   REAL zsav_tsol(klon)
    594   !
    595   REAL dist, rmu0(klon), fract(klon)
    596   REAL zrmu0(klon), zfract(klon)
    597   REAL zdtime, zdtime1, zdtime2, zlongi
    598   !
    599   REAL qcheck
    600   REAL z_avant(klon), z_apres(klon), z_factor(klon)
    601   LOGICAL zx_ajustq
    602   !
    603   REAL za, zb
    604   REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
    605   real zqsat(klon,klev)
    606 !
    607   INTEGER i, k, iq, ig, j, nsrf, ll, l, iiq
    608 !
    609   REAL t_coup
    610   PARAMETER (t_coup=234.0)
    611 
    612   !ym A voir plus tard !!
    613   !ym      REAL zx_relief(iim,jjmp1)
    614   !ym      REAL zx_aire(iim,jjmp1)
    615   !
    616   ! Grandeurs de sorties
    617   REAL s_capCL(klon)
    618   REAL s_oliqCL(klon), s_cteiCL(klon)
    619   REAL s_trmb1(klon), s_trmb2(klon)
    620   REAL s_trmb3(klon)
    621   !KE43
    622   ! Variables locales pour la convection de K. Emanuel (sb):
    623 
    624   REAL tvp(klon,klev)       ! virtual temp of lifted parcel
    625   CHARACTER*40 capemaxcels  !max(CAPE)
    626 
    627   REAL rflag(klon)          ! flag fonctionnement de convect
    628   INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
    629 
    630   ! -- convect43:
    631   INTEGER ntra              ! nb traceurs pour convect4.3
    632   REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
    633   REAL dplcldt(klon), dplcldr(klon)
    634   !?     .     condm_con(klon,klev),conda_con(klon,klev),
    635   !?     .     mr_con(klon,klev),ep_con(klon,klev)
    636   !?     .    ,sadiab(klon,klev),wadiab(klon,klev)
    637   ! --
    638   !34EK
    639   !
    640   ! Variables du changement
    641   !
    642   ! con: convection
    643   ! lsc: condensation a grande echelle (Large-Scale-Condensation)
    644   ! ajs: ajustement sec
    645   ! eva: evaporation de l'eau liquide nuageuse
    646   ! vdf: couche limite (Vertical DiFfusion)
    647 
    648   ! tendance nulles
    649   REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0
    650 
    651   !
    652   !********************************************************
    653   !     declarations
    654 
    655   !********************************************************
    656   !IM 081204 END
    657   !
    658   REAL pen_u(klon,klev), pen_d(klon,klev)
    659   REAL pde_u(klon,klev), pde_d(klon,klev)
    660   INTEGER kcbot(klon), kctop(klon), kdtop(klon)
    661   !
    662   REAL ratqsc(klon,klev)
    663   real ratqsbas,ratqshaut,tau_ratqs
    664   save ratqsbas,ratqshaut,tau_ratqs
    665   !$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)
    666 
    667   ! Parametres lies au nouveau schema de nuages (SB, PDF)
    668   real fact_cldcon
    669   real facttemps
    670   logical ok_newmicro
    671   save ok_newmicro
    672   !$OMP THREADPRIVATE(ok_newmicro)
    673   !real ref_liq_pi(klon,klev), ref_ice_pi(klon,klev)
    674   save fact_cldcon,facttemps
    675   !$OMP THREADPRIVATE(fact_cldcon,facttemps)
    676 
    677   integer iflag_cld_th
    678   save iflag_cld_th
    679   !$OMP THREADPRIVATE(iflag_cld_th)
    680   logical ptconv(klon,klev)
    681   !IM cf. AM 081204 BEG
    682   logical ptconvth(klon,klev)
    683   !IM cf. AM 081204 END
    684   !
    685   ! Variables liees a l'ecriture de la bande histoire physique
    686   !
    687   !======================================================================
    688   !
    689 
    690   !
    691   integer itau_w   ! pas de temps ecriture = itap + itau_phy
    692   !
    693   !
    694   ! Variables locales pour effectuer les appels en serie
    695   !
    696   !IM RH a 2m (la surface)
    697   REAL Lheat
    698 
    699   INTEGER        length
    700   PARAMETER    ( length = 100 )
    701   REAL tabcntr0( length       )
    702   !
    703   INTEGER ndex2d(nbp_lon*nbp_lat)
    704   !IM
    705   !
    706   !IM AMIP2 BEG
    707   REAL moyglo, mountor
    708   !IM 141004 BEG
    709   REAL zustrdr(klon), zvstrdr(klon)
    710   REAL zustrli(klon), zvstrli(klon)
    711   REAL zustrph(klon), zvstrph(klon)
    712   REAL aam, torsfc
    713   !IM 141004 END
    714   !IM 190504 BEG
    715   INTEGER ij
    716 !  INTEGER imp1jmp1
    717 !  PARAMETER(imp1jmp1=(iim+1)*jjmp1)
    718   !ym A voir plus tard
    719 !  REAL zx_tmp((nbp_lon+1)*nbp_lat)
    720 !  REAL airedyn(nbp_lon+1,nbp_lat)
    721   !IM 190504 END
    722   LOGICAL ok_msk
    723   REAL msk(klon)
    724   !IM
    725   REAL airetot, pi
    726   !ym A voir plus tard
    727   !ym      REAL zm_wo(jjmp1, klev)
    728   !IM AMIP2 END
    729   !
    730   REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
    731   REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
    732   REAL zx_tmp_2d(nbp_lon,nbp_lat)
    733   REAL zx_lon(nbp_lon,nbp_lat)
    734   REAL zx_lat(nbp_lon,nbp_lat)
    735   !
    736   INTEGER nid_day_seri, nid_ctesGCM
    737   SAVE nid_day_seri, nid_ctesGCM
    738   !$OMP THREADPRIVATE(nid_day_seri,nid_ctesGCM)
    739   !
    740   !IM 280405 BEG
    741   !  INTEGER nid_bilKPins, nid_bilKPave
    742   !  SAVE nid_bilKPins, nid_bilKPave
    743   !  !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)
    744   !
    745   REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
    746   REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert.
    747   REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert.
    748   REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert.
    749   !
    750   INTEGER nhori, nvert
    751   REAL zsto
    752   REAL zstophy, zout
    753 
    754   real zjulian
    755   save zjulian
    756   !$OMP THREADPRIVATE(zjulian)
    757 
    758   character*20 modname
    759   character*80 abort_message
    760   logical, save ::  ok_sync, ok_sync_omp
    761   !$OMP THREADPRIVATE(ok_sync)
    762   real date0
    763   integer idayref
    764 
    765   ! essai writephys
    766   integer fid_day, fid_mth, fid_ins
    767   parameter (fid_ins = 1, fid_day = 2, fid_mth = 3)
    768   integer prof2d_on, prof3d_on, prof2d_av, prof3d_av
    769   parameter (prof2d_on = 1, prof3d_on = 2, &
    770        prof2d_av = 3, prof3d_av = 4)
    771   !     Variables liees au bilan d'energie et d'enthalpi
    772   REAL ztsol(klon)
    773   REAL      d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
    774   REAL      d_h_vcol_phy
    775   REAL      fs_bound, fq_bound
    776   SAVE      d_h_vcol_phy
    777   !$OMP THREADPRIVATE(d_h_vcol_phy)
    778   REAL      zero_v(klon)
    779   CHARACTER*40 ztit
    780   INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
    781   SAVE      ip_ebil
    782   DATA      ip_ebil/0/
    783   !$OMP THREADPRIVATE(ip_ebil)
    784   INTEGER   if_ebil ! level for energy conserv. dignostics
    785   SAVE      if_ebil
    786   !$OMP THREADPRIVATE(if_ebil)
    787   REAL q2m(klon,nbsrf)  ! humidite a 2m
    788 
    789   !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
    790   CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
    791   CHARACTER*40 tinst, tave, typeval
    792   REAL cldtaupi(klon,klev)  ! Cloud optical thickness for pre-industrial (pi) aerosols
    793 
    794 
    795   ! Aerosol optical properties
    796   CHARACTER*4, DIMENSION(naero_grp) :: rfname
    797   REAL, DIMENSION(klon,klev)     :: mass_solu_aero    ! total mass concentration for all soluble aerosols[ug/m3]
    798   REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi ! - " - (pre-industrial value)
    799 
    800   ! Parameters
    801   LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not
    802   LOGICAL ok_cdnc          ! ok cloud droplet number concentration (O. Boucher 01-2013)
    803   REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)
    804   SAVE ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1
    805   !$OMP THREADPRIVATE(ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1)
    806   LOGICAL, SAVE :: aerosol_couple ! true  : calcul des aerosols dans INCA
    807   ! false : lecture des aerosol dans un fichier
    808   !$OMP THREADPRIVATE(aerosol_couple)   
    809   INTEGER, SAVE :: flag_aerosol
    810   !$OMP THREADPRIVATE(flag_aerosol)
    811   LOGICAL, SAVE :: new_aod
    812   !$OMP THREADPRIVATE(new_aod)
    813   !
    814   !--STRAT AEROSOL
    815   LOGICAL, SAVE :: flag_aerosol_strat
    816   !$OMP THREADPRIVATE(flag_aerosol_strat)
    817   !c-fin STRAT AEROSOL
    818   !
    819   ! Declaration des constantes et des fonctions thermodynamiques
    820   !
    821   LOGICAL,SAVE :: first=.true.
    822   !$OMP THREADPRIVATE(first)
    823 
    824   integer, save::  read_climoz ! read ozone climatology
    825   !     (let it keep the default OpenMP shared attribute)
    826   !     Allowed values are 0, 1 and 2
    827   !     0: do not read an ozone climatology
    828   !     1: read a single ozone climatology that will be used day and night
    829   !     2: read two ozone climatologies, the average day and night
    830   !     climatology and the daylight climatology
    831 
    832   integer, save:: ncid_climoz ! NetCDF file containing ozone climatologies
    833   !     (let it keep the default OpenMP shared attribute)
    834 
    835   real, pointer, save:: press_climoz(:)
    836   !     (let it keep the default OpenMP shared attribute)
    837   !     edges of pressure intervals for ozone climatologies, in Pa, in strictly
    838   !     ascending order
    839 
    840   integer, save:: co3i = 0
    841   !     time index in NetCDF file of current ozone fields
    842   !$OMP THREADPRIVATE(co3i)
    843 
    844   integer ro3i
    845   !     required time index in NetCDF file for the ozone fields, between 1
    846   !     and 360
    847 
    848   INTEGER ierr
    849   include "YOMCST.h"
    850   include "YOETHF.h"
    851   include "FCTTRE.h"
    852   !IM 100106 BEG : pouvoir sortir les ctes de la physique
    853   include "conema3.h"
    854   include "fisrtilp.h"
    855   include "nuage.h"
    856   include "compbl.h"
    857   !IM 100106 END : pouvoir sortir les ctes de la physique
    858   !
    859 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    860   ! Declarations pour Simulateur COSP
    861   !============================================================
    862   real :: mr_ozone(klon,klev)
    863 
    864   !IM sorties fichier 1D paramLMDZ_phy.nc
    865   REAL :: zx_tmp_0d(1,1)
    866   INTEGER, PARAMETER :: np=1
    867   REAL,dimension(klon_glo)        :: rlat_glo
    868   REAL,dimension(klon_glo)        :: rlon_glo
    869   REAL gbils(1), gevap(1), gevapt(1), glat(1), gnet0(1), gnet(1)
    870   REAL grain(1), gtsol(1), gt2m(1), gprw(1)
    871 
    872   !IM stations CFMIP
    873   INTEGER, SAVE :: nCFMIP
    874   !$OMP THREADPRIVATE(nCFMIP)
    875   INTEGER, PARAMETER :: npCFMIP=120
    876   INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:)
    877   REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:)
    878   !$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP)
    879   INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:)
    880   REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:)
    881   !$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM)
    882   INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
    883   !$OMP THREADPRIVATE(iGCM, jGCM)
    884   logical, dimension(nfiles)            :: phys_out_filestations
    885   logical, parameter :: lNMC=.FALSE.
    886 
    887   !IM betaCRF
    888   REAL, SAVE :: pfree, beta_pbl, beta_free
    889   !$OMP THREADPRIVATE(pfree, beta_pbl, beta_free)
    890   REAL, SAVE :: lon1_beta,  lon2_beta, lat1_beta, lat2_beta
    891   !$OMP THREADPRIVATE(lon1_beta,  lon2_beta, lat1_beta, lat2_beta)
    892   LOGICAL, SAVE :: mskocean_beta
    893   !$OMP THREADPRIVATE(mskocean_beta)
    894   REAL, dimension(klon, klev) :: beta         ! facteur sur cldtaurad et cldemirad pour evaluer les retros liees aux CRF
    895   REAL, dimension(klon, klev) :: cldtaurad    ! epaisseur optique pour radlwsw pour tester "CRF off"
    896   REAL, dimension(klon, klev) :: cldtaupirad  ! epaisseur optique pour radlwsw pour tester "CRF off"
    897   REAL, dimension(klon, klev) :: cldemirad    ! emissivite pour radlwsw pour tester "CRF off"
    898   REAL, dimension(klon, klev) :: cldfrarad    ! fraction nuageuse
    899 
    900   INTEGER :: nbtr_tmp ! Number of tracer inside concvl
    901   REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
    902   integer iostat
    903 
    904   REAL zzz
    905 !albedo SB >>>
    906   real,dimension(6),save :: SFRWL
    907 !albedo SB <<<
    908 
    909   ! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
    910   jjmp1=nbp_lat
    911 
    912   !======================================================================
    913   ! Gestion calendrier : mise a jour du module phys_cal_mod
    914   !
    915   pdtphys=pdtphys_
    916   CALL update_time(pdtphys)
    917 
    918   !======================================================================
    919   ! Ecriture eventuelle d'un profil verticale en entree de la physique.
    920   ! Utilise notamment en 1D mais peut etre active egalement en 3D
    921   ! en imposant la valeur de igout.
    922   !======================================================================d
    923   if (prt_level.ge.1) then
    924      igout=klon/2+1/klon
    925      write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    926      write(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), longitude_deg(igout)
    927      write(lunout,*) &
    928           'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
    929      write(lunout,*) &
    930           nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys
    931 
    932      write(lunout,*) 'paprs, play, phi, u, v, t'
    933      do k=1,klev
    934         write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
    935              u(igout,k),v(igout,k),t(igout,k)
    936      enddo
    937      write(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
    938      do k=1,klev
    939         write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
    940      enddo
    941   endif
    942 
    943   !======================================================================
    944 
    945   if (first) then
    946      
    947      !CR:nvelles variables convection/poches froides
    948 
    949      print*, '================================================='
    950      print*, 'Allocation des variables locales et sauvegardees'
    951      call phys_local_var_init
    952      !
    953      pasphys=pdtphys
    954      !     appel a la lecture du run.def physique
    955      call conf_phys(ok_journe, ok_mensuel, &
    956           ok_instan, ok_hf, &
    957           ok_LES, &
    958           callstats, &
    959           solarlong0,seuil_inversion, &
    960           fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
    961           iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
    962           ok_ade, ok_aie, ok_cdnc, aerosol_couple,  &
    963           flag_aerosol, flag_aerosol_strat, new_aod, &
    964           bl95_b0, bl95_b1, &
    965           !     nv flags pour la convection et les poches froides
    966           read_climoz, &
    967           alp_offset)
    968      call phys_state_var_init(read_climoz)
    969      call phys_output_var_init
    970      print*, '================================================='
    971      !
    972 !CR: check sur le nb de traceurs de l eau
    973      if ((iflag_ice_thermo.gt.0).and.(nqo==2)) then
    974           WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers (H2Ov, H2Ol, H2Oi)', ' but nqo=', nqo, &
    975           '. Might as well stop here.'
     264    ! Variables pour le lessivage convectif
     265    ! RomP >>>
     266    real phi2(klon,klev,klev)
     267    real d1a(klon,klev),dam(klon,klev)
     268    real ev(klon,klev)
     269    real clw(klon,klev),elij(klon,klev,klev)
     270    real epmlmMm(klon,klev,klev),eplaMm(klon,klev)
     271    ! RomP <<<
     272    !IM definition dynamique o_trac dans phys_output_open
     273    !      type(ctrl_out) :: o_trac(nqtot)
     274
     275    ! variables a une pression donnee
     276    !
     277    include "declare_STDlev.h"
     278    !
     279    !
     280    include "radopt.h"
     281    !
     282    !
     283
     284
     285    INTEGER debug
     286    INTEGER n
     287    !ym      INTEGER npoints
     288    !ym      PARAMETER(npoints=klon)
     289    !
     290    INTEGER nregISCtot
     291    PARAMETER(nregISCtot=1)
     292    !
     293    ! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties
     294    ! sur 1 region rectangulaire y compris pour 1 point
     295    ! imin_debut : indice minimum de i; nbpti : nombre de points en
     296    ! direction i (longitude)
     297    ! jmin_debut : indice minimum de j; nbptj : nombre de points en
     298    ! direction j (latitude)
     299    INTEGER imin_debut, nbpti
     300    INTEGER jmin_debut, nbptj
     301    !IM: region='3d' <==> sorties en global
     302    CHARACTER*3 region
     303    PARAMETER(region='3d')
     304    logical ok_hf
     305    !
     306    save ok_hf
     307    !$OMP THREADPRIVATE(ok_hf)
     308
     309    INTEGER,PARAMETER :: longcles=20
     310    REAL,SAVE :: clesphy0(longcles)
     311    !$OMP THREADPRIVATE(clesphy0)
     312    !
     313    ! Variables propres a la physique
     314    INTEGER itap
     315    SAVE itap                   ! compteur pour la physique
     316    !$OMP THREADPRIVATE(itap)
     317
     318    INTEGER, SAVE :: abortphy=0   ! Reprere si on doit arreter en fin de phys
     319    !$OMP THREADPRIVATE(abortphy)
     320    !
     321    REAL,save ::  solarlong0
     322    !$OMP THREADPRIVATE(solarlong0)
     323
     324    !
     325    !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
     326    !
     327    !IM 141004     REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
     328    REAL zulow(klon),zvlow(klon)
     329    !
     330    INTEGER igwd,idx(klon),itest(klon)
     331    !
     332    !      REAL,allocatable,save :: run_off_lic_0(:)
     333    ! !$OMP THREADPRIVATE(run_off_lic_0)
     334    !ym      SAVE run_off_lic_0
     335    !KE43
     336    ! Variables liees a la convection de K. Emanuel (sb):
     337    !
     338    REAL bas, top             ! cloud base and top levels
     339    SAVE bas
     340    SAVE top
     341    !$OMP THREADPRIVATE(bas, top)
     342    !------------------------------------------------------------------
     343    ! Upmost level reached by deep convection and related variable (jyg)
     344    !
     345    INTEGER izero
     346    INTEGER k_upper_cv
     347    !------------------------------------------------------------------
     348    !
     349    !==========================================================================
     350    !CR04.12.07: on ajoute les nouvelles variables du nouveau schema
     351    !de convection avec poches froides
     352    ! Variables li\'ees \`a la poche froide (jyg)
     353
     354    REAL mip(klon,klev)  ! mass flux shed by the adiab ascent at each level
     355    !
     356    REAL wape_prescr, fip_prescr
     357    INTEGER it_wape_prescr
     358    SAVE wape_prescr, fip_prescr, it_wape_prescr
     359    !$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)
     360    !
     361    ! variables supplementaires de concvl
     362    REAL Tconv(klon,klev)
     363    REAL sij(klon,klev,klev)
     364
     365    real, save :: alp_bl_prescr=0.
     366    real, save :: ale_bl_prescr=0.
     367
     368    real, save :: ale_max=1000.
     369    real, save :: alp_max=2.
     370
     371    real, save :: wake_s_min_lsp=0.1
     372
     373    !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
     374    !$OMP THREADPRIVATE(ale_max,alp_max)
     375    !$OMP THREADPRIVATE(wake_s_min_lsp)
     376
     377
     378    real ok_wk_lsp(klon)
     379
     380    !RC
     381    ! Variables li\'ees \`a la poche froide (jyg et rr)
     382    ! Version diagnostique pour l'instant : pas de r\'etroaction sur
     383    ! la convection
     384
     385    REAL t_wake(klon,klev),q_wake(klon,klev) ! wake pour la convection
     386
     387    REAL wake_dth(klon,klev)        ! wake : temp pot difference
     388
     389    REAL wake_d_deltat_gw(klon,klev)! wake : delta T tendency due to
     390    ! Gravity Wave (/s)
     391    REAL wake_omgbdth(klon,klev)    ! Wake : flux of Delta_Theta
     392    ! transported by LS omega
     393    REAL wake_dp_omgb(klon,klev)    ! Wake : vertical gradient of
     394    ! large scale omega
     395    REAL wake_dtKE(klon,klev)       ! Wake : differential heating
     396    ! (wake - unpertubed) CONV
     397    REAL wake_dqKE(klon,klev)       ! Wake : differential moistening
     398    ! (wake - unpertubed) CONV
     399    REAL wake_dtPBL(klon,klev)      ! Wake : differential heating
     400    ! (wake - unpertubed) PBL
     401    REAL wake_dqPBL(klon,klev)      ! Wake : differential moistening
     402    ! (wake - unpertubed) PBL
     403    REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev)
     404    REAL wake_dp_deltomg(klon,klev) ! Wake : gradient vertical de wake_omg
     405    REAL wake_spread(klon,klev)     ! spreading term in wake_delt
     406    !
     407    !pourquoi y'a pas de save??
     408    !
     409    INTEGER wake_k(klon)            ! Wake sommet
     410    !
     411    REAL t_undi(klon,klev)          ! temperature moyenne dans la zone
     412    ! non perturbee
     413    REAL q_undi(klon,klev)          ! humidite moyenne dans la zone
     414    ! non perturbee
     415    !
     416    !jyg<
     417    !cc      REAL wake_pe(klon)              ! Wake potential energy - WAPE
     418    !>jyg
     419
     420    REAL wake_gfl(klon)             ! Gust Front Length
     421    REAL wake_dens(klon)
     422    !
     423    !
     424    REAL dt_dwn(klon,klev)
     425    REAL dq_dwn(klon,klev)
     426    REAL wdt_PBL(klon,klev)
     427    REAL udt_PBL(klon,klev)
     428    REAL wdq_PBL(klon,klev)
     429    REAL udq_PBL(klon,klev)
     430    REAL M_dwn(klon,klev)
     431    REAL M_up(klon,klev)
     432    REAL dt_a(klon,klev)
     433    REAL dq_a(klon,klev)
     434    REAL d_t_adjwk(klon,klev)                !jyg
     435    REAL d_q_adjwk(klon,klev)                !jyg
     436    LOGICAL,SAVE :: ok_adjwk=.FALSE.
     437    !$OMP THREADPRIVATE(ok_adjwk)
     438    REAL, dimension(klon) :: www
     439    REAL, SAVE :: alp_offset
     440    !$OMP THREADPRIVATE(alp_offset)
     441
     442    ! !!
     443    !=================================================================
     444    !         PROVISOIRE : DECOUPLAGE PBL/WAKE
     445    !         --------------------------------
     446    REAL wake_deltat_sav(klon,klev)
     447    REAL wake_deltaq_sav(klon,klev)
     448    !=================================================================
     449
     450    !
     451    !RR:fin declarations poches froides
     452    !==========================================================================
     453
     454    REAL ztv(klon,klev),ztva(klon,klev)
     455    REAL zpspsk(klon,klev)
     456    REAL ztla(klon,klev),zqla(klon,klev)
     457    REAL zthl(klon,klev)
     458
     459    !cc nrlmd le 10/04/2012
     460
     461    !--------Stochastic Boundary Layer Triggering: ALE_BL--------
     462    !---Propri\'et\'es du thermiques au LCL
     463    real zlcl_th(klon)          ! Altitude du LCL calcul\'e
     464    ! continument (pcon dans
     465    ! thermcell_main.F90)
     466    real fraca0(klon)           ! Fraction des thermiques au LCL
     467    real w0(klon)               ! Vitesse des thermiques au LCL
     468    real w_conv(klon)           ! Vitesse verticale de grande \'echelle au LCL
     469    real tke0(klon,klev+1)      ! TKE au d\'ebut du pas de temps
     470    real therm_tke_max0(klon)   ! TKE dans les thermiques au LCL
     471    real env_tke_max0(klon)     ! TKE dans l'environnement au LCL
     472
     473    !---D\'eclenchement stochastique
     474    integer :: tau_trig(klon)
     475
     476    REAL,SAVE :: random_notrig_max=1.
     477    !$OMP THREADPRIVATE(random_notrig_max)
     478
     479    !--------Statistical Boundary Layer Closure: ALP_BL--------
     480    !---Profils de TKE dans et hors du thermique
     481    real therm_tke_max(klon,klev)   ! Profil de TKE dans les thermiques
     482    real env_tke_max(klon,klev)     ! Profil de TKE dans l'environnement
     483
     484
     485    !cc fin nrlmd le 10/04/2012
     486
     487    ! Variables locales pour la couche limite (al1):
     488    !
     489    !Al1      REAL pblh(klon)           ! Hauteur de couche limite
     490    !Al1      SAVE pblh
     491    !34EK
     492    !
     493    ! Variables locales:
     494    !
     495    !AA
     496    !AA  Pour phytrac
     497    REAL u1(klon)             ! vents dans la premiere couche U
     498    REAL v1(klon)             ! vents dans la premiere couche V
     499
     500    !@$$      LOGICAL offline           ! Controle du stockage ds "physique"
     501    !@$$      PARAMETER (offline=.false.)
     502    !@$$      INTEGER physid
     503    REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
     504    REAL frac_nucl(klon,klev) ! idem (nucleation)
     505    ! RomP >>>
     506    REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
     507    ! RomP <<<
     508
     509    REAL          :: calday
     510
     511    !IM cf FH pour Tiedtke 080604
     512    REAL rain_tiedtke(klon),snow_tiedtke(klon)
     513    !
     514    !IM 050204 END
     515    REAL devap(klon) ! evaporation et sa derivee
     516    REAL dsens(klon) ! chaleur sensible et sa derivee
     517
     518    !
     519    ! Conditions aux limites
     520    !
     521    !
     522    REAL :: day_since_equinox
     523    ! Date de l'equinoxe de printemps
     524    INTEGER, parameter :: mth_eq=3, day_eq=21
     525    REAL :: jD_eq
     526
     527    LOGICAL, parameter :: new_orbit = .true.
     528
     529    !
     530    INTEGER lmt_pas
     531    SAVE lmt_pas                ! frequence de mise a jour
     532    !$OMP THREADPRIVATE(lmt_pas)
     533    real zmasse(klon, nbp_lev),exner(klon, nbp_lev)
     534    !     (column-density of mass of air in a cell, in kg m-2)
     535    real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
     536
     537    !IM sorties
     538    REAL un_jour
     539    PARAMETER(un_jour=86400.)
     540    INTEGER itapm1 !pas de temps de la physique du(es) mois precedents
     541    SAVE itapm1    !mis a jour le dernier pas de temps du mois en cours
     542    !$OMP THREADPRIVATE(itapm1)
     543    !======================================================================
     544    !
     545    ! Declaration des procedures appelees
     546    !
     547    EXTERNAL angle     ! calculer angle zenithal du soleil
     548    EXTERNAL alboc     ! calculer l'albedo sur ocean
     549    EXTERNAL ajsec     ! ajustement sec
     550    EXTERNAL conlmd    ! convection (schema LMD)
     551    !KE43
     552    EXTERNAL conema3  ! convect4.3
     553    EXTERNAL fisrtilp  ! schema de condensation a grande echelle (pluie)
     554    !AA
     555    ! JBM (3/14) fisrtilp_tr not loaded
     556    ! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
     557    !                          ! stockage des coefficients necessaires au
     558    !                          ! lessivage OFF-LINE et ON-LINE
     559    EXTERNAL hgardfou  ! verifier les temperatures
     560    EXTERNAL nuage     ! calculer les proprietes radiatives
     561    !C      EXTERNAL o3cm      ! initialiser l'ozone
     562    EXTERNAL orbite    ! calculer l'orbite terrestre
     563    EXTERNAL phyetat0  ! lire l'etat initial de la physique
     564    EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
     565    EXTERNAL suphel    ! initialiser certaines constantes
     566    EXTERNAL transp    ! transport total de l'eau et de l'energie
     567    !IM
     568    EXTERNAL haut2bas  !variables de haut en bas
     569    EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
     570    EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression
     571    !     EXTERNAL moy_undefSTD  !moyenne d'1 var a 1 niveau de pression
     572    ! EXTERNAL moyglo_aire
     573    ! moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)
     574    ! par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)
     575    !
     576    !
     577    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     578    ! Local variables
     579    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     580    !
     581    REAL rhcl(klon,klev)    ! humiditi relative ciel clair
     582    REAL dialiq(klon,klev)  ! eau liquide nuageuse
     583    REAL diafra(klon,klev)  ! fraction nuageuse
     584    REAL cldliq(klon,klev)  ! eau liquide nuageuse
     585    !
     586    !XXX PB
     587    REAL fluxq(klon,klev, nbsrf)   ! flux turbulent d'humidite
     588    !
     589    REAL zxfluxt(klon, klev)
     590    REAL zxfluxq(klon, klev)
     591    REAL zxfluxu(klon, klev)
     592    REAL zxfluxv(klon, klev)
     593
     594    ! Le rayonnement n'est pas calcule tous les pas, il faut donc
     595    !                      sauvegarder les sorties du rayonnement
     596    !ym      SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
     597    !ym      SAVE  sollwdownclr, toplwdown, toplwdownclr
     598    !ym      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0
     599    !
     600    INTEGER itaprad
     601    SAVE itaprad
     602    !$OMP THREADPRIVATE(itaprad)
     603    !
     604    REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
     605    REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
     606
     607    !
     608    !  REAL zxsnow(klon)
     609    REAL zxsnow_dummy(klon)
     610    REAL zsav_tsol(klon)
     611    !
     612    REAL dist, rmu0(klon), fract(klon)
     613    REAL zrmu0(klon), zfract(klon)
     614    REAL zdtime, zdtime1, zdtime2, zlongi
     615    !
     616    REAL qcheck
     617    REAL z_avant(klon), z_apres(klon), z_factor(klon)
     618    LOGICAL zx_ajustq
     619    !
     620    REAL za, zb
     621    REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
     622    real zqsat(klon,klev)
     623    !
     624    INTEGER i, k, iq, ig, j, nsrf, ll, l, iiq
     625    !
     626    REAL t_coup
     627    PARAMETER (t_coup=234.0)
     628
     629    !ym A voir plus tard !!
     630    !ym      REAL zx_relief(iim,jjmp1)
     631    !ym      REAL zx_aire(iim,jjmp1)
     632    !
     633    ! Grandeurs de sorties
     634    REAL s_capCL(klon)
     635    REAL s_oliqCL(klon), s_cteiCL(klon)
     636    REAL s_trmb1(klon), s_trmb2(klon)
     637    REAL s_trmb3(klon)
     638    !KE43
     639    ! Variables locales pour la convection de K. Emanuel (sb):
     640
     641    REAL tvp(klon,klev)       ! virtual temp of lifted parcel
     642    CHARACTER*40 capemaxcels  !max(CAPE)
     643
     644    REAL rflag(klon)          ! flag fonctionnement de convect
     645    INTEGER iflagctrl(klon)          ! flag fonctionnement de convect
     646
     647    ! -- convect43:
     648    INTEGER ntra              ! nb traceurs pour convect4.3
     649    REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
     650    REAL dplcldt(klon), dplcldr(klon)
     651    !?     .     condm_con(klon,klev),conda_con(klon,klev),
     652    !?     .     mr_con(klon,klev),ep_con(klon,klev)
     653    !?     .    ,sadiab(klon,klev),wadiab(klon,klev)
     654    ! --
     655    !34EK
     656    !
     657    ! Variables du changement
     658    !
     659    ! con: convection
     660    ! lsc: condensation a grande echelle (Large-Scale-Condensation)
     661    ! ajs: ajustement sec
     662    ! eva: evaporation de l'eau liquide nuageuse
     663    ! vdf: couche limite (Vertical DiFfusion)
     664
     665    ! tendance nulles
     666    REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0
     667
     668    !
     669    !********************************************************
     670    !     declarations
     671
     672    !********************************************************
     673    !IM 081204 END
     674    !
     675    REAL pen_u(klon,klev), pen_d(klon,klev)
     676    REAL pde_u(klon,klev), pde_d(klon,klev)
     677    INTEGER kcbot(klon), kctop(klon), kdtop(klon)
     678    !
     679    REAL ratqsc(klon,klev)
     680    real ratqsbas,ratqshaut,tau_ratqs
     681    save ratqsbas,ratqshaut,tau_ratqs
     682    !$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)
     683
     684    ! Parametres lies au nouveau schema de nuages (SB, PDF)
     685    real fact_cldcon
     686    real facttemps
     687    logical ok_newmicro
     688    save ok_newmicro
     689    !$OMP THREADPRIVATE(ok_newmicro)
     690    !real ref_liq_pi(klon,klev), ref_ice_pi(klon,klev)
     691    save fact_cldcon,facttemps
     692    !$OMP THREADPRIVATE(fact_cldcon,facttemps)
     693
     694    integer iflag_cld_th
     695    save iflag_cld_th
     696    !$OMP THREADPRIVATE(iflag_cld_th)
     697    logical ptconv(klon,klev)
     698    !IM cf. AM 081204 BEG
     699    logical ptconvth(klon,klev)
     700    !IM cf. AM 081204 END
     701    !
     702    ! Variables liees a l'ecriture de la bande histoire physique
     703    !
     704    !======================================================================
     705    !
     706
     707    !
     708    integer itau_w   ! pas de temps ecriture = itap + itau_phy
     709    !
     710    !
     711    ! Variables locales pour effectuer les appels en serie
     712    !
     713    !IM RH a 2m (la surface)
     714    REAL Lheat
     715
     716    INTEGER        length
     717    PARAMETER    ( length = 100 )
     718    REAL tabcntr0( length       )
     719    !
     720    INTEGER ndex2d(nbp_lon*nbp_lat)
     721    !IM
     722    !
     723    !IM AMIP2 BEG
     724    REAL moyglo, mountor
     725    !IM 141004 BEG
     726    REAL zustrdr(klon), zvstrdr(klon)
     727    REAL zustrli(klon), zvstrli(klon)
     728    REAL zustrph(klon), zvstrph(klon)
     729    REAL aam, torsfc
     730    !IM 141004 END
     731    !IM 190504 BEG
     732    INTEGER ij
     733    !  INTEGER imp1jmp1
     734    !  PARAMETER(imp1jmp1=(iim+1)*jjmp1)
     735    !ym A voir plus tard
     736    !  REAL zx_tmp((nbp_lon+1)*nbp_lat)
     737    !  REAL airedyn(nbp_lon+1,nbp_lat)
     738    !IM 190504 END
     739    LOGICAL ok_msk
     740    REAL msk(klon)
     741    !IM
     742    REAL airetot, pi
     743    !ym A voir plus tard
     744    !ym      REAL zm_wo(jjmp1, klev)
     745    !IM AMIP2 END
     746    !
     747    REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
     748    REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
     749    REAL zx_tmp_2d(nbp_lon,nbp_lat)
     750    REAL zx_lon(nbp_lon,nbp_lat)
     751    REAL zx_lat(nbp_lon,nbp_lat)
     752    !
     753    INTEGER nid_day_seri, nid_ctesGCM
     754    SAVE nid_day_seri, nid_ctesGCM
     755    !$OMP THREADPRIVATE(nid_day_seri,nid_ctesGCM)
     756    !
     757    !IM 280405 BEG
     758    !  INTEGER nid_bilKPins, nid_bilKPave
     759    !  SAVE nid_bilKPins, nid_bilKPave
     760    !  !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)
     761    !
     762    REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
     763    REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert.
     764    REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert.
     765    REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert.
     766    !
     767    INTEGER nhori, nvert
     768    REAL zsto
     769    REAL zstophy, zout
     770
     771    real zjulian
     772    save zjulian
     773    !$OMP THREADPRIVATE(zjulian)
     774
     775    character*20 modname
     776    character*80 abort_message
     777    logical, save ::  ok_sync, ok_sync_omp
     778    !$OMP THREADPRIVATE(ok_sync)
     779    real date0
     780    integer idayref
     781
     782    ! essai writephys
     783    integer fid_day, fid_mth, fid_ins
     784    parameter (fid_ins = 1, fid_day = 2, fid_mth = 3)
     785    integer prof2d_on, prof3d_on, prof2d_av, prof3d_av
     786    parameter (prof2d_on = 1, prof3d_on = 2, &
     787         prof2d_av = 3, prof3d_av = 4)
     788    !     Variables liees au bilan d'energie et d'enthalpi
     789    REAL ztsol(klon)
     790    REAL      d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
     791    REAL      d_h_vcol_phy
     792    REAL      fs_bound, fq_bound
     793    SAVE      d_h_vcol_phy
     794    !$OMP THREADPRIVATE(d_h_vcol_phy)
     795    REAL      zero_v(klon)
     796    CHARACTER*40 ztit
     797    INTEGER   ip_ebil  ! PRINT level for energy conserv. diag.
     798    SAVE      ip_ebil
     799    DATA      ip_ebil/0/
     800    !$OMP THREADPRIVATE(ip_ebil)
     801    INTEGER   if_ebil ! level for energy conserv. dignostics
     802    SAVE      if_ebil
     803    !$OMP THREADPRIVATE(if_ebil)
     804    REAL q2m(klon,nbsrf)  ! humidite a 2m
     805
     806    !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
     807    CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
     808    CHARACTER*40 tinst, tave, typeval
     809    REAL cldtaupi(klon,klev) ! Cloud optical thickness for
     810    ! pre-industrial (pi) aerosols
     811
     812
     813    ! Aerosol optical properties
     814    CHARACTER*4, DIMENSION(naero_grp) :: rfname
     815    REAL, DIMENSION(klon,klev)     :: mass_solu_aero ! total mass
     816    ! concentration
     817    ! for all soluble
     818    ! aerosols[ug/m3]
     819    REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi
     820    ! - " - (pre-industrial value)
     821
     822    ! Parameters
     823    LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not
     824    LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013)
     825    REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)
     826    SAVE ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1
     827    !$OMP THREADPRIVATE(ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1)
     828    LOGICAL, SAVE :: aerosol_couple ! true  : calcul des aerosols dans INCA
     829    ! false : lecture des aerosol dans un fichier
     830    !$OMP THREADPRIVATE(aerosol_couple)   
     831    INTEGER, SAVE :: flag_aerosol
     832    !$OMP THREADPRIVATE(flag_aerosol)
     833    LOGICAL, SAVE :: new_aod
     834    !$OMP THREADPRIVATE(new_aod)
     835    !
     836    !--STRAT AEROSOL
     837    LOGICAL, SAVE :: flag_aerosol_strat
     838    !$OMP THREADPRIVATE(flag_aerosol_strat)
     839    !c-fin STRAT AEROSOL
     840    !
     841    ! Declaration des constantes et des fonctions thermodynamiques
     842    !
     843    LOGICAL,SAVE :: first=.true.
     844    !$OMP THREADPRIVATE(first)
     845
     846    integer, save::  read_climoz ! read ozone climatology
     847    !     (let it keep the default OpenMP shared attribute)
     848    !     Allowed values are 0, 1 and 2
     849    !     0: do not read an ozone climatology
     850    !     1: read a single ozone climatology that will be used day and night
     851    !     2: read two ozone climatologies, the average day and night
     852    !     climatology and the daylight climatology
     853
     854    integer, save:: ncid_climoz ! NetCDF file containing ozone climatologies
     855    !     (let it keep the default OpenMP shared attribute)
     856
     857    real, pointer, save:: press_climoz(:)
     858    ! (let it keep the default OpenMP shared attribute)
     859    ! edges of pressure intervals for ozone climatologies, in Pa, in strictly
     860    ! ascending order
     861
     862    integer, save:: co3i = 0
     863    !     time index in NetCDF file of current ozone fields
     864    !$OMP THREADPRIVATE(co3i)
     865
     866    integer ro3i
     867    !     required time index in NetCDF file for the ozone fields, between 1
     868    !     and 360
     869
     870    INTEGER ierr
     871    include "YOMCST.h"
     872    include "YOETHF.h"
     873    include "FCTTRE.h"
     874    !IM 100106 BEG : pouvoir sortir les ctes de la physique
     875    include "conema3.h"
     876    include "fisrtilp.h"
     877    include "nuage.h"
     878    include "compbl.h"
     879    !IM 100106 END : pouvoir sortir les ctes de la physique
     880    !
     881    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     882    ! Declarations pour Simulateur COSP
     883    !============================================================
     884    real :: mr_ozone(klon,klev)
     885
     886    !IM sorties fichier 1D paramLMDZ_phy.nc
     887    REAL :: zx_tmp_0d(1,1)
     888    INTEGER, PARAMETER :: np=1
     889    REAL,dimension(klon_glo)        :: rlat_glo
     890    REAL,dimension(klon_glo)        :: rlon_glo
     891    REAL gbils(1), gevap(1), gevapt(1), glat(1), gnet0(1), gnet(1)
     892    REAL grain(1), gtsol(1), gt2m(1), gprw(1)
     893
     894    !IM stations CFMIP
     895    INTEGER, SAVE :: nCFMIP
     896    !$OMP THREADPRIVATE(nCFMIP)
     897    INTEGER, PARAMETER :: npCFMIP=120
     898    INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:)
     899    REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:)
     900    !$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP)
     901    INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:)
     902    REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:)
     903    !$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM)
     904    INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
     905    !$OMP THREADPRIVATE(iGCM, jGCM)
     906    logical, dimension(nfiles)            :: phys_out_filestations
     907    logical, parameter :: lNMC=.FALSE.
     908
     909    !IM betaCRF
     910    REAL, SAVE :: pfree, beta_pbl, beta_free
     911    !$OMP THREADPRIVATE(pfree, beta_pbl, beta_free)
     912    REAL, SAVE :: lon1_beta,  lon2_beta, lat1_beta, lat2_beta
     913    !$OMP THREADPRIVATE(lon1_beta,  lon2_beta, lat1_beta, lat2_beta)
     914    LOGICAL, SAVE :: mskocean_beta
     915    !$OMP THREADPRIVATE(mskocean_beta)
     916    REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et
     917    ! cldemirad pour evaluer les
     918    ! retros liees aux CRF
     919    REAL, dimension(klon, klev) :: cldtaurad   ! epaisseur optique
     920    ! pour radlwsw pour
     921    ! tester "CRF off"
     922    REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique
     923    ! pour radlwsw pour
     924    ! tester "CRF off"
     925    REAL, dimension(klon, klev) :: cldemirad   ! emissivite pour
     926    ! radlwsw pour tester
     927    ! "CRF off"
     928    REAL, dimension(klon, klev) :: cldfrarad   ! fraction nuageuse
     929
     930    INTEGER :: nbtr_tmp ! Number of tracer inside concvl
     931    REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
     932    integer iostat
     933
     934    REAL zzz
     935    !albedo SB >>>
     936    real,dimension(6),save :: SFRWL
     937    !albedo SB <<<
     938
     939    !--OB variables for mass fixer (hard coded for now)
     940    logical, parameter :: mass_fixer=.false.
     941    real qql1(klon),qql2(klon),zdz,corrqql
     942
     943    ! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
     944    jjmp1=nbp_lat
     945
     946    !======================================================================
     947    ! Gestion calendrier : mise a jour du module phys_cal_mod
     948    !
     949    pdtphys=pdtphys_
     950    CALL update_time(pdtphys)
     951
     952    !======================================================================
     953    ! Ecriture eventuelle d'un profil verticale en entree de la physique.
     954    ! Utilise notamment en 1D mais peut etre active egalement en 3D
     955    ! en imposant la valeur de igout.
     956    !======================================================================d
     957    if (prt_level.ge.1) then
     958       igout=klon/2+1/klon
     959       write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
     960       write(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), &
     961            longitude_deg(igout)
     962       write(lunout,*) &
     963            'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
     964       write(lunout,*) &
     965            nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys
     966
     967       write(lunout,*) 'paprs, play, phi, u, v, t'
     968       do k=1,klev
     969          write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
     970               u(igout,k),v(igout,k),t(igout,k)
     971       enddo
     972       write(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
     973       do k=1,klev
     974          write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
     975       enddo
     976    endif
     977
     978    !======================================================================
     979
     980    if (first) then
     981
     982       !CR:nvelles variables convection/poches froides
     983
     984       print*, '================================================='
     985       print*, 'Allocation des variables locales et sauvegardees'
     986       call phys_local_var_init
     987       !
     988       pasphys=pdtphys
     989       !     appel a la lecture du run.def physique
     990       call conf_phys(ok_journe, ok_mensuel, &
     991            ok_instan, ok_hf, &
     992            ok_LES, &
     993            callstats, &
     994            solarlong0,seuil_inversion, &
     995            fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
     996            iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
     997            ok_ade, ok_aie, ok_cdnc, aerosol_couple,  &
     998            flag_aerosol, flag_aerosol_strat, new_aod, &
     999            bl95_b0, bl95_b1, &
     1000                                ! nv flags pour la convection et les
     1001                                ! poches froides
     1002            read_climoz, &
     1003            alp_offset)
     1004       call phys_state_var_init(read_climoz)
     1005       call phys_output_var_init
     1006       print*, '================================================='
     1007       !
     1008       !CR: check sur le nb de traceurs de l eau
     1009       if ((iflag_ice_thermo.gt.0).and.(nqo==2)) then
     1010          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
     1011               '(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.'
    9761012          STOP
    977      endif
    978 
    979      dnwd0=0.0
    980      ftd=0.0
    981      fqd=0.0
    982      cin=0.
    983      !ym Attention pbase pas initialise dans concvl !!!!
    984      pbase=0
    985      !IM 180608
    986 
    987      itau_con=0
    988      first=.false.
    989 
    990   endif  ! first
    991 
    992   !ym => necessaire pour iflag_con != 2   
    993   pmfd(:,:) = 0.
    994   pen_u(:,:) = 0.
    995   pen_d(:,:) = 0.
    996   pde_d(:,:) = 0.
    997   pde_u(:,:) = 0.
    998   aam=0.
    999   d_t_adjwk(:,:)=0
    1000   d_q_adjwk(:,:)=0
    1001 
    1002   alp_bl_conv(:)=0.
    1003 
    1004   torsfc=0.
    1005   forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
    1006 
    1007 
    1008 
    1009   modname = 'physiq'
    1010   !IM
    1011   IF (ip_ebil_phy.ge.1) THEN
    1012      DO i=1,klon
    1013         zero_v(i)=0.
    1014      END DO
    1015   END IF
    1016 
    1017   IF (debut) THEN
    1018      CALL suphel ! initialiser constantes et parametres phys.
    1019      CALL getin_p('random_notrig_max',random_notrig_max)
    1020      CALL getin_p('ok_adjwk',ok_adjwk)
    1021   ENDIF
    1022 
    1023   if(prt_level.ge.1) print*,'CONVERGENCE PHYSIQUE THERM 1 '
    1024 
    1025 
    1026   !======================================================================
    1027   ! Gestion calendrier : mise a jour du module phys_cal_mod
    1028   !
    1029   !     CALL phys_cal_update(jD_cur,jH_cur)
    1030 
    1031   !
    1032   ! Si c'est le debut, il faut initialiser plusieurs choses
    1033   !          ********
    1034   !
    1035   IF (debut) THEN
    1036      !rv
    1037      !CRinitialisation de wght_th et lalim_conv pour la definition de la couche alimentation
    1038      !de la convection a partir des caracteristiques du thermique
    1039      wght_th(:,:)=1.
    1040      lalim_conv(:)=1
    1041      !RC
    1042      ustar(:,:)=0.
    1043      u10m(:,:)=0.
    1044      v10m(:,:)=0.
    1045      rain_con(:)=0.
    1046      snow_con(:)=0.
    1047      topswai(:)=0.
    1048      topswad(:)=0.
    1049      solswai(:)=0.
    1050      solswad(:)=0.
    1051 
    1052      wmax_th(:)=0.
    1053      tau_overturning_th(:)=0.
    1054 
    1055      IF (type_trac == 'inca') THEN
    1056         ! jg : initialisation jusqu'au ces variables sont dans restart
    1057         ccm(:,:,:) = 0.
    1058         tau_aero(:,:,:,:) = 0.
    1059         piz_aero(:,:,:,:) = 0.
    1060         cg_aero(:,:,:,:) = 0.
    1061 
    1062         config_inca='none' ! default
    1063         CALL getin_p('config_inca',config_inca)
    1064 
    1065      ELSE
    1066         config_inca='none' ! default
    1067      END IF
    1068      
    1069      IF (aerosol_couple .AND. (config_inca /= "aero" .AND. config_inca /= "aeNP ")) THEN
    1070         abort_message = 'if aerosol_couple is activated, config_inca need to be aero or aeNP'
    1071         CALL abort_physic (modname,abort_message,1)
    1072      ENDIF
    1073 
    1074 
    1075 
    1076      rnebcon0(:,:) = 0.0
    1077      clwcon0(:,:) = 0.0
    1078      rnebcon(:,:) = 0.0
    1079      clwcon(:,:) = 0.0
    1080 
    1081      !IM     
    1082      IF (ip_ebil_phy.ge.1) d_h_vcol_phy=0.
    1083      !
    1084      print*,'iflag_coupl,iflag_clos,iflag_wake', &
    1085           iflag_coupl,iflag_clos,iflag_wake
    1086      print*,'iflag_CYCLE_DIURNE', iflag_cycle_diurne
    1087      !
    1088      IF (iflag_con.EQ.2.AND.iflag_cld_th.GT.-1) THEN
    1089         abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
    1090         CALL abort_physic (modname,abort_message,1)
    1091      ENDIF
    1092      !
    1093      !
    1094      ! Initialiser les compteurs:
    1095      !
    1096      itap    = 0
    1097      itaprad = 0
    1098 
    1099 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1100      !! Un petit travail \`a faire ici.
    1101 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1102 
    1103      if (iflag_pbl>1) then
    1104         PRINT*, "Using method MELLOR&YAMADA"
    1105      endif
    1106 
    1107 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1108      ! FH 2008/05/02 changement lie a la lecture de nbapp_rad dans phylmd plutot que
    1109      ! dyn3d
    1110      ! Attention : la version precedente n'etait pas tres propre.
    1111      ! Il se peut qu'il faille prendre une valeur differente de nbapp_rad
    1112      ! pour obtenir le meme resultat.
    1113      dtime=pdtphys
    1114      IF (MOD(INT(86400./dtime),nbapp_rad).EQ.0) THEN
    1115        radpas = NINT( 86400./dtime/nbapp_rad)
    1116      ELSE
    1117        WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un multiple de nbapp_rad'
    1118        WRITE(lunout,*) 'changer nbapp_rad ou alors commenter ce test mais 1+1<>2'
    1119        abort_message='nbre de pas de temps physique n est pas multiple de nbapp_rad'
    1120        call abort_physic(modname,abort_message,1)
    1121      ENDIF
    1122 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1123 
    1124      CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
    1125      IF (klon_glo==1) THEN
    1126         coefh=0. ; coefm=0. ; pbl_tke=0.
    1127         coefh(:,2,:)=1.e-2 ; coefm(:,2,:)=1.e-2 ; pbl_tke(:,2,:)=1.e-2
    1128         PRINT*,'FH WARNING : lignes a supprimer'
    1129      ENDIF
    1130      !IM begin
    1131      print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
    1132           ,ratqs(1,1)
    1133      !IM end
    1134 
    1135 
    1136 
    1137 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1138      !
    1139      ! on remet le calendrier a zero
    1140      !
    1141      IF (raz_date .eq. 1) THEN
    1142         itau_phy = 0
    1143      ENDIF
    1144 
    1145      CALL printflag( tabcntr0,radpas,ok_journe, &
    1146           ok_instan, ok_region )
    1147      !
    1148      IF (ABS(dtime-pdtphys).GT.0.001) THEN
    1149         WRITE(lunout,*) 'Pas physique n est pas correct',dtime, &
    1150              pdtphys
    1151         abort_message='Pas physique n est pas correct '
    1152         !           call abort_physic(modname,abort_message,1)
    1153         dtime=pdtphys
    1154      ENDIF
    1155      IF (nlon .NE. klon) THEN
    1156         WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon,  &
    1157              klon
    1158         abort_message='nlon et klon ne sont pas coherents'
    1159         call abort_physic(modname,abort_message,1)
    1160      ENDIF
    1161      IF (nlev .NE. klev) THEN
    1162         WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, &
    1163              klev
    1164         abort_message='nlev et klev ne sont pas coherents'
    1165         call abort_physic(modname,abort_message,1)
    1166      ENDIF
    1167      !
    1168      IF (dtime*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN
    1169         WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
    1170         WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
    1171         abort_message='Nbre d appels au rayonnement insuffisant'
    1172         call abort_physic(modname,abort_message,1)
    1173      ENDIF
    1174      WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
    1175      WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", &
    1176           ok_cvl
    1177      !
    1178      !KE43
    1179      ! Initialisation pour la convection de K.E. (sb):
    1180      IF (iflag_con.GE.3) THEN
    1181 
    1182         WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3  "
    1183         WRITE(lunout,*) &
    1184              "On va utiliser le melange convectif des traceurs qui"
    1185         WRITE(lunout,*)"est calcule dans convect4.3"
    1186         WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
    1187 
    1188         DO i = 1, klon
    1189            ema_cbmf(i) = 0.
    1190            ema_pcb(i)  = 0.
    1191            ema_pct(i)  = 0.
    1192            !          ema_workcbmf(i) = 0.
    1193         ENDDO
    1194         !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG
    1195         DO i = 1, klon
    1196            ibas_con(i) = 1
    1197            itop_con(i) = 1
    1198         ENDDO
    1199         !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END
    1200         !===============================================================================
    1201         !CR:04.12.07: initialisations poches froides
    1202         ! Controle de ALE et ALP pour la fermeture convective (jyg)
    1203         if (iflag_wake>=1) then
    1204            CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
    1205                 ,alp_bl_prescr, ale_bl_prescr)
    1206            ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
    1207            !        print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
    1208         endif
    1209 
    1210 !        do i = 1,klon
    1211 !           Ale_bl(i)=0.
    1212 !           Alp_bl(i)=0.
    1213 !        enddo
    1214 
    1215         !================================================================================
    1216         !IM stations CFMIP
    1217         nCFMIP=npCFMIP
    1218         OPEN(98,file='npCFMIP_param.data',status='old', &
    1219              form='formatted',iostat=iostat)
    1220         if (iostat == 0) then
    1221            READ(98,*,end=998) nCFMIP
    1222 998        CONTINUE
    1223            CLOSE(98)
    1224            CONTINUE
    1225            IF(nCFMIP.GT.npCFMIP) THEN
    1226               print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
    1227               call abort_physic("physiq", "", 1)
    1228            else
    1229               print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
    1230            ENDIF
    1231 
    1232            !
    1233            ALLOCATE(tabCFMIP(nCFMIP))
    1234            ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
    1235            ALLOCATE(tabijGCM(nCFMIP))
    1236            ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
    1237            ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))
    1238            !
    1239            ! lecture des nCFMIP stations CFMIP, de leur numero
    1240            ! et des coordonnees geographiques lonCFMIP, latCFMIP
    1241            !
    1242            CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP,  &
    1243                 lonCFMIP, latCFMIP)
    1244            !
    1245            ! identification des
    1246            ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la grille de LMDZ
    1247            ! 2) indices points tabijGCM de la grille physique 1d sur klon points
    1248            ! 3) indices iGCM, jGCM de la grille physique 2d
    1249            !
    1250            CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
    1251                 tabijGCM, lonGCM, latGCM, iGCM, jGCM)
    1252            !
    1253         else
    1254            ALLOCATE(tabijGCM(0))
    1255            ALLOCATE(lonGCM(0), latGCM(0))
    1256            ALLOCATE(iGCM(0), jGCM(0))
    1257         end if
    1258      else
    1259         ALLOCATE(tabijGCM(0))
    1260         ALLOCATE(lonGCM(0), latGCM(0))
    1261         ALLOCATE(iGCM(0), jGCM(0))
    1262      ENDIF
    1263 
    1264      DO i=1,klon
    1265         rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
    1266      ENDDO
    1267 
    1268      !34EK
    1269      IF (ok_orodr) THEN
    1270 
    1271 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1272         ! FH sans doute a enlever de finitivement ou, si on le garde, l'activer
    1273         ! justement quand ok_orodr = false.
    1274         ! ce rugoro est utilise par la couche limite et fait double emploi
    1275         ! avec les param\'etrisations sp\'ecifiques de Francois Lott.
    1276         !           DO i=1,klon
    1277         !             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
    1278         !           ENDDO
    1279 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1280         IF (ok_strato) THEN
    1281            CALL SUGWD_strato(klon,klev,paprs,pplay)
    1282         ELSE
    1283            CALL SUGWD(klon,klev,paprs,pplay)
    1284         ENDIF
    1285 
    1286         DO i=1,klon
    1287            zuthe(i)=0.
    1288            zvthe(i)=0.
    1289            if(zstd(i).gt.10.)then
    1290               zuthe(i)=(1.-zgam(i))*cos(zthe(i))
    1291               zvthe(i)=(1.-zgam(i))*sin(zthe(i))
    1292            endif
    1293         ENDDO
    1294      ENDIF
    1295      !
    1296      !
    1297      lmt_pas = NINT(86400./dtime * 1.0)   ! tous les jours
    1298      WRITE(lunout,*)'La frequence de lecture surface est de ',  &
    1299           lmt_pas
    1300      !
    1301      capemaxcels = 't_max(X)'
    1302      t2mincels = 't_min(X)'
    1303      t2maxcels = 't_max(X)'
    1304      tinst = 'inst(X)'
    1305      tave = 'ave(X)'
    1306      !IM cf. AM 081204 BEG
    1307      write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
    1308      !IM cf. AM 081204 END
    1309      !
    1310      !=============================================================
    1311      !   Initialisation des sorties
    1312      !=============================================================
     1013       endif
     1014
     1015       dnwd0=0.0
     1016       ftd=0.0
     1017       fqd=0.0
     1018       cin=0.
     1019       !ym Attention pbase pas initialise dans concvl !!!!
     1020       pbase=0
     1021       !IM 180608
     1022
     1023       itau_con=0
     1024       first=.false.
     1025
     1026    endif  ! first
     1027
     1028    !ym => necessaire pour iflag_con != 2   
     1029    pmfd(:,:) = 0.
     1030    pen_u(:,:) = 0.
     1031    pen_d(:,:) = 0.
     1032    pde_d(:,:) = 0.
     1033    pde_u(:,:) = 0.
     1034    aam=0.
     1035    d_t_adjwk(:,:)=0
     1036    d_q_adjwk(:,:)=0
     1037
     1038    alp_bl_conv(:)=0.
     1039
     1040    torsfc=0.
     1041    forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
     1042
     1043
     1044
     1045    modname = 'physiq'
     1046    !IM
     1047    IF (ip_ebil_phy.ge.1) THEN
     1048       DO i=1,klon
     1049          zero_v(i)=0.
     1050       END DO
     1051    END IF
     1052
     1053    IF (debut) THEN
     1054       CALL suphel ! initialiser constantes et parametres phys.
     1055       CALL getin_p('random_notrig_max',random_notrig_max)
     1056       CALL getin_p('ok_adjwk',ok_adjwk)
     1057    ENDIF
     1058
     1059    if(prt_level.ge.1) print*,'CONVERGENCE PHYSIQUE THERM 1 '
     1060
     1061
     1062    !======================================================================
     1063    ! Gestion calendrier : mise a jour du module phys_cal_mod
     1064    !
     1065    !     CALL phys_cal_update(jD_cur,jH_cur)
     1066
     1067    !
     1068    ! Si c'est le debut, il faut initialiser plusieurs choses
     1069    !          ********
     1070    !
     1071    IF (debut) THEN
     1072       !rv CRinitialisation de wght_th et lalim_conv pour la
     1073       !definition de la couche alimentation de la convection a partir
     1074       !des caracteristiques du thermique
     1075       wght_th(:,:)=1.
     1076       lalim_conv(:)=1
     1077       !RC
     1078       ustar(:,:)=0.
     1079       u10m(:,:)=0.
     1080       v10m(:,:)=0.
     1081       rain_con(:)=0.
     1082       snow_con(:)=0.
     1083       topswai(:)=0.
     1084       topswad(:)=0.
     1085       solswai(:)=0.
     1086       solswad(:)=0.
     1087
     1088       wmax_th(:)=0.
     1089       tau_overturning_th(:)=0.
     1090
     1091       IF (type_trac == 'inca') THEN
     1092          ! jg : initialisation jusqu'au ces variables sont dans restart
     1093          ccm(:,:,:) = 0.
     1094          tau_aero(:,:,:,:) = 0.
     1095          piz_aero(:,:,:,:) = 0.
     1096          cg_aero(:,:,:,:) = 0.
     1097
     1098          config_inca='none' ! default
     1099          CALL getin_p('config_inca',config_inca)
     1100
     1101       ELSE
     1102          config_inca='none' ! default
     1103       END IF
     1104
     1105       IF (aerosol_couple .AND. (config_inca /= "aero" &
     1106            .AND. config_inca /= "aeNP ")) THEN
     1107          abort_message &
     1108               = 'if aerosol_couple is activated, config_inca need to be ' &
     1109               // 'aero or aeNP'
     1110          CALL abort_physic (modname,abort_message,1)
     1111       ENDIF
     1112
     1113
     1114
     1115       rnebcon0(:,:) = 0.0
     1116       clwcon0(:,:) = 0.0
     1117       rnebcon(:,:) = 0.0
     1118       clwcon(:,:) = 0.0
     1119
     1120       !IM     
     1121       IF (ip_ebil_phy.ge.1) d_h_vcol_phy=0.
     1122       !
     1123       print*,'iflag_coupl,iflag_clos,iflag_wake', &
     1124            iflag_coupl,iflag_clos,iflag_wake
     1125       print*,'iflag_CYCLE_DIURNE', iflag_cycle_diurne
     1126       !
     1127       IF (iflag_con.EQ.2.AND.iflag_cld_th.GT.-1) THEN
     1128          abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
     1129          CALL abort_physic (modname,abort_message,1)
     1130       ENDIF
     1131       !
     1132       !
     1133       ! Initialiser les compteurs:
     1134       !
     1135       itap    = 0
     1136       itaprad = 0
     1137
     1138       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1139       !! Un petit travail \`a faire ici.
     1140       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1141
     1142       if (iflag_pbl>1) then
     1143          PRINT*, "Using method MELLOR&YAMADA"
     1144       endif
     1145
     1146       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1147       ! FH 2008/05/02 changement lie a la lecture de nbapp_rad dans
     1148       ! phylmd plutot que dyn3d
     1149       ! Attention : la version precedente n'etait pas tres propre.
     1150       ! Il se peut qu'il faille prendre une valeur differente de nbapp_rad
     1151       ! pour obtenir le meme resultat.
     1152       dtime=pdtphys
     1153       IF (MOD(INT(86400./dtime),nbapp_rad).EQ.0) THEN
     1154          radpas = NINT( 86400./dtime/nbapp_rad)
     1155       ELSE
     1156          WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
     1157               'multiple de nbapp_rad'
     1158          WRITE(lunout,*) 'changer nbapp_rad ou alors commenter ce test ', &
     1159               'mais 1+1<>2'
     1160          abort_message='nbre de pas de temps physique n est pas multiple ' &
     1161               // 'de nbapp_rad'
     1162          call abort_physic(modname,abort_message,1)
     1163       ENDIF
     1164       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1165
     1166       CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
     1167       IF (klon_glo==1) THEN
     1168          coefh=0. ; coefm=0. ; pbl_tke=0.
     1169          coefh(:,2,:)=1.e-2 ; coefm(:,2,:)=1.e-2 ; pbl_tke(:,2,:)=1.e-2
     1170          PRINT*,'FH WARNING : lignes a supprimer'
     1171       ENDIF
     1172       !IM begin
     1173       print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
     1174            ,ratqs(1,1)
     1175       !IM end
     1176
     1177
     1178
     1179       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1180       !
     1181       ! on remet le calendrier a zero
     1182       !
     1183       IF (raz_date .eq. 1) THEN
     1184          itau_phy = 0
     1185       ENDIF
     1186
     1187       CALL printflag( tabcntr0,radpas,ok_journe, &
     1188            ok_instan, ok_region )
     1189       !
     1190       IF (ABS(dtime-pdtphys).GT.0.001) THEN
     1191          WRITE(lunout,*) 'Pas physique n est pas correct',dtime, &
     1192               pdtphys
     1193          abort_message='Pas physique n est pas correct '
     1194          !           call abort_physic(modname,abort_message,1)
     1195          dtime=pdtphys
     1196       ENDIF
     1197       IF (nlon .NE. klon) THEN
     1198          WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon,  &
     1199               klon
     1200          abort_message='nlon et klon ne sont pas coherents'
     1201          call abort_physic(modname,abort_message,1)
     1202       ENDIF
     1203       IF (nlev .NE. klev) THEN
     1204          WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, &
     1205               klev
     1206          abort_message='nlev et klev ne sont pas coherents'
     1207          call abort_physic(modname,abort_message,1)
     1208       ENDIF
     1209       !
     1210       IF (dtime*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN
     1211          WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
     1212          WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
     1213          abort_message='Nbre d appels au rayonnement insuffisant'
     1214          call abort_physic(modname,abort_message,1)
     1215       ENDIF
     1216       WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
     1217       WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", &
     1218            ok_cvl
     1219       !
     1220       !KE43
     1221       ! Initialisation pour la convection de K.E. (sb):
     1222       IF (iflag_con.GE.3) THEN
     1223
     1224          WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3  "
     1225          WRITE(lunout,*) &
     1226               "On va utiliser le melange convectif des traceurs qui"
     1227          WRITE(lunout,*)"est calcule dans convect4.3"
     1228          WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
     1229
     1230          DO i = 1, klon
     1231             ema_cbmf(i) = 0.
     1232             ema_pcb(i)  = 0.
     1233             ema_pct(i)  = 0.
     1234             !          ema_workcbmf(i) = 0.
     1235          ENDDO
     1236          !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG
     1237          DO i = 1, klon
     1238             ibas_con(i) = 1
     1239             itop_con(i) = 1
     1240          ENDDO
     1241          !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END
     1242          !================================================================
     1243          !CR:04.12.07: initialisations poches froides
     1244          ! Controle de ALE et ALP pour la fermeture convective (jyg)
     1245          if (iflag_wake>=1) then
     1246             CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
     1247                  ,alp_bl_prescr, ale_bl_prescr)
     1248             ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
     1249             !        print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
     1250          endif
     1251
     1252          !        do i = 1,klon
     1253          !           Ale_bl(i)=0.
     1254          !           Alp_bl(i)=0.
     1255          !        enddo
     1256
     1257          !===================================================================
     1258          !IM stations CFMIP
     1259          nCFMIP=npCFMIP
     1260          OPEN(98,file='npCFMIP_param.data',status='old', &
     1261               form='formatted',iostat=iostat)
     1262          if (iostat == 0) then
     1263             READ(98,*,end=998) nCFMIP
     1264998          CONTINUE
     1265             CLOSE(98)
     1266             CONTINUE
     1267             IF(nCFMIP.GT.npCFMIP) THEN
     1268                print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
     1269                call abort_physic("physiq", "", 1)
     1270             else
     1271                print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
     1272             ENDIF
     1273
     1274             !
     1275             ALLOCATE(tabCFMIP(nCFMIP))
     1276             ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
     1277             ALLOCATE(tabijGCM(nCFMIP))
     1278             ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
     1279             ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))
     1280             !
     1281             ! lecture des nCFMIP stations CFMIP, de leur numero
     1282             ! et des coordonnees geographiques lonCFMIP, latCFMIP
     1283             !
     1284             CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP,  &
     1285                  lonCFMIP, latCFMIP)
     1286             !
     1287             ! identification des
     1288             ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la
     1289             ! grille de LMDZ
     1290             ! 2) indices points tabijGCM de la grille physique 1d sur
     1291             ! klon points
     1292             ! 3) indices iGCM, jGCM de la grille physique 2d
     1293             !
     1294             CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
     1295                  tabijGCM, lonGCM, latGCM, iGCM, jGCM)
     1296             !
     1297          else
     1298             ALLOCATE(tabijGCM(0))
     1299             ALLOCATE(lonGCM(0), latGCM(0))
     1300             ALLOCATE(iGCM(0), jGCM(0))
     1301          end if
     1302       else
     1303          ALLOCATE(tabijGCM(0))
     1304          ALLOCATE(lonGCM(0), latGCM(0))
     1305          ALLOCATE(iGCM(0), jGCM(0))
     1306       ENDIF
     1307
     1308       DO i=1,klon
     1309          rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
     1310       ENDDO
     1311
     1312       !34EK
     1313       IF (ok_orodr) THEN
     1314
     1315          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1316          ! FH sans doute a enlever de finitivement ou, si on le
     1317          ! garde, l'activer justement quand ok_orodr = false.
     1318          ! ce rugoro est utilise par la couche limite et fait double emploi
     1319          ! avec les param\'etrisations sp\'ecifiques de Francois Lott.
     1320          !           DO i=1,klon
     1321          !             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
     1322          !           ENDDO
     1323          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1324          IF (ok_strato) THEN
     1325             CALL SUGWD_strato(klon,klev,paprs,pplay)
     1326          ELSE
     1327             CALL SUGWD(klon,klev,paprs,pplay)
     1328          ENDIF
     1329
     1330          DO i=1,klon
     1331             zuthe(i)=0.
     1332             zvthe(i)=0.
     1333             if(zstd(i).gt.10.)then
     1334                zuthe(i)=(1.-zgam(i))*cos(zthe(i))
     1335                zvthe(i)=(1.-zgam(i))*sin(zthe(i))
     1336             endif
     1337          ENDDO
     1338       ENDIF
     1339       !
     1340       !
     1341       lmt_pas = NINT(86400./dtime * 1.0)   ! tous les jours
     1342       WRITE(lunout,*)'La frequence de lecture surface est de ',  &
     1343            lmt_pas
     1344       !
     1345       capemaxcels = 't_max(X)'
     1346       t2mincels = 't_min(X)'
     1347       t2maxcels = 't_max(X)'
     1348       tinst = 'inst(X)'
     1349       tave = 'ave(X)'
     1350       !IM cf. AM 081204 BEG
     1351       write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
     1352       !IM cf. AM 081204 END
     1353       !
     1354       !=============================================================
     1355       !   Initialisation des sorties
     1356       !=============================================================
    13131357
    13141358#ifdef CPP_IOIPSL
    13151359
    1316      !$OMP MASTER
    1317 ! FH : if ok_sync=.true. , the time axis is written at each time step
    1318 ! in the output files. Only at the end in the opposite case
    1319      ok_sync_omp=.false.
    1320      CALL getin('ok_sync',ok_sync_omp)
    1321      call phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
    1322           iGCM,jGCM,lonGCM,latGCM, &
    1323           jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
    1324           type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
    1325           ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,  &
    1326           read_climoz, phys_out_filestations, &
    1327           new_aod, aerosol_couple, &
    1328           flag_aerosol_strat, pdtphys, paprs, pphis,  &
    1329           pplay, lmax_th, ptconv, ptconvth, ivap,  &
    1330           d_t, qx, d_qx, zmasse, ok_sync_omp)
    1331      !$OMP END MASTER
    1332      !$OMP BARRIER
    1333      ok_sync=ok_sync_omp
    1334 
    1335      freq_outNMC(1) = ecrit_files(7)
    1336      freq_outNMC(2) = ecrit_files(8)
    1337      freq_outNMC(3) = ecrit_files(9)
    1338      WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
    1339      WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
    1340      WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)
    1341 
    1342      include "ini_histday_seri.h"
    1343 
    1344      include "ini_paramLMDZ_phy.h"
     1360       !$OMP MASTER
     1361       ! FH : if ok_sync=.true. , the time axis is written at each time step
     1362       ! in the output files. Only at the end in the opposite case
     1363       ok_sync_omp=.false.
     1364       CALL getin('ok_sync',ok_sync_omp)
     1365       call phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
     1366            iGCM,jGCM,lonGCM,latGCM, &
     1367            jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
     1368            type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
     1369            ok_hf,ok_instan,ok_LES,ok_ade,ok_aie,  &
     1370            read_climoz, phys_out_filestations, &
     1371            new_aod, aerosol_couple, &
     1372            flag_aerosol_strat, pdtphys, paprs, pphis,  &
     1373            pplay, lmax_th, ptconv, ptconvth, ivap,  &
     1374            d_t, qx, d_qx, zmasse, ok_sync_omp)
     1375       !$OMP END MASTER
     1376       !$OMP BARRIER
     1377       ok_sync=ok_sync_omp
     1378
     1379       freq_outNMC(1) = ecrit_files(7)
     1380       freq_outNMC(2) = ecrit_files(8)
     1381       freq_outNMC(3) = ecrit_files(9)
     1382       WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
     1383       WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
     1384       WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)
     1385
     1386       include "ini_histday_seri.h"
     1387
     1388       include "ini_paramLMDZ_phy.h"
    13451389
    13461390#endif
    1347      ecrit_reg = ecrit_reg * un_jour
    1348      ecrit_tra = ecrit_tra * un_jour
    1349 
    1350      !XXXPB Positionner date0 pour initialisation de ORCHIDEE
    1351      date0 = jD_ref
    1352      WRITE(*,*) 'physiq date0 : ',date0
    1353      !
    1354      !
    1355      !
    1356      ! Prescrire l'ozone dans l'atmosphere
    1357      !
    1358      !
    1359      !c         DO i = 1, klon
    1360      !c         DO k = 1, klev
    1361      !c            CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
    1362      !c         ENDDO
    1363      !c         ENDDO
    1364      !
    1365      IF (type_trac == 'inca') THEN
     1391       ecrit_reg = ecrit_reg * un_jour
     1392       ecrit_tra = ecrit_tra * un_jour
     1393
     1394       !XXXPB Positionner date0 pour initialisation de ORCHIDEE
     1395       date0 = jD_ref
     1396       WRITE(*,*) 'physiq date0 : ',date0
     1397       !
     1398       !
     1399       !
     1400       ! Prescrire l'ozone dans l'atmosphere
     1401       !
     1402       !
     1403       !c         DO i = 1, klon
     1404       !c         DO k = 1, klev
     1405       !c            CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
     1406       !c         ENDDO
     1407       !c         ENDDO
     1408       !
     1409       IF (type_trac == 'inca') THEN
    13661410#ifdef INCA
    1367         CALL VTe(VTphysiq)
    1368         CALL VTb(VTinca)
    1369         calday = REAL(days_elapsed) + jH_cur
    1370         WRITE(lunout,*) 'initial time chemini', days_elapsed, calday
    1371 
    1372         CALL chemini(  &
    1373              rg, &
    1374              ra, &
    1375              cell_area, &
    1376              latitude_deg, &
    1377              longitude_deg, &
    1378              presnivs, &
    1379              calday, &
    1380              klon, &
    1381              nqtot, &
    1382              pdtphys, &
    1383              annee_ref, &
    1384              day_ref,  &
    1385              day_ini, &
    1386              start_time, &
    1387              itau_phy, &
    1388              io_lon, &
    1389              io_lat)
    1390 
    1391         CALL VTe(VTinca)
    1392         CALL VTb(VTphysiq)
     1411          CALL VTe(VTphysiq)
     1412          CALL VTb(VTinca)
     1413          calday = REAL(days_elapsed) + jH_cur
     1414          WRITE(lunout,*) 'initial time chemini', days_elapsed, calday
     1415
     1416          CALL chemini(  &
     1417               rg, &
     1418               ra, &
     1419               cell_area, &
     1420               latitude_deg, &
     1421               longitude_deg, &
     1422               presnivs, &
     1423               calday, &
     1424               klon, &
     1425               nqtot, &
     1426               pdtphys, &
     1427               annee_ref, &
     1428               day_ref,  &
     1429               day_ini, &
     1430               start_time, &
     1431               itau_phy, &
     1432               io_lon, &
     1433               io_lat)
     1434
     1435          CALL VTe(VTinca)
     1436          CALL VTb(VTphysiq)
    13931437#endif
    1394      END IF
    1395      !
    1396 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1397      ! Nouvelle initialisation pour le rayonnement RRTM
    1398 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1399 
    1400      call iniradia(klon,klev,paprs(1,1:klev+1))
    1401 
    1402      !$omp single
    1403      if (read_climoz >= 1) then
    1404         call open_climoz(ncid_climoz, press_climoz)
    1405      END IF
    1406      !$omp end single
    1407      !
    1408      !IM betaCRF
    1409      pfree=70000. !Pa
    1410      beta_pbl=1.
    1411      beta_free=1.
    1412      lon1_beta=-180.
    1413      lon2_beta=+180.
    1414      lat1_beta=90.
    1415      lat2_beta=-90.
    1416      mskocean_beta=.FALSE.
    1417 
    1418 !albedo SB >>>
    1419      select case(nsw)
    1420      case(2)
    1421      SFRWL(1)=0.45538747
    1422      SFRWL(2)=0.54461211
    1423      case(4)
    1424      SFRWL(1)=0.45538747
    1425      SFRWL(2)=0.32870591
    1426      SFRWL(3)=0.18568763
    1427      SFRWL(4)=3.02191470E-02
    1428      case(6)
    1429      SFRWL(1)=1.28432794E-03
    1430      SFRWL(2)=0.12304168
    1431      SFRWL(3)=0.33106142
    1432      SFRWL(4)=0.32870591
    1433      SFRWL(5)=0.18568763
    1434      SFRWL(6)=3.02191470E-02
    1435      end select
    1436 
    1437 
    1438 !albedo SB <<<
    1439 
    1440      OPEN(99,file='beta_crf.data',status='old', &
    1441           form='formatted',err=9999)
    1442      READ(99,*,end=9998) pfree
    1443      READ(99,*,end=9998) beta_pbl
    1444      READ(99,*,end=9998) beta_free
    1445      READ(99,*,end=9998) lon1_beta
    1446      READ(99,*,end=9998) lon2_beta
    1447      READ(99,*,end=9998) lat1_beta
    1448      READ(99,*,end=9998) lat2_beta
    1449      READ(99,*,end=9998) mskocean_beta
    1450 9998 Continue
    1451      CLOSE(99)
    1452 9999 Continue
    1453      WRITE(*,*)'pfree=',pfree
    1454      WRITE(*,*)'beta_pbl=',beta_pbl
    1455      WRITE(*,*)'beta_free=',beta_free
    1456      WRITE(*,*)'lon1_beta=',lon1_beta
    1457      WRITE(*,*)'lon2_beta=',lon2_beta
    1458      WRITE(*,*)'lat1_beta=',lat1_beta
    1459      WRITE(*,*)'lat2_beta=',lat2_beta
    1460      WRITE(*,*)'mskocean_beta=',mskocean_beta
    1461   ENDIF
    1462   !
    1463   !   ****************     Fin  de   IF ( debut  )   ***************
    1464   !
    1465   !
    1466   ! Incrementer le compteur de la physique
    1467   !
    1468   itap   = itap + 1
    1469   !
    1470   !
    1471   ! Update fraction of the sub-surfaces (pctsrf) and
    1472   ! initialize, where a new fraction has appeared, all variables depending
    1473   ! on the surface fraction.
    1474   !
    1475   CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
    1476        pctsrf, fevap, z0m, z0h, agesno,              &
    1477        falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
    1478 
    1479   ! Update time and other variables in Reprobus
    1480   IF (type_trac == 'repr') THEN
     1438       END IF
     1439       !
     1440       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1441       ! Nouvelle initialisation pour le rayonnement RRTM
     1442       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1443
     1444       call iniradia(klon,klev,paprs(1,1:klev+1))
     1445
     1446       !$omp single
     1447       if (read_climoz >= 1) then
     1448          call open_climoz(ncid_climoz, press_climoz)
     1449       END IF
     1450       !$omp end single
     1451       !
     1452       !IM betaCRF
     1453       pfree=70000. !Pa
     1454       beta_pbl=1.
     1455       beta_free=1.
     1456       lon1_beta=-180.
     1457       lon2_beta=+180.
     1458       lat1_beta=90.
     1459       lat2_beta=-90.
     1460       mskocean_beta=.FALSE.
     1461
     1462       !albedo SB >>>
     1463       select case(nsw)
     1464       case(2)
     1465          SFRWL(1)=0.45538747
     1466          SFRWL(2)=0.54461211
     1467       case(4)
     1468          SFRWL(1)=0.45538747
     1469          SFRWL(2)=0.32870591
     1470          SFRWL(3)=0.18568763
     1471          SFRWL(4)=3.02191470E-02
     1472       case(6)
     1473          SFRWL(1)=1.28432794E-03
     1474          SFRWL(2)=0.12304168
     1475          SFRWL(3)=0.33106142
     1476          SFRWL(4)=0.32870591
     1477          SFRWL(5)=0.18568763
     1478          SFRWL(6)=3.02191470E-02
     1479       end select
     1480
     1481
     1482       !albedo SB <<<
     1483
     1484       OPEN(99,file='beta_crf.data',status='old', &
     1485            form='formatted',err=9999)
     1486       READ(99,*,end=9998) pfree
     1487       READ(99,*,end=9998) beta_pbl
     1488       READ(99,*,end=9998) beta_free
     1489       READ(99,*,end=9998) lon1_beta
     1490       READ(99,*,end=9998) lon2_beta
     1491       READ(99,*,end=9998) lat1_beta
     1492       READ(99,*,end=9998) lat2_beta
     1493       READ(99,*,end=9998) mskocean_beta
     14949998   Continue
     1495       CLOSE(99)
     14969999   Continue
     1497       WRITE(*,*)'pfree=',pfree
     1498       WRITE(*,*)'beta_pbl=',beta_pbl
     1499       WRITE(*,*)'beta_free=',beta_free
     1500       WRITE(*,*)'lon1_beta=',lon1_beta
     1501       WRITE(*,*)'lon2_beta=',lon2_beta
     1502       WRITE(*,*)'lat1_beta=',lat1_beta
     1503       WRITE(*,*)'lat2_beta=',lat2_beta
     1504       WRITE(*,*)'mskocean_beta=',mskocean_beta
     1505    ENDIF
     1506    !
     1507    !   ****************     Fin  de   IF ( debut  )   ***************
     1508    !
     1509    !
     1510    ! Incrementer le compteur de la physique
     1511    !
     1512    itap   = itap + 1
     1513    !
     1514    !
     1515    ! Update fraction of the sub-surfaces (pctsrf) and
     1516    ! initialize, where a new fraction has appeared, all variables depending
     1517    ! on the surface fraction.
     1518    !
     1519    CALL change_srf_frac(itap, dtime, days_elapsed+1,  &
     1520         pctsrf, fevap, z0m, z0h, agesno,              &
     1521         falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke)
     1522
     1523    ! Update time and other variables in Reprobus
     1524    IF (type_trac == 'repr') THEN
    14811525#ifdef REPROBUS
    1482      CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
    1483      print*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
    1484      CALL Rtime(debut)
     1526       CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
     1527       print*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
     1528       CALL Rtime(debut)
    14851529#endif
    1486   END IF
    1487 
    1488 
    1489   ! Tendances bidons pour les processus qui n'affectent pas certaines
    1490   ! variables.
    1491   du0(:,:)=0.
    1492   dv0(:,:)=0.
    1493   dt0 = 0.
    1494   dq0(:,:)=0.
    1495   dql0(:,:)=0.
    1496   dqi0(:,:)=0.
    1497   !
    1498   ! Mettre a zero des variables de sortie (pour securite)
    1499   !
    1500   DO i = 1, klon
    1501      d_ps(i) = 0.0
    1502   ENDDO
    1503   DO k = 1, klev
    1504      DO i = 1, klon
    1505         d_t(i,k) = 0.0
    1506         d_u(i,k) = 0.0
    1507         d_v(i,k) = 0.0
    1508      ENDDO
    1509   ENDDO
    1510   DO iq = 1, nqtot
    1511      DO k = 1, klev
    1512         DO i = 1, klon
    1513            d_qx(i,k,iq) = 0.0
    1514         ENDDO
    1515      ENDDO
    1516   ENDDO
    1517   da(:,:)=0.
    1518   mp(:,:)=0.
    1519   phi(:,:,:)=0.
    1520   ! RomP >>>
    1521   phi2(:,:,:)=0.
    1522   beta_prec_fisrt(:,:)=0.
    1523   beta_prec(:,:)=0.
    1524   epmlmMm(:,:,:)=0.
    1525   eplaMm(:,:)=0.
    1526   d1a(:,:)=0.
    1527   dam(:,:)=0.
    1528   pmflxr=0.
    1529   pmflxs=0.
    1530   ! RomP <<<
    1531 
    1532   !
    1533   ! Ne pas affecter les valeurs entrees de u, v, h, et q
    1534   !
    1535   DO k = 1, klev
    1536      DO i = 1, klon
    1537         t_seri(i,k)  = t(i,k)
    1538         u_seri(i,k)  = u(i,k)
    1539         v_seri(i,k)  = v(i,k)
    1540         q_seri(i,k)  = qx(i,k,ivap)
    1541         ql_seri(i,k) = qx(i,k,iliq)
    1542 !CR: ATTENTION, on rajoute la variable glace
    1543         if (nqo.eq.2) then
    1544            qs_seri(i,k) = 0.
    1545         else if (nqo.eq.3) then
    1546            qs_seri(i,k) = qx(i,k,isol)
    1547         endif
    1548      ENDDO
    1549   ENDDO
    1550   tke0(:,:)=pbl_tke(:,:,is_ave)
    1551 !CR:Nombre de traceurs de l'eau: nqo
    1552 !  IF (nqtot.GE.3) THEN
    1553    IF (nqtot.GE.(nqo+1)) THEN
    1554 !     DO iq = 3, nqtot       
    1555      DO iq = nqo+1, nqtot 
    1556         DO  k = 1, klev
    1557            DO  i = 1, klon
    1558 !              tr_seri(i,k,iq-2) = qx(i,k,iq)
    1559               tr_seri(i,k,iq-nqo) = qx(i,k,iq)
    1560            ENDDO
    1561         ENDDO
    1562      ENDDO
    1563   ELSE
    1564      DO k = 1, klev
    1565         DO i = 1, klon
    1566            tr_seri(i,k,1) = 0.0
    1567         ENDDO
    1568      ENDDO
    1569   ENDIF
    1570   !
    1571   DO i = 1, klon
    1572      ztsol(i) = 0.
    1573   ENDDO
    1574   DO nsrf = 1, nbsrf
    1575      DO i = 1, klon
    1576         ztsol(i) = ztsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
    1577      ENDDO
    1578   ENDDO
    1579   !IM
    1580   IF (ip_ebil_phy.ge.1) THEN
    1581      ztit='after dynamic'
    1582      CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
    1583           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    1584           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    1585      !     Comme les tendances de la physique sont ajoute dans la dynamique,
    1586      !     on devrait avoir que la variation d'entalpie par la dynamique
    1587      !     est egale a la variation de la physique au pas de temps precedent.
    1588      !     Donc la somme de ces 2 variations devrait etre nulle.
    1589      call diagphy(cell_area,ztit,ip_ebil_phy &
    1590           , zero_v, zero_v, zero_v, zero_v, zero_v &
    1591           , zero_v, zero_v, zero_v, ztsol &
    1592           , d_h_vcol+d_h_vcol_phy, d_qt, 0. &
    1593           , fs_bound, fq_bound )
    1594   END IF
    1595 
    1596   ! Diagnostiquer la tendance dynamique
    1597   !
    1598   IF (ancien_ok) THEN
    1599      DO k = 1, klev
    1600         DO i = 1, klon
    1601            d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
    1602            d_v_dyn(i,k) = (v_seri(i,k)-v_ancien(i,k))/dtime
    1603            d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
    1604            d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
    1605         ENDDO
    1606      ENDDO
    1607 !!! RomP >>>   td dyn traceur
    1608 !!     IF (nqtot.GE.3) THEN       ! jyg
    1609 !!        DO iq = 3, nqtot        ! jyg
    1610      IF (nqtot.GE.nqo+1) THEN     ! jyg
    1611         DO iq = nqo+1, nqtot      ! jyg
    1612            DO k = 1, klev
    1613               DO i = 1, klon
    1614 !!                 d_tr_dyn(i,k,iq-2)= &                                 ! jyg
    1615 !!                      (tr_seri(i,k,iq-2)-tr_ancien(i,k,iq-2))/dtime    ! jyg
    1616                  d_tr_dyn(i,k,iq-nqo)= &                                 ! jyg
    1617                       (tr_seri(i,k,iq-nqo)-tr_ancien(i,k,iq-nqo))/dtime  ! jyg
    1618                  !         iiq=niadv(iq)
    1619                  !         print*,i,k," d_tr_dyn",d_tr_dyn(i,k,iq-nqo),"tra:",iq,tname(iiq)
    1620               ENDDO
    1621            ENDDO
    1622         ENDDO
    1623      ENDIF
    1624 !!! RomP <<<
    1625   ELSE
    1626      DO k = 1, klev
    1627         DO i = 1, klon
    1628            d_u_dyn(i,k) = 0.0
    1629            d_v_dyn(i,k) = 0.0
    1630            d_t_dyn(i,k) = 0.0
    1631            d_q_dyn(i,k) = 0.0
    1632         ENDDO
    1633      ENDDO
    1634 !!! RomP >>>   td dyn traceur
    1635 !!     IF (nqtot.GE.3) THEN                                            ! jyg
    1636 !!        DO iq = 3, nqtot                                             ! jyg
    1637      IF (nqtot.GE.nqo+1) THEN                                          ! jyg
    1638         DO iq = nqo+1, nqtot                                           ! jyg
    1639            DO k = 1, klev
    1640               DO i = 1, klon
    1641 !!                 d_tr_dyn(i,k,iq-2)= 0.0                             ! jyg
    1642                  d_tr_dyn(i,k,iq-nqo)= 0.0                             ! jyg
    1643               ENDDO
    1644            ENDDO
    1645         ENDDO
    1646      ENDIF
    1647 !!! RomP <<<
    1648      ancien_ok = .TRUE.
    1649   ENDIF
    1650   !
    1651   ! Ajouter le geopotentiel du sol:
    1652   !
    1653   DO k = 1, klev
    1654      DO i = 1, klon
    1655         zphi(i,k) = pphi(i,k) + pphis(i)
    1656      ENDDO
    1657   ENDDO
    1658   !
    1659   ! Verifier les temperatures
    1660   !
    1661   !IM BEG
    1662   IF (check) THEN
    1663      amn=MIN(ftsol(1,is_ter),1000.)
    1664      amx=MAX(ftsol(1,is_ter),-1000.)
    1665      DO i=2, klon
    1666         amn=MIN(ftsol(i,is_ter),amn)
    1667         amx=MAX(ftsol(i,is_ter),amx)
    1668      ENDDO
    1669      !
    1670      PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx
    1671   ENDIF !(check) THEN
    1672   !IM END
    1673   !
    1674   CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
    1675   IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'
    1676 
    1677   !
    1678   !IM BEG
    1679   IF (check) THEN
    1680      amn=MIN(ftsol(1,is_ter),1000.)
    1681      amx=MAX(ftsol(1,is_ter),-1000.)
    1682      DO i=2, klon
    1683         amn=MIN(ftsol(i,is_ter),amn)
    1684         amx=MAX(ftsol(i,is_ter),amx)
    1685      ENDDO
    1686      !
    1687      PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx
    1688   ENDIF !(check) THEN
    1689   !IM END
    1690   !
    1691   ! Mettre en action les conditions aux limites (albedo, sst, etc.).
    1692   ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
    1693   !
    1694   if (read_climoz >= 1) then
    1695      ! Ozone from a file
    1696      ! Update required ozone index:
    1697      ro3i = int((days_elapsed + jh_cur - jh_1jan) / year_len * 360.) + 1
    1698      if (ro3i == 361) ro3i = 360
    1699      ! (This should never occur, except perhaps because of roundup
    1700      ! error. See documentation.)
    1701      if (ro3i /= co3i) then
    1702         ! Update ozone field:
    1703         if (read_climoz == 1) then
    1704            call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, &
    1705                 press_in_edg=press_climoz, paprs=paprs, v3=wo)
    1706         else
    1707            ! read_climoz == 2
    1708            call regr_pr_av(ncid_climoz, (/"tro3         ", "tro3_daylight"/), &
    1709                 julien=ro3i, press_in_edg=press_climoz, paprs=paprs, v3=wo)
    1710         end if
    1711         ! Convert from mole fraction of ozone to column density of ozone in a
    1712         ! cell, in kDU:
    1713         forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
    1714              * zmasse / dobson_u / 1e3
    1715         ! (By regridding ozone values for LMDZ only once every 360th of
    1716         ! year, we have already neglected the variation of pressure in one
    1717         ! 360th of year. So do not recompute "wo" at each time step even if
    1718         ! "zmasse" changes a little.)
    1719         co3i = ro3i
    1720      end if
    1721   ELSEIF (MOD(itap-1,lmt_pas) == 0) THEN
    1722      ! Once per day, update ozone from Royer:
    1723 
    1724      IF (solarlong0<-999.) then
    1725         ! Generic case with evolvoing season
    1726         zzz=real(days_elapsed+1)
    1727      ELSE IF (abs(solarlong0-1000.)<1.e-4) then
    1728         ! Particular case with annual mean insolation
    1729         zzz=real(90) ! could be revisited
    1730         IF (read_climoz/=-1) THEN
    1731            abort_message ='read_climoz=-1 is recommended when solarlong0=1000.'
    1732            CALL abort_physic (modname,abort_message,1)
    1733         ENDIF
    1734      ELSE
    1735         ! Case where the season is imposed with solarlong0
    1736         zzz=real(90) ! could be revisited
    1737      ENDIF
    1738      wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
    1739   ENDIF
    1740   !
    1741   ! Re-evaporer l'eau liquide nuageuse
    1742   !
    1743   DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
    1744      DO i = 1, klon
    1745         zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
    1746         !jyg<
    1747         !      Attention : Arnaud a propose des formules completement differentes
    1748         !                  A verifier !!!
    1749         zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
    1750         IF (iflag_ice_thermo .EQ. 0) THEN
    1751            zlsdcp=zlvdcp
    1752         ENDIF
    1753         !>jyg
    1754      
    1755         if (iflag_ice_thermo.eq.0) then   
    1756 !pas necessaire a priori
    1757 
    1758         zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
    1759         zb = MAX(0.0,ql_seri(i,k))
    1760         za = - MAX(0.0,ql_seri(i,k)) &
    1761              * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
    1762         t_seri(i,k) = t_seri(i,k) + za
    1763         q_seri(i,k) = q_seri(i,k) + zb
    1764         ql_seri(i,k) = 0.0
    1765         d_t_eva(i,k) = za
    1766         d_q_eva(i,k) = zb
    1767 
    1768         else
    1769 
    1770 !CR: on r\'e-\'evapore eau liquide et glace
    1771 
    1772 !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
    1773 !        zb = MAX(0.0,ql_seri(i,k))
    1774 !        za = - MAX(0.0,ql_seri(i,k)) &
    1775 !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
    1776         zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
    1777         za = - MAX(0.0,ql_seri(i,k))*zlvdcp &
    1778              - MAX(0.0,qs_seri(i,k))*zlsdcp
    1779         t_seri(i,k) = t_seri(i,k) + za
    1780         q_seri(i,k) = q_seri(i,k) + zb
    1781         ql_seri(i,k) = 0.0
    1782 !on \'evapore la glace
    1783         qs_seri(i,k) = 0.0
    1784         d_t_eva(i,k) = za
    1785         d_q_eva(i,k) = zb
    1786         endif
    1787 
    1788      ENDDO
    1789   ENDDO
    1790   !IM
    1791   IF (ip_ebil_phy.ge.2) THEN
    1792      ztit='after reevap'
    1793      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,1,dtime &
    1794           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    1795           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    1796      call diagphy(cell_area,ztit,ip_ebil_phy &
    1797           , zero_v, zero_v, zero_v, zero_v, zero_v &
    1798           , zero_v, zero_v, zero_v, ztsol &
    1799           , d_h_vcol, d_qt, d_ec &
    1800           , fs_bound, fq_bound )
    1801      !
    1802   END IF
    1803 
    1804   !
    1805   !=========================================================================
    1806   ! Calculs de l'orbite.
    1807   ! Necessaires pour le rayonnement et la surface (calcul de l'albedo).
    1808   ! doit donc etre plac\'e avant radlwsw et pbl_surface
    1809 
    1810 !!!   jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1811   call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
    1812   day_since_equinox = (jD_cur + jH_cur) - jD_eq
    1813   !
    1814   !   choix entre calcul de la longitude solaire vraie ou valeur fixee a
    1815   !   solarlong0
    1816   if (solarlong0<-999.) then
    1817      if (new_orbit) then
    1818         ! calcul selon la routine utilisee pour les planetes
    1819         call solarlong(day_since_equinox, zlongi, dist)
    1820      else
    1821         ! calcul selon la routine utilisee pour l'AR4
    1822         CALL orbite(REAL(days_elapsed+1),zlongi,dist)
    1823      endif
    1824   else
    1825      zlongi=solarlong0  ! longitude solaire vraie
    1826      dist=1.            ! distance au soleil / moyenne
    1827   endif
    1828   if(prt_level.ge.1)                                                &
    1829        write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
    1830 
    1831 
    1832 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    1833   ! Calcul de l'ensoleillement :
    1834   ! ============================
    1835   ! Pour une solarlong0=1000., on calcule un ensoleillement moyen sur
    1836   ! l'annee a partir d'une formule analytique.
    1837   ! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
    1838   ! non nul aux poles.
    1839   IF (abs(solarlong0-1000.)<1.e-4) then
    1840      call zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
    1841                     latitude_deg,longitude_deg,rmu0,fract)
    1842      JrNt = 1.0
    1843   ELSE
    1844   ! recode par Olivier Boucher en sept 2015
    1845      SELECT CASE (iflag_cycle_diurne)
    1846      CASE(0) 
    1847      !  Sans cycle diurne
    1848         CALL angle(zlongi, latitude_deg, fract, rmu0)
    1849         swradcorr = 1.0
    1850         JrNt = 1.0
    1851         zrmu0 = rmu0
    1852      CASE(1) 
    1853      !  Avec cycle diurne sans application des poids
    1854      !  bit comparable a l ancienne formulation cycle_diurne=true
    1855      !  on integre entre gmtime et gmtime+radpas
    1856         zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
    1857         CALL zenang(zlongi,jH_cur,0.0,zdtime, &
    1858                     latitude_deg,longitude_deg,rmu0,fract)
    1859         zrmu0 = rmu0
    1860         swradcorr = 1.0
    1861      ! Calcul du flag jour-nuit
    1862         JrNt = 0.0
    1863         WHERE (fract.GT.0.0) JrNt = 1.0
    1864      CASE(2) 
    1865      !  Avec cycle diurne sans application des poids
    1866      !  On integre entre gmtime-pdtphys et gmtime+pdtphys*(radpas-1)
    1867      !  Comme cette routine est appele a tous les pas de temps de la physique
    1868      !  meme si le rayonnement n'est pas appele je remonte en arriere les
    1869      !  radpas-1 pas de temps suivant. Petite ruse avec MOD pour prendre en
    1870      !  compte le premier pas de temps de la physique pendant lequel itaprad=0
    1871         zdtime1=dtime*REAL(-MOD(itaprad,radpas)-1)     
    1872         zdtime2=dtime*REAL(radpas-MOD(itaprad,radpas)-1)
    1873         CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
    1874                     latitude_deg,longitude_deg,rmu0,fract)
    1875      !
    1876      ! Calcul des poids
    1877      !
    1878         zdtime1=-dtime !--on corrige le rayonnement pour representer le
    1879         zdtime2=0.0    !--pas de temps de la physique qui se termine
    1880         CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
    1881                     latitude_deg,longitude_deg,zrmu0,zfract)
    1882         swradcorr = 0.0
    1883         WHERE (rmu0.GE.1.e-10 .OR. fract.GE.1.e-10) swradcorr=zfract/fract*zrmu0/rmu0
    1884      ! Calcul du flag jour-nuit
    1885         JrNt = 0.0
    1886         WHERE (zfract.GT.0.0) JrNt = 1.0
    1887      END SELECT
    1888   ENDIF
    1889 
    1890   if (mydebug) then
    1891      call writefield_phy('u_seri',u_seri,nbp_lev)
    1892      call writefield_phy('v_seri',v_seri,nbp_lev)
    1893      call writefield_phy('t_seri',t_seri,nbp_lev)
    1894      call writefield_phy('q_seri',q_seri,nbp_lev)
    1895   endif
    1896 
    1897   !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    1898   ! Appel au pbl_surface : Planetary Boudary Layer et Surface
    1899   ! Cela implique tous les interactions des sous-surfaces et la partie diffusion
    1900   ! turbulent du couche limit.
    1901   !
    1902   ! Certains varibales de sorties de pbl_surface sont utiliser que pour
    1903   ! ecriture des fihiers hist_XXXX.nc, ces sont :
    1904   !   qsol,      zq2m,      s_pblh,  s_lcl,
    1905   !   s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
    1906   !   s_therm,   s_trmb1,   s_trmb2, s_trmb3,
    1907   !   zu10m,     zv10m,   fder,
    1908   !   zxqsurf,   rh2m,      zxfluxu, zxfluxv,
    1909   !   frugs,     agesno,    fsollw,  fsolsw,
    1910   !   d_ts,      fevap,     fluxlat, t2m,
    1911   !   wfbils,    wfbilo,    fluxt,   fluxu, fluxv,
    1912   !
    1913   ! Certains ne sont pas utiliser du tout :
    1914   !   dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq
    1915   !
    1916 
    1917   ! Calcul de l'humidite de saturation au niveau du sol
    1918 
    1919 
    1920 
    1921   if (iflag_pbl/=0) then
    1922 
    1923 !jyg+nrlmd<
    1924       IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
    1925         print *,'debut du splitting de la PBL'
    1926       ENDIF
    1927 !!!
    1928 !=================================================================
    1929 !         PROVISOIRE : DECOUPLAGE PBL/WAKE
    1930 !         --------------------------------
    1931 !
    1932 !!      wake_deltat_sav(:,:)=wake_deltat(:,:)
    1933 !!      wake_deltaq_sav(:,:)=wake_deltaq(:,:)
    1934 !!      wake_deltat(:,:)=0.
    1935 !!      wake_deltaq(:,:)=0.
    1936 !=================================================================
    1937 !>jyg+nrlmd
    1938 !
    1939 !-------gustiness calculation-------!
    1940      IF (iflag_gusts==0) THEN
    1941         gustiness(1:klon)=0
    1942      ELSE IF (iflag_gusts==1) THEN
    1943         do i = 1, klon
    1944            gustiness(i)=f_gust_bl*ale_bl(i)+f_gust_wk*ale_wake(i)
    1945         enddo
    1946 !     ELSE IF (iflag_gusts==2) THEN
    1947 !        do i = 1, klon
    1948 !           gustiness(i)=f_gust_bl*ale_bl(i)+sigma_wk(i)*f_gust_wk*ale_wake(i) !! need to make sigma_wk accessible here
    1949 !        enddo
    1950 !     ELSE IF (iflag_gusts==3) THEN
    1951 !        do i = 1, klon
    1952 !           gustiness(i)=f_gust_bl*alp_bl(i)+f_gust_wk*alp_wake(i)
    1953 !        enddo
    1954      ENDIF
    1955 
    1956 
    1957 
    1958      CALL pbl_surface(  &
    1959           dtime,     date0,     itap,    days_elapsed+1, &
    1960           debut,     lafin, &
    1961           longitude_deg, latitude_deg, rugoro,  zrmu0,      &
    1962           zsig,      sollwdown, pphi,    cldt,      &
    1963           rain_fall, snow_fall, solsw,   sollw,     &
    1964           gustiness,                                &
    1965           t_seri,    q_seri,    u_seri,  v_seri,    &
    1966 !nrlmd+jyg<
    1967           wake_deltat, wake_deltaq, wake_cstar, wake_s, &
    1968 !>nrlmd+jyg
    1969           pplay,     paprs,     pctsrf,             &
    1970           ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
    1971 !albedo SB <<<
    1972           cdragh,    cdragm,  u1,    v1,            &
    1973 !albedo SB >>>
    1974 !          albsol1,   albsol2,   sens,    evap,      &
    1975           albsol_dir,   albsol_dif,   sens,    evap,   & 
    1976 !albedo SB <<<
    1977           albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
    1978           zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
    1979           d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
    1980 !nrlmd<
    1981   !jyg<
    1982           d_t_vdf_w, d_q_vdf_w, &
    1983           d_t_vdf_x, d_q_vdf_x, &
    1984           sens_x, zxfluxlat_x, sens_w, zxfluxlat_w, &
    1985   !>jyg
    1986           delta_tsurf,wake_dens, &
    1987           cdragh_x,cdragh_w,cdragm_x,cdragm_w, &
    1988           kh,kh_x,kh_w, &
    1989 !>nrlmd
    1990           coefh(1:klon,1:klev,1:nbsrf+1),     coefm(1:klon,1:klev,1:nbsrf+1), &
    1991           slab_wfbils,                 &
    1992           qsol,      zq2m,      s_pblh,  s_lcl, &
    1993 !jyg<
    1994           s_pblh_x, s_lcl_x, s_pblh_w, s_lcl_w, &
    1995 !>jyg
    1996           s_capCL,   s_oliqCL,  s_cteiCL,s_pblT, &
    1997           s_therm,   s_trmb1,   s_trmb2, s_trmb3, &
    1998           zustar, zu10m,     zv10m,   fder, &
    1999           zxqsurf,   rh2m,      zxfluxu, zxfluxv, &
    2000           z0m, z0h,     agesno,    fsollw,  fsolsw, &
    2001           d_ts,      fevap,     fluxlat, t2m, &
    2002           wfbils,    wfbilo,    fluxt,   fluxu,  fluxv, &
    2003           dsens,     devap,     zxsnow, &
    2004           zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke, &
    2005 !nrlmd+jyg<
    2006           wake_delta_pbl_TKE &
    2007 !>nrlmd+jyg
    2008                       )
    2009 !
    2010 !=================================================================
    2011 !         PROVISOIRE : DECOUPLAGE PBL/WAKE
    2012 !         --------------------------------
    2013 !
    2014 !!      wake_deltat(:,:)=wake_deltat_sav(:,:)
    2015 !!      wake_deltaq(:,:)=wake_deltaq_sav(:,:)
    2016 !=================================================================
    2017 !
    2018 !  Add turbulent diffusion tendency to the wake difference variables
    2019     IF (mod(iflag_pbl_split,2) .NE. 0) THEN
    2020      wake_deltat(:,:) = wake_deltat(:,:) + (d_t_vdf_w(:,:)-d_t_vdf_x(:,:))
    2021      wake_deltaq(:,:) = wake_deltaq(:,:) + (d_q_vdf_w(:,:)-d_q_vdf_x(:,:))
     1530    END IF
     1531
     1532
     1533    ! Tendances bidons pour les processus qui n'affectent pas certaines
     1534    ! variables.
     1535    du0(:,:)=0.
     1536    dv0(:,:)=0.
     1537    dt0 = 0.
     1538    dq0(:,:)=0.
     1539    dql0(:,:)=0.
     1540    dqi0(:,:)=0.
     1541    !
     1542    ! Mettre a zero des variables de sortie (pour securite)
     1543    !
     1544    DO i = 1, klon
     1545       d_ps(i) = 0.0
     1546    ENDDO
     1547    DO k = 1, klev
     1548       DO i = 1, klon
     1549          d_t(i,k) = 0.0
     1550          d_u(i,k) = 0.0
     1551          d_v(i,k) = 0.0
     1552       ENDDO
     1553    ENDDO
     1554    DO iq = 1, nqtot
     1555       DO k = 1, klev
     1556          DO i = 1, klon
     1557             d_qx(i,k,iq) = 0.0
     1558          ENDDO
     1559       ENDDO
     1560    ENDDO
     1561    da(:,:)=0.
     1562    mp(:,:)=0.
     1563    phi(:,:,:)=0.
     1564    ! RomP >>>
     1565    phi2(:,:,:)=0.
     1566    beta_prec_fisrt(:,:)=0.
     1567    beta_prec(:,:)=0.
     1568    epmlmMm(:,:,:)=0.
     1569    eplaMm(:,:)=0.
     1570    d1a(:,:)=0.
     1571    dam(:,:)=0.
     1572    pmflxr=0.
     1573    pmflxs=0.
     1574    ! RomP <<<
     1575
     1576    !
     1577    ! Ne pas affecter les valeurs entrees de u, v, h, et q
     1578    !
     1579    DO k = 1, klev
     1580       DO i = 1, klon
     1581          t_seri(i,k)  = t(i,k)
     1582          u_seri(i,k)  = u(i,k)
     1583          v_seri(i,k)  = v(i,k)
     1584          q_seri(i,k)  = qx(i,k,ivap)
     1585          ql_seri(i,k) = qx(i,k,iliq)
     1586          !CR: ATTENTION, on rajoute la variable glace
     1587          if (nqo.eq.2) then
     1588             qs_seri(i,k) = 0.
     1589          else if (nqo.eq.3) then
     1590             qs_seri(i,k) = qx(i,k,isol)
     1591          endif
     1592       ENDDO
     1593    ENDDO
     1594    !
     1595    !--OB mass fixer
     1596    IF (mass_fixer) THEN
     1597    !--store initial water burden
     1598    qql1(:)=0.0
     1599    DO i = 1, klon
     1600      DO k = 1, klev
     1601        qql1(i)=qql1(i)+(q_seri(i,k)+ql_seri(i,k))*zmasse(i,k)
     1602      ENDDO
     1603    ENDDO
    20221604    ENDIF
    2023 
    2024 
    2025      !---------------------------------------------------------------------
    2026      ! ajout des tendances de la diffusion turbulente
    2027      IF (klon_glo==1) THEN
    2028         CALL add_pbl_tend &
    2029         (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf',abortphy)
    2030      ELSE
    2031         CALL add_phys_tend &
    2032         (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,'vdf',abortphy)
    2033      ENDIF
    2034      !--------------------------------------------------------------------
    2035 
    2036      if (mydebug) then
    2037         call writefield_phy('u_seri',u_seri,nbp_lev)
    2038         call writefield_phy('v_seri',v_seri,nbp_lev)
    2039         call writefield_phy('t_seri',t_seri,nbp_lev)
    2040         call writefield_phy('q_seri',q_seri,nbp_lev)
    2041      endif
    2042 
    2043 
    2044 !albedo SB >>>
    2045  albsol1=0.
    2046  albsol2=0.
    2047  falb1=0.
    2048  falb2=0.
    2049 select case(nsw)
    2050 case(2)
    2051  albsol1=albsol_dir(:,1)
    2052  albsol2=albsol_dir(:,2)
    2053  falb1=falb_dir(:,1,:)
    2054  falb2=falb_dir(:,2,:)
    2055 case(4)
    2056  albsol1=albsol_dir(:,1)
    2057  albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)+albsol_dir(:,4)*SFRWL(4)
    2058  albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
    2059  falb1=falb_dir(:,1,:)
    2060  falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)+falb_dir(:,4,:)*SFRWL(4)
    2061  falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
    2062 case(6)
    2063  albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3)
    2064  albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
    2065  albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5)+albsol_dir(:,6)*SFRWL(6)
    2066  albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
    2067  falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3)
    2068  falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
    2069  falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5)+falb_dir(:,6,:)*SFRWL(6)
    2070  falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
    2071 end select
    2072 !albedo SB <<<
    2073 
    2074 
    2075      CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
    2076           t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)
    2077 
    2078 
    2079      IF (ip_ebil_phy.ge.2) THEN
    2080         ztit='after surface_main'
    2081         CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    2082              , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2083              , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2084         call diagphy(cell_area,ztit,ip_ebil_phy &
    2085              , zero_v, zero_v, zero_v, zero_v, sens &
    2086              , evap  , zero_v, zero_v, ztsol &
    2087              , d_h_vcol, d_qt, d_ec &
    2088              , fs_bound, fq_bound )
    2089      END IF
    2090 
    2091   ENDIF
    2092   ! =================================================================== c
    2093   !   Calcul de Qsat
    2094 
    2095   DO k = 1, klev
    2096      DO i = 1, klon
    2097         zx_t = t_seri(i,k)
    2098         IF (thermcep) THEN
    2099            zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
    2100            zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
    2101            zx_qs  = MIN(0.5,zx_qs)
    2102            zcor   = 1./(1.-retv*zx_qs)
    2103            zx_qs  = zx_qs*zcor
    2104         ELSE
    2105 !!           IF (zx_t.LT.t_coup) THEN             !jyg
    2106            IF (zx_t.LT.rtt) THEN                  !jyg
    2107               zx_qs = qsats(zx_t)/pplay(i,k)
    2108            ELSE
    2109               zx_qs = qsatl(zx_t)/pplay(i,k)
    2110            ENDIF
    2111         ENDIF
    2112         zqsat(i,k)=zx_qs
    2113      ENDDO
    2114   ENDDO
    2115 
    2116   if (prt_level.ge.1) then
    2117      write(lunout,*) 'L   qsat (g/kg) avant clouds_gno'
    2118      write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
    2119   endif
    2120   !
    2121   ! Appeler la convection (au choix)
    2122   !
    2123   DO k = 1, klev
    2124      DO i = 1, klon
    2125         conv_q(i,k) = d_q_dyn(i,k)  &
    2126              + d_q_vdf(i,k)/dtime
    2127         conv_t(i,k) = d_t_dyn(i,k)  &
    2128              + d_t_vdf(i,k)/dtime
    2129      ENDDO
    2130   ENDDO
    2131   IF (check) THEN
    2132      za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    2133      WRITE(lunout,*) "avantcon=", za
    2134   ENDIF
    2135   zx_ajustq = .FALSE.
    2136   IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
    2137   IF (zx_ajustq) THEN
    2138      DO i = 1, klon
    2139         z_avant(i) = 0.0
    2140      ENDDO
    2141      DO k = 1, klev
    2142         DO i = 1, klon
    2143            z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
    2144                 *(paprs(i,k)-paprs(i,k+1))/RG
    2145         ENDDO
    2146      ENDDO
    2147   ENDIF
    2148 
    2149   ! Calcule de vitesse verticale a partir de flux de masse verticale
    2150   DO k = 1, klev
    2151      DO i = 1, klon
    2152         omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
    2153      END DO
    2154   END DO
    2155   if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
    2156        omega(igout, :)
    2157 
    2158   IF (iflag_con.EQ.1) THEN
    2159      abort_message ='reactiver le call conlmd dans physiq.F'
    2160      CALL abort_physic (modname,abort_message,1)
    2161      !     CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
    2162      !    .             d_t_con, d_q_con,
    2163      !    .             rain_con, snow_con, ibas_con, itop_con)
    2164   ELSE IF (iflag_con.EQ.2) THEN
    2165      CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &
    2166           conv_t, conv_q, -evap, omega, &
    2167           d_t_con, d_q_con, rain_con, snow_con, &
    2168           pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
    2169           kcbot, kctop, kdtop, pmflxr, pmflxs)
    2170      d_u_con = 0.
    2171      d_v_con = 0.
    2172 
    2173      WHERE (rain_con < 0.) rain_con = 0.
    2174      WHERE (snow_con < 0.) snow_con = 0.
    2175      DO i = 1, klon
    2176         ibas_con(i) = klev+1 - kcbot(i)
    2177         itop_con(i) = klev+1 - kctop(i)
    2178      ENDDO
    2179   ELSE IF (iflag_con.GE.3) THEN
    2180      ! nb of tracers for the KE convection:
    2181      ! MAF la partie traceurs est faite dans phytrac
    2182      ! on met ntra=1 pour limiter les appels mais on peut
    2183      ! supprimer les calculs / ftra.
    2184      ntra = 1
    2185 
    2186      !=========================================================================
    2187      !ajout pour la parametrisation des poches froides: calcul de
    2188      !t_wake et t_undi: si pas de poches froides, t_wake=t_undi=t_seri
    2189      do k=1,klev
    2190         do i=1,klon
    2191            if (iflag_wake>=1) then
    2192               t_wake(i,k) = t_seri(i,k) &
    2193                    +(1-wake_s(i))*wake_deltat(i,k)
    2194               q_wake(i,k) = q_seri(i,k) &
    2195                    +(1-wake_s(i))*wake_deltaq(i,k)
    2196               t_undi(i,k) = t_seri(i,k) &
    2197                    -wake_s(i)*wake_deltat(i,k)
    2198               q_undi(i,k) = q_seri(i,k) &
    2199                    -wake_s(i)*wake_deltaq(i,k)
    2200            else
    2201               t_wake(i,k) = t_seri(i,k)
    2202               q_wake(i,k) = q_seri(i,k)
    2203               t_undi(i,k) = t_seri(i,k)
    2204               q_undi(i,k) = q_seri(i,k)
    2205            endif
    2206         enddo
    2207      enddo
    2208 !
    2209 !jyg<
    2210      ! Perform dry adiabatic adjustment on wake profile
    2211      ! The corresponding tendencies are added to the convective tendencies
    2212      ! after the call to the convective scheme.
    2213      IF (iflag_wake>=1) then
    2214       IF (ok_adjwk) THEN
    2215         limbas(:) = 1
    2216         CALL ajsec(paprs, pplay, t_wake, q_wake, limbas, &
     1605    !--fin mass fixer
     1606
     1607    tke0(:,:)=pbl_tke(:,:,is_ave)
     1608    !CR:Nombre de traceurs de l'eau: nqo
     1609    !  IF (nqtot.GE.3) THEN
     1610    IF (nqtot.GE.(nqo+1)) THEN
     1611       !     DO iq = 3, nqtot       
     1612       DO iq = nqo+1, nqtot 
     1613          DO  k = 1, klev
     1614             DO  i = 1, klon
     1615                !              tr_seri(i,k,iq-2) = qx(i,k,iq)
     1616                tr_seri(i,k,iq-nqo) = qx(i,k,iq)
     1617             ENDDO
     1618          ENDDO
     1619       ENDDO
     1620    ELSE
     1621       DO k = 1, klev
     1622          DO i = 1, klon
     1623             tr_seri(i,k,1) = 0.0
     1624          ENDDO
     1625       ENDDO
     1626    ENDIF
     1627    !
     1628    DO i = 1, klon
     1629       ztsol(i) = 0.
     1630    ENDDO
     1631    DO nsrf = 1, nbsrf
     1632       DO i = 1, klon
     1633          ztsol(i) = ztsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
     1634       ENDDO
     1635    ENDDO
     1636    !IM
     1637    IF (ip_ebil_phy.ge.1) THEN
     1638       ztit='after dynamic'
     1639       CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
     1640            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     1641            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     1642       !     Comme les tendances de la physique sont ajoute dans la dynamique,
     1643       !     on devrait avoir que la variation d'entalpie par la dynamique
     1644       !     est egale a la variation de la physique au pas de temps precedent.
     1645       !     Donc la somme de ces 2 variations devrait etre nulle.
     1646       call diagphy(cell_area,ztit,ip_ebil_phy &
     1647            , zero_v, zero_v, zero_v, zero_v, zero_v &
     1648            , zero_v, zero_v, zero_v, ztsol &
     1649            , d_h_vcol+d_h_vcol_phy, d_qt, 0. &
     1650            , fs_bound, fq_bound )
     1651    END IF
     1652
     1653    ! Diagnostiquer la tendance dynamique
     1654    !
     1655    IF (ancien_ok) THEN
     1656       DO k = 1, klev
     1657          DO i = 1, klon
     1658             d_u_dyn(i,k) = (u_seri(i,k)-u_ancien(i,k))/dtime
     1659             d_v_dyn(i,k) = (v_seri(i,k)-v_ancien(i,k))/dtime
     1660             d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
     1661             d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
     1662          ENDDO
     1663       ENDDO
     1664       ! !! RomP >>>   td dyn traceur
     1665       !!     IF (nqtot.GE.3) THEN       ! jyg
     1666       !!        DO iq = 3, nqtot        ! jyg
     1667       IF (nqtot.GE.nqo+1) THEN     ! jyg
     1668          DO iq = nqo+1, nqtot      ! jyg
     1669             DO k = 1, klev
     1670                DO i = 1, klon
     1671                   !! d_tr_dyn(i,k,iq-2)= &                               ! jyg
     1672                   !!    (tr_seri(i,k,iq-2)-tr_ancien(i,k,iq-2))/dtime    ! jyg
     1673                   d_tr_dyn(i,k,iq-nqo)= &                                ! jyg
     1674                        (tr_seri(i,k,iq-nqo)-tr_ancien(i,k,iq-nqo))/dtime ! jyg
     1675                   !         iiq=niadv(iq)
     1676                   ! print*,i,k," d_tr_dyn",d_tr_dyn(i,k,iq-nqo),"tra:",iq,&
     1677                   !  tname(iiq)
     1678                ENDDO
     1679             ENDDO
     1680          ENDDO
     1681       ENDIF
     1682       ! !! RomP <<<
     1683    ELSE
     1684       DO k = 1, klev
     1685          DO i = 1, klon
     1686             d_u_dyn(i,k) = 0.0
     1687             d_v_dyn(i,k) = 0.0
     1688             d_t_dyn(i,k) = 0.0
     1689             d_q_dyn(i,k) = 0.0
     1690          ENDDO
     1691       ENDDO
     1692       ! !! RomP >>>   td dyn traceur
     1693       !!     IF (nqtot.GE.3) THEN                                     ! jyg
     1694       !!        DO iq = 3, nqtot                                      ! jyg
     1695       IF (nqtot.GE.nqo+1) THEN                                        ! jyg
     1696          DO iq = nqo+1, nqtot                                         ! jyg
     1697             DO k = 1, klev
     1698                DO i = 1, klon
     1699                   !! d_tr_dyn(i,k,iq-2)= 0.0                            ! jyg
     1700                   d_tr_dyn(i,k,iq-nqo)= 0.0                             ! jyg
     1701                ENDDO
     1702             ENDDO
     1703          ENDDO
     1704       ENDIF
     1705       ! !! RomP <<<
     1706       ancien_ok = .TRUE.
     1707    ENDIF
     1708    !
     1709    ! Ajouter le geopotentiel du sol:
     1710    !
     1711    DO k = 1, klev
     1712       DO i = 1, klon
     1713          zphi(i,k) = pphi(i,k) + pphis(i)
     1714       ENDDO
     1715    ENDDO
     1716    !
     1717    ! Verifier les temperatures
     1718    !
     1719    !IM BEG
     1720    IF (check) THEN
     1721       amn=MIN(ftsol(1,is_ter),1000.)
     1722       amx=MAX(ftsol(1,is_ter),-1000.)
     1723       DO i=2, klon
     1724          amn=MIN(ftsol(i,is_ter),amn)
     1725          amx=MAX(ftsol(i,is_ter),amx)
     1726       ENDDO
     1727       !
     1728       PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx
     1729    ENDIF !(check) THEN
     1730    !IM END
     1731    !
     1732    CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
     1733    IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'
     1734
     1735    !
     1736    !IM BEG
     1737    IF (check) THEN
     1738       amn=MIN(ftsol(1,is_ter),1000.)
     1739       amx=MAX(ftsol(1,is_ter),-1000.)
     1740       DO i=2, klon
     1741          amn=MIN(ftsol(i,is_ter),amn)
     1742          amx=MAX(ftsol(i,is_ter),amx)
     1743       ENDDO
     1744       !
     1745       PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx
     1746    ENDIF !(check) THEN
     1747    !IM END
     1748    !
     1749    ! Mettre en action les conditions aux limites (albedo, sst, etc.).
     1750    ! Prescrire l'ozone et calculer l'albedo sur l'ocean.
     1751    !
     1752    if (read_climoz >= 1) then
     1753       ! Ozone from a file
     1754       ! Update required ozone index:
     1755       ro3i = int((days_elapsed + jh_cur - jh_1jan) / year_len * 360.) + 1
     1756       if (ro3i == 361) ro3i = 360
     1757       ! (This should never occur, except perhaps because of roundup
     1758       ! error. See documentation.)
     1759       if (ro3i /= co3i) then
     1760          ! Update ozone field:
     1761          if (read_climoz == 1) then
     1762             call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, &
     1763                  press_in_edg=press_climoz, paprs=paprs, v3=wo)
     1764          else
     1765             ! read_climoz == 2
     1766             call regr_pr_av(ncid_climoz, (/"tro3         ", &
     1767                  "tro3_daylight"/), julien=ro3i, press_in_edg=press_climoz, &
     1768                  paprs=paprs, v3=wo)
     1769          end if
     1770          ! Convert from mole fraction of ozone to column density of ozone in a
     1771          ! cell, in kDU:
     1772          forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
     1773               * zmasse / dobson_u / 1e3
     1774          ! (By regridding ozone values for LMDZ only once every 360th of
     1775          ! year, we have already neglected the variation of pressure in one
     1776          ! 360th of year. So do not recompute "wo" at each time step even if
     1777          ! "zmasse" changes a little.)
     1778          co3i = ro3i
     1779       end if
     1780    ELSEIF (MOD(itap-1,lmt_pas) == 0) THEN
     1781       ! Once per day, update ozone from Royer:
     1782
     1783       IF (solarlong0<-999.) then
     1784          ! Generic case with evolvoing season
     1785          zzz=real(days_elapsed+1)
     1786       ELSE IF (abs(solarlong0-1000.)<1.e-4) then
     1787          ! Particular case with annual mean insolation
     1788          zzz=real(90) ! could be revisited
     1789          IF (read_climoz/=-1) THEN
     1790             abort_message ='read_climoz=-1 is recommended when ' &
     1791                  // 'solarlong0=1000.'
     1792             CALL abort_physic (modname,abort_message,1)
     1793          ENDIF
     1794       ELSE
     1795          ! Case where the season is imposed with solarlong0
     1796          zzz=real(90) ! could be revisited
     1797       ENDIF
     1798       wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
     1799    ENDIF
     1800    !
     1801    ! Re-evaporer l'eau liquide nuageuse
     1802    !
     1803    DO k = 1, klev  ! re-evaporation de l'eau liquide nuageuse
     1804       DO i = 1, klon
     1805          zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
     1806          !jyg<
     1807          !  Attention : Arnaud a propose des formules completement differentes
     1808          !                  A verifier !!!
     1809          zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
     1810          IF (iflag_ice_thermo .EQ. 0) THEN
     1811             zlsdcp=zlvdcp
     1812          ENDIF
     1813          !>jyg
     1814
     1815          if (iflag_ice_thermo.eq.0) then   
     1816             !pas necessaire a priori
     1817
     1818             zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
     1819             zb = MAX(0.0,ql_seri(i,k))
     1820             za = - MAX(0.0,ql_seri(i,k)) &
     1821                  * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
     1822             t_seri(i,k) = t_seri(i,k) + za
     1823             q_seri(i,k) = q_seri(i,k) + zb
     1824             ql_seri(i,k) = 0.0
     1825             d_t_eva(i,k) = za
     1826             d_q_eva(i,k) = zb
     1827
     1828          else
     1829
     1830             !CR: on r\'e-\'evapore eau liquide et glace
     1831
     1832             !        zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
     1833             !        zb = MAX(0.0,ql_seri(i,k))
     1834             !        za = - MAX(0.0,ql_seri(i,k)) &
     1835             !             * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta)
     1836             zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
     1837             za = - MAX(0.0,ql_seri(i,k))*zlvdcp &
     1838                  - MAX(0.0,qs_seri(i,k))*zlsdcp
     1839             t_seri(i,k) = t_seri(i,k) + za
     1840             q_seri(i,k) = q_seri(i,k) + zb
     1841             ql_seri(i,k) = 0.0
     1842             !on \'evapore la glace
     1843             qs_seri(i,k) = 0.0
     1844             d_t_eva(i,k) = za
     1845             d_q_eva(i,k) = zb
     1846          endif
     1847
     1848       ENDDO
     1849    ENDDO
     1850    !IM
     1851    IF (ip_ebil_phy.ge.2) THEN
     1852       ztit='after reevap'
     1853       CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,1,dtime &
     1854            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     1855            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     1856       call diagphy(cell_area,ztit,ip_ebil_phy &
     1857            , zero_v, zero_v, zero_v, zero_v, zero_v &
     1858            , zero_v, zero_v, zero_v, ztsol &
     1859            , d_h_vcol, d_qt, d_ec &
     1860            , fs_bound, fq_bound )
     1861       !
     1862    END IF
     1863
     1864    !
     1865    !=========================================================================
     1866    ! Calculs de l'orbite.
     1867    ! Necessaires pour le rayonnement et la surface (calcul de l'albedo).
     1868    ! doit donc etre plac\'e avant radlwsw et pbl_surface
     1869
     1870    ! !!   jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1871    call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
     1872    day_since_equinox = (jD_cur + jH_cur) - jD_eq
     1873    !
     1874    !   choix entre calcul de la longitude solaire vraie ou valeur fixee a
     1875    !   solarlong0
     1876    if (solarlong0<-999.) then
     1877       if (new_orbit) then
     1878          ! calcul selon la routine utilisee pour les planetes
     1879          call solarlong(day_since_equinox, zlongi, dist)
     1880       else
     1881          ! calcul selon la routine utilisee pour l'AR4
     1882          CALL orbite(REAL(days_elapsed+1),zlongi,dist)
     1883       endif
     1884    else
     1885       zlongi=solarlong0  ! longitude solaire vraie
     1886       dist=1.            ! distance au soleil / moyenne
     1887    endif
     1888    if(prt_level.ge.1)                                                &
     1889         write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
     1890
     1891
     1892    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     1893    ! Calcul de l'ensoleillement :
     1894    ! ============================
     1895    ! Pour une solarlong0=1000., on calcule un ensoleillement moyen sur
     1896    ! l'annee a partir d'une formule analytique.
     1897    ! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
     1898    ! non nul aux poles.
     1899    IF (abs(solarlong0-1000.)<1.e-4) then
     1900       call zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
     1901            latitude_deg,longitude_deg,rmu0,fract)
     1902       JrNt = 1.0
     1903    ELSE
     1904       ! recode par Olivier Boucher en sept 2015
     1905       SELECT CASE (iflag_cycle_diurne)
     1906       CASE(0) 
     1907          !  Sans cycle diurne
     1908          CALL angle(zlongi, latitude_deg, fract, rmu0)
     1909          swradcorr = 1.0
     1910          JrNt = 1.0
     1911          zrmu0 = rmu0
     1912       CASE(1) 
     1913          !  Avec cycle diurne sans application des poids
     1914          !  bit comparable a l ancienne formulation cycle_diurne=true
     1915          !  on integre entre gmtime et gmtime+radpas
     1916          zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
     1917          CALL zenang(zlongi,jH_cur,0.0,zdtime, &
     1918               latitude_deg,longitude_deg,rmu0,fract)
     1919          zrmu0 = rmu0
     1920          swradcorr = 1.0
     1921          ! Calcul du flag jour-nuit
     1922          JrNt = 0.0
     1923          WHERE (fract.GT.0.0) JrNt = 1.0
     1924       CASE(2) 
     1925          !  Avec cycle diurne sans application des poids
     1926          !  On integre entre gmtime-pdtphys et gmtime+pdtphys*(radpas-1)
     1927          !  Comme cette routine est appele a tous les pas de temps de
     1928          !  la physique meme si le rayonnement n'est pas appele je
     1929          !  remonte en arriere les radpas-1 pas de temps
     1930          !  suivant. Petite ruse avec MOD pour prendre en compte le
     1931          !  premier pas de temps de la physique pendant lequel
     1932          !  itaprad=0
     1933          zdtime1=dtime*REAL(-MOD(itaprad,radpas)-1)     
     1934          zdtime2=dtime*REAL(radpas-MOD(itaprad,radpas)-1)
     1935          CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
     1936               latitude_deg,longitude_deg,rmu0,fract)
     1937          !
     1938          ! Calcul des poids
     1939          !
     1940          zdtime1=-dtime !--on corrige le rayonnement pour representer le
     1941          zdtime2=0.0    !--pas de temps de la physique qui se termine
     1942          CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
     1943               latitude_deg,longitude_deg,zrmu0,zfract)
     1944          swradcorr = 0.0
     1945          WHERE (rmu0.GE.1.e-10 .OR. fract.GE.1.e-10) &
     1946               swradcorr=zfract/fract*zrmu0/rmu0
     1947          ! Calcul du flag jour-nuit
     1948          JrNt = 0.0
     1949          WHERE (zfract.GT.0.0) JrNt = 1.0
     1950       END SELECT
     1951    ENDIF
     1952
     1953    if (mydebug) then
     1954       call writefield_phy('u_seri',u_seri,nbp_lev)
     1955       call writefield_phy('v_seri',v_seri,nbp_lev)
     1956       call writefield_phy('t_seri',t_seri,nbp_lev)
     1957       call writefield_phy('q_seri',q_seri,nbp_lev)
     1958    endif
     1959
     1960    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
     1961    ! Appel au pbl_surface : Planetary Boudary Layer et Surface
     1962    ! Cela implique tous les interactions des sous-surfaces et la
     1963    ! partie diffusion turbulent du couche limit.
     1964    !
     1965    ! Certains varibales de sorties de pbl_surface sont utiliser que pour
     1966    ! ecriture des fihiers hist_XXXX.nc, ces sont :
     1967    !   qsol,      zq2m,      s_pblh,  s_lcl,
     1968    !   s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
     1969    !   s_therm,   s_trmb1,   s_trmb2, s_trmb3,
     1970    !   zu10m,     zv10m,   fder,
     1971    !   zxqsurf,   rh2m,      zxfluxu, zxfluxv,
     1972    !   frugs,     agesno,    fsollw,  fsolsw,
     1973    !   d_ts,      fevap,     fluxlat, t2m,
     1974    !   wfbils,    wfbilo,    fluxt,   fluxu, fluxv,
     1975    !
     1976    ! Certains ne sont pas utiliser du tout :
     1977    !   dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq
     1978    !
     1979
     1980    ! Calcul de l'humidite de saturation au niveau du sol
     1981
     1982
     1983
     1984    if (iflag_pbl/=0) then
     1985
     1986       !jyg+nrlmd<
     1987       IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
     1988          print *,'debut du splitting de la PBL'
     1989       ENDIF
     1990       ! !!
     1991       !=================================================================
     1992       !         PROVISOIRE : DECOUPLAGE PBL/WAKE
     1993       !         --------------------------------
     1994       !
     1995       !!      wake_deltat_sav(:,:)=wake_deltat(:,:)
     1996       !!      wake_deltaq_sav(:,:)=wake_deltaq(:,:)
     1997       !!      wake_deltat(:,:)=0.
     1998       !!      wake_deltaq(:,:)=0.
     1999       !=================================================================
     2000       !>jyg+nrlmd
     2001       !
     2002       !-------gustiness calculation-------!
     2003       IF (iflag_gusts==0) THEN
     2004          gustiness(1:klon)=0
     2005       ELSE IF (iflag_gusts==1) THEN
     2006          do i = 1, klon
     2007             gustiness(i)=f_gust_bl*ale_bl(i)+f_gust_wk*ale_wake(i)
     2008          enddo
     2009          ! ELSE IF (iflag_gusts==2) THEN
     2010          !    do i = 1, klon
     2011          !       gustiness(i)=f_gust_bl*ale_bl(i)+sigma_wk(i)*f_gust_wk&
     2012          !           *ale_wake(i) !! need to make sigma_wk accessible here
     2013          !    enddo
     2014          ! ELSE IF (iflag_gusts==3) THEN
     2015          !    do i = 1, klon
     2016          !       gustiness(i)=f_gust_bl*alp_bl(i)+f_gust_wk*alp_wake(i)
     2017          !    enddo
     2018       ENDIF
     2019
     2020
     2021
     2022       CALL pbl_surface(  &
     2023            dtime,     date0,     itap,    days_elapsed+1, &
     2024            debut,     lafin, &
     2025            longitude_deg, latitude_deg, rugoro,  zrmu0,      &
     2026            zsig,      sollwdown, pphi,    cldt,      &
     2027            rain_fall, snow_fall, solsw,   sollw,     &
     2028            gustiness,                                &
     2029            t_seri,    q_seri,    u_seri,  v_seri,    &
     2030                                !nrlmd+jyg<
     2031            wake_deltat, wake_deltaq, wake_cstar, wake_s, &
     2032                                !>nrlmd+jyg
     2033            pplay,     paprs,     pctsrf,             &
     2034            ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
     2035                                !albedo SB <<<
     2036            cdragh,    cdragm,  u1,    v1,            &
     2037                                !albedo SB >>>
     2038                                ! albsol1,   albsol2,   sens,    evap,      &
     2039            albsol_dir,   albsol_dif,   sens,    evap,   & 
     2040                                !albedo SB <<<
     2041            albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
     2042            zxtsol,    zxfluxlat, zt2m,    qsat2m,  &
     2043            d_t_vdf,   d_q_vdf,   d_u_vdf, d_v_vdf, d_t_diss, &
     2044                                !nrlmd<
     2045                                !jyg<
     2046            d_t_vdf_w, d_q_vdf_w, &
     2047            d_t_vdf_x, d_q_vdf_x, &
     2048            sens_x, zxfluxlat_x, sens_w, zxfluxlat_w, &
     2049                                !>jyg
     2050            delta_tsurf,wake_dens, &
     2051            cdragh_x,cdragh_w,cdragm_x,cdragm_w, &
     2052            kh,kh_x,kh_w, &
     2053                                !>nrlmd
     2054            coefh(1:klon,1:klev,1:nbsrf+1), coefm(1:klon,1:klev,1:nbsrf+1), &
     2055            slab_wfbils,                 &
     2056            qsol,      zq2m,      s_pblh,  s_lcl, &
     2057                                !jyg<
     2058            s_pblh_x, s_lcl_x, s_pblh_w, s_lcl_w, &
     2059                                !>jyg
     2060            s_capCL,   s_oliqCL,  s_cteiCL,s_pblT, &
     2061            s_therm,   s_trmb1,   s_trmb2, s_trmb3, &
     2062            zustar, zu10m,     zv10m,   fder, &
     2063            zxqsurf,   rh2m,      zxfluxu, zxfluxv, &
     2064            z0m, z0h,     agesno,    fsollw,  fsolsw, &
     2065            d_ts,      fevap,     fluxlat, t2m, &
     2066            wfbils,    wfbilo,    fluxt,   fluxu,  fluxv, &
     2067            dsens,     devap,     zxsnow, &
     2068            zxfluxt,   zxfluxq,   q2m,     fluxq, pbl_tke, &
     2069                                !nrlmd+jyg<
     2070            wake_delta_pbl_TKE &
     2071                                !>nrlmd+jyg
     2072            )
     2073       !
     2074       !=================================================================
     2075       !         PROVISOIRE : DECOUPLAGE PBL/WAKE
     2076       !         --------------------------------
     2077       !
     2078       !!      wake_deltat(:,:)=wake_deltat_sav(:,:)
     2079       !!      wake_deltaq(:,:)=wake_deltaq_sav(:,:)
     2080       !=================================================================
     2081       !
     2082       !  Add turbulent diffusion tendency to the wake difference variables
     2083       IF (mod(iflag_pbl_split,2) .NE. 0) THEN
     2084          wake_deltat(:,:) = wake_deltat(:,:) + (d_t_vdf_w(:,:)-d_t_vdf_x(:,:))
     2085          wake_deltaq(:,:) = wake_deltaq(:,:) + (d_q_vdf_w(:,:)-d_q_vdf_x(:,:))
     2086       ENDIF
     2087
     2088
     2089       !---------------------------------------------------------------------
     2090       ! ajout des tendances de la diffusion turbulente
     2091       IF (klon_glo==1) THEN
     2092          CALL add_pbl_tend &
     2093               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
     2094               'vdf',abortphy)
     2095       ELSE
     2096          CALL add_phys_tend &
     2097               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
     2098               'vdf',abortphy)
     2099       ENDIF
     2100       !--------------------------------------------------------------------
     2101
     2102       if (mydebug) then
     2103          call writefield_phy('u_seri',u_seri,nbp_lev)
     2104          call writefield_phy('v_seri',v_seri,nbp_lev)
     2105          call writefield_phy('t_seri',t_seri,nbp_lev)
     2106          call writefield_phy('q_seri',q_seri,nbp_lev)
     2107       endif
     2108
     2109
     2110       !albedo SB >>>
     2111       albsol1=0.
     2112       albsol2=0.
     2113       falb1=0.
     2114       falb2=0.
     2115       select case(nsw)
     2116       case(2)
     2117          albsol1=albsol_dir(:,1)
     2118          albsol2=albsol_dir(:,2)
     2119          falb1=falb_dir(:,1,:)
     2120          falb2=falb_dir(:,2,:)
     2121       case(4)
     2122          albsol1=albsol_dir(:,1)
     2123          albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3) &
     2124               +albsol_dir(:,4)*SFRWL(4)
     2125          albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     2126          falb1=falb_dir(:,1,:)
     2127          falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3) &
     2128               +falb_dir(:,4,:)*SFRWL(4)
     2129          falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
     2130       case(6)
     2131          albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2) &
     2132               +albsol_dir(:,3)*SFRWL(3)
     2133          albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     2134          albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5) &
     2135               +albsol_dir(:,6)*SFRWL(6)
     2136          albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     2137          falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2) &
     2138               +falb_dir(:,3,:)*SFRWL(3)
     2139          falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
     2140          falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5) &
     2141               +falb_dir(:,6,:)*SFRWL(6)
     2142          falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
     2143       end select
     2144       !albedo SB <<<
     2145
     2146
     2147       CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
     2148            t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)
     2149
     2150
     2151       IF (ip_ebil_phy.ge.2) THEN
     2152          ztit='after surface_main'
     2153          CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
     2154               , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     2155               , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     2156          call diagphy(cell_area,ztit,ip_ebil_phy &
     2157               , zero_v, zero_v, zero_v, zero_v, sens &
     2158               , evap  , zero_v, zero_v, ztsol &
     2159               , d_h_vcol, d_qt, d_ec &
     2160               , fs_bound, fq_bound )
     2161       END IF
     2162
     2163    ENDIF
     2164    ! =================================================================== c
     2165    !   Calcul de Qsat
     2166
     2167    DO k = 1, klev
     2168       DO i = 1, klon
     2169          zx_t = t_seri(i,k)
     2170          IF (thermcep) THEN
     2171             zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
     2172             zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
     2173             zx_qs  = MIN(0.5,zx_qs)
     2174             zcor   = 1./(1.-retv*zx_qs)
     2175             zx_qs  = zx_qs*zcor
     2176          ELSE
     2177             !!           IF (zx_t.LT.t_coup) THEN             !jyg
     2178             IF (zx_t.LT.rtt) THEN                  !jyg
     2179                zx_qs = qsats(zx_t)/pplay(i,k)
     2180             ELSE
     2181                zx_qs = qsatl(zx_t)/pplay(i,k)
     2182             ENDIF
     2183          ENDIF
     2184          zqsat(i,k)=zx_qs
     2185       ENDDO
     2186    ENDDO
     2187
     2188    if (prt_level.ge.1) then
     2189       write(lunout,*) 'L   qsat (g/kg) avant clouds_gno'
     2190       write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
     2191    endif
     2192    !
     2193    ! Appeler la convection (au choix)
     2194    !
     2195    DO k = 1, klev
     2196       DO i = 1, klon
     2197          conv_q(i,k) = d_q_dyn(i,k)  &
     2198               + d_q_vdf(i,k)/dtime
     2199          conv_t(i,k) = d_t_dyn(i,k)  &
     2200               + d_t_vdf(i,k)/dtime
     2201       ENDDO
     2202    ENDDO
     2203    IF (check) THEN
     2204       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
     2205       WRITE(lunout,*) "avantcon=", za
     2206    ENDIF
     2207    zx_ajustq = .FALSE.
     2208    IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
     2209    IF (zx_ajustq) THEN
     2210       DO i = 1, klon
     2211          z_avant(i) = 0.0
     2212       ENDDO
     2213       DO k = 1, klev
     2214          DO i = 1, klon
     2215             z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
     2216                  *(paprs(i,k)-paprs(i,k+1))/RG
     2217          ENDDO
     2218       ENDDO
     2219    ENDIF
     2220
     2221    ! Calcule de vitesse verticale a partir de flux de masse verticale
     2222    DO k = 1, klev
     2223       DO i = 1, klon
     2224          omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
     2225       END DO
     2226    END DO
     2227    if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
     2228         omega(igout, :)
     2229
     2230    IF (iflag_con.EQ.1) THEN
     2231       abort_message ='reactiver le call conlmd dans physiq.F'
     2232       CALL abort_physic (modname,abort_message,1)
     2233       !     CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
     2234       !    .             d_t_con, d_q_con,
     2235       !    .             rain_con, snow_con, ibas_con, itop_con)
     2236    ELSE IF (iflag_con.EQ.2) THEN
     2237       CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &
     2238            conv_t, conv_q, -evap, omega, &
     2239            d_t_con, d_q_con, rain_con, snow_con, &
     2240            pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
     2241            kcbot, kctop, kdtop, pmflxr, pmflxs)
     2242       d_u_con = 0.
     2243       d_v_con = 0.
     2244
     2245       WHERE (rain_con < 0.) rain_con = 0.
     2246       WHERE (snow_con < 0.) snow_con = 0.
     2247       DO i = 1, klon
     2248          ibas_con(i) = klev+1 - kcbot(i)
     2249          itop_con(i) = klev+1 - kctop(i)
     2250       ENDDO
     2251    ELSE IF (iflag_con.GE.3) THEN
     2252       ! nb of tracers for the KE convection:
     2253       ! MAF la partie traceurs est faite dans phytrac
     2254       ! on met ntra=1 pour limiter les appels mais on peut
     2255       ! supprimer les calculs / ftra.
     2256       ntra = 1
     2257
     2258       !=======================================================================
     2259       !ajout pour la parametrisation des poches froides: calcul de
     2260       !t_wake et t_undi: si pas de poches froides, t_wake=t_undi=t_seri
     2261       do k=1,klev
     2262          do i=1,klon
     2263             if (iflag_wake>=1) then
     2264                t_wake(i,k) = t_seri(i,k) &
     2265                     +(1-wake_s(i))*wake_deltat(i,k)
     2266                q_wake(i,k) = q_seri(i,k) &
     2267                     +(1-wake_s(i))*wake_deltaq(i,k)
     2268                t_undi(i,k) = t_seri(i,k) &
     2269                     -wake_s(i)*wake_deltat(i,k)
     2270                q_undi(i,k) = q_seri(i,k) &
     2271                     -wake_s(i)*wake_deltaq(i,k)
     2272             else
     2273                t_wake(i,k) = t_seri(i,k)
     2274                q_wake(i,k) = q_seri(i,k)
     2275                t_undi(i,k) = t_seri(i,k)
     2276                q_undi(i,k) = q_seri(i,k)
     2277             endif
     2278          enddo
     2279       enddo
     2280       !
     2281       !jyg<
     2282       ! Perform dry adiabatic adjustment on wake profile
     2283       ! The corresponding tendencies are added to the convective tendencies
     2284       ! after the call to the convective scheme.
     2285       IF (iflag_wake>=1) then
     2286          IF (ok_adjwk) THEN
     2287             limbas(:) = 1
     2288             CALL ajsec(paprs, pplay, t_wake, q_wake, limbas, &
    22172289                  d_t_adjwk, d_q_adjwk)
    2218       ENDIF
    2219 !
    2220       DO k=1,klev
    2221         DO i=1,klon
    2222           IF (wake_s(i) .GT. 1.e-3) THEN
    2223             t_wake(i,k) = t_wake(i,k) + d_t_adjwk(i,k)
    2224             q_wake(i,k) = q_wake(i,k) + d_q_adjwk(i,k)
    2225             wake_deltat(i,k) = wake_deltat(i,k) + d_t_adjwk(i,k)
    2226             wake_deltaq(i,k) = wake_deltaq(i,k) + d_q_adjwk(i,k)
    22272290          ENDIF
    2228         ENDDO
    2229       ENDDO
    2230      ENDIF ! (iflag_wake>=1)
    2231 !>jyg
    2232 !
    2233 
    2234      ! Calcul de l'energie disponible ALE (J/kg) et de la puissance
    2235      ! disponible ALP (W/m2) pour le soulevement des particules dans
    2236      ! le modele convectif
    2237      !
    2238      do i = 1,klon
    2239         ALE(i) = 0.
    2240         ALP(i) = 0.
    2241      enddo
    2242      !
    2243      !calcul de ale_wake et alp_wake
    2244      if (iflag_wake>=1) then
    2245         if (itap .le. it_wape_prescr) then
    2246            do i = 1,klon
    2247               ale_wake(i) = wape_prescr
    2248               alp_wake(i) = fip_prescr
    2249            enddo
    2250         else
    2251            do i = 1,klon
    2252               !jyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
    2253               !cc           ale_wake(i) = 0.5*wake_cstar(i)**2
    2254               ale_wake(i) = wake_pe(i)
    2255               alp_wake(i) = wake_fip(i)
    2256            enddo
    2257         endif
    2258      else
    2259         do i = 1,klon
    2260            ale_wake(i) = 0.
    2261            alp_wake(i) = 0.
    2262         enddo
    2263      endif
    2264      !combinaison avec ale et alp de couche limite: constantes si pas
    2265      !de couplage, valeurs calculees dans le thermique sinon
    2266      if (iflag_coupl.eq.0) then
    2267         if (debut.and.prt_level.gt.9) &
    2268              WRITE(lunout,*)'ALE et ALP imposes'
    2269         do i = 1,klon
    2270            !on ne couple que ale
    2271            !           ALE(i) = max(ale_wake(i),Ale_bl(i))
    2272            ALE(i) = max(ale_wake(i),ale_bl_prescr)
    2273            !on ne couple que alp
    2274            !           ALP(i) = alp_wake(i) + Alp_bl(i)
    2275            ALP(i) = alp_wake(i) + alp_bl_prescr
    2276         enddo
    2277      else
    2278         IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique'
    2279         !         do i = 1,klon
    2280         !             ALE(i) = max(ale_wake(i),Ale_bl(i))
    2281         ! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
    2282         !             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
    2283         !         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
    2284         !         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
    2285         !         enddo
    2286 
    2287         ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2288         ! Modif FH 2010/04/27. Sans doute temporaire.
    2289         ! Deux options pour le alp_offset : constant si >?? 0 ou
    2290         ! proportionnel ??a w si <0
    2291         ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2292 ! Estimation d'une vitesse verticale effective pour ALP
    2293         if (1==0) THEN
    2294         www(1:klon)=0.
    2295         do k=2,klev-1
    2296            do i=1,klon
    2297               www(i)=max(www(i),-omega(i,k)*RD*t_seri(i,k)/(RG*paprs(i,k)) &
    2298 &                    *zw2(i,k)*zw2(i,k))
    2299 !             if (paprs(i,k)>pbase(i)) then
    2300 ! calcul approche de la vitesse verticale en m/s
    2301 !                www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k))
    2302 !             endif
    2303 !   Le 0.1 est en gros H / ps = 1e5 / 1e4
    2304            enddo
    2305         enddo
    2306         do i=1,klon
    2307            if (www(i)>0. .and. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i)
    2308         enddo
    2309         ENDIF
    2310 
    2311 
    2312         do i = 1,klon
    2313            ALE(i) = max(ale_wake(i),Ale_bl(i))
    2314            !cc nrlmd le 10/04/2012----------Stochastic triggering--------------
    2315            if (iflag_trig_bl.ge.1) then
    2316               ALE(i) = max(ale_wake(i),Ale_bl_trig(i))
    2317            endif
    2318            !cc fin nrlmd le 10/04/2012
    2319            if (alp_offset>=0.) then
    2320               ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
    2321            else
    2322        abort_message ='Ne pas passer la car www non calcule'
    2323        CALL abort_physic (modname,abort_message,1)
    2324 
    2325 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2326 !                                _                  _
    2327 ! Ajout d'une composante 3 * A * w w'2 a  w'3  avec w=www : w max sous pbase
    2328 !       ou A est la fraction couverte par les ascendances w'
    2329 !       on utilise le fait que A * w'3 = ALP
    2330 !       et donc A * w'2 ~ ALP / sqrt(ALE)  (on ajoute 0.1 pour les
    2331 !       singularites)
    2332              ALP(i)=alp_wake(i)*(1.+3.*www(i)/( sqrt(ale_wake(i))+0.1) ) &
    2333   &                +alp_bl(i)  *(1.+3.*www(i)/( sqrt(ale_bl(i))  +0.1) )
    2334 !             ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
    2335 !             if (alp(i)<0.) then
    2336 !                print*,'ALP ',alp(i),alp_wake(i) &
    2337 !                     ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
    2338 !             endif
    2339            endif
    2340         enddo
    2341 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2342 
    2343      endif
    2344      do i=1,klon
    2345         if (alp(i)>alp_max) then
    2346            IF(prt_level>9)WRITE(lunout,*)                             &
    2347                 'WARNING SUPER ALP (seuil=',alp_max, &
    2348                 '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i)
    2349            alp(i)=alp_max
    2350         endif
    2351         if (ale(i)>ale_max) then
    2352            IF(prt_level>9)WRITE(lunout,*)                             &
    2353                 'WARNING SUPER ALE (seuil=',ale_max, &
    2354                 '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i)
    2355            ale(i)=ale_max
    2356         endif
    2357      enddo
    2358 
    2359      !fin calcul ale et alp
    2360      !=======================================================================
    2361 
    2362 
    2363      ! sb, oct02:
    2364      ! Schema de convection modularise et vectorise:
    2365      ! (driver commun aux versions 3 et 4)
    2366      !
    2367      IF (ok_cvl) THEN ! new driver for convectL
    2368      !
    2369 !jyg<
    2370 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2371      ! Calculate the upmost level of deep convection loops: k_upper_cv
    2372      !  (near 22 km)
    2373    izero = klon/2+1/klon
    2374    k_upper_cv = klev
    2375    DO k = klev,1,-1
    2376      IF (pphi(izero,k) > 22.e4) k_upper_cv = k
    2377    ENDDO
    2378    IF (prt_level .ge. 5) THEN
    2379      Print *, 'upmost level of deep convection loops: k_upper_cv = ',k_upper_cv
    2380    ENDIF
    2381      !
    2382 !>jyg
    2383         IF (type_trac == 'repr') THEN
    2384            nbtr_tmp=ntra
    2385         ELSE
    2386            nbtr_tmp=nbtr
    2387         END IF
    2388         !jyg   iflag_con est dans clesphys
    2389         !c          CALL concvl (iflag_con,iflag_clos,
    2390         CALL concvl (iflag_clos, &
    2391              dtime, paprs, pplay, k_upper_cv, t_undi,q_undi, &
    2392              t_wake,q_wake,wake_s, &
    2393              u_seri,v_seri,tr_seri,nbtr_tmp, &
    2394              ALE,ALP, &
    2395              sig1,w01, &
    2396              d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
    2397              rain_con, snow_con, ibas_con, itop_con, sigd, &
    2398              ema_cbmf,plcl,plfc,wbeff,upwd,dnwd,dnwd0, &
    2399              Ma,mip,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &
    2400              pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
    2401              ! RomP >>>
    2402              !!     .        pmflxr,pmflxs,da,phi,mp,
    2403              !!     .        ftd,fqd,lalim_conv,wght_th)
    2404              pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,clw,elij, &
    2405              ftd,fqd,lalim_conv,wght_th, &
    2406              ev, ep,epmlmMm,eplaMm, &
    2407              wdtrainA,wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &
    2408              tau_cld_cv,coefw_cld_cv)
    2409         ! RomP <<<
    2410 
    2411         !IM begin
    2412         !       print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
    2413         !    .dnwd0(1,1),ftd(1,1),fqd(1,1)
    2414         !IM end
    2415         !IM cf. FH
    2416         clwcon0=qcondc
    2417         pmfu(:,:)=upwd(:,:)+dnwd(:,:)
    2418 
    2419         do i = 1, klon
    2420            if (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+1
    2421         enddo
    2422 !
    2423 !jyg<
    2424 !    Add the tendency due to the dry adjustment of the wake profile
    2425       IF (iflag_wake>=1) THEN
    2426         DO k=1,klev
     2291          !
     2292          DO k=1,klev
     2293             DO i=1,klon
     2294                IF (wake_s(i) .GT. 1.e-3) THEN
     2295                   t_wake(i,k) = t_wake(i,k) + d_t_adjwk(i,k)
     2296                   q_wake(i,k) = q_wake(i,k) + d_q_adjwk(i,k)
     2297                   wake_deltat(i,k) = wake_deltat(i,k) + d_t_adjwk(i,k)
     2298                   wake_deltaq(i,k) = wake_deltaq(i,k) + d_q_adjwk(i,k)
     2299                ENDIF
     2300             ENDDO
     2301          ENDDO
     2302       ENDIF ! (iflag_wake>=1)
     2303       !>jyg
     2304       !
     2305
     2306       ! Calcul de l'energie disponible ALE (J/kg) et de la puissance
     2307       ! disponible ALP (W/m2) pour le soulevement des particules dans
     2308       ! le modele convectif
     2309       !
     2310       do i = 1,klon
     2311          ALE(i) = 0.
     2312          ALP(i) = 0.
     2313       enddo
     2314       !
     2315       !calcul de ale_wake et alp_wake
     2316       if (iflag_wake>=1) then
     2317          if (itap .le. it_wape_prescr) then
     2318             do i = 1,klon
     2319                ale_wake(i) = wape_prescr
     2320                alp_wake(i) = fip_prescr
     2321             enddo
     2322          else
     2323             do i = 1,klon
     2324                !jyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
     2325                !cc           ale_wake(i) = 0.5*wake_cstar(i)**2
     2326                ale_wake(i) = wake_pe(i)
     2327                alp_wake(i) = wake_fip(i)
     2328             enddo
     2329          endif
     2330       else
     2331          do i = 1,klon
     2332             ale_wake(i) = 0.
     2333             alp_wake(i) = 0.
     2334          enddo
     2335       endif
     2336       !combinaison avec ale et alp de couche limite: constantes si pas
     2337       !de couplage, valeurs calculees dans le thermique sinon
     2338       if (iflag_coupl.eq.0) then
     2339          if (debut.and.prt_level.gt.9) &
     2340               WRITE(lunout,*)'ALE et ALP imposes'
     2341          do i = 1,klon
     2342             !on ne couple que ale
     2343             !           ALE(i) = max(ale_wake(i),Ale_bl(i))
     2344             ALE(i) = max(ale_wake(i),ale_bl_prescr)
     2345             !on ne couple que alp
     2346             !           ALP(i) = alp_wake(i) + Alp_bl(i)
     2347             ALP(i) = alp_wake(i) + alp_bl_prescr
     2348          enddo
     2349       else
     2350          IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique'
     2351          !         do i = 1,klon
     2352          !             ALE(i) = max(ale_wake(i),Ale_bl(i))
     2353          ! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
     2354          !             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
     2355          !         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
     2356          !         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
     2357          !         enddo
     2358
     2359          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2360          ! Modif FH 2010/04/27. Sans doute temporaire.
     2361          ! Deux options pour le alp_offset : constant si >?? 0 ou
     2362          ! proportionnel ??a w si <0
     2363          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2364          ! Estimation d'une vitesse verticale effective pour ALP
     2365          if (1==0) THEN
     2366             www(1:klon)=0.
     2367             do k=2,klev-1
     2368                do i=1,klon
     2369                   www(i)=max(www(i),-omega(i,k)*RD*t_seri(i,k) &
     2370                        /(RG*paprs(i,k)) *zw2(i,k)*zw2(i,k))
     2371                   ! if (paprs(i,k)>pbase(i)) then
     2372                   ! calcul approche de la vitesse verticale en m/s
     2373                   !  www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k))
     2374                   !             endif
     2375                   !   Le 0.1 est en gros H / ps = 1e5 / 1e4
     2376                enddo
     2377             enddo
     2378             do i=1,klon
     2379                if (www(i)>0. .and. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i)
     2380             enddo
     2381          ENDIF
     2382
     2383
     2384          do i = 1,klon
     2385             ALE(i) = max(ale_wake(i),Ale_bl(i))
     2386             !cc nrlmd le 10/04/2012----------Stochastic triggering------------
     2387             if (iflag_trig_bl.ge.1) then
     2388                ALE(i) = max(ale_wake(i),Ale_bl_trig(i))
     2389             endif
     2390             !cc fin nrlmd le 10/04/2012
     2391             if (alp_offset>=0.) then
     2392                ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
     2393             else
     2394                abort_message ='Ne pas passer la car www non calcule'
     2395                CALL abort_physic (modname,abort_message,1)
     2396
     2397                ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2398                !                                _                  _
     2399                ! Ajout d'une composante 3 * A * w w'2 a w'3 avec
     2400                ! w=www : w max sous pbase ou A est la fraction
     2401                ! couverte par les ascendances w' on utilise le fait
     2402                ! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE)
     2403                ! (on ajoute 0.1 pour les singularites)
     2404                ALP(i)=alp_wake(i)*(1.+3.*www(i)/( sqrt(ale_wake(i))+0.1) ) &
     2405                     +alp_bl(i)  *(1.+3.*www(i)/( sqrt(ale_bl(i))  +0.1) )
     2406                !    ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
     2407                !             if (alp(i)<0.) then
     2408                !                print*,'ALP ',alp(i),alp_wake(i) &
     2409                !                     ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
     2410                !             endif
     2411             endif
     2412          enddo
     2413          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2414
     2415       endif
     2416       do i=1,klon
     2417          if (alp(i)>alp_max) then
     2418             IF(prt_level>9)WRITE(lunout,*)                             &
     2419                  'WARNING SUPER ALP (seuil=',alp_max, &
     2420                  '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i)
     2421             alp(i)=alp_max
     2422          endif
     2423          if (ale(i)>ale_max) then
     2424             IF(prt_level>9)WRITE(lunout,*)                             &
     2425                  'WARNING SUPER ALE (seuil=',ale_max, &
     2426                  '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i)
     2427             ale(i)=ale_max
     2428          endif
     2429       enddo
     2430
     2431       !fin calcul ale et alp
     2432       !=======================================================================
     2433
     2434
     2435       ! sb, oct02:
     2436       ! Schema de convection modularise et vectorise:
     2437       ! (driver commun aux versions 3 et 4)
     2438       !
     2439       IF (ok_cvl) THEN ! new driver for convectL
     2440          !
     2441          !jyg<
     2442          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     2443          ! Calculate the upmost level of deep convection loops: k_upper_cv
     2444          !  (near 22 km)
     2445          izero = klon/2+1/klon
     2446          k_upper_cv = klev
     2447          DO k = klev,1,-1
     2448             IF (pphi(izero,k) > 22.e4) k_upper_cv = k
     2449          ENDDO
     2450          IF (prt_level .ge. 5) THEN
     2451             Print *, 'upmost level of deep convection loops: k_upper_cv = ', &
     2452                  k_upper_cv
     2453          ENDIF
     2454          !
     2455          !>jyg
     2456          IF (type_trac == 'repr') THEN
     2457             nbtr_tmp=ntra
     2458          ELSE
     2459             nbtr_tmp=nbtr
     2460          END IF
     2461          !jyg   iflag_con est dans clesphys
     2462          !c          CALL concvl (iflag_con,iflag_clos,
     2463          CALL concvl (iflag_clos, &
     2464               dtime, paprs, pplay, k_upper_cv, t_undi,q_undi, &
     2465               t_wake,q_wake,wake_s, &
     2466               u_seri,v_seri,tr_seri,nbtr_tmp, &
     2467               ALE,ALP, &
     2468               sig1,w01, &
     2469               d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
     2470               rain_con, snow_con, ibas_con, itop_con, sigd, &
     2471               ema_cbmf,plcl,plfc,wbeff,upwd,dnwd,dnwd0, &
     2472               Ma,mip,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &
     2473               pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
     2474                                ! RomP >>>
     2475                                !!     .        pmflxr,pmflxs,da,phi,mp,
     2476                                !!     .        ftd,fqd,lalim_conv,wght_th)
     2477               pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,clw,elij, &
     2478               ftd,fqd,lalim_conv,wght_th, &
     2479               ev, ep,epmlmMm,eplaMm, &
     2480               wdtrainA,wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &
     2481               tau_cld_cv,coefw_cld_cv,epmax_diag)
     2482          ! RomP <<<
     2483
     2484          !IM begin
     2485          !       print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
     2486          !    .dnwd0(1,1),ftd(1,1),fqd(1,1)
     2487          !IM end
     2488          !IM cf. FH
     2489          clwcon0=qcondc
     2490          pmfu(:,:)=upwd(:,:)+dnwd(:,:)
     2491
     2492          do i = 1, klon
     2493             if (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+1
     2494          enddo
     2495          !
     2496          !jyg<
     2497          !    Add the tendency due to the dry adjustment of the wake profile
     2498          IF (iflag_wake>=1) THEN
     2499             DO k=1,klev
     2500                DO i=1,klon
     2501                   ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/dtime
     2502                   fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/dtime
     2503                   d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
     2504                   d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
     2505                ENDDO
     2506             ENDDO
     2507          ENDIF
     2508          !>jyg
     2509          !
     2510       ELSE ! ok_cvl
     2511
     2512          ! MAF conema3 ne contient pas les traceurs
     2513          CALL conema3 (dtime, &
     2514               paprs,pplay,t_seri,q_seri, &
     2515               u_seri,v_seri,tr_seri,ntra, &
     2516               sig1,w01, &
     2517               d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
     2518               rain_con, snow_con, ibas_con, itop_con, &
     2519               upwd,dnwd,dnwd0,bas,top, &
     2520               Ma,cape,tvp,rflag, &
     2521               pbase &
     2522               ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr &
     2523               ,clwcon0)
     2524
     2525       ENDIF ! ok_cvl
     2526
     2527       !
     2528       ! Correction precip
     2529       rain_con = rain_con * cvl_corr
     2530       snow_con = snow_con * cvl_corr
     2531       !
     2532
     2533       IF (.NOT. ok_gust) THEN
     2534          do i = 1, klon
     2535             wd(i)=0.0
     2536          enddo
     2537       ENDIF
     2538
     2539       ! =================================================================== c
     2540       ! Calcul des proprietes des nuages convectifs
     2541       !
     2542
     2543       !   calcul des proprietes des nuages convectifs
     2544       clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
     2545       IF (iflag_cld_cv == 0) THEN
     2546          call clouds_gno &
     2547               (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
     2548       ELSE
     2549          call clouds_bigauss &
     2550               (klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
     2551       ENDIF
     2552
     2553
     2554       ! =================================================================== c
     2555
     2556       DO i = 1, klon
     2557          itop_con(i) = min(max(itop_con(i),1),klev)
     2558          ibas_con(i) = min(max(ibas_con(i),1),itop_con(i))
     2559       ENDDO
     2560
     2561       DO i = 1, klon
     2562          ema_pcb(i)  = paprs(i,ibas_con(i))
     2563       ENDDO
     2564       DO i = 1, klon
     2565          ! L'idicage de itop_con peut cacher un pb potentiel
     2566          ! FH sous la dictee de JYG, CR
     2567          ema_pct(i)  = paprs(i,itop_con(i)+1)
     2568
     2569          if (itop_con(i).gt.klev-3) then
     2570             if(prt_level >= 9) then
     2571                write(lunout,*)'La convection monte trop haut '
     2572                write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
     2573             endif
     2574          endif
     2575       ENDDO
     2576    ELSE IF (iflag_con.eq.0) THEN
     2577       write(lunout,*) 'On n appelle pas la convection'
     2578       clwcon0=0.
     2579       rnebcon0=0.
     2580       d_t_con=0.
     2581       d_q_con=0.
     2582       d_u_con=0.
     2583       d_v_con=0.
     2584       rain_con=0.
     2585       snow_con=0.
     2586       bas=1
     2587       top=1
     2588    ELSE
     2589       WRITE(lunout,*) "iflag_con non-prevu", iflag_con
     2590       call abort_physic("physiq", "", 1)
     2591    ENDIF
     2592
     2593    !     CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
     2594    !    .              d_u_con, d_v_con)
     2595
     2596    CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
     2597         'convection',abortphy)
     2598
     2599    !-------------------------------------------------------------------------
     2600
     2601    if (mydebug) then
     2602       call writefield_phy('u_seri',u_seri,nbp_lev)
     2603       call writefield_phy('v_seri',v_seri,nbp_lev)
     2604       call writefield_phy('t_seri',t_seri,nbp_lev)
     2605       call writefield_phy('q_seri',q_seri,nbp_lev)
     2606    endif
     2607
     2608    !IM
     2609    IF (ip_ebil_phy.ge.2) THEN
     2610       ztit='after convect'
     2611       CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
     2612            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     2613            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     2614       call diagphy(cell_area,ztit,ip_ebil_phy &
     2615            , zero_v, zero_v, zero_v, zero_v, zero_v &
     2616            , zero_v, rain_con, snow_con, ztsol &
     2617            , d_h_vcol, d_qt, d_ec &
     2618            , fs_bound, fq_bound )
     2619    END IF
     2620    !
     2621    IF (check) THEN
     2622       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
     2623       WRITE(lunout,*)"aprescon=", za
     2624       zx_t = 0.0
     2625       za = 0.0
     2626       DO i = 1, klon
     2627          za = za + cell_area(i)/REAL(klon)
     2628          zx_t = zx_t + (rain_con(i)+ &
     2629               snow_con(i))*cell_area(i)/REAL(klon)
     2630       ENDDO
     2631       zx_t = zx_t/za*dtime
     2632       WRITE(lunout,*)"Precip=", zx_t
     2633    ENDIF
     2634    IF (zx_ajustq) THEN
     2635       DO i = 1, klon
     2636          z_apres(i) = 0.0
     2637       ENDDO
     2638       DO k = 1, klev
     2639          DO i = 1, klon
     2640             z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
     2641                  *(paprs(i,k)-paprs(i,k+1))/RG
     2642          ENDDO
     2643       ENDDO
     2644       DO i = 1, klon
     2645          z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &
     2646               /z_apres(i)
     2647       ENDDO
     2648       DO k = 1, klev
     2649          DO i = 1, klon
     2650             IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
     2651                  z_factor(i).LT.(1.0-1.0E-08)) THEN
     2652                q_seri(i,k) = q_seri(i,k) * z_factor(i)
     2653             ENDIF
     2654          ENDDO
     2655       ENDDO
     2656    ENDIF
     2657    zx_ajustq=.FALSE.
     2658
     2659    !
     2660    !==========================================================================
     2661    !RR:Evolution de la poche froide: on ne fait pas de separation wake/env
     2662    !pour la couche limite diffuse pour l instant
     2663    !
     2664    !
     2665    ! nrlmd le 22/03/2011---Si on met les poches hors des thermiques
     2666    ! il faut rajouter cette tendance calcul\'ee hors des poches
     2667    ! froides
     2668    !
     2669    if (iflag_wake>=1) then
     2670       DO k=1,klev
    24272671          DO i=1,klon
    2428             ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/dtime
    2429             fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/dtime
    2430             d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
    2431             d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
     2672             dt_dwn(i,k)  = ftd(i,k)
     2673             dq_dwn(i,k)  = fqd(i,k)
     2674             M_dwn(i,k)   = dnwd0(i,k)
     2675             M_up(i,k)    = upwd(i,k)
     2676             dt_a(i,k)    = d_t_con(i,k)/dtime - ftd(i,k)
     2677             dq_a(i,k)    = d_q_con(i,k)/dtime - fqd(i,k)
    24322678          ENDDO
    2433         ENDDO
    2434       ENDIF
    2435 !>jyg
    2436 !
    2437      ELSE ! ok_cvl
    2438 
    2439         ! MAF conema3 ne contient pas les traceurs
    2440         CALL conema3 (dtime, &
    2441              paprs,pplay,t_seri,q_seri, &
    2442              u_seri,v_seri,tr_seri,ntra, &
    2443              sig1,w01, &
    2444              d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
    2445              rain_con, snow_con, ibas_con, itop_con, &
    2446              upwd,dnwd,dnwd0,bas,top, &
    2447              Ma,cape,tvp,rflag, &
    2448              pbase &
    2449              ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr &
    2450              ,clwcon0)
    2451 
    2452      ENDIF ! ok_cvl
    2453 
    2454      !
    2455      ! Correction precip
    2456      rain_con = rain_con * cvl_corr
    2457      snow_con = snow_con * cvl_corr
    2458      !
    2459 
    2460      IF (.NOT. ok_gust) THEN
    2461         do i = 1, klon
    2462            wd(i)=0.0
    2463         enddo
    2464      ENDIF
    2465 
    2466      ! =================================================================== c
    2467      ! Calcul des proprietes des nuages convectifs
    2468      !
    2469 
    2470      !   calcul des proprietes des nuages convectifs
    2471      clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
    2472      IF (iflag_cld_cv == 0) THEN
    2473      call clouds_gno &
    2474           (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
    2475      ELSE
    2476      call clouds_bigauss &
    2477           (klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
    2478      ENDIF
    2479 
    2480 
    2481      ! =================================================================== c
    2482 
    2483      DO i = 1, klon
    2484         itop_con(i) = min(max(itop_con(i),1),klev)
    2485         ibas_con(i) = min(max(ibas_con(i),1),itop_con(i))
    2486      ENDDO
    2487 
    2488      DO i = 1, klon
    2489         ema_pcb(i)  = paprs(i,ibas_con(i))
    2490      ENDDO
    2491      DO i = 1, klon
    2492         ! L'idicage de itop_con peut cacher un pb potentiel
    2493         ! FH sous la dictee de JYG, CR
    2494         ema_pct(i)  = paprs(i,itop_con(i)+1)
    2495 
    2496         if (itop_con(i).gt.klev-3) then
    2497            if(prt_level >= 9) then
    2498               write(lunout,*)'La convection monte trop haut '
    2499               write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
    2500            endif
    2501         endif
    2502      ENDDO
    2503   ELSE IF (iflag_con.eq.0) THEN
    2504      write(lunout,*) 'On n appelle pas la convection'
    2505      clwcon0=0.
    2506      rnebcon0=0.
    2507      d_t_con=0.
    2508      d_q_con=0.
    2509      d_u_con=0.
    2510      d_v_con=0.
    2511      rain_con=0.
    2512      snow_con=0.
    2513      bas=1
    2514      top=1
    2515   ELSE
    2516      WRITE(lunout,*) "iflag_con non-prevu", iflag_con
    2517      call abort_physic("physiq", "", 1)
    2518   ENDIF
    2519 
    2520   !     CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
    2521   !    .              d_u_con, d_v_con)
    2522 
    2523   CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
    2524        'convection',abortphy)
    2525 
    2526   !----------------------------------------------------------------------------
    2527 
    2528   if (mydebug) then
    2529      call writefield_phy('u_seri',u_seri,nbp_lev)
    2530      call writefield_phy('v_seri',v_seri,nbp_lev)
    2531      call writefield_phy('t_seri',t_seri,nbp_lev)
    2532      call writefield_phy('q_seri',q_seri,nbp_lev)
    2533   endif
    2534 
    2535   !IM
    2536   IF (ip_ebil_phy.ge.2) THEN
    2537      ztit='after convect'
    2538      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    2539           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2540           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2541      call diagphy(cell_area,ztit,ip_ebil_phy &
    2542           , zero_v, zero_v, zero_v, zero_v, zero_v &
    2543           , zero_v, rain_con, snow_con, ztsol &
    2544           , d_h_vcol, d_qt, d_ec &
    2545           , fs_bound, fq_bound )
    2546   END IF
    2547   !
    2548   IF (check) THEN
    2549      za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    2550      WRITE(lunout,*)"aprescon=", za
    2551      zx_t = 0.0
    2552      za = 0.0
    2553      DO i = 1, klon
    2554         za = za + cell_area(i)/REAL(klon)
    2555         zx_t = zx_t + (rain_con(i)+ &
    2556              snow_con(i))*cell_area(i)/REAL(klon)
    2557      ENDDO
    2558      zx_t = zx_t/za*dtime
    2559      WRITE(lunout,*)"Precip=", zx_t
    2560   ENDIF
    2561   IF (zx_ajustq) THEN
    2562      DO i = 1, klon
    2563         z_apres(i) = 0.0
    2564      ENDDO
    2565      DO k = 1, klev
    2566         DO i = 1, klon
    2567            z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
    2568                 *(paprs(i,k)-paprs(i,k+1))/RG
    2569         ENDDO
    2570      ENDDO
    2571      DO i = 1, klon
    2572         z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &
    2573              /z_apres(i)
    2574      ENDDO
    2575      DO k = 1, klev
    2576         DO i = 1, klon
    2577            IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
    2578                 z_factor(i).LT.(1.0-1.0E-08)) THEN
    2579               q_seri(i,k) = q_seri(i,k) * z_factor(i)
    2580            ENDIF
    2581         ENDDO
    2582      ENDDO
    2583   ENDIF
    2584   zx_ajustq=.FALSE.
    2585 
    2586   !
    2587   !=============================================================================
    2588   !RR:Evolution de la poche froide: on ne fait pas de separation wake/env
    2589   !pour la couche limite diffuse pour l instant
    2590   !
    2591   !
    2592   !!! nrlmd le 22/03/2011---Si on met les poches hors des thermiques il faut rajouter cette
    2593   !------------------------- tendance calcul\'ee hors des poches froides
    2594   !
    2595   if (iflag_wake>=1) then
    2596      DO k=1,klev
    2597         DO i=1,klon
    2598            dt_dwn(i,k)  = ftd(i,k)
    2599            dq_dwn(i,k)  = fqd(i,k)
    2600            M_dwn(i,k)   = dnwd0(i,k)
    2601            M_up(i,k)    = upwd(i,k)
    2602            dt_a(i,k)    = d_t_con(i,k)/dtime - ftd(i,k)
    2603            dq_a(i,k)    = d_q_con(i,k)/dtime - fqd(i,k)
    2604         ENDDO
    2605      ENDDO
    2606 !nrlmd+jyg<
    2607      DO k=1,klev
    2608         DO i=1,klon
    2609           wdt_PBL(i,k) =  0.
    2610           wdq_PBL(i,k) =  0.
    2611           udt_PBL(i,k) =  0.
    2612           udq_PBL(i,k) =  0.
    2613         ENDDO
    2614      ENDDO
    2615 !
    2616      IF (mod(iflag_pbl_split,2) .EQ. 1) THEN
     2679       ENDDO
     2680       !nrlmd+jyg<
    26172681       DO k=1,klev
    2618         DO i=1,klon
    2619        wdt_PBL(i,k) = wdt_PBL(i,k) + d_t_vdf_w(i,k)/dtime
    2620        wdq_PBL(i,k) = wdq_PBL(i,k) + d_q_vdf_w(i,k)/dtime
    2621        udt_PBL(i,k) = udt_PBL(i,k) + d_t_vdf_x(i,k)/dtime
    2622        udq_PBL(i,k) = udq_PBL(i,k) + d_q_vdf_x(i,k)/dtime
    2623 !!        dt_dwn(i,k)  = dt_dwn(i,k) + d_t_vdf_w(i,k)/dtime
    2624 !!        dq_dwn(i,k)  = dq_dwn(i,k) + d_q_vdf_w(i,k)/dtime
    2625 !!        dt_a  (i,k)    = dt_a(i,k) + d_t_vdf_x(i,k)/dtime
    2626 !!        dq_a  (i,k)    = dq_a(i,k) + d_q_vdf_x(i,k)/dtime
    2627         ENDDO
    2628        ENDDO
    2629       ENDIF
    2630       IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
    2631        DO k=1,klev
    2632         DO i=1,klon
    2633 !!        dt_dwn(i,k)  = dt_dwn(i,k) + 0.
    2634 !!        dq_dwn(i,k)  = dq_dwn(i,k) + 0.
    2635 !!        dt_a(i,k)   = dt_a(i,k)   + d_t_ajs(i,k)/dtime
    2636 !!        dq_a(i,k)   = dq_a(i,k)   + d_q_ajs(i,k)/dtime
    2637         udt_PBL(i,k)   = udt_PBL(i,k)   + d_t_ajs(i,k)/dtime
    2638         udq_PBL(i,k)   = udq_PBL(i,k)   + d_q_ajs(i,k)/dtime
    2639         ENDDO
    2640        ENDDO
    2641       ENDIF
    2642 !>nrlmd+jyg
    2643 
    2644      IF (iflag_wake==2) THEN
    2645         ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
    2646         DO k = 1,klev
    2647            dt_dwn(:,k)= dt_dwn(:,k)+ &
    2648                 ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime
    2649            dq_dwn(:,k)= dq_dwn(:,k)+ &
    2650                 ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime
    2651         ENDDO
    2652      ELSEIF (iflag_wake==3) THEN
    2653         ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
    2654         DO k = 1,klev
    2655            DO i=1,klon
    2656               IF (rneb(i,k)==0.) THEN
    2657 ! On ne tient compte des tendances qu'en dehors des nuages (c'est-\`a-dire
    2658 ! a priri dans une region ou l'eau se reevapore).
    2659                 dt_dwn(i,k)= dt_dwn(i,k)+ &
    2660                 ok_wk_lsp(i)*d_t_lsc(i,k)/dtime
    2661                 dq_dwn(i,k)= dq_dwn(i,k)+ &
    2662                 ok_wk_lsp(i)*d_q_lsc(i,k)/dtime
    2663               ENDIF
    2664            ENDDO
    2665         ENDDO
    2666      ENDIF
    2667 
    2668      !
    2669      !calcul caracteristiques de la poche froide
    2670      call calWAKE (paprs,pplay,dtime &
    2671           ,t_seri,q_seri,omega &
    2672           ,dt_dwn,dq_dwn,M_dwn,M_up &
    2673           ,dt_a,dq_a,sigd &
    2674           ,wdt_PBL,wdq_PBL &
    2675           ,udt_PBL,udq_PBL &
    2676           ,wake_deltat,wake_deltaq,wake_dth &
    2677           ,wake_h,wake_s,wake_dens &
    2678           ,wake_pe,wake_fip,wake_gfl &
    2679           ,dt_wake,dq_wake &
    2680           ,wake_k, t_undi,q_undi &
    2681           ,wake_omgbdth,wake_dp_omgb &
    2682           ,wake_dtKE,wake_dqKE &
    2683           ,wake_dtPBL,wake_dqPBL &
    2684           ,wake_omg,wake_dp_deltomg &
    2685           ,wake_spread,wake_Cstar,wake_d_deltat_gw &
    2686           ,wake_ddeltat,wake_ddeltaq)
    2687      !
    2688      !-------------------------------------------------------------------------
    2689      ! ajout des tendances des poches froides
    2690      ! Faire rapidement disparaitre l'ancien dt_wake pour garder un d_t_wake
    2691      ! coherent avec les autres d_t_...
    2692      d_t_wake(:,:)=dt_wake(:,:)*dtime
    2693      d_q_wake(:,:)=dq_wake(:,:)*dtime
    2694      CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake',abortphy)
    2695      !------------------------------------------------------------------------
    2696 
    2697   endif  ! (iflag_wake>=1)
    2698   !
    2699   !===================================================================
    2700   !JYG
    2701   IF (ip_ebil_phy.ge.2) THEN
    2702      ztit='after wake'
    2703      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    2704           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    2705           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    2706      call diagphy(cell_area,ztit,ip_ebil_phy &
    2707           , zero_v, zero_v, zero_v, zero_v, zero_v &
    2708           , zero_v, zero_v, zero_v, ztsol &
    2709           , d_h_vcol, d_qt, d_ec &
    2710           , fs_bound, fq_bound )
    2711   END IF
    2712 
    2713   !      print*,'apres callwake iflag_cld_th=', iflag_cld_th
    2714   !
    2715   !===================================================================
    2716   ! Convection seche (thermiques ou ajustement)
    2717   !===================================================================
    2718   !
    2719   call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
    2720        ,seuil_inversion,weak_inversion,dthmin)
    2721 
    2722 
    2723 
    2724   d_t_ajsb(:,:)=0.
    2725   d_q_ajsb(:,:)=0.
    2726   d_t_ajs(:,:)=0.
    2727   d_u_ajs(:,:)=0.
    2728   d_v_ajs(:,:)=0.
    2729   d_q_ajs(:,:)=0.
    2730   clwcon0th(:,:)=0.
    2731   !
    2732   !      fm_therm(:,:)=0.
    2733   !      entr_therm(:,:)=0.
    2734   !      detr_therm(:,:)=0.
    2735   !
    2736   IF(prt_level>9)WRITE(lunout,*) &
    2737        'AVANT LA CONVECTION SECHE , iflag_thermals=' &
    2738        ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
    2739   if(iflag_thermals<0) then
    2740      !  Rien
    2741      !  ====
    2742      IF(prt_level>9)WRITE(lunout,*)'pas de convection seche'
    2743 
    2744 
    2745   else
    2746 
    2747      !  Thermiques
    2748      !  ==========
    2749      IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
    2750           ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
    2751 
    2752 
    2753      !cc nrlmd le 10/04/2012
    2754      DO k=1,klev+1
    2755         DO i=1,klon
    2756            pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
    2757            pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
    2758            pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
    2759            pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
    2760         ENDDO
    2761      ENDDO
    2762      !cc fin nrlmd le 10/04/2012
    2763 
    2764      if (iflag_thermals>=1) then
    2765 !jyg<
    2766          IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
    2767 !  Appel des thermiques avec les profils exterieurs aux poches
     2682          DO i=1,klon
     2683             wdt_PBL(i,k) =  0.
     2684             wdq_PBL(i,k) =  0.
     2685             udt_PBL(i,k) =  0.
     2686             udq_PBL(i,k) =  0.
     2687          ENDDO
     2688       ENDDO
     2689       !
     2690       IF (mod(iflag_pbl_split,2) .EQ. 1) THEN
    27682691          DO k=1,klev
    2769            DO i=1,klon
    2770             t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
    2771             q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
    2772            ENDDO
     2692             DO i=1,klon
     2693                wdt_PBL(i,k) = wdt_PBL(i,k) + d_t_vdf_w(i,k)/dtime
     2694                wdq_PBL(i,k) = wdq_PBL(i,k) + d_q_vdf_w(i,k)/dtime
     2695                udt_PBL(i,k) = udt_PBL(i,k) + d_t_vdf_x(i,k)/dtime
     2696                udq_PBL(i,k) = udq_PBL(i,k) + d_q_vdf_x(i,k)/dtime
     2697                !!        dt_dwn(i,k)  = dt_dwn(i,k) + d_t_vdf_w(i,k)/dtime
     2698                !!        dq_dwn(i,k)  = dq_dwn(i,k) + d_q_vdf_w(i,k)/dtime
     2699                !!        dt_a  (i,k)    = dt_a(i,k) + d_t_vdf_x(i,k)/dtime
     2700                !!        dq_a  (i,k)    = dq_a(i,k) + d_q_vdf_x(i,k)/dtime
     2701             ENDDO
    27732702          ENDDO
    2774          ELSE
    2775 !  Appel des thermiques avec les profils moyens
     2703       ENDIF
     2704       IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
    27762705          DO k=1,klev
    2777            DO i=1,klon
    2778             t_therm(i,k) = t_seri(i,k)
    2779             q_therm(i,k) = q_seri(i,k)
    2780            ENDDO
     2706             DO i=1,klon
     2707                !!        dt_dwn(i,k)  = dt_dwn(i,k) + 0.
     2708                !!        dq_dwn(i,k)  = dq_dwn(i,k) + 0.
     2709                !!        dt_a(i,k)   = dt_a(i,k)   + d_t_ajs(i,k)/dtime
     2710                !!        dq_a(i,k)   = dq_a(i,k)   + d_q_ajs(i,k)/dtime
     2711                udt_PBL(i,k)   = udt_PBL(i,k)   + d_t_ajs(i,k)/dtime
     2712                udq_PBL(i,k)   = udq_PBL(i,k)   + d_q_ajs(i,k)/dtime
     2713             ENDDO
    27812714          ENDDO
    2782          ENDIF
    2783 !>jyg
    2784         call calltherm(pdtphys &
    2785              ,pplay,paprs,pphi,weak_inversion &
    2786 !!             ,u_seri,v_seri,t_seri,q_seri,zqsat,debut &  !jyg
    2787              ,u_seri,v_seri,t_therm,q_therm,zqsat,debut &  !jyg
    2788              ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
    2789              ,fm_therm,entr_therm,detr_therm &
    2790              ,zqasc,clwcon0th,lmax_th,ratqscth &
    2791              ,ratqsdiff,zqsatth &
    2792              !on rajoute ale et alp, et les caracteristiques de la couche alim
    2793              ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca &
    2794              ,ztv,zpspsk,ztla,zthl &
    2795              !cc nrlmd le 10/04/2012
    2796              ,pbl_tke_input,pctsrf,omega,cell_area &
    2797              ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
    2798              ,n2,s2,ale_bl_stat &
    2799              ,therm_tke_max,env_tke_max &
    2800              ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
    2801              ,alp_bl_conv,alp_bl_stat &
    2802              !cc fin nrlmd le 10/04/2012
    2803              ,zqla,ztva )
    2804 !
    2805 !jyg<
    2806          IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
    2807 !  Si les thermiques ne sont presents que hors des poches, la tendance moyenne
    2808 !  associ\'ee doit etre multipliee par la fraction surfacique qu'ils couvrent.
    2809           DO k=1,klev
    2810            DO i=1,klon
    2811 !
    2812             wake_deltat(i,k) = wake_deltat(i,k) - d_t_ajs(i,k)
    2813             wake_deltaq(i,k) = wake_deltaq(i,k) - d_q_ajs(i,k)
    2814             t_seri(i,k) = t_therm(i,k) + wake_s(i)*wake_deltat(i,k)
    2815             q_seri(i,k) = q_therm(i,k) + wake_s(i)*wake_deltaq(i,k)
    2816 !
    2817             d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
    2818             d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
    2819             d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
    2820             d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
    2821 !
    2822            ENDDO
     2715       ENDIF
     2716       !>nrlmd+jyg
     2717
     2718       IF (iflag_wake==2) THEN
     2719          ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
     2720          DO k = 1,klev
     2721             dt_dwn(:,k)= dt_dwn(:,k)+ &
     2722                  ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime
     2723             dq_dwn(:,k)= dq_dwn(:,k)+ &
     2724                  ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime
    28232725          ENDDO
    2824          ELSE
    2825           DO k=1,klev
    2826            DO i=1,klon
    2827             t_seri(i,k) = t_therm(i,k)
    2828             q_seri(i,k) = q_therm(i,k)
    2829            ENDDO
     2726       ELSEIF (iflag_wake==3) THEN
     2727          ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
     2728          DO k = 1,klev
     2729             DO i=1,klon
     2730                IF (rneb(i,k)==0.) THEN
     2731                   ! On ne tient compte des tendances qu'en dehors des
     2732                   ! nuages (c'est-\`a-dire a priri dans une region ou
     2733                   ! l'eau se reevapore).
     2734                   dt_dwn(i,k)= dt_dwn(i,k)+ &
     2735                        ok_wk_lsp(i)*d_t_lsc(i,k)/dtime
     2736                   dq_dwn(i,k)= dq_dwn(i,k)+ &
     2737                        ok_wk_lsp(i)*d_q_lsc(i,k)/dtime
     2738                ENDIF
     2739             ENDDO
    28302740          ENDDO
    2831          ENDIF
    2832 !>jyg
    2833 
    2834         !cc nrlmd le 10/04/2012
    2835         !-----------Stochastic triggering-----------
    2836         if (iflag_trig_bl.ge.1) then
    2837            !
    2838            IF (prt_level .GE. 10) THEN
    2839               print *,'cin, ale_bl_stat, alp_bl_stat ', &
    2840                    cin, ale_bl_stat, alp_bl_stat
    2841            ENDIF
    2842 
    2843 
    2844            !----Initialisations
    2845            do i=1,klon
    2846               proba_notrig(i)=1.
    2847               random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
    2848               if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
    2849               if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then
    2850                  tau_trig(i)=tau_trig_shallow
    2851               else
    2852                  tau_trig(i)=tau_trig_deep
    2853               endif
    2854            enddo
    2855            !
    2856            IF (prt_level .GE. 10) THEN
    2857               print *,'random_notrig, tau_trig ', &
    2858                    random_notrig, tau_trig
    2859               print *,'s_trig,s2,n2 ', &
    2860                    s_trig,s2,n2
    2861            ENDIF
    2862 
    2863            !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
    2864            IF (iflag_trig_bl.eq.1) then
    2865 
    2866               !----Tirage al\'eatoire et calcul de ale_bl_trig
    2867               do i=1,klon
    2868                  if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
    2869                     proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
    2870                          (n2(i)*dtime/tau_trig(i))
    2871                     !        print *, 'proba_notrig(i) ',proba_notrig(i)
    2872                     if (random_notrig(i) .ge. proba_notrig(i)) then
    2873                        ale_bl_trig(i)=ale_bl_stat(i)
    2874                     else
    2875                        ale_bl_trig(i)=0.
    2876                     endif
    2877                  else
    2878                     proba_notrig(i)=1.
    2879                     random_notrig(i)=0.
    2880                     ale_bl_trig(i)=0.
    2881                  endif
    2882               enddo
    2883 
    2884            ELSE IF (iflag_trig_bl.ge.2) then
    2885 
    2886               do i=1,klon
    2887                  if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
    2888                     proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
    2889                          (n2(i)*dtime/tau_trig(i))
    2890                     !        print *, 'proba_notrig(i) ',proba_notrig(i)
    2891                     if (random_notrig(i) .ge. proba_notrig(i)) then
    2892                        ale_bl_trig(i)=Ale_bl(i)
    2893                     else
    2894                        ale_bl_trig(i)=0.
    2895                     endif
    2896                  else
    2897                     proba_notrig(i)=1.
    2898                     random_notrig(i)=0.
    2899                     ale_bl_trig(i)=0.
    2900                  endif
    2901               enddo
    2902 
    2903            ENDIF
    2904 
    2905            !
    2906            IF (prt_level .GE. 10) THEN
    2907               print *,'proba_notrig, ale_bl_trig ', &
    2908                    proba_notrig, ale_bl_trig
    2909            ENDIF
    2910 
    2911         endif !(iflag_trig_bl)
    2912 
    2913         !-----------Statistical closure-----------
    2914         if (iflag_clos_bl.eq.1) then
    2915 
    2916            do i=1,klon
    2917               !CR: alp probabiliste
    2918               if (ale_bl_trig(i).gt.0.) then
    2919                  alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
    2920               endif
    2921            enddo
    2922 
    2923         else if (iflag_clos_bl.eq.2) then
    2924 
    2925            !CR: alp calculee dans thermcell_main
    2926            do i=1,klon
    2927               alp_bl(i)=alp_bl_stat(i)
    2928            enddo
    2929 
    2930         else
    2931 
    2932            alp_bl_stat(:)=0.
    2933 
    2934         endif !(iflag_clos_bl)
    2935 
    2936         IF (prt_level .GE. 10) THEN
    2937            print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat
    2938         ENDIF
    2939 
    2940         !cc fin nrlmd le 10/04/2012
    2941 
    2942         ! ----------------------------------------------------------------------
    2943         ! Transport de la TKE par les panaches thermiques.
    2944         ! FH : 2010/02/01
    2945         !     if (iflag_pbl.eq.10) then
    2946         !     call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
    2947         !    s           rg,paprs,pbl_tke)
    2948         !     endif
    2949         ! ----------------------------------------------------------------------
    2950         !IM/FH: 2011/02/23
    2951         ! Couplage Thermiques/Emanuel seulement si T<0
    2952         if (iflag_coupl==2) then
    2953          IF (prt_level .GE. 10) THEN
    2954            print*,'Couplage Thermiques/Emanuel seulement si T<0'
    2955          ENDIF
    2956            do i=1,klon
    2957               if (t_seri(i,lmax_th(i))>273.) then
    2958                  Ale_bl(i)=0.
    2959               endif
    2960            enddo
    2961         endif
    2962 
    2963         do i=1,klon
    2964            !           zmax_th(i)=pphi(i,lmax_th(i))/rg
    2965            !CR:04/05/12:correction calcul zmax
    2966            zmax_th(i)=zmax0(i)
    2967         enddo
    2968 
    2969      endif
    2970 
    2971 
    2972      !  Ajustement sec
    2973      !  ==============
    2974 
    2975      ! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
    2976      ! a partir du sommet des thermiques.
    2977      ! Dans le cas contraire, on demarre au niveau 1.
    2978 
    2979      if (iflag_thermals>=13.or.iflag_thermals<=0) then
    2980 
    2981         if(iflag_thermals.eq.0) then
    2982            IF(prt_level>9)WRITE(lunout,*)'ajsec'
    2983            limbas(:)=1
    2984         else
    2985            limbas(:)=lmax_th(:)
    2986         endif
    2987 
    2988         ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
    2989         ! pour des test de convergence numerique.
    2990         ! Le nouveau ajsec est a priori mieux, meme pour le cas
    2991         ! iflag_thermals = 0 (l'ancienne version peut faire des tendances
    2992         ! non nulles numeriquement pour des mailles non concernees.
    2993 
    2994         if (iflag_thermals==0) then
    2995            ! Calling adjustment alone (but not the thermal plume model)
    2996            CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
    2997                 , d_t_ajsb, d_q_ajsb)
    2998         else if (iflag_thermals>0) then
    2999            ! Calling adjustment above the top of thermal plumes
    3000            CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
    3001                 , d_t_ajsb, d_q_ajsb)
    3002         endif
    3003 
    3004         !-----------------------------------------------------------------------
    3005         ! ajout des tendances de l'ajustement sec ou des thermiques
    3006         CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs,'ajsb',abortphy)
    3007         d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
    3008         d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
    3009 
    3010         !---------------------------------------------------------------------
    3011 
    3012      endif
    3013 
    3014   endif
    3015   !
    3016   !===================================================================
    3017   !IM
    3018   IF (ip_ebil_phy.ge.2) THEN
    3019      ztit='after dry_adjust'
    3020      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    3021           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    3022           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3023      call diagphy(cell_area,ztit,ip_ebil_phy &
    3024           , zero_v, zero_v, zero_v, zero_v, zero_v &
    3025           , zero_v, zero_v, zero_v, ztsol &
    3026           , d_h_vcol, d_qt, d_ec &
    3027           , fs_bound, fq_bound )
    3028   END IF
    3029 
    3030 
    3031   !-------------------------------------------------------------------------
    3032   ! Computation of ratqs, the width (normalized) of the subrid scale
    3033   ! water distribution
    3034   CALL  calcratqs(klon,klev,prt_level,lunout,        &
    3035        iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
    3036        ratqsbas,ratqshaut,tau_ratqs,fact_cldcon,   &
    3037        ptconv,ptconvth,clwcon0th, rnebcon0th,     &
    3038        paprs,pplay,q_seri,zqsat,fm_therm, &
    3039        ratqs,ratqsc)
    3040 
    3041 
    3042   !
    3043   ! Appeler le processus de condensation a grande echelle
    3044   ! et le processus de precipitation
    3045   !-------------------------------------------------------------------------
    3046   IF (prt_level .GE.10) THEN
    3047      print *,'itap, ->fisrtilp ',itap
    3048   ENDIF
    3049   !
    3050   CALL fisrtilp(dtime,paprs,pplay, &
    3051        t_seri, q_seri,ptconv,ratqs, &
    3052        d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &
    3053        rain_lsc, snow_lsc, &
    3054        pfrac_impa, pfrac_nucl, pfrac_1nucl, &
    3055        frac_impa, frac_nucl, beta_prec_fisrt, &
    3056        prfl, psfl, rhcl,  &
    3057        zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
    3058        iflag_ice_thermo)
    3059   !
    3060   WHERE (rain_lsc < 0) rain_lsc = 0.
    3061   WHERE (snow_lsc < 0) snow_lsc = 0.
    3062 
    3063   CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs,'lsc',abortphy)
    3064   !---------------------------------------------------------------------------
    3065   DO k = 1, klev
    3066      DO i = 1, klon
    3067         cldfra(i,k) = rneb(i,k)
    3068 !CR: a quoi ca sert? Faut-il ajouter qs_seri?
    3069         IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
    3070      ENDDO
    3071   ENDDO
    3072   IF (check) THEN
    3073      za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
    3074      WRITE(lunout,*)"apresilp=", za
    3075      zx_t = 0.0
    3076      za = 0.0
    3077      DO i = 1, klon
    3078         za = za + cell_area(i)/REAL(klon)
    3079         zx_t = zx_t + (rain_lsc(i) &
    3080              + snow_lsc(i))*cell_area(i)/REAL(klon)
    3081      ENDDO
    3082      zx_t = zx_t/za*dtime
    3083      WRITE(lunout,*)"Precip=", zx_t
    3084   ENDIF
    3085   !IM
    3086   IF (ip_ebil_phy.ge.2) THEN
    3087      ztit='after fisrt'
    3088      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    3089           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    3090           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3091      call diagphy(cell_area,ztit,ip_ebil_phy &
    3092           , zero_v, zero_v, zero_v, zero_v, zero_v &
    3093           , zero_v, rain_lsc, snow_lsc, ztsol &
    3094           , d_h_vcol, d_qt, d_ec &
    3095           , fs_bound, fq_bound )
    3096   END IF
    3097 
    3098   if (mydebug) then
    3099      call writefield_phy('u_seri',u_seri,nbp_lev)
    3100      call writefield_phy('v_seri',v_seri,nbp_lev)
    3101      call writefield_phy('t_seri',t_seri,nbp_lev)
    3102      call writefield_phy('q_seri',q_seri,nbp_lev)
    3103   endif
    3104 
    3105   !
    3106   !-------------------------------------------------------------------
    3107   !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
    3108   !-------------------------------------------------------------------
    3109 
    3110   ! 1. NUAGES CONVECTIFS
    3111   !
    3112   !IM cf FH
    3113   !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
    3114   IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
    3115      snow_tiedtke=0.
    3116      !     print*,'avant calcul de la pseudo precip '
    3117      !     print*,'iflag_cld_th',iflag_cld_th
    3118      if (iflag_cld_th.eq.-1) then
    3119         rain_tiedtke=rain_con
    3120      else
    3121         !       print*,'calcul de la pseudo precip '
    3122         rain_tiedtke=0.
    3123         !         print*,'calcul de la pseudo precip 0'
    3124         do k=1,klev
    3125            do i=1,klon
    3126               if (d_q_con(i,k).lt.0.) then
    3127                  rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
    3128                       *(paprs(i,k)-paprs(i,k+1))/rg
    3129               endif
    3130            enddo
    3131         enddo
    3132      endif
    3133      !
    3134      !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
    3135      !
    3136 
    3137      ! Nuages diagnostiques pour Tiedtke
    3138      CALL diagcld1(paprs,pplay, &
    3139           !IM cf FH  .             rain_con,snow_con,ibas_con,itop_con,
    3140           rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
    3141           diafra,dialiq)
    3142      DO k = 1, klev
    3143         DO i = 1, klon
    3144            IF (diafra(i,k).GT.cldfra(i,k)) THEN
    3145               cldliq(i,k) = dialiq(i,k)
    3146               cldfra(i,k) = diafra(i,k)
    3147            ENDIF
    3148         ENDDO
    3149      ENDDO
    3150 
    3151   ELSE IF (iflag_cld_th.ge.3) THEN
    3152      !  On prend pour les nuages convectifs le max du calcul de la
    3153      !  convection et du calcul du pas de temps precedent diminue d'un facteur
    3154      !  facttemps
    3155      facteur = pdtphys *facttemps
    3156      do k=1,klev
    3157         do i=1,klon
    3158            rnebcon(i,k)=rnebcon(i,k)*facteur
    3159            if (rnebcon0(i,k)*clwcon0(i,k).gt.rnebcon(i,k)*clwcon(i,k)) &
    3160                 then
    3161               rnebcon(i,k)=rnebcon0(i,k)
    3162               clwcon(i,k)=clwcon0(i,k)
    3163            endif
    3164         enddo
    3165      enddo
    3166 
    3167      !
    3168      !jq - introduce the aerosol direct and first indirect radiative forcings
    3169      !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
    3170      IF (flag_aerosol .gt. 0) THEN
    3171          IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    3172            IF (.NOT. aerosol_couple) THEN
    3173               !
    3174               CALL readaerosol_optic( &
    3175                    debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
    3176                    pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    3177                    mass_solu_aero, mass_solu_aero_pi,  &
    3178                    tau_aero, piz_aero, cg_aero,  &
    3179                    tausum_aero, tau3d_aero)
    3180            ENDIF
    3181          ELSE                       ! RRTM radiation
    3182            IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
    3183             abort_message='config_inca=aero et rrtm=1 impossible'
    3184             call abort_physic(modname,abort_message,1)
    3185            ELSE
    3186 !
     2741       ENDIF
     2742
     2743       !
     2744       !calcul caracteristiques de la poche froide
     2745       call calWAKE (paprs,pplay,dtime &
     2746            ,t_seri,q_seri,omega &
     2747            ,dt_dwn,dq_dwn,M_dwn,M_up &
     2748            ,dt_a,dq_a,sigd &
     2749            ,wdt_PBL,wdq_PBL &
     2750            ,udt_PBL,udq_PBL &
     2751            ,wake_deltat,wake_deltaq,wake_dth &
     2752            ,wake_h,wake_s,wake_dens &
     2753            ,wake_pe,wake_fip,wake_gfl &
     2754            ,dt_wake,dq_wake &
     2755            ,wake_k, t_undi,q_undi &
     2756            ,wake_omgbdth,wake_dp_omgb &
     2757            ,wake_dtKE,wake_dqKE &
     2758            ,wake_dtPBL,wake_dqPBL &
     2759            ,wake_omg,wake_dp_deltomg &
     2760            ,wake_spread,wake_Cstar,wake_d_deltat_gw &
     2761            ,wake_ddeltat,wake_ddeltaq)
     2762       !
     2763       !-----------------------------------------------------------------------
     2764       ! ajout des tendances des poches froides
     2765       ! Faire rapidement disparaitre l'ancien dt_wake pour garder un d_t_wake
     2766       ! coherent avec les autres d_t_...
     2767       d_t_wake(:,:)=dt_wake(:,:)*dtime
     2768       d_q_wake(:,:)=dq_wake(:,:)*dtime
     2769       CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake', &
     2770            abortphy)
     2771       !------------------------------------------------------------------------
     2772
     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
     2790    !
     2791    !===================================================================
     2792    ! Convection seche (thermiques ou ajustement)
     2793    !===================================================================
     2794    !
     2795    call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
     2796         ,seuil_inversion,weak_inversion,dthmin)
     2797
     2798
     2799
     2800    d_t_ajsb(:,:)=0.
     2801    d_q_ajsb(:,:)=0.
     2802    d_t_ajs(:,:)=0.
     2803    d_u_ajs(:,:)=0.
     2804    d_v_ajs(:,:)=0.
     2805    d_q_ajs(:,:)=0.
     2806    clwcon0th(:,:)=0.
     2807    !
     2808    !      fm_therm(:,:)=0.
     2809    !      entr_therm(:,:)=0.
     2810    !      detr_therm(:,:)=0.
     2811    !
     2812    IF(prt_level>9)WRITE(lunout,*) &
     2813         'AVANT LA CONVECTION SECHE , iflag_thermals=' &
     2814         ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
     2815    if(iflag_thermals<0) then
     2816       !  Rien
     2817       !  ====
     2818       IF(prt_level>9)WRITE(lunout,*)'pas de convection seche'
     2819
     2820
     2821    else
     2822
     2823       !  Thermiques
     2824       !  ==========
     2825       IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
     2826            ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
     2827
     2828
     2829       !cc nrlmd le 10/04/2012
     2830       DO k=1,klev+1
     2831          DO i=1,klon
     2832             pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
     2833             pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
     2834             pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
     2835             pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
     2836          ENDDO
     2837       ENDDO
     2838       !cc fin nrlmd le 10/04/2012
     2839
     2840       if (iflag_thermals>=1) then
     2841          !jyg<
     2842          IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
     2843             !  Appel des thermiques avec les profils exterieurs aux poches
     2844             DO k=1,klev
     2845                DO i=1,klon
     2846                   t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
     2847                   q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
     2848                ENDDO
     2849             ENDDO
     2850          ELSE
     2851             !  Appel des thermiques avec les profils moyens
     2852             DO k=1,klev
     2853                DO i=1,klon
     2854                   t_therm(i,k) = t_seri(i,k)
     2855                   q_therm(i,k) = q_seri(i,k)
     2856                ENDDO
     2857             ENDDO
     2858          ENDIF
     2859          !>jyg
     2860          call calltherm(pdtphys &
     2861               ,pplay,paprs,pphi,weak_inversion &
     2862                                ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut &
     2863               !jyg
     2864               ,u_seri,v_seri,t_therm,q_therm,zqsat,debut &  !jyg
     2865               ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
     2866               ,fm_therm,entr_therm,detr_therm &
     2867               ,zqasc,clwcon0th,lmax_th,ratqscth &
     2868               ,ratqsdiff,zqsatth &
     2869                                !on rajoute ale et alp, et les
     2870                                !caracteristiques de la couche alim
     2871               ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca &
     2872               ,ztv,zpspsk,ztla,zthl &
     2873                                !cc nrlmd le 10/04/2012
     2874               ,pbl_tke_input,pctsrf,omega,cell_area &
     2875               ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
     2876               ,n2,s2,ale_bl_stat &
     2877               ,therm_tke_max,env_tke_max &
     2878               ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
     2879               ,alp_bl_conv,alp_bl_stat &
     2880                                !cc fin nrlmd le 10/04/2012
     2881               ,zqla,ztva )
     2882          !
     2883          !jyg<
     2884          IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
     2885             !  Si les thermiques ne sont presents que hors des
     2886             !  poches, la tendance moyenne associ\'ee doit etre
     2887             !  multipliee par la fraction surfacique qu'ils couvrent.
     2888             DO k=1,klev
     2889                DO i=1,klon
     2890                   !
     2891                   wake_deltat(i,k) = wake_deltat(i,k) - d_t_ajs(i,k)
     2892                   wake_deltaq(i,k) = wake_deltaq(i,k) - d_q_ajs(i,k)
     2893                   t_seri(i,k) = t_therm(i,k) + wake_s(i)*wake_deltat(i,k)
     2894                   q_seri(i,k) = q_therm(i,k) + wake_s(i)*wake_deltaq(i,k)
     2895                   !
     2896                   d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
     2897                   d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
     2898                   d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
     2899                   d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
     2900                   !
     2901                ENDDO
     2902             ENDDO
     2903          ELSE
     2904             DO k=1,klev
     2905                DO i=1,klon
     2906                   t_seri(i,k) = t_therm(i,k)
     2907                   q_seri(i,k) = q_therm(i,k)
     2908                ENDDO
     2909             ENDDO
     2910          ENDIF
     2911          !>jyg
     2912
     2913          !cc nrlmd le 10/04/2012
     2914          !-----------Stochastic triggering-----------
     2915          if (iflag_trig_bl.ge.1) then
     2916             !
     2917             IF (prt_level .GE. 10) THEN
     2918                print *,'cin, ale_bl_stat, alp_bl_stat ', &
     2919                     cin, ale_bl_stat, alp_bl_stat
     2920             ENDIF
     2921
     2922
     2923             !----Initialisations
     2924             do i=1,klon
     2925                proba_notrig(i)=1.
     2926                random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
     2927                if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
     2928                if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then
     2929                   tau_trig(i)=tau_trig_shallow
     2930                else
     2931                   tau_trig(i)=tau_trig_deep
     2932                endif
     2933             enddo
     2934             !
     2935             IF (prt_level .GE. 10) THEN
     2936                print *,'random_notrig, tau_trig ', &
     2937                     random_notrig, tau_trig
     2938                print *,'s_trig,s2,n2 ', &
     2939                     s_trig,s2,n2
     2940             ENDIF
     2941
     2942             !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
     2943             IF (iflag_trig_bl.eq.1) then
     2944
     2945                !----Tirage al\'eatoire et calcul de ale_bl_trig
     2946                do i=1,klon
     2947                   if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
     2948                      proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
     2949                           (n2(i)*dtime/tau_trig(i))
     2950                      !        print *, 'proba_notrig(i) ',proba_notrig(i)
     2951                      if (random_notrig(i) .ge. proba_notrig(i)) then
     2952                         ale_bl_trig(i)=ale_bl_stat(i)
     2953                      else
     2954                         ale_bl_trig(i)=0.
     2955                      endif
     2956                   else
     2957                      proba_notrig(i)=1.
     2958                      random_notrig(i)=0.
     2959                      ale_bl_trig(i)=0.
     2960                   endif
     2961                enddo
     2962
     2963             ELSE IF (iflag_trig_bl.ge.2) then
     2964
     2965                do i=1,klon
     2966                   if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
     2967                      proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
     2968                           (n2(i)*dtime/tau_trig(i))
     2969                      !        print *, 'proba_notrig(i) ',proba_notrig(i)
     2970                      if (random_notrig(i) .ge. proba_notrig(i)) then
     2971                         ale_bl_trig(i)=Ale_bl(i)
     2972                      else
     2973                         ale_bl_trig(i)=0.
     2974                      endif
     2975                   else
     2976                      proba_notrig(i)=1.
     2977                      random_notrig(i)=0.
     2978                      ale_bl_trig(i)=0.
     2979                   endif
     2980                enddo
     2981
     2982             ENDIF
     2983
     2984             !
     2985             IF (prt_level .GE. 10) THEN
     2986                print *,'proba_notrig, ale_bl_trig ', &
     2987                     proba_notrig, ale_bl_trig
     2988             ENDIF
     2989
     2990          endif !(iflag_trig_bl)
     2991
     2992          !-----------Statistical closure-----------
     2993          if (iflag_clos_bl.eq.1) then
     2994
     2995             do i=1,klon
     2996                !CR: alp probabiliste
     2997                if (ale_bl_trig(i).gt.0.) then
     2998                   alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
     2999                endif
     3000             enddo
     3001
     3002          else if (iflag_clos_bl.eq.2) then
     3003
     3004             !CR: alp calculee dans thermcell_main
     3005             do i=1,klon
     3006                alp_bl(i)=alp_bl_stat(i)
     3007             enddo
     3008
     3009          else
     3010
     3011             alp_bl_stat(:)=0.
     3012
     3013          endif !(iflag_clos_bl)
     3014
     3015          IF (prt_level .GE. 10) THEN
     3016             print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat
     3017          ENDIF
     3018
     3019          !cc fin nrlmd le 10/04/2012
     3020
     3021          ! ------------------------------------------------------------------
     3022          ! Transport de la TKE par les panaches thermiques.
     3023          ! FH : 2010/02/01
     3024          !     if (iflag_pbl.eq.10) then
     3025          !     call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
     3026          !    s           rg,paprs,pbl_tke)
     3027          !     endif
     3028          ! -------------------------------------------------------------------
     3029          !IM/FH: 2011/02/23
     3030          ! Couplage Thermiques/Emanuel seulement si T<0
     3031          if (iflag_coupl==2) then
     3032             IF (prt_level .GE. 10) THEN
     3033                print*,'Couplage Thermiques/Emanuel seulement si T<0'
     3034             ENDIF
     3035             do i=1,klon
     3036                if (t_seri(i,lmax_th(i))>273.) then
     3037                   Ale_bl(i)=0.
     3038                endif
     3039             enddo
     3040          endif
     3041
     3042          do i=1,klon
     3043             !           zmax_th(i)=pphi(i,lmax_th(i))/rg
     3044             !CR:04/05/12:correction calcul zmax
     3045             zmax_th(i)=zmax0(i)
     3046          enddo
     3047
     3048       endif
     3049
     3050
     3051       !  Ajustement sec
     3052       !  ==============
     3053
     3054       ! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
     3055       ! a partir du sommet des thermiques.
     3056       ! Dans le cas contraire, on demarre au niveau 1.
     3057
     3058       if (iflag_thermals>=13.or.iflag_thermals<=0) then
     3059
     3060          if(iflag_thermals.eq.0) then
     3061             IF(prt_level>9)WRITE(lunout,*)'ajsec'
     3062             limbas(:)=1
     3063          else
     3064             limbas(:)=lmax_th(:)
     3065          endif
     3066
     3067          ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
     3068          ! pour des test de convergence numerique.
     3069          ! Le nouveau ajsec est a priori mieux, meme pour le cas
     3070          ! iflag_thermals = 0 (l'ancienne version peut faire des tendances
     3071          ! non nulles numeriquement pour des mailles non concernees.
     3072
     3073          if (iflag_thermals==0) then
     3074             ! Calling adjustment alone (but not the thermal plume model)
     3075             CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
     3076                  , d_t_ajsb, d_q_ajsb)
     3077          else if (iflag_thermals>0) then
     3078             ! Calling adjustment above the top of thermal plumes
     3079             CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
     3080                  , d_t_ajsb, d_q_ajsb)
     3081          endif
     3082
     3083          !--------------------------------------------------------------------
     3084          ! ajout des tendances de l'ajustement sec ou des thermiques
     3085          CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs, &
     3086               'ajsb',abortphy)
     3087          d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
     3088          d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
     3089
     3090          !---------------------------------------------------------------------
     3091
     3092       endif
     3093
     3094    endif
     3095    !
     3096    !===================================================================
     3097    !IM
     3098    IF (ip_ebil_phy.ge.2) THEN
     3099       ztit='after dry_adjust'
     3100       CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
     3101            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     3102            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     3103       call diagphy(cell_area,ztit,ip_ebil_phy &
     3104            , zero_v, zero_v, zero_v, zero_v, zero_v &
     3105            , zero_v, zero_v, zero_v, ztsol &
     3106            , d_h_vcol, d_qt, d_ec &
     3107            , fs_bound, fq_bound )
     3108    END IF
     3109
     3110
     3111    !-------------------------------------------------------------------------
     3112    ! Computation of ratqs, the width (normalized) of the subrid scale
     3113    ! water distribution
     3114    CALL  calcratqs(klon,klev,prt_level,lunout,        &
     3115         iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
     3116         ratqsbas,ratqshaut,tau_ratqs,fact_cldcon,   &
     3117         ptconv,ptconvth,clwcon0th, rnebcon0th,     &
     3118         paprs,pplay,q_seri,zqsat,fm_therm, &
     3119         ratqs,ratqsc)
     3120
     3121
     3122    !
     3123    ! Appeler le processus de condensation a grande echelle
     3124    ! et le processus de precipitation
     3125    !-------------------------------------------------------------------------
     3126    IF (prt_level .GE.10) THEN
     3127       print *,'itap, ->fisrtilp ',itap
     3128    ENDIF
     3129    !
     3130    CALL fisrtilp(dtime,paprs,pplay, &
     3131         t_seri, q_seri,ptconv,ratqs, &
     3132         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &
     3133         rain_lsc, snow_lsc, &
     3134         pfrac_impa, pfrac_nucl, pfrac_1nucl, &
     3135         frac_impa, frac_nucl, beta_prec_fisrt, &
     3136         prfl, psfl, rhcl,  &
     3137         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
     3138         iflag_ice_thermo)
     3139    !
     3140    WHERE (rain_lsc < 0) rain_lsc = 0.
     3141    WHERE (snow_lsc < 0) snow_lsc = 0.
     3142
     3143    CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs, &
     3144         'lsc',abortphy)
     3145    !---------------------------------------------------------------------------
     3146    DO k = 1, klev
     3147       DO i = 1, klon
     3148          cldfra(i,k) = rneb(i,k)
     3149          !CR: a quoi ca sert? Faut-il ajouter qs_seri?
     3150          IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
     3151       ENDDO
     3152    ENDDO
     3153    IF (check) THEN
     3154       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
     3155       WRITE(lunout,*)"apresilp=", za
     3156       zx_t = 0.0
     3157       za = 0.0
     3158       DO i = 1, klon
     3159          za = za + cell_area(i)/REAL(klon)
     3160          zx_t = zx_t + (rain_lsc(i) &
     3161               + snow_lsc(i))*cell_area(i)/REAL(klon)
     3162       ENDDO
     3163       zx_t = zx_t/za*dtime
     3164       WRITE(lunout,*)"Precip=", zx_t
     3165    ENDIF
     3166    !IM
     3167    IF (ip_ebil_phy.ge.2) THEN
     3168       ztit='after fisrt'
     3169       CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
     3170            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     3171            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     3172       call diagphy(cell_area,ztit,ip_ebil_phy &
     3173            , zero_v, zero_v, zero_v, zero_v, zero_v &
     3174            , zero_v, rain_lsc, snow_lsc, ztsol &
     3175            , d_h_vcol, d_qt, d_ec &
     3176            , fs_bound, fq_bound )
     3177    END IF
     3178
     3179    if (mydebug) then
     3180       call writefield_phy('u_seri',u_seri,nbp_lev)
     3181       call writefield_phy('v_seri',v_seri,nbp_lev)
     3182       call writefield_phy('t_seri',t_seri,nbp_lev)
     3183       call writefield_phy('q_seri',q_seri,nbp_lev)
     3184    endif
     3185
     3186    !
     3187    !-------------------------------------------------------------------
     3188    !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
     3189    !-------------------------------------------------------------------
     3190
     3191    ! 1. NUAGES CONVECTIFS
     3192    !
     3193    !IM cf FH
     3194    !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
     3195    IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
     3196       snow_tiedtke=0.
     3197       !     print*,'avant calcul de la pseudo precip '
     3198       !     print*,'iflag_cld_th',iflag_cld_th
     3199       if (iflag_cld_th.eq.-1) then
     3200          rain_tiedtke=rain_con
     3201       else
     3202          !       print*,'calcul de la pseudo precip '
     3203          rain_tiedtke=0.
     3204          !         print*,'calcul de la pseudo precip 0'
     3205          do k=1,klev
     3206             do i=1,klon
     3207                if (d_q_con(i,k).lt.0.) then
     3208                   rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
     3209                        *(paprs(i,k)-paprs(i,k+1))/rg
     3210                endif
     3211             enddo
     3212          enddo
     3213       endif
     3214       !
     3215       !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
     3216       !
     3217
     3218       ! Nuages diagnostiques pour Tiedtke
     3219       CALL diagcld1(paprs,pplay, &
     3220                                !IM cf FH. rain_con,snow_con,ibas_con,itop_con,
     3221            rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
     3222            diafra,dialiq)
     3223       DO k = 1, klev
     3224          DO i = 1, klon
     3225             IF (diafra(i,k).GT.cldfra(i,k)) THEN
     3226                cldliq(i,k) = dialiq(i,k)
     3227                cldfra(i,k) = diafra(i,k)
     3228             ENDIF
     3229          ENDDO
     3230       ENDDO
     3231
     3232    ELSE IF (iflag_cld_th.ge.3) THEN
     3233       !  On prend pour les nuages convectifs le max du calcul de la
     3234       !  convection et du calcul du pas de temps precedent diminue d'un facteur
     3235       !  facttemps
     3236       facteur = pdtphys *facttemps
     3237       do k=1,klev
     3238          do i=1,klon
     3239             rnebcon(i,k)=rnebcon(i,k)*facteur
     3240             if (rnebcon0(i,k)*clwcon0(i,k).gt.rnebcon(i,k)*clwcon(i,k)) &
     3241                  then
     3242                rnebcon(i,k)=rnebcon0(i,k)
     3243                clwcon(i,k)=clwcon0(i,k)
     3244             endif
     3245          enddo
     3246       enddo
     3247
     3248       !
     3249       !jq - introduce the aerosol direct and first indirect radiative forcings
     3250       !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
     3251       IF (flag_aerosol .gt. 0) THEN
     3252          IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     3253             IF (.NOT. aerosol_couple) THEN
     3254                !
     3255                CALL readaerosol_optic( &
     3256                     debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
     3257                     pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     3258                     mass_solu_aero, mass_solu_aero_pi,  &
     3259                     tau_aero, piz_aero, cg_aero,  &
     3260                     tausum_aero, tau3d_aero)
     3261             ENDIF
     3262          ELSE                       ! RRTM radiation
     3263             IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
     3264                abort_message='config_inca=aero et rrtm=1 impossible'
     3265                call abort_physic(modname,abort_message,1)
     3266             ELSE
     3267                !
    31873268#ifdef CPP_RRTM
    3188            IF (NSW.EQ.6) THEN
    3189 !--new aerosol properties
    3190 !
    3191              CALL readaerosol_optic_rrtm( debut, aerosol_couple, &
    3192              new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
    3193              pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    3194              tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
    3195              tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
    3196              tausum_aero, tau3d_aero)
    3197 
    3198            ELSE IF (NSW.EQ.2) THEN
    3199 !--for now we use the old aerosol properties
    3200 !
    3201               CALL readaerosol_optic( &
    3202                    debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
    3203                    pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
    3204                    mass_solu_aero, mass_solu_aero_pi,  &
    3205                    tau_aero, piz_aero, cg_aero,  &
    3206                    tausum_aero, tau3d_aero)
    3207 !
     3269                IF (NSW.EQ.6) THEN
     3270                   !--new aerosol properties
     3271                   !
     3272                   CALL readaerosol_optic_rrtm( debut, aerosol_couple, &
     3273                        new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
     3274                        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     3275                        tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
     3276                        tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
     3277                        tausum_aero, tau3d_aero)
     3278
     3279                ELSE IF (NSW.EQ.2) THEN
     3280                   !--for now we use the old aerosol properties
     3281                   !
     3282                   CALL readaerosol_optic( &
     3283                        debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
     3284                        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
     3285                        mass_solu_aero, mass_solu_aero_pi,  &
     3286                        tau_aero, piz_aero, cg_aero,  &
     3287                        tausum_aero, tau3d_aero)
     3288                   !
    32083289                   !--natural aerosols
    32093290                   tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
    … …  
    32143295                   piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
    32153296                   cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
    3216            ELSE
    3217               abort_message='Only NSW=2 or 6 are possible with aerosols and iflag_rrtm=1'
    3218               call abort_physic(modname,abort_message,1)
    3219            ENDIF
    3220 
    3221            CALL aeropt_lw_rrtm
    3222 !
     3297                ELSE
     3298                   abort_message='Only NSW=2 or 6 are possible with ' &
     3299                        // 'aerosols and iflag_rrtm=1'
     3300                   call abort_physic(modname,abort_message,1)
     3301                ENDIF
     3302
     3303                CALL aeropt_lw_rrtm
     3304                !
    32233305#else
    3224            abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
    3225            call abort_physic(modname,abort_message,1)
     3306                abort_message='You should compile with -rrtm if running ' &
     3307                     // 'with iflag_rrtm=1'
     3308                call abort_physic(modname,abort_message,1)
    32263309#endif
    3227               !
    3228            ENDIF
    3229         ENDIF
    3230      ELSE
    3231         tausum_aero(:,:,:) = 0.
    3232         IF (iflag_rrtm .EQ. 0) THEN !--old radiation
    3233            tau_aero(:,:,:,:) = 1.e-15
    3234            piz_aero(:,:,:,:) = 1.
    3235            cg_aero(:,:,:,:)  = 0.
    3236         ELSE
    3237            tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
    3238            tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
    3239            piz_aero_sw_rrtm(:,:,:,:) = 1.0
    3240            cg_aero_sw_rrtm(:,:,:,:)  = 0.0
    3241         ENDIF
    3242      ENDIF
    3243      !
    3244      !--STRAT AEROSOL
    3245      !--updates tausum_aero,tau_aero,piz_aero,cg_aero
    3246      IF (flag_aerosol_strat) THEN
    3247         IF (prt_level .GE.10) THEN
    3248          PRINT *,'appel a readaerosolstrat', mth_cur
    3249         ENDIF
    3250         IF (iflag_rrtm.EQ.0) THEN
    3251            CALL readaerosolstrato(debut)
    3252         ELSE
     3310                !
     3311             ENDIF
     3312          ENDIF
     3313       ELSE
     3314          tausum_aero(:,:,:) = 0.
     3315          IF (iflag_rrtm .EQ. 0) THEN !--old radiation
     3316             tau_aero(:,:,:,:) = 1.e-15
     3317             piz_aero(:,:,:,:) = 1.
     3318             cg_aero(:,:,:,:)  = 0.
     3319          ELSE
     3320             tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
     3321             tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
     3322             piz_aero_sw_rrtm(:,:,:,:) = 1.0
     3323             cg_aero_sw_rrtm(:,:,:,:)  = 0.0
     3324          ENDIF
     3325       ENDIF
     3326       !
     3327       !--STRAT AEROSOL
     3328       !--updates tausum_aero,tau_aero,piz_aero,cg_aero
     3329       IF (flag_aerosol_strat) THEN
     3330          IF (prt_level .GE.10) THEN
     3331             PRINT *,'appel a readaerosolstrat', mth_cur
     3332          ENDIF
     3333          IF (iflag_rrtm.EQ.0) THEN
     3334             CALL readaerosolstrato(debut)
     3335          ELSE
    32533336#ifdef CPP_RRTM
    3254            CALL readaerosolstrato_rrtm(debut)
     3337             CALL readaerosolstrato_rrtm(debut)
    32553338#else
    32563339
    3257            abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
    3258            call abort_physic(modname,abort_message,1)
     3340             abort_message='You should compile with -rrtm if running ' &
     3341                  // 'with iflag_rrtm=1'
     3342             call abort_physic(modname,abort_message,1)
    32593343#endif
    3260         ENDIF
    3261      ENDIF
    3262      !--fin STRAT AEROSOL
    3263 
    3264 
    3265      !   On prend la somme des fractions nuageuses et des contenus en eau
    3266 
    3267      if (iflag_cld_th>=5) then
    3268 
    3269         do k=1,klev
    3270            ptconvth(:,k)=fm_therm(:,k+1)>0.
    3271         enddo
    3272 
    3273         if (iflag_coupl==4) then
    3274 
    3275            ! Dans le cas iflag_coupl==4, on prend la somme des convertures
    3276            ! convectives et lsc dans la partie des thermiques
    3277            ! Le controle par iflag_coupl est peut etre provisoire.
    3278            do k=1,klev
    3279               do i=1,klon
    3280                  if (ptconv(i,k).and.ptconvth(i,k)) then
    3281                     cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
    3282                     cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    3283                  else if (ptconv(i,k)) then
    3284                     cldfra(i,k)=rnebcon(i,k)
    3285                     cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
    3286                  endif
    3287               enddo
    3288            enddo
    3289 
    3290         else if (iflag_coupl==5) then
    3291            do k=1,klev
    3292               do i=1,klon
    3293                  cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
    3294                  cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
    3295               enddo
    3296            enddo
    3297 
    3298         else
    3299 
    3300            ! Si on est sur un point touche par la convection profonde et pas
    3301            ! par les thermiques, on prend la couverture nuageuse et l'eau nuageuse
    3302            ! de la convection profonde.
    3303 
    3304            !IM/FH: 2011/02/23
    3305            ! definition des points sur lesquels ls thermiques sont actifs
    3306 
    3307            do k=1,klev
    3308               do i=1,klon
    3309                  if (ptconv(i,k).and. .not. ptconvth(i,k)) then
    3310                     cldfra(i,k)=rnebcon(i,k)
    3311                     cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
    3312                  endif
    3313               enddo
    3314            enddo
    3315 
    3316         endif
    3317 
    3318      else
    3319 
    3320         ! Ancienne version
    3321         cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
    3322         cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
    3323      endif
    3324 
    3325   ENDIF
    3326 
    3327   !     plulsc(:)=0.
    3328   !     do k=1,klev,-1
    3329   !        do i=1,klon
    3330   !              zzz=prfl(:,k)+psfl(:,k)
    3331   !           if (.not.ptconvth.zzz.gt.0.)
    3332   !        enddo prfl, psfl,
    3333   !     enddo
    3334   !
    3335   ! 2. NUAGES STARTIFORMES
    3336   !
    3337   IF (ok_stratus) THEN
    3338      CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
    3339      DO k = 1, klev
    3340         DO i = 1, klon
    3341            IF (diafra(i,k).GT.cldfra(i,k)) THEN
    3342               cldliq(i,k) = dialiq(i,k)
    3343               cldfra(i,k) = diafra(i,k)
    3344            ENDIF
    3345         ENDDO
    3346      ENDDO
    3347   ENDIF
    3348   !
    3349   ! Precipitation totale
    3350   !
    3351   DO i = 1, klon
    3352      rain_fall(i) = rain_con(i) + rain_lsc(i)
    3353      snow_fall(i) = snow_con(i) + snow_lsc(i)
    3354   ENDDO
    3355   !IM
    3356   IF (ip_ebil_phy.ge.2) THEN
    3357      ztit="after diagcld"
    3358      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    3359           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    3360           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3361      call diagphy(cell_area,ztit,ip_ebil_phy &
    3362           , zero_v, zero_v, zero_v, zero_v, zero_v &
    3363           , zero_v, zero_v, zero_v, ztsol &
    3364           , d_h_vcol, d_qt, d_ec &
    3365           , fs_bound, fq_bound )
    3366   END IF
    3367   !
    3368   ! Calculer l'humidite relative pour diagnostique
    3369   !
    3370   DO k = 1, klev
    3371      DO i = 1, klon
    3372         zx_t = t_seri(i,k)
    3373         IF (thermcep) THEN
    3374 !!           if (iflag_ice_thermo.eq.0) then                 !jyg
    3375            zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
    3376 !!           else                                            !jyg
    3377 !!           zdelta = MAX(0.,SIGN(1.,t_glace_min-zx_t))      !jyg
    3378 !!           endif                                           !jyg
    3379            zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
    3380            zx_qs  = MIN(0.5,zx_qs)
    3381            zcor   = 1./(1.-retv*zx_qs)
    3382            zx_qs  = zx_qs*zcor
    3383         ELSE
    3384 !!           IF (zx_t.LT.t_coup) THEN             !jyg
    3385            IF (zx_t.LT.rtt) THEN                  !jyg
    3386               zx_qs = qsats(zx_t)/pplay(i,k)
    3387            ELSE
    3388               zx_qs = qsatl(zx_t)/pplay(i,k)
    3389            ENDIF
    3390         ENDIF
    3391         zx_rh(i,k) = q_seri(i,k)/zx_qs
    3392         zqsat(i,k)=zx_qs
    3393      ENDDO
    3394   ENDDO
    3395 
    3396   !IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
    3397   !   equivalente a 2m (tpote) pour diagnostique
    3398   !
    3399   DO i = 1, klon
    3400      tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA
    3401      IF (thermcep) THEN
    3402         IF(zt2m(i).LT.RTT) then
    3403            Lheat=RLSTT
    3404         ELSE
    3405            Lheat=RLVTT
    3406         ENDIF
    3407      ELSE
    3408         IF (zt2m(i).LT.RTT) THEN
    3409            Lheat=RLSTT
    3410         ELSE
    3411            Lheat=RLVTT
    3412         ENDIF
    3413      ENDIF
    3414      tpote(i) = tpot(i)*      &
    3415           EXP((Lheat *qsat2m(i))/(RCPD*zt2m(i)))
    3416   ENDDO
    3417 
    3418   IF (type_trac == 'inca') THEN
     3344          ENDIF
     3345       ENDIF
     3346       !--fin STRAT AEROSOL
     3347
     3348
     3349       !   On prend la somme des fractions nuageuses et des contenus en eau
     3350
     3351       if (iflag_cld_th>=5) then
     3352
     3353          do k=1,klev
     3354             ptconvth(:,k)=fm_therm(:,k+1)>0.
     3355          enddo
     3356
     3357          if (iflag_coupl==4) then
     3358
     3359             ! Dans le cas iflag_coupl==4, on prend la somme des convertures
     3360             ! convectives et lsc dans la partie des thermiques
     3361             ! Le controle par iflag_coupl est peut etre provisoire.
     3362             do k=1,klev
     3363                do i=1,klon
     3364                   if (ptconv(i,k).and.ptconvth(i,k)) then
     3365                      cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
     3366                      cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
     3367                   else if (ptconv(i,k)) then
     3368                      cldfra(i,k)=rnebcon(i,k)
     3369                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
     3370                   endif
     3371                enddo
     3372             enddo
     3373
     3374          else if (iflag_coupl==5) then
     3375             do k=1,klev
     3376                do i=1,klon
     3377                   cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
     3378                   cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
     3379                enddo
     3380             enddo
     3381
     3382          else
     3383
     3384             ! Si on est sur un point touche par la convection
     3385             ! profonde et pas par les thermiques, on prend la
     3386             ! couverture nuageuse et l'eau nuageuse de la convection
     3387             ! profonde.
     3388
     3389             !IM/FH: 2011/02/23
     3390             ! definition des points sur lesquels ls thermiques sont actifs
     3391
     3392             do k=1,klev
     3393                do i=1,klon
     3394                   if (ptconv(i,k).and. .not. ptconvth(i,k)) then
     3395                      cldfra(i,k)=rnebcon(i,k)
     3396                      cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
     3397                   endif
     3398                enddo
     3399             enddo
     3400
     3401          endif
     3402
     3403       else
     3404
     3405          ! Ancienne version
     3406          cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
     3407          cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
     3408       endif
     3409
     3410    ENDIF
     3411
     3412    !     plulsc(:)=0.
     3413    !     do k=1,klev,-1
     3414    !        do i=1,klon
     3415    !              zzz=prfl(:,k)+psfl(:,k)
     3416    !           if (.not.ptconvth.zzz.gt.0.)
     3417    !        enddo prfl, psfl,
     3418    !     enddo
     3419    !
     3420    ! 2. NUAGES STARTIFORMES
     3421    !
     3422    IF (ok_stratus) THEN
     3423       CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
     3424       DO k = 1, klev
     3425          DO i = 1, klon
     3426             IF (diafra(i,k).GT.cldfra(i,k)) THEN
     3427                cldliq(i,k) = dialiq(i,k)
     3428                cldfra(i,k) = diafra(i,k)
     3429             ENDIF
     3430          ENDDO
     3431       ENDDO
     3432    ENDIF
     3433    !
     3434    ! Precipitation totale
     3435    !
     3436    DO i = 1, klon
     3437       rain_fall(i) = rain_con(i) + rain_lsc(i)
     3438       snow_fall(i) = snow_con(i) + snow_lsc(i)
     3439    ENDDO
     3440    !IM
     3441    IF (ip_ebil_phy.ge.2) THEN
     3442       ztit="after diagcld"
     3443       CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
     3444            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     3445            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     3446       call diagphy(cell_area,ztit,ip_ebil_phy &
     3447            , zero_v, zero_v, zero_v, zero_v, zero_v &
     3448            , zero_v, zero_v, zero_v, ztsol &
     3449            , d_h_vcol, d_qt, d_ec &
     3450            , fs_bound, fq_bound )
     3451    END IF
     3452    !
     3453    ! Calculer l'humidite relative pour diagnostique
     3454    !
     3455    DO k = 1, klev
     3456       DO i = 1, klon
     3457          zx_t = t_seri(i,k)
     3458          IF (thermcep) THEN
     3459             !!           if (iflag_ice_thermo.eq.0) then                 !jyg
     3460             zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
     3461             !!           else                                            !jyg
     3462             !!           zdelta = MAX(0.,SIGN(1.,t_glace_min-zx_t))      !jyg
     3463             !!           endif                                           !jyg
     3464             zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
     3465             zx_qs  = MIN(0.5,zx_qs)
     3466             zcor   = 1./(1.-retv*zx_qs)
     3467             zx_qs  = zx_qs*zcor
     3468          ELSE
     3469             !!           IF (zx_t.LT.t_coup) THEN             !jyg
     3470             IF (zx_t.LT.rtt) THEN                  !jyg
     3471                zx_qs = qsats(zx_t)/pplay(i,k)
     3472             ELSE
     3473                zx_qs = qsatl(zx_t)/pplay(i,k)
     3474             ENDIF
     3475          ENDIF
     3476          zx_rh(i,k) = q_seri(i,k)/zx_qs
     3477          zqsat(i,k)=zx_qs
     3478       ENDDO
     3479    ENDDO
     3480
     3481    !IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
     3482    !   equivalente a 2m (tpote) pour diagnostique
     3483    !
     3484    DO i = 1, klon
     3485       tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA
     3486       IF (thermcep) THEN
     3487          IF(zt2m(i).LT.RTT) then
     3488             Lheat=RLSTT
     3489          ELSE
     3490             Lheat=RLVTT
     3491          ENDIF
     3492       ELSE
     3493          IF (zt2m(i).LT.RTT) THEN
     3494             Lheat=RLSTT
     3495          ELSE
     3496             Lheat=RLVTT
     3497          ENDIF
     3498       ENDIF
     3499       tpote(i) = tpot(i)*      &
     3500            EXP((Lheat *qsat2m(i))/(RCPD*zt2m(i)))
     3501    ENDDO
     3502
     3503    IF (type_trac == 'inca') THEN
    34193504#ifdef INCA
    3420      CALL VTe(VTphysiq)
    3421      CALL VTb(VTinca)
    3422      calday = REAL(days_elapsed + 1) + jH_cur
    3423 
    3424      call chemtime(itap+itau_phy-1, date0, dtime, itap)
    3425      IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN
    3426         CALL AEROSOL_METEO_CALC( &
    3427              calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
    3428              prfl,psfl,pctsrf,cell_area, &
    3429              latitude_deg,longitude_deg,u10m,v10m)
    3430      END IF
    3431 
    3432      zxsnow_dummy(:) = 0.0
    3433 
    3434      CALL chemhook_begin (calday, &
    3435           days_elapsed+1, &
    3436           jH_cur, &
    3437           pctsrf(1,1), &
    3438           latitude_deg, &
    3439           longitude_deg, &
    3440           cell_area, &
    3441           paprs, &
    3442           pplay, &
    3443           coefh(1:klon,1:klev,is_ave), &
    3444           pphi, &
    3445           t_seri, &
    3446           u, &
    3447           v, &
    3448           wo(:, :, 1), &
    3449           q_seri, &
    3450           zxtsol, &
    3451           zxsnow_dummy, &
    3452           solsw, &
    3453           albsol1, &
    3454           rain_fall, &
    3455           snow_fall, &
    3456           itop_con, &
    3457           ibas_con, &
    3458           cldfra, &
    3459           nbp_lon, &
    3460           nbp_lat-1, &
    3461           tr_seri, &
    3462           ftsol, &
    3463           paprs, &
    3464           cdragh, &
    3465           cdragm, &
    3466           pctsrf, &
    3467           pdtphys, &
    3468           itap)
    3469 
    3470      CALL VTe(VTinca)
    3471      CALL VTb(VTphysiq)
     3505       CALL VTe(VTphysiq)
     3506       CALL VTb(VTinca)
     3507       calday = REAL(days_elapsed + 1) + jH_cur
     3508
     3509       call chemtime(itap+itau_phy-1, date0, dtime, itap)
     3510       IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN
     3511          CALL AEROSOL_METEO_CALC( &
     3512               calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
     3513               prfl,psfl,pctsrf,cell_area, &
     3514               latitude_deg,longitude_deg,u10m,v10m)
     3515       END IF
     3516
     3517       zxsnow_dummy(:) = 0.0
     3518
     3519       CALL chemhook_begin (calday, &
     3520            days_elapsed+1, &
     3521            jH_cur, &
     3522            pctsrf(1,1), &
     3523            latitude_deg, &
     3524            longitude_deg, &
     3525            cell_area, &
     3526            paprs, &
     3527            pplay, &
     3528            coefh(1:klon,1:klev,is_ave), &
     3529            pphi, &
     3530            t_seri, &
     3531            u, &
     3532            v, &
     3533            wo(:, :, 1), &
     3534            q_seri, &
     3535            zxtsol, &
     3536            zxsnow_dummy, &
     3537            solsw, &
     3538            albsol1, &
     3539            rain_fall, &
     3540            snow_fall, &
     3541            itop_con, &
     3542            ibas_con, &
     3543            cldfra, &
     3544            nbp_lon, &
     3545            nbp_lat-1, &
     3546            tr_seri, &
     3547            ftsol, &
     3548            paprs, &
     3549            cdragh, &
     3550            cdragm, &
     3551            pctsrf, &
     3552            pdtphys, &
     3553            itap)
     3554
     3555       CALL VTe(VTinca)
     3556       CALL VTb(VTphysiq)
    34723557#endif
    3473   END IF !type_trac = inca
    3474   !     
    3475   ! Calculer les parametres optiques des nuages et quelques
    3476   ! parametres pour diagnostiques:
    3477   !
    3478 
    3479   IF (aerosol_couple.AND.config_inca=='aero') THEN
    3480      mass_solu_aero(:,:)    = ccm(:,:,1)
    3481      mass_solu_aero_pi(:,:) = ccm(:,:,2)
    3482   END IF
    3483 
    3484   if (ok_newmicro) then
    3485      IF (iflag_rrtm.NE.0) THEN
     3558    END IF !type_trac = inca
     3559    !     
     3560    ! Calculer les parametres optiques des nuages et quelques
     3561    ! parametres pour diagnostiques:
     3562    !
     3563
     3564    IF (aerosol_couple.AND.config_inca=='aero') THEN
     3565       mass_solu_aero(:,:)    = ccm(:,:,1)
     3566       mass_solu_aero_pi(:,:) = ccm(:,:,2)
     3567    END IF
     3568
     3569    if (ok_newmicro) then
     3570       IF (iflag_rrtm.NE.0) THEN
    34863571#ifdef CPP_RRTM
    3487         IF (ok_cdnc.AND.NRADLP.NE.3) THEN
    3488            abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 pour ok_cdnc'
    3489            call abort_physic(modname,abort_message,1)
    3490         endif
     3572          IF (ok_cdnc.AND.NRADLP.NE.3) THEN
     3573             abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
     3574                  // 'pour ok_cdnc'
     3575             call abort_physic(modname,abort_message,1)
     3576          endif
    34913577#else
    34923578
    3493         abort_message='You should compile with -rrtm if running with iflag_rrtm=1'
    3494         call abort_physic(modname,abort_message,1)
     3579          abort_message='You should compile with -rrtm if running with ' &
     3580               // 'iflag_rrtm=1'
     3581          call abort_physic(modname,abort_message,1)
    34953582#endif
    3496      ENDIF
    3497      CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, &
    3498           paprs, pplay, t_seri, cldliq, cldfra, &
    3499           cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
    3500           flwp, fiwp, flwc, fiwc, &
    3501           mass_solu_aero, mass_solu_aero_pi, &
    3502           cldtaupi, re, fl, ref_liq, ref_ice, &
    3503           ref_liq_pi, ref_ice_pi)
    3504   else
    3505      CALL nuage (paprs, pplay, &
    3506           t_seri, cldliq, cldfra, cldtau, cldemi, &
    3507           cldh, cldl, cldm, cldt, cldq, &
    3508           ok_aie, &
    3509           mass_solu_aero, mass_solu_aero_pi, &
    3510           bl95_b0, bl95_b1, &
    3511           cldtaupi, re, fl)
    3512   endif
    3513   !
    3514   !IM betaCRF
    3515   !
    3516   cldtaurad   = cldtau
    3517   cldtaupirad = cldtaupi
    3518   cldemirad   = cldemi
    3519   cldfrarad   = cldfra
    3520 
    3521   !
    3522   if(lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. &
    3523        lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN
    3524      !
    3525      ! global
    3526      !
    3527      DO k=1, klev
    3528         DO i=1, klon
    3529            if (pplay(i,k).GE.pfree) THEN
    3530               beta(i,k) = beta_pbl
    3531            else
    3532               beta(i,k) = beta_free
    3533            endif
    3534            if (mskocean_beta) THEN
    3535               beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
    3536            endif
    3537            cldtaurad(i,k)   = cldtau(i,k) * beta(i,k)
    3538            cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
    3539            cldemirad(i,k)   = cldemi(i,k) * beta(i,k)
    3540            cldfrarad(i,k)   = cldfra(i,k) * beta(i,k)
    3541         ENDDO
    3542      ENDDO
    3543      !
    3544   else
    3545      !
    3546      ! regional
    3547      !
    3548      DO k=1, klev
    3549         DO i=1,klon
    3550            !
    3551            if (longitude_deg(i).ge.lon1_beta.AND. &
    3552                longitude_deg(i).le.lon2_beta.AND. &
    3553                latitude_deg(i).le.lat1_beta.AND. &
    3554                latitude_deg(i).ge.lat2_beta) THEN
    3555               if (pplay(i,k).GE.pfree) THEN
    3556                  beta(i,k) = beta_pbl
    3557               else
    3558                  beta(i,k) = beta_free
    3559               endif
    3560               if (mskocean_beta) THEN
    3561                  beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
    3562               endif
    3563               cldtaurad(i,k)   = cldtau(i,k) * beta(i,k)
    3564               cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
    3565               cldemirad(i,k)   = cldemi(i,k) * beta(i,k)
    3566               cldfrarad(i,k)   = cldfra(i,k) * beta(i,k)
    3567            endif
    3568            !
    3569         ENDDO
    3570      ENDDO
    3571      !
    3572   endif
    3573   !
    3574   ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
    3575   !
    3576   IF (MOD(itaprad,radpas).EQ.0) THEN
    3577 
    3578 !albedo SB >>> 
    3579   if(ok_chlorophyll)then
    3580   print*,"-- reading chlorophyll"
    3581   call readchlorophyll(debut)
    3582   endif
    3583   !do i=1,klon
    3584   !if(chl_con(i)>1.) print*,i,chl_con(i),pctsrf(i,is_ter)
    3585   !enddo
    3586 !albedo SB <<<
    3587 
    3588 
    3589      if (mydebug) then
    3590         call writefield_phy('u_seri',u_seri,nbp_lev)
    3591         call writefield_phy('v_seri',v_seri,nbp_lev)
    3592         call writefield_phy('t_seri',t_seri,nbp_lev)
    3593         call writefield_phy('q_seri',q_seri,nbp_lev)
    3594      endif
    3595 
    3596 !
    3597 !sonia :   If Iflag_radia >=2, pertubation of some variables input to radiation
    3598 !(DICE)
    3599 !
    3600       IF (iflag_radia .ge. 2) THEN
    3601         zsav_tsol (:) = zxtsol(:)
    3602         call perturb_radlwsw(zxtsol,iflag_radia)
    3603       ENDIF
    3604 
    3605      IF (aerosol_couple.AND.config_inca=='aero') THEN
     3583       ENDIF
     3584       CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, &
     3585            paprs, pplay, t_seri, cldliq, cldfra, &
     3586            cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
     3587            flwp, fiwp, flwc, fiwc, &
     3588            mass_solu_aero, mass_solu_aero_pi, &
     3589            cldtaupi, re, fl, ref_liq, ref_ice, &
     3590            ref_liq_pi, ref_ice_pi)
     3591    else
     3592       CALL nuage (paprs, pplay, &
     3593            t_seri, cldliq, cldfra, cldtau, cldemi, &
     3594            cldh, cldl, cldm, cldt, cldq, &
     3595            ok_aie, &
     3596            mass_solu_aero, mass_solu_aero_pi, &
     3597            bl95_b0, bl95_b1, &
     3598            cldtaupi, re, fl)
     3599    endif
     3600    !
     3601    !IM betaCRF
     3602    !
     3603    cldtaurad   = cldtau
     3604    cldtaupirad = cldtaupi
     3605    cldemirad   = cldemi
     3606    cldfrarad   = cldfra
     3607
     3608    !
     3609    if(lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. &
     3610         lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN
     3611       !
     3612       ! global
     3613       !
     3614       DO k=1, klev
     3615          DO i=1, klon
     3616             if (pplay(i,k).GE.pfree) THEN
     3617                beta(i,k) = beta_pbl
     3618             else
     3619                beta(i,k) = beta_free
     3620             endif
     3621             if (mskocean_beta) THEN
     3622                beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
     3623             endif
     3624             cldtaurad(i,k)   = cldtau(i,k) * beta(i,k)
     3625             cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
     3626             cldemirad(i,k)   = cldemi(i,k) * beta(i,k)
     3627             cldfrarad(i,k)   = cldfra(i,k) * beta(i,k)
     3628          ENDDO
     3629       ENDDO
     3630       !
     3631    else
     3632       !
     3633       ! regional
     3634       !
     3635       DO k=1, klev
     3636          DO i=1,klon
     3637             !
     3638             if (longitude_deg(i).ge.lon1_beta.AND. &
     3639                  longitude_deg(i).le.lon2_beta.AND. &
     3640                  latitude_deg(i).le.lat1_beta.AND. &
     3641                  latitude_deg(i).ge.lat2_beta) THEN
     3642                if (pplay(i,k).GE.pfree) THEN
     3643                   beta(i,k) = beta_pbl
     3644                else
     3645                   beta(i,k) = beta_free
     3646                endif
     3647                if (mskocean_beta) THEN
     3648                   beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
     3649                endif
     3650                cldtaurad(i,k)   = cldtau(i,k) * beta(i,k)
     3651                cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
     3652                cldemirad(i,k)   = cldemi(i,k) * beta(i,k)
     3653                cldfrarad(i,k)   = cldfra(i,k) * beta(i,k)
     3654             endif
     3655             !
     3656          ENDDO
     3657       ENDDO
     3658       !
     3659    endif
     3660    !
     3661    ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
     3662    !
     3663    IF (MOD(itaprad,radpas).EQ.0) THEN
     3664
     3665       !albedo SB >>> 
     3666       if(ok_chlorophyll)then
     3667          print*,"-- reading chlorophyll"
     3668          call readchlorophyll(debut)
     3669       endif
     3670       !do i=1,klon
     3671       !if(chl_con(i)>1.) print*,i,chl_con(i),pctsrf(i,is_ter)
     3672       !enddo
     3673       !albedo SB <<<
     3674
     3675
     3676       if (mydebug) then
     3677          call writefield_phy('u_seri',u_seri,nbp_lev)
     3678          call writefield_phy('v_seri',v_seri,nbp_lev)
     3679          call writefield_phy('t_seri',t_seri,nbp_lev)
     3680          call writefield_phy('q_seri',q_seri,nbp_lev)
     3681       endif
     3682
     3683       !
     3684       !sonia : If Iflag_radia >=2, pertubation of some variables
     3685       !input to radiation (DICE)
     3686       !
     3687       IF (iflag_radia .ge. 2) THEN
     3688          zsav_tsol (:) = zxtsol(:)
     3689          call perturb_radlwsw(zxtsol,iflag_radia)
     3690       ENDIF
     3691
     3692       IF (aerosol_couple.AND.config_inca=='aero') THEN
    36063693#ifdef INCA
    3607         CALL radlwsw_inca  &
    3608              (kdlon,kflev,dist, rmu0, fract, solaire, &
    3609              paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, &
    3610              wo(:, :, 1), &
    3611              cldfrarad, cldemirad, cldtaurad, &
    3612              heat,heat0,cool,cool0,albpla, &
    3613              topsw,toplw,solsw,sollw, &
    3614              sollwdown, &
    3615              topsw0,toplw0,solsw0,sollw0, &
    3616              lwdn0, lwdn, lwup0, lwup,  &
    3617              swdn0, swdn, swup0, swup, &
    3618              ok_ade, ok_aie, &
    3619              tau_aero, piz_aero, cg_aero, &
    3620              topswad_aero, solswad_aero, &
    3621              topswad0_aero, solswad0_aero, &
    3622              topsw_aero, topsw0_aero, &
    3623              solsw_aero, solsw0_aero, &
    3624              cldtaupirad, &
    3625              topswai_aero, solswai_aero)
     3694          CALL radlwsw_inca  &
     3695               (kdlon,kflev,dist, rmu0, fract, solaire, &
     3696               paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, &
     3697               wo(:, :, 1), &
     3698               cldfrarad, cldemirad, cldtaurad, &
     3699               heat,heat0,cool,cool0,albpla, &
     3700               topsw,toplw,solsw,sollw, &
     3701               sollwdown, &
     3702               topsw0,toplw0,solsw0,sollw0, &
     3703               lwdn0, lwdn, lwup0, lwup,  &
     3704               swdn0, swdn, swup0, swup, &
     3705               ok_ade, ok_aie, &
     3706               tau_aero, piz_aero, cg_aero, &
     3707               topswad_aero, solswad_aero, &
     3708               topswad0_aero, solswad0_aero, &
     3709               topsw_aero, topsw0_aero, &
     3710               solsw_aero, solsw0_aero, &
     3711               cldtaupirad, &
     3712               topswai_aero, solswai_aero)
    36263713
    36273714#endif
    3628      ELSE
    3629         !
    3630         !IM calcul radiatif pour le cas actuel
    3631         !
    3632         RCO2 = RCO2_act
    3633         RCH4 = RCH4_act
    3634         RN2O = RN2O_act
    3635         RCFC11 = RCFC11_act
    3636         RCFC12 = RCFC12_act
    3637         !
    3638         IF (prt_level .GE.10) THEN
    3639            print *,' ->radlwsw, number 1 '
    3640         ENDIF
    3641         !
    3642         CALL radlwsw &
    3643              (dist, rmu0, fract,  &
    3644 !albedo SB >>>
    3645 !             paprs, pplay,zxtsol,albsol1, albsol2,  &
    3646              paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif,  &
    3647 !albedo SB <<<
    3648              t_seri,q_seri,wo, &
    3649              cldfrarad, cldemirad, cldtaurad, &
    3650              ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol, &
    3651              flag_aerosol_strat, &
    3652              tau_aero, piz_aero, cg_aero, &
    3653              tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,&     ! Rajoute par OB pour RRTM
    3654              tau_aero_lw_rrtm, &
    3655              cldtaupirad,new_aod, &
    3656              zqsat, flwc, fiwc, &
    3657              ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    3658              heat,heat0,cool,cool0,albpla, &
    3659              topsw,toplw,solsw,sollw, &
    3660              sollwdown, &
    3661              topsw0,toplw0,solsw0,sollw0, &
    3662              lwdn0, lwdn, lwup0, lwup,  &
    3663              swdn0, swdn, swup0, swup, &
    3664              topswad_aero, solswad_aero, &
    3665              topswai_aero, solswai_aero, &
    3666              topswad0_aero, solswad0_aero, &
    3667              topsw_aero, topsw0_aero, &
    3668              solsw_aero, solsw0_aero, &
    3669              topswcf_aero, solswcf_aero, &
    3670              !-C. Kleinschmitt for LW diagnostics
    3671              toplwad_aero, sollwad_aero,&
    3672              toplwai_aero, sollwai_aero, &
    3673              toplwad0_aero, sollwad0_aero,&
    3674              !-end
    3675              ZLWFT0_i, ZFLDN0, ZFLUP0, &
    3676              ZSWFT0_i, ZFSDN0, ZFSUP0)
    3677 
    3678         !
    3679         !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
    3680         !IM des taux doit etre different du taux actuel
    3681         !IM Par defaut on a les taux perturbes egaux aux taux actuels
    3682         !
    3683         if (ok_4xCO2atm) then
    3684            if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
    3685                 RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
    3686                 RCFC12_per.NE.RCFC12_act) THEN
    3687               !
    3688               RCO2 = RCO2_per
    3689               RCH4 = RCH4_per
    3690               RN2O = RN2O_per
    3691               RCFC11 = RCFC11_per
    3692               RCFC12 = RCFC12_per
    3693               !
    3694               IF (prt_level .GE.10) THEN
    3695                  print *,' ->radlwsw, number 2 '
    3696               ENDIF
    3697               !
    3698               CALL radlwsw &
    3699                    (dist, rmu0, fract,  &
    3700 !albedo SB >>>
    3701 !                   paprs, pplay,zxtsol,albsol1, albsol2,  &
    3702                    paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
    3703 !albedo SB <<<
    3704                    t_seri,q_seri,wo, &
    3705                    cldfra, cldemi, cldtau, &
    3706                    ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol, &
    3707                    flag_aerosol_strat, &
    3708                    tau_aero, piz_aero, cg_aero, &
    3709                    tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,&     ! Rajoute par OB pour RRTM
    3710                    tau_aero_lw_rrtm, &
    3711                    cldtaupi,new_aod, &
    3712                    zqsat, flwc, fiwc, &
    3713                    ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
    3714                    heatp,heat0p,coolp,cool0p,albplap, &
    3715                    topswp,toplwp,solswp,sollwp, &
    3716                    sollwdownp, &
    3717                    topsw0p,toplw0p,solsw0p,sollw0p, &
    3718                    lwdn0p, lwdnp, lwup0p, lwupp,  &
    3719                    swdn0p, swdnp, swup0p, swupp, &
    3720                    topswad_aerop, solswad_aerop, &
    3721                    topswai_aerop, solswai_aerop, &
    3722                    topswad0_aerop, solswad0_aerop, &
    3723                    topsw_aerop, topsw0_aerop, &
    3724                    solsw_aerop, solsw0_aerop, &
    3725                    topswcf_aerop, solswcf_aerop, &
    3726                    !-C. Kleinschmitt for LW diagnostics
    3727                    toplwad_aerop, sollwad_aerop,&
    3728                    toplwai_aerop, sollwai_aerop, &
    3729                    toplwad0_aerop, sollwad0_aerop,&
    3730                    !-end
    3731                    ZLWFT0_i, ZFLDN0, ZFLUP0, &
    3732                    ZSWFT0_i, ZFSDN0, ZFSUP0)
    3733            endif
    3734         endif
    3735         !
    3736      ENDIF ! aerosol_couple
    3737      itaprad = 0
    3738 !
    3739 !  If Iflag_radia >=2, reset pertubed variables
    3740 !
    3741       IF (iflag_radia .ge. 2) THEN
    3742         zxtsol(:) = zsav_tsol (:)
    3743       ENDIF
    3744   ENDIF ! MOD(itaprad,radpas)
    3745   itaprad = itaprad + 1
    3746 
    3747   IF (iflag_radia.eq.0) THEN
    3748      IF (prt_level.ge.9) THEN
    3749         PRINT *,'--------------------------------------------------'
    3750         PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
    3751         PRINT *,'>>>>           heat et cool mis a zero '
    3752         PRINT *,'--------------------------------------------------'
    3753      END IF
    3754      heat=0.
    3755      cool=0.
    3756      sollw=0.   ! MPL 01032011
    3757      solsw=0.
    3758      radsol=0.
    3759      swup=0.    ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
    3760      swup0=0.
    3761      lwup=0.
    3762      lwup0=0.
    3763      lwdn=0.
    3764      lwdn0=0.
    3765   END IF
    3766 
    3767   !
    3768   ! Calculer radsol a l'exterieur de radlwsw
    3769   ! pour prendre en compte le cycle diurne
    3770   ! recode par Olivier Boucher en sept 2015
    3771   !
    3772   radsol=solsw*swradcorr+sollw
    3773   if (ok_4xCO2atm) then
    3774     radsolp=solswp*swradcorr+sollwp
    3775   endif
    3776 
    3777   !
    3778   ! Ajouter la tendance des rayonnements (tous les pas)
    3779   ! avec une correction pour le cycle diurne dans le SW
    3780   !
    3781  
    3782   DO k=1, klev
    3783     d_t_swr(:,k)=swradcorr(:)*heat(:,k)*dtime/RDAY
    3784     d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*dtime/RDAY
    3785     d_t_lwr(:,k)=-cool(:,k)*dtime/RDAY
    3786     d_t_lw0(:,k)=-cool0(:,k)*dtime/RDAY
    3787   ENDDO
    3788 
    3789   CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy)
    3790   CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy)
    3791 
    3792   !
    3793   if (mydebug) then
    3794      call writefield_phy('u_seri',u_seri,nbp_lev)
    3795      call writefield_phy('v_seri',v_seri,nbp_lev)
    3796      call writefield_phy('t_seri',t_seri,nbp_lev)
    3797      call writefield_phy('q_seri',q_seri,nbp_lev)
    3798   endif
    3799 
    3800   !IM
    3801   IF (ip_ebil_phy.ge.2) THEN
    3802      ztit='after rad'
    3803      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    3804           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    3805           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    3806      call diagphy(cell_area,ztit,ip_ebil_phy &
    3807           , topsw, toplw, solsw, sollw, zero_v &
    3808           , zero_v, zero_v, zero_v, ztsol &
    3809           , d_h_vcol, d_qt, d_ec &
    3810           , fs_bound, fq_bound )
    3811   END IF
    3812   !
    3813   !
    3814   ! Calculer l'hydrologie de la surface
    3815   !
    3816   !      CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
    3817   !     .            agesno, ftsol,fqsurf,fsnow, ruis)
    3818   !
    3819 
    3820   !
    3821   ! Calculer le bilan du sol et la derive de temperature (couplage)
    3822   !
    3823   DO i = 1, klon
    3824      !         bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
    3825      ! a la demande de JLD
    3826      bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
    3827   ENDDO
    3828   !
    3829   !moddeblott(jan95)
    3830   ! Appeler le programme de parametrisation de l'orographie
    3831   ! a l'echelle sous-maille:
    3832   !
    3833   IF (prt_level .GE.10) THEN
    3834      print *,' call orography ? ', ok_orodr
    3835   ENDIF
    3836   !
    3837   IF (ok_orodr) THEN
    3838      !
    3839      !  selection des points pour lesquels le shema est actif:
    3840      igwd=0
    3841      DO i=1,klon
    3842         itest(i)=0
    3843         !        IF ((zstd(i).gt.10.0)) THEN
    3844         IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
    3845            itest(i)=1
    3846            igwd=igwd+1
    3847            idx(igwd)=i
    3848         ENDIF
    3849      ENDDO
    3850      !        igwdim=MAX(1,igwd)
    3851      !
    3852      IF (ok_strato) THEN
    3853 
    3854         CALL drag_noro_strato(klon,klev,dtime,paprs,pplay, &
    3855              zmea,zstd, zsig, zgam, zthe,zpic,zval, &
    3856              igwd,idx,itest, &
    3857              t_seri, u_seri, v_seri, &
    3858              zulow, zvlow, zustrdr, zvstrdr, &
    3859              d_t_oro, d_u_oro, d_v_oro)
    3860 
    3861      ELSE
    3862         CALL drag_noro(klon,klev,dtime,paprs,pplay, &
    3863              zmea,zstd, zsig, zgam, zthe,zpic,zval, &
    3864              igwd,idx,itest, &
    3865              t_seri, u_seri, v_seri, &
    3866              zulow, zvlow, zustrdr, zvstrdr, &
    3867              d_t_oro, d_u_oro, d_v_oro)
    3868      ENDIF
    3869      !
    3870      !  ajout des tendances
    3871      !-----------------------------------------------------------------------------------------
    3872      ! ajout des tendances de la trainee de l'orographie
    3873      CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro',abortphy)
    3874      !-----------------------------------------------------------------------------------------
    3875      !
    3876   ENDIF ! fin de test sur ok_orodr
    3877   !
    3878   if (mydebug) then
    3879      call writefield_phy('u_seri',u_seri,nbp_lev)
    3880      call writefield_phy('v_seri',v_seri,nbp_lev)
    3881      call writefield_phy('t_seri',t_seri,nbp_lev)
    3882      call writefield_phy('q_seri',q_seri,nbp_lev)
    3883   endif
    3884 
    3885   IF (ok_orolf) THEN
    3886      !
    3887      !  selection des points pour lesquels le shema est actif:
    3888      igwd=0
    3889      DO i=1,klon
    3890         itest(i)=0
    3891         IF ((zpic(i)-zmea(i)).GT.100.) THEN
    3892            itest(i)=1
    3893            igwd=igwd+1
    3894            idx(igwd)=i
    3895         ENDIF
    3896      ENDDO
    3897      !        igwdim=MAX(1,igwd)
    3898      !
    3899      IF (ok_strato) THEN
    3900 
    3901         CALL lift_noro_strato(klon,klev,dtime,paprs,pplay, &
    3902              latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
    3903              igwd,idx,itest, &
    3904              t_seri, u_seri, v_seri, &
    3905              zulow, zvlow, zustrli, zvstrli, &
    3906              d_t_lif, d_u_lif, d_v_lif               )
    3907 
    3908      ELSE
    3909         CALL lift_noro(klon,klev,dtime,paprs,pplay, &
    3910              latitude_deg,zmea,zstd,zpic, &
    3911              itest, &
    3912              t_seri, u_seri, v_seri, &
    3913              zulow, zvlow, zustrli, zvstrli, &
    3914              d_t_lif, d_u_lif, d_v_lif)
    3915      ENDIF
    3916 
    3917      ! ajout des tendances de la portance de l'orographie
    3918      CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, &
    3919           'lif', abortphy)
    3920   ENDIF ! fin de test sur ok_orolf
    3921 
    3922   IF (ok_hines) then
    3923      !  HINES GWD PARAMETRIZATION
    3924      east_gwstress=0.
    3925      west_gwstress=0.
    3926      du_gwd_hines=0.
    3927      dv_gwd_hines=0.
    3928      CALL hines_gwd(klon, klev, dtime, paprs, pplay, latitude_deg, t_seri, u_seri, &
    3929           v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, du_gwd_hines, &
    3930           dv_gwd_hines)
    3931      zustr_gwd_hines=0.
    3932      zvstr_gwd_hines=0.
    3933      DO k = 1, klev
    3934         zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/dtime &
    3935              * (paprs(:, k)-paprs(:, k+1))/rg
    3936         zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/dtime &
    3937              * (paprs(:, k)-paprs(:, k+1))/rg
    3938      ENDDO
    3939 
    3940      d_t_hin(:, :)=0.
    3941      CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, dqi0, &
    3942           paprs, 'hin', abortphy)
    3943   ENDIF
    3944 
    3945   IF (.not. ok_hines .and. ok_gwd_rando) then
    3946      CALL acama_GWD_rando(DTIME, pplay, latitude_deg, t_seri, u_seri, v_seri, rot, &
    3947           zustr_gwd_front, zvstr_gwd_front, du_gwd_front, dv_gwd_front, &
    3948           east_gwstress, west_gwstress)
    3949      zustr_gwd_front=0.
    3950      zvstr_gwd_front=0.
    3951      DO k = 1, klev
    3952         zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/dtime &
    3953              * (paprs(:, k)-paprs(:, k+1))/rg
    3954         zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/dtime &
    3955              * (paprs(:, k)-paprs(:, k+1))/rg
    3956      ENDDO
    3957 
    3958      CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &
    3959           paprs, 'front_gwd_rando', abortphy)
    3960   ENDIF
    3961 
    3962   if (ok_gwd_rando) then
    3963      call FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
    3964           rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
    3965           du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
    3966      CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, &
    3967           paprs, 'flott_gwd_rando', abortphy)
    3968      zustr_gwd_rando=0.
    3969      zvstr_gwd_rando=0.
    3970      DO k = 1, klev
    3971         zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/dtime &
    3972              * (paprs(:, k)-paprs(:, k+1))/rg
    3973         zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/dtime &
    3974              * (paprs(:, k)-paprs(:, k+1))/rg
    3975      ENDDO
    3976   end if
    3977 
    3978   ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
    3979 
    3980   if (mydebug) then
    3981      call writefield_phy('u_seri',u_seri,nbp_lev)
    3982      call writefield_phy('v_seri',v_seri,nbp_lev)
    3983      call writefield_phy('t_seri',t_seri,nbp_lev)
    3984      call writefield_phy('q_seri',q_seri,nbp_lev)
    3985   endif
    3986 
    3987   DO i = 1, klon
    3988      zustrph(i)=0.
    3989      zvstrph(i)=0.
    3990   ENDDO
    3991   DO k = 1, klev
    3992      DO i = 1, klon
    3993         zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime* &
    3994              (paprs(i,k)-paprs(i,k+1))/rg
    3995         zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime* &
    3996              (paprs(i,k)-paprs(i,k+1))/rg
    3997      ENDDO
    3998   ENDDO
    3999   !
    4000   !IM calcul composantes axiales du moment angulaire et couple des montagnes
    4001   !
    4002   IF (is_sequential .and. ok_orodr) THEN
    4003      CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
    4004           ra,rg,romega, &
    4005           latitude_deg,longitude_deg,pphis, &
    4006           zustrdr,zustrli,zustrph, &
    4007           zvstrdr,zvstrli,zvstrph, &
    4008           paprs,u,v, &
    4009           aam, torsfc)
    4010   ENDIF
    4011   !IM cf. FLott END
    4012   !IM
    4013   IF (ip_ebil_phy.ge.2) THEN
    4014      ztit='after orography'
    4015      CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
    4016           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    4017           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    4018      call diagphy(cell_area,ztit,ip_ebil_phy &
    4019           , zero_v, zero_v, zero_v, zero_v, zero_v &
    4020           , zero_v, zero_v, zero_v, ztsol &
    4021           , d_h_vcol, d_qt, d_ec &
    4022           , fs_bound, fq_bound )
    4023   END IF
    4024 
    4025   !DC Calcul de la tendance due au methane
    4026   IF(ok_qch4) THEN
    4027      CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
    4028   ! ajout de la tendance d'humidite due au methane
    4029      CALL add_phys_tend(du0, dv0, dt0, d_q_ch4*dtime, dql0, dqi0, paprs, &
    4030           'q_ch4', abortphy)
    4031   END IF
    4032   !
    4033   !
    4034   !====================================================================
    4035   ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
    4036   !====================================================================
    4037   ! Abderrahmane 24.08.09
    4038 
    4039   IF (ok_cosp) THEN
    4040      ! adeclarer
     3715       ELSE
     3716          !
     3717          !IM calcul radiatif pour le cas actuel
     3718          !
     3719          RCO2 = RCO2_act
     3720          RCH4 = RCH4_act
     3721          RN2O = RN2O_act
     3722          RCFC11 = RCFC11_act
     3723          RCFC12 = RCFC12_act
     3724          !
     3725          IF (prt_level .GE.10) THEN
     3726             print *,' ->radlwsw, number 1 '
     3727          ENDIF
     3728          !
     3729          CALL radlwsw &
     3730               (dist, rmu0, fract,  &
     3731                                !albedo SB >>>
     3732                                !      paprs, pplay,zxtsol,albsol1, albsol2,  &
     3733               paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif,  &
     3734                                !albedo SB <<<
     3735               t_seri,q_seri,wo, &
     3736               cldfrarad, cldemirad, cldtaurad, &
     3737               ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol, &
     3738               flag_aerosol_strat, &
     3739               tau_aero, piz_aero, cg_aero, &
     3740               tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
     3741               ! Rajoute par OB pour RRTM
     3742               tau_aero_lw_rrtm, &
     3743               cldtaupirad,new_aod, &
     3744               zqsat, flwc, fiwc, &
     3745               ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
     3746               heat,heat0,cool,cool0,albpla, &
     3747               topsw,toplw,solsw,sollw, &
     3748               sollwdown, &
     3749               topsw0,toplw0,solsw0,sollw0, &
     3750               lwdn0, lwdn, lwup0, lwup,  &
     3751               swdn0, swdn, swup0, swup, &
     3752               topswad_aero, solswad_aero, &
     3753               topswai_aero, solswai_aero, &
     3754               topswad0_aero, solswad0_aero, &
     3755               topsw_aero, topsw0_aero, &
     3756               solsw_aero, solsw0_aero, &
     3757               topswcf_aero, solswcf_aero, &
     3758                                !-C. Kleinschmitt for LW diagnostics
     3759               toplwad_aero, sollwad_aero,&
     3760               toplwai_aero, sollwai_aero, &
     3761               toplwad0_aero, sollwad0_aero,&
     3762                                !-end
     3763               ZLWFT0_i, ZFLDN0, ZFLUP0, &
     3764               ZSWFT0_i, ZFSDN0, ZFSUP0)
     3765
     3766          !
     3767          !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
     3768          !IM des taux doit etre different du taux actuel
     3769          !IM Par defaut on a les taux perturbes egaux aux taux actuels
     3770          !
     3771          if (ok_4xCO2atm) then
     3772             if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
     3773                  RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
     3774                  RCFC12_per.NE.RCFC12_act) THEN
     3775                !
     3776                RCO2 = RCO2_per
     3777                RCH4 = RCH4_per
     3778                RN2O = RN2O_per
     3779                RCFC11 = RCFC11_per
     3780                RCFC12 = RCFC12_per
     3781                !
     3782                IF (prt_level .GE.10) THEN
     3783                   print *,' ->radlwsw, number 2 '
     3784                ENDIF
     3785                !
     3786                CALL radlwsw &
     3787                     (dist, rmu0, fract,  &
     3788                                !albedo SB >>>
     3789                                !      paprs, pplay,zxtsol,albsol1, albsol2,  &
     3790                     paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
     3791                                !albedo SB <<<
     3792                     t_seri,q_seri,wo, &
     3793                     cldfra, cldemi, cldtau, &
     3794                     ok_ade.OR.flag_aerosol_strat, ok_aie, flag_aerosol, &
     3795                     flag_aerosol_strat, &
     3796                     tau_aero, piz_aero, cg_aero, &
     3797                     tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
     3798                                ! Rajoute par OB pour RRTM
     3799                     tau_aero_lw_rrtm, &
     3800                     cldtaupi,new_aod, &
     3801                     zqsat, flwc, fiwc, &
     3802                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
     3803                     heatp,heat0p,coolp,cool0p,albplap, &
     3804                     topswp,toplwp,solswp,sollwp, &
     3805                     sollwdownp, &
     3806                     topsw0p,toplw0p,solsw0p,sollw0p, &
     3807                     lwdn0p, lwdnp, lwup0p, lwupp,  &
     3808                     swdn0p, swdnp, swup0p, swupp, &
     3809                     topswad_aerop, solswad_aerop, &
     3810                     topswai_aerop, solswai_aerop, &
     3811                     topswad0_aerop, solswad0_aerop, &
     3812                     topsw_aerop, topsw0_aerop, &
     3813                     solsw_aerop, solsw0_aerop, &
     3814                     topswcf_aerop, solswcf_aerop, &
     3815                                !-C. Kleinschmitt for LW diagnostics
     3816                     toplwad_aerop, sollwad_aerop,&
     3817                     toplwai_aerop, sollwai_aerop, &
     3818                     toplwad0_aerop, sollwad0_aerop,&
     3819                                !-end
     3820                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
     3821                     ZSWFT0_i, ZFSDN0, ZFSUP0)
     3822             endif
     3823          endif
     3824          !
     3825       ENDIF ! aerosol_couple
     3826       itaprad = 0
     3827       !
     3828       !  If Iflag_radia >=2, reset pertubed variables
     3829       !
     3830       IF (iflag_radia .ge. 2) THEN
     3831          zxtsol(:) = zsav_tsol (:)
     3832       ENDIF
     3833    ENDIF ! MOD(itaprad,radpas)
     3834    itaprad = itaprad + 1
     3835
     3836    IF (iflag_radia.eq.0) THEN
     3837       IF (prt_level.ge.9) THEN
     3838          PRINT *,'--------------------------------------------------'
     3839          PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
     3840          PRINT *,'>>>>           heat et cool mis a zero '
     3841          PRINT *,'--------------------------------------------------'
     3842       END IF
     3843       heat=0.
     3844       cool=0.
     3845       sollw=0.   ! MPL 01032011
     3846       solsw=0.
     3847       radsol=0.
     3848       swup=0.    ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
     3849       swup0=0.
     3850       lwup=0.
     3851       lwup0=0.
     3852       lwdn=0.
     3853       lwdn0=0.
     3854    END IF
     3855
     3856    !
     3857    ! Calculer radsol a l'exterieur de radlwsw
     3858    ! pour prendre en compte le cycle diurne
     3859    ! recode par Olivier Boucher en sept 2015
     3860    !
     3861    radsol=solsw*swradcorr+sollw
     3862    if (ok_4xCO2atm) then
     3863       radsolp=solswp*swradcorr+sollwp
     3864    endif
     3865
     3866    !
     3867    ! Ajouter la tendance des rayonnements (tous les pas)
     3868    ! avec une correction pour le cycle diurne dans le SW
     3869    !
     3870
     3871    DO k=1, klev
     3872       d_t_swr(:,k)=swradcorr(:)*heat(:,k)*dtime/RDAY
     3873       d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*dtime/RDAY
     3874       d_t_lwr(:,k)=-cool(:,k)*dtime/RDAY
     3875       d_t_lw0(:,k)=-cool0(:,k)*dtime/RDAY
     3876    ENDDO
     3877
     3878    CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy)
     3879    CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy)
     3880
     3881    !
     3882    if (mydebug) then
     3883       call writefield_phy('u_seri',u_seri,nbp_lev)
     3884       call writefield_phy('v_seri',v_seri,nbp_lev)
     3885       call writefield_phy('t_seri',t_seri,nbp_lev)
     3886       call writefield_phy('q_seri',q_seri,nbp_lev)
     3887    endif
     3888
     3889    !IM
     3890    IF (ip_ebil_phy.ge.2) THEN
     3891       ztit='after rad'
     3892       CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
     3893            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     3894            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     3895       call diagphy(cell_area,ztit,ip_ebil_phy &
     3896            , topsw, toplw, solsw, sollw, zero_v &
     3897            , zero_v, zero_v, zero_v, ztsol &
     3898            , d_h_vcol, d_qt, d_ec &
     3899            , fs_bound, fq_bound )
     3900    END IF
     3901    !
     3902    !
     3903    ! Calculer l'hydrologie de la surface
     3904    !
     3905    !      CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
     3906    !     .            agesno, ftsol,fqsurf,fsnow, ruis)
     3907    !
     3908
     3909    !
     3910    ! Calculer le bilan du sol et la derive de temperature (couplage)
     3911    !
     3912    DO i = 1, klon
     3913       !         bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
     3914       ! a la demande de JLD
     3915       bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
     3916    ENDDO
     3917    !
     3918    !moddeblott(jan95)
     3919    ! Appeler le programme de parametrisation de l'orographie
     3920    ! a l'echelle sous-maille:
     3921    !
     3922    IF (prt_level .GE.10) THEN
     3923       print *,' call orography ? ', ok_orodr
     3924    ENDIF
     3925    !
     3926    IF (ok_orodr) THEN
     3927       !
     3928       !  selection des points pour lesquels le shema est actif:
     3929       igwd=0
     3930       DO i=1,klon
     3931          itest(i)=0
     3932          !        IF ((zstd(i).gt.10.0)) THEN
     3933          IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
     3934             itest(i)=1
     3935             igwd=igwd+1
     3936             idx(igwd)=i
     3937          ENDIF
     3938       ENDDO
     3939       !        igwdim=MAX(1,igwd)
     3940       !
     3941       IF (ok_strato) THEN
     3942
     3943          CALL drag_noro_strato(klon,klev,dtime,paprs,pplay, &
     3944               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
     3945               igwd,idx,itest, &
     3946               t_seri, u_seri, v_seri, &
     3947               zulow, zvlow, zustrdr, zvstrdr, &
     3948               d_t_oro, d_u_oro, d_v_oro)
     3949
     3950       ELSE
     3951          CALL drag_noro(klon,klev,dtime,paprs,pplay, &
     3952               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
     3953               igwd,idx,itest, &
     3954               t_seri, u_seri, v_seri, &
     3955               zulow, zvlow, zustrdr, zvstrdr, &
     3956               d_t_oro, d_u_oro, d_v_oro)
     3957       ENDIF
     3958       !
     3959       !  ajout des tendances
     3960       !-----------------------------------------------------------------------
     3961       ! ajout des tendances de la trainee de l'orographie
     3962       CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro', &
     3963            abortphy)
     3964       !----------------------------------------------------------------------
     3965       !
     3966    ENDIF ! fin de test sur ok_orodr
     3967    !
     3968    if (mydebug) then
     3969       call writefield_phy('u_seri',u_seri,nbp_lev)
     3970       call writefield_phy('v_seri',v_seri,nbp_lev)
     3971       call writefield_phy('t_seri',t_seri,nbp_lev)
     3972       call writefield_phy('q_seri',q_seri,nbp_lev)
     3973    endif
     3974
     3975    IF (ok_orolf) THEN
     3976       !
     3977       !  selection des points pour lesquels le shema est actif:
     3978       igwd=0
     3979       DO i=1,klon
     3980          itest(i)=0
     3981          IF ((zpic(i)-zmea(i)).GT.100.) THEN
     3982             itest(i)=1
     3983             igwd=igwd+1
     3984             idx(igwd)=i
     3985          ENDIF
     3986       ENDDO
     3987       !        igwdim=MAX(1,igwd)
     3988       !
     3989       IF (ok_strato) THEN
     3990
     3991          CALL lift_noro_strato(klon,klev,dtime,paprs,pplay, &
     3992               latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
     3993               igwd,idx,itest, &
     3994               t_seri, u_seri, v_seri, &
     3995               zulow, zvlow, zustrli, zvstrli, &
     3996               d_t_lif, d_u_lif, d_v_lif               )
     3997
     3998       ELSE
     3999          CALL lift_noro(klon,klev,dtime,paprs,pplay, &
     4000               latitude_deg,zmea,zstd,zpic, &
     4001               itest, &
     4002               t_seri, u_seri, v_seri, &
     4003               zulow, zvlow, zustrli, zvstrli, &
     4004               d_t_lif, d_u_lif, d_v_lif)
     4005       ENDIF
     4006
     4007       ! ajout des tendances de la portance de l'orographie
     4008       CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, &
     4009            'lif', abortphy)
     4010    ENDIF ! fin de test sur ok_orolf
     4011
     4012    IF (ok_hines) then
     4013       !  HINES GWD PARAMETRIZATION
     4014       east_gwstress=0.
     4015       west_gwstress=0.
     4016       du_gwd_hines=0.
     4017       dv_gwd_hines=0.
     4018       CALL hines_gwd(klon, klev, dtime, paprs, pplay, latitude_deg, t_seri, &
     4019            u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, &
     4020            du_gwd_hines, dv_gwd_hines)
     4021       zustr_gwd_hines=0.
     4022       zvstr_gwd_hines=0.
     4023       DO k = 1, klev
     4024          zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/dtime &
     4025               * (paprs(:, k)-paprs(:, k+1))/rg
     4026          zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/dtime &
     4027               * (paprs(:, k)-paprs(:, k+1))/rg
     4028       ENDDO
     4029
     4030       d_t_hin(:, :)=0.
     4031       CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
     4032            dqi0, paprs, 'hin', abortphy)
     4033    ENDIF
     4034
     4035    IF (.not. ok_hines .and. ok_gwd_rando) then
     4036       CALL acama_GWD_rando(DTIME, pplay, latitude_deg, t_seri, u_seri, &
     4037            v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, &
     4038            dv_gwd_front, east_gwstress, west_gwstress)
     4039       zustr_gwd_front=0.
     4040       zvstr_gwd_front=0.
     4041       DO k = 1, klev
     4042          zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/dtime &
     4043               * (paprs(:, k)-paprs(:, k+1))/rg
     4044          zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/dtime &
     4045               * (paprs(:, k)-paprs(:, k+1))/rg
     4046       ENDDO
     4047
     4048       CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &
     4049            paprs, 'front_gwd_rando', abortphy)
     4050    ENDIF
     4051
     4052    if (ok_gwd_rando) then
     4053       call FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
     4054            rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
     4055            du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
     4056       CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, &
     4057            paprs, 'flott_gwd_rando', abortphy)
     4058       zustr_gwd_rando=0.
     4059       zvstr_gwd_rando=0.
     4060       DO k = 1, klev
     4061          zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/dtime &
     4062               * (paprs(:, k)-paprs(:, k+1))/rg
     4063          zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/dtime &
     4064               * (paprs(:, k)-paprs(:, k+1))/rg
     4065       ENDDO
     4066    end if
     4067
     4068    ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
     4069
     4070    if (mydebug) then
     4071       call writefield_phy('u_seri',u_seri,nbp_lev)
     4072       call writefield_phy('v_seri',v_seri,nbp_lev)
     4073       call writefield_phy('t_seri',t_seri,nbp_lev)
     4074       call writefield_phy('q_seri',q_seri,nbp_lev)
     4075    endif
     4076
     4077    DO i = 1, klon
     4078       zustrph(i)=0.
     4079       zvstrph(i)=0.
     4080    ENDDO
     4081    DO k = 1, klev
     4082       DO i = 1, klon
     4083          zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime* &
     4084               (paprs(i,k)-paprs(i,k+1))/rg
     4085          zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime* &
     4086               (paprs(i,k)-paprs(i,k+1))/rg
     4087       ENDDO
     4088    ENDDO
     4089    !
     4090    !IM calcul composantes axiales du moment angulaire et couple des montagnes
     4091    !
     4092    IF (is_sequential .and. ok_orodr) THEN
     4093       CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
     4094            ra,rg,romega, &
     4095            latitude_deg,longitude_deg,pphis, &
     4096            zustrdr,zustrli,zustrph, &
     4097            zvstrdr,zvstrli,zvstrph, &
     4098            paprs,u,v, &
     4099            aam, torsfc)
     4100    ENDIF
     4101    !IM cf. FLott END
     4102    !IM
     4103    IF (ip_ebil_phy.ge.2) THEN
     4104       ztit='after orography'
     4105       CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
     4106            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     4107            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     4108       call diagphy(cell_area,ztit,ip_ebil_phy &
     4109            , zero_v, zero_v, zero_v, zero_v, zero_v &
     4110            , zero_v, zero_v, zero_v, ztsol &
     4111            , d_h_vcol, d_qt, d_ec &
     4112            , fs_bound, fq_bound )
     4113    END IF
     4114
     4115    !DC Calcul de la tendance due au methane
     4116    IF(ok_qch4) THEN
     4117       CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
     4118       ! ajout de la tendance d'humidite due au methane
     4119       CALL add_phys_tend(du0, dv0, dt0, d_q_ch4*dtime, dql0, dqi0, paprs, &
     4120            'q_ch4', abortphy)
     4121    END IF
     4122    !
     4123    !
     4124    !====================================================================
     4125    ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
     4126    !====================================================================
     4127    ! Abderrahmane 24.08.09
     4128
     4129    IF (ok_cosp) THEN
     4130       ! adeclarer
    40414131#ifdef CPP_COSP
    4042      IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/dtime)).EQ.0) THEN
    4043 
    4044       IF (prt_level .GE.10) THEN
    4045         print*,'freq_cosp',freq_cosp
    4046       ENDIF
    4047         mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
    4048         !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
    4049         !     s        ref_liq,ref_ice
    4050         call phys_cosp(itap,dtime,freq_cosp, &
    4051              ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
    4052              ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, &
    4053              klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
    4054              JrNt,ref_liq,ref_ice, &
    4055              pctsrf(:,is_ter)+pctsrf(:,is_lic), &
    4056              zu10m,zv10m,pphis, &
    4057              zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
    4058              qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
    4059              prfl(:,1:klev),psfl(:,1:klev), &
    4060              pmflxr(:,1:klev),pmflxs(:,1:klev), &
    4061              mr_ozone,cldtau, cldemi)
    4062 
    4063         !     L          calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
    4064         !     L          cfaddbze,clcalipso2,dbze,cltlidarradar,
    4065         !     M          clMISR,
    4066         !     R          clisccp2,boxtauisccp,boxptopisccp,tclisccp,ctpisccp,
    4067         !     I          tauisccp,albisccp,meantbisccp,meantbclrisccp)
    4068 
    4069      ENDIF
     4132       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/dtime)).EQ.0) THEN
     4133
     4134          IF (prt_level .GE.10) THEN
     4135             print*,'freq_cosp',freq_cosp
     4136          ENDIF
     4137          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
     4138          !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
     4139          !     s        ref_liq,ref_ice
     4140          call phys_cosp(itap,dtime,freq_cosp, &
     4141               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
     4142               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, &
     4143               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
     4144               JrNt,ref_liq,ref_ice, &
     4145               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
     4146               zu10m,zv10m,pphis, &
     4147               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
     4148               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
     4149               prfl(:,1:klev),psfl(:,1:klev), &
     4150               pmflxr(:,1:klev),pmflxs(:,1:klev), &
     4151               mr_ozone,cldtau, cldemi)
     4152
     4153          !     L         calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
     4154          !     L          cfaddbze,clcalipso2,dbze,cltlidarradar,
     4155          !     M          clMISR,
     4156          !     R          clisccp2,boxtauisccp,boxptopisccp,tclisccp,ctpisccp,
     4157          !     I          tauisccp,albisccp,meantbisccp,meantbclrisccp)
     4158
     4159       ENDIF
    40704160
    40714161#endif
    4072   ENDIF  !ok_cosp
    4073 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4074   !AA
    4075   !AA Installation de l'interface online-offline pour traceurs
    4076   !AA
    4077   !====================================================================
    4078   !   Calcul  des tendances traceurs
    4079   !====================================================================
    4080   !
    4081 
    4082   IF (type_trac=='repr') THEN
    4083      sh_in(:,:) = q_seri(:,:)
    4084   ELSE
    4085      sh_in(:,:) = qx(:,:,ivap)
    4086   END IF
    4087 
    4088   call phytrac ( &
    4089        itap,     days_elapsed+1,    jH_cur,   debut, &
    4090        lafin,    dtime,     u, v,     t, &
    4091        paprs,    pplay,     pmfu,     pmfd, &
    4092        pen_u,    pde_u,     pen_d,    pde_d, &
    4093        cdragh,   coefh(1:klon,1:klev,is_ave),   fm_therm, entr_therm, &
    4094        u1,       v1,        ftsol,    pctsrf, &
    4095        zustar,   zu10m,     zv10m, &
    4096        wstar(:,is_ave),    ale_bl,         ale_wake, &
    4097        latitude_deg, longitude_deg, &
    4098        frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, &
    4099        presnivs, pphis,     pphi,     albsol1, &
    4100        sh_in,    rhcl,      cldfra,   rneb, &
    4101        diafra,   cldliq,    itop_con, ibas_con, &
    4102        pmflxr,   pmflxs,    prfl,     psfl, &
    4103        da,       phi,       mp,       upwd, &
    4104        phi2,     d1a,       dam,      sij, wght_cvfd, &        !<<RomP+RL
    4105        wdtrainA, wdtrainM,  sigd,     clw,elij, &   !<<RomP
    4106        ev,       ep,        epmlmMm,  eplaMm, &     !<<RomP
    4107        dnwd,     aerosol_couple,      flxmass_w, &
    4108        tau_aero, piz_aero,  cg_aero,  ccm, &
    4109        rfname, &
    4110        d_tr_dyn, &                                 !<<RomP
    4111        tr_seri)
    4112 
    4113   IF (offline) THEN
    4114 
    4115      IF (prt_level.ge.9) &
    4116           print*,'Attention on met a 0 les thermiques pour phystoke'
    4117      call phystokenc ( &
    4118           nlon,klev,pdtphys,longitude_deg,latitude_deg, &
    4119           t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
    4120           fm_therm,entr_therm, &
    4121           cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
    4122           frac_impa, frac_nucl, &
    4123           pphis,cell_area,dtime,itap, &
    4124           qx(:,:,ivap),da,phi,mp,upwd,dnwd)
    4125 
    4126 
    4127   ENDIF
    4128 
    4129   !
    4130   ! Calculer le transport de l'eau et de l'energie (diagnostique)
    4131   !
    4132   CALL transp (paprs,zxtsol, &
    4133        t_seri, q_seri, u_seri, v_seri, zphi, &
    4134        ve, vq, ue, uq)
    4135   !
    4136   !IM global posePB BEG
    4137   IF(1.EQ.0) THEN
    4138      !
    4139      CALL transp_lay (paprs,zxtsol, &
    4140           t_seri, q_seri, u_seri, v_seri, zphi, &
    4141           ve_lay, vq_lay, ue_lay, uq_lay)
    4142      !
    4143   ENDIF !(1.EQ.0) THEN
    4144   !IM global posePB END
    4145   ! Accumuler les variables a stocker dans les fichiers histoire:
    4146   !
    4147 
    4148   !================================================================
    4149   ! Conversion of kinetic and potential energy into heat, for
    4150   ! parameterisation of subgrid-scale motions
    4151   !================================================================
    4152 
    4153   d_t_ec(:,:)=0.
    4154   forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
    4155   CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap), &
    4156        u_seri,v_seri,t_seri,q_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
    4157        zmasse,exner,d_t_ec)
    4158   t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
    4159 
    4160   !IM
    4161   IF (ip_ebil_phy.ge.1) THEN
    4162      ztit='after physic'
    4163      CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
    4164           , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
    4165           , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
    4166      !     Comme les tendances de la physique sont ajoute dans la dynamique,
    4167      !     on devrait avoir que la variation d'entalpie par la dynamique
    4168      !     est egale a la variation de la physique au pas de temps precedent.
    4169      !     Donc la somme de ces 2 variations devrait etre nulle.
    4170 
    4171      call diagphy(cell_area,ztit,ip_ebil_phy &
    4172           , topsw, toplw, solsw, sollw, sens &
    4173           , evap, rain_fall, snow_fall, ztsol &
    4174           , d_h_vcol, d_qt, d_ec &
    4175           , fs_bound, fq_bound )
    4176      !
    4177      d_h_vcol_phy=d_h_vcol
    4178      !
    4179   END IF
    4180   !
    4181   !=======================================================================
    4182   !   SORTIES
    4183   !=======================================================================
    4184   !
    4185   !IM initialisation + calculs divers diag AMIP2
    4186   !
    4187   include "calcul_divers.h"
    4188   !
    4189   !IM Interpolation sur les niveaux de pression du NMC
    4190   !   -------------------------------------------------
     4162    ENDIF  !ok_cosp
     4163    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     4164    !AA
     4165    !AA Installation de l'interface online-offline pour traceurs
     4166    !AA
     4167    !====================================================================
     4168    !   Calcul  des tendances traceurs
     4169    !====================================================================
     4170    !
     4171
     4172    IF (type_trac=='repr') THEN
     4173       sh_in(:,:) = q_seri(:,:)
     4174    ELSE
     4175       sh_in(:,:) = qx(:,:,ivap)
     4176    END IF
     4177
     4178    call phytrac ( &
     4179         itap,     days_elapsed+1,    jH_cur,   debut, &
     4180         lafin,    dtime,     u, v,     t, &
     4181         paprs,    pplay,     pmfu,     pmfd, &
     4182         pen_u,    pde_u,     pen_d,    pde_d, &
     4183         cdragh,   coefh(1:klon,1:klev,is_ave),   fm_therm, entr_therm, &
     4184         u1,       v1,        ftsol,    pctsrf, &
     4185         zustar,   zu10m,     zv10m, &
     4186         wstar(:,is_ave),    ale_bl,         ale_wake, &
     4187         latitude_deg, longitude_deg, &
     4188         frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, &
     4189         presnivs, pphis,     pphi,     albsol1, &
     4190         sh_in,    rhcl,      cldfra,   rneb, &
     4191         diafra,   cldliq,    itop_con, ibas_con, &
     4192         pmflxr,   pmflxs,    prfl,     psfl, &
     4193         da,       phi,       mp,       upwd, &
     4194         phi2,     d1a,       dam,      sij, wght_cvfd, &        !<<RomP+RL
     4195         wdtrainA, wdtrainM,  sigd,     clw,elij, &   !<<RomP
     4196         ev,       ep,        epmlmMm,  eplaMm, &     !<<RomP
     4197         dnwd,     aerosol_couple,      flxmass_w, &
     4198         tau_aero, piz_aero,  cg_aero,  ccm, &
     4199         rfname, &
     4200         d_tr_dyn, &                                 !<<RomP
     4201         tr_seri)
     4202
     4203    IF (offline) THEN
     4204
     4205       IF (prt_level.ge.9) &
     4206            print*,'Attention on met a 0 les thermiques pour phystoke'
     4207       call phystokenc ( &
     4208            nlon,klev,pdtphys,longitude_deg,latitude_deg, &
     4209            t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
     4210            fm_therm,entr_therm, &
     4211            cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
     4212            frac_impa, frac_nucl, &
     4213            pphis,cell_area,dtime,itap, &
     4214            qx(:,:,ivap),da,phi,mp,upwd,dnwd)
     4215
     4216
     4217    ENDIF
     4218
     4219    !
     4220    ! Calculer le transport de l'eau et de l'energie (diagnostique)
     4221    !
     4222    CALL transp (paprs,zxtsol, &
     4223         t_seri, q_seri, u_seri, v_seri, zphi, &
     4224         ve, vq, ue, uq)
     4225    !
     4226    !IM global posePB BEG
     4227    IF(1.EQ.0) THEN
     4228       !
     4229       CALL transp_lay (paprs,zxtsol, &
     4230            t_seri, q_seri, u_seri, v_seri, zphi, &
     4231            ve_lay, vq_lay, ue_lay, uq_lay)
     4232       !
     4233    ENDIF !(1.EQ.0) THEN
     4234    !IM global posePB END
     4235    ! Accumuler les variables a stocker dans les fichiers histoire:
     4236    !
     4237
     4238    !================================================================
     4239    ! Conversion of kinetic and potential energy into heat, for
     4240    ! parameterisation of subgrid-scale motions
     4241    !================================================================
     4242
     4243    d_t_ec(:,:)=0.
     4244    forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
     4245    CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap), &
     4246         u_seri,v_seri,t_seri,q_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
     4247         zmasse,exner,d_t_ec)
     4248    t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
     4249
     4250    !IM
     4251    IF (ip_ebil_phy.ge.1) THEN
     4252       ztit='after physic'
     4253       CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
     4254            , t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
     4255            , d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec)
     4256       !     Comme les tendances de la physique sont ajoute dans la dynamique,
     4257       !     on devrait avoir que la variation d'entalpie par la dynamique
     4258       !     est egale a la variation de la physique au pas de temps precedent.
     4259       !     Donc la somme de ces 2 variations devrait etre nulle.
     4260
     4261       call diagphy(cell_area,ztit,ip_ebil_phy &
     4262            , topsw, toplw, solsw, sollw, sens &
     4263            , evap, rain_fall, snow_fall, ztsol &
     4264            , d_h_vcol, d_qt, d_ec &
     4265            , fs_bound, fq_bound )
     4266       !
     4267       d_h_vcol_phy=d_h_vcol
     4268       !
     4269    END IF
     4270    !
     4271    !=======================================================================
     4272    !   SORTIES
     4273    !=======================================================================
     4274    !
     4275    !IM initialisation + calculs divers diag AMIP2
     4276    !
     4277    include "calcul_divers.h"
     4278    !
     4279    !IM Interpolation sur les niveaux de pression du NMC
     4280    !   -------------------------------------------------
    41914281#ifdef CPP_XIOS
    4192           !$OMP MASTER
    4193           !On recupere la valeur de la missing value donnee dans le xml
    4194           CALL xios_get_field_attr("t850",default_value=missing_val_omp)
    4195 !         PRINT *,"ARNAUD value missing ",missing_val_omp
    4196           !$OMP END MASTER
    4197           !$OMP BARRIER
    4198           missing_val=missing_val_omp
     4282    !$OMP MASTER
     4283    !On recupere la valeur de la missing value donnee dans le xml
     4284    CALL xios_get_field_attr("t850",default_value=missing_val_omp)
     4285    !         PRINT *,"ARNAUD value missing ",missing_val_omp
     4286    !$OMP END MASTER
     4287    !$OMP BARRIER
     4288    missing_val=missing_val_omp
    41994289#endif
    42004290#ifndef CPP_XIOS
    4201           missing_val=missing_val_nf90
     4291    missing_val=missing_val_nf90
    42024292#endif
    4203   !
    4204   include "calcul_STDlev.h"
    4205   !
    4206   ! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
    4207   CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
    4208   !
    4209   !cc prw = eau precipitable
    4210   DO i = 1, klon
    4211      prw(i) = 0.
    4212      DO k = 1, klev
    4213         prw(i) = prw(i) + &
    4214              q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
    4215      ENDDO
    4216   ENDDO
    4217   !
    4218   IF (type_trac == 'inca') THEN
     4293    !
     4294    include "calcul_STDlev.h"
     4295    !
     4296    ! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
     4297    CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
     4298    !
     4299    !cc prw = eau precipitable
     4300    DO i = 1, klon
     4301       prw(i) = 0.
     4302       DO k = 1, klev
     4303          prw(i) = prw(i) + &
     4304               q_seri(i,k)*(paprs(i,k)-paprs(i,k+1))/RG
     4305       ENDDO
     4306    ENDDO
     4307    !
     4308    IF (type_trac == 'inca') THEN
    42194309#ifdef INCA
    4220      CALL VTe(VTphysiq)
    4221      CALL VTb(VTinca)
    4222 
    4223      CALL chemhook_end ( &
    4224           dtime, &
    4225           pplay, &
    4226           t_seri, &
    4227           tr_seri, &
    4228           nbtr, &
    4229           paprs, &
    4230           q_seri, &
    4231           cell_area, &
    4232           pphi, &
    4233           pphis, &
    4234           zx_rh)
    4235 
    4236      CALL VTe(VTinca)
    4237      CALL VTb(VTphysiq)
     4310       CALL VTe(VTphysiq)
     4311       CALL VTb(VTinca)
     4312
     4313       CALL chemhook_end ( &
     4314            dtime, &
     4315            pplay, &
     4316            t_seri, &
     4317            tr_seri, &
     4318            nbtr, &
     4319            paprs, &
     4320            q_seri, &
     4321            cell_area, &
     4322            pphi, &
     4323            pphis, &
     4324            zx_rh)
     4325
     4326       CALL VTe(VTinca)
     4327       CALL VTb(VTphysiq)
    42384328#endif
    4239   END IF
    4240 
    4241 
    4242   !
    4243   ! Convertir les incrementations en tendances
    4244   !
    4245   IF (prt_level .GE.10) THEN
    4246      print *,'Convertir les incrementations en tendances '
    4247   ENDIF
    4248   !
    4249   if (mydebug) then
    4250      call writefield_phy('u_seri',u_seri,nbp_lev)
    4251      call writefield_phy('v_seri',v_seri,nbp_lev)
    4252      call writefield_phy('t_seri',t_seri,nbp_lev)
    4253      call writefield_phy('q_seri',q_seri,nbp_lev)
    4254   endif
    4255 
    4256   DO k = 1, klev
    4257      DO i = 1, klon
    4258         d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
    4259         d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
    4260         d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
    4261         d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
    4262         d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
    4263 !CR: on ajoute le contenu en glace
    4264         if (nqo.eq.3) then
    4265         d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime
    4266         endif
    4267      ENDDO
    4268   ENDDO
    4269   !
    4270 !CR: nb de traceurs eau: nqo
    4271 !  IF (nqtot.GE.3) THEN
    4272    IF (nqtot.GE.(nqo+1)) THEN
    4273 !     DO iq = 3, nqtot
    4274      DO iq = nqo+1, nqtot
    4275         DO  k = 1, klev
    4276            DO  i = 1, klon
    4277 !              d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
    4278                d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / dtime
    4279            ENDDO
    4280         ENDDO
    4281      ENDDO
    4282   ENDIF
    4283   !
    4284   !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
    4285   !IM global posePB      include "write_bilKP_ins.h"
    4286   !IM global posePB      include "write_bilKP_ave.h"
    4287   !
    4288 
    4289   ! Sauvegarder les valeurs de t et q a la fin de la physique:
    4290   !
    4291   DO k = 1, klev
    4292      DO i = 1, klon
    4293         u_ancien(i,k) = u_seri(i,k)
    4294         v_ancien(i,k) = v_seri(i,k)
    4295         t_ancien(i,k) = t_seri(i,k)
    4296         q_ancien(i,k) = q_seri(i,k)
    4297      ENDDO
    4298   ENDDO
    4299 
    4300 !!! RomP >>>
    4301 !CR: nb de traceurs eau: nqo
    4302 !  IF (nqtot.GE.3) THEN
    4303    IF (nqtot.GE.(nqo+1)) THEN
    4304 !     DO iq = 3, nqtot
    4305      DO iq = nqo+1, nqtot
    4306         DO k = 1, klev
    4307            DO i = 1, klon
    4308 !              tr_ancien(i,k,iq-2) = tr_seri(i,k,iq-2)
    4309               tr_ancien(i,k,iq-nqo) = tr_seri(i,k,iq-nqo)
    4310            ENDDO
    4311         ENDDO
    4312      ENDDO
    4313   ENDIF
    4314 !!! RomP <<<
    4315   !==========================================================================
    4316   ! Sorties des tendances pour un point particulier
    4317   ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
    4318   ! pour le debug
    4319   ! La valeur de igout est attribuee plus haut dans le programme
    4320   !==========================================================================
    4321 
    4322   if (prt_level.ge.1) then
    4323      write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    4324      write(lunout,*) &
    4325           'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
    4326      write(lunout,*) &
    4327           nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
    4328           pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
    4329           pctsrf(igout,is_sic)
    4330      write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
    4331      do k=1,klev
    4332         write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
    4333              d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
    4334              d_t_eva(igout,k)
    4335      enddo
    4336      write(lunout,*) 'cool,heat'
    4337      do k=1,klev
    4338         write(lunout,*) cool(igout,k),heat(igout,k)
    4339      enddo
    4340 
    4341 !jyg<     (En attendant de statuer sur le sort de d_t_oli)
    4342 !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    4343 !jyg!     do k=1,klev
    4344 !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
    4345 !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    4346 !jyg!     enddo
    4347      write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
    4348      do k=1,klev
    4349         write(lunout,*) d_t_vdf(igout,k), &
    4350              d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
    4351      enddo
    4352 !>jyg
    4353 
    4354      write(lunout,*) 'd_ps ',d_ps(igout)
    4355      write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
    4356      do k=1,klev
    4357         write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
    4358              d_qx(igout,k,1),d_qx(igout,k,2)
    4359      enddo
    4360   endif
    4361 
    4362   !==========================================================================
    4363 
    4364   !============================================================
    4365   !   Calcul de la temperature potentielle
    4366   !============================================================
    4367   DO k = 1, klev
    4368      DO i = 1, klon
    4369         !JYG/IM theta en debut du pas de temps
    4370         !JYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
    4371         !JYG/IM theta en fin de pas de temps de physique
    4372         theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
    4373         ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers     MPL 20130625
    4374         ! fth_fonctions.F90 et parkind1.F90
    4375         ! sinon thetal=theta
    4376         !       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
    4377         !    :         ql_seri(i,k))
    4378         thetal(i,k)=theta(i,k)
    4379      ENDDO
    4380   ENDDO
    4381   !
    4382 
    4383   ! 22.03.04 BEG
    4384   !=============================================================
    4385   !   Ecriture des sorties
    4386   !=============================================================
     4329    END IF
     4330
     4331
     4332    !
     4333    ! Convertir les incrementations en tendances
     4334    !
     4335    IF (prt_level .GE.10) THEN
     4336       print *,'Convertir les incrementations en tendances '
     4337    ENDIF
     4338    !
     4339    if (mydebug) then
     4340       call writefield_phy('u_seri',u_seri,nbp_lev)
     4341       call writefield_phy('v_seri',v_seri,nbp_lev)
     4342       call writefield_phy('t_seri',t_seri,nbp_lev)
     4343       call writefield_phy('q_seri',q_seri,nbp_lev)
     4344    endif
     4345
     4346    DO k = 1, klev
     4347       DO i = 1, klon
     4348          d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
     4349          d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
     4350          d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
     4351          d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
     4352          d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
     4353          !CR: on ajoute le contenu en glace
     4354          if (nqo.eq.3) then
     4355             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime
     4356          endif
     4357       ENDDO
     4358    ENDDO
     4359    !
     4360    !CR: nb de traceurs eau: nqo
     4361    !  IF (nqtot.GE.3) THEN
     4362    IF (nqtot.GE.(nqo+1)) THEN
     4363       !     DO iq = 3, nqtot
     4364       DO iq = nqo+1, nqtot
     4365          DO  k = 1, klev
     4366             DO  i = 1, klon
     4367                ! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
     4368                d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / dtime
     4369             ENDDO
     4370          ENDDO
     4371       ENDDO
     4372    ENDIF
     4373    !
     4374    !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
     4375    !IM global posePB      include "write_bilKP_ins.h"
     4376    !IM global posePB      include "write_bilKP_ave.h"
     4377    !
     4378
     4379    ! Sauvegarder les valeurs de t et q a la fin de la physique:
     4380    !
     4381    DO k = 1, klev
     4382       DO i = 1, klon
     4383          u_ancien(i,k) = u_seri(i,k)
     4384          v_ancien(i,k) = v_seri(i,k)
     4385          t_ancien(i,k) = t_seri(i,k)
     4386          q_ancien(i,k) = q_seri(i,k)
     4387       ENDDO
     4388    ENDDO
     4389
     4390    ! !! RomP >>>
     4391    !CR: nb de traceurs eau: nqo
     4392    !  IF (nqtot.GE.3) THEN
     4393    IF (nqtot.GE.(nqo+1)) THEN
     4394       !     DO iq = 3, nqtot
     4395       DO iq = nqo+1, nqtot
     4396          DO k = 1, klev
     4397             DO i = 1, klon
     4398                !              tr_ancien(i,k,iq-2) = tr_seri(i,k,iq-2)
     4399                tr_ancien(i,k,iq-nqo) = tr_seri(i,k,iq-nqo)
     4400             ENDDO
     4401          ENDDO
     4402       ENDDO
     4403    ENDIF
     4404    ! !! RomP <<<
     4405    !==========================================================================
     4406    ! Sorties des tendances pour un point particulier
     4407    ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
     4408    ! pour le debug
     4409    ! La valeur de igout est attribuee plus haut dans le programme
     4410    !==========================================================================
     4411
     4412    if (prt_level.ge.1) then
     4413       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
     4414       write(lunout,*) &
     4415            'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
     4416       write(lunout,*) &
     4417            nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
     4418            pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
     4419            pctsrf(igout,is_sic)
     4420       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
     4421       do k=1,klev
     4422          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
     4423               d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
     4424               d_t_eva(igout,k)
     4425       enddo
     4426       write(lunout,*) 'cool,heat'
     4427       do k=1,klev
     4428          write(lunout,*) cool(igout,k),heat(igout,k)
     4429       enddo
     4430
     4431       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
     4432       !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
     4433       !jyg!     do k=1,klev
     4434       !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
     4435       !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
     4436       !jyg!     enddo
     4437       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
     4438       do k=1,klev
     4439          write(lunout,*) d_t_vdf(igout,k), &
     4440               d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
     4441       enddo
     4442       !>jyg
     4443
     4444       write(lunout,*) 'd_ps ',d_ps(igout)
     4445       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
     4446       do k=1,klev
     4447          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
     4448               d_qx(igout,k,1),d_qx(igout,k,2)
     4449       enddo
     4450    endif
     4451
     4452    !==========================================================================
     4453
     4454    !============================================================
     4455    !   Calcul de la temperature potentielle
     4456    !============================================================
     4457    DO k = 1, klev
     4458       DO i = 1, klon
     4459          !JYG/IM theta en debut du pas de temps
     4460          !JYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
     4461          !JYG/IM theta en fin de pas de temps de physique
     4462          theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
     4463          ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
     4464          !     MPL 20130625
     4465          ! fth_fonctions.F90 et parkind1.F90
     4466          ! sinon thetal=theta
     4467          !       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
     4468          !    :         ql_seri(i,k))
     4469          thetal(i,k)=theta(i,k)
     4470       ENDDO
     4471    ENDDO
     4472    !
     4473
     4474    ! 22.03.04 BEG
     4475    !=============================================================
     4476    !   Ecriture des sorties
     4477    !=============================================================
    43874478#ifdef CPP_IOIPSL
    43884479
    4389   ! Recupere des varibles calcule dans differents modules
    4390   ! pour ecriture dans histxxx.nc
    4391 
    4392   ! Get some variables from module fonte_neige_mod
    4393   CALL fonte_neige_get_vars(pctsrf,  &
    4394        zxfqcalving, zxfqfonte, zxffonte)
    4395 
    4396 
    4397 
    4398 
    4399   !=============================================================
    4400   ! Separation entre thermiques et non thermiques dans les sorties
    4401   ! de fisrtilp
    4402   !=============================================================
    4403 
    4404   if (iflag_thermals>=1) then
    4405      d_t_lscth=0.
    4406      d_t_lscst=0.
    4407      d_q_lscth=0.
    4408      d_q_lscst=0.
    4409      do k=1,klev
    4410         do i=1,klon
    4411            if (ptconvth(i,k)) then
    4412               d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    4413               d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4414            else
    4415               d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
    4416               d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
    4417            endif
    4418         enddo
    4419      enddo
    4420 
    4421      do i=1,klon
    4422         plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
    4423         plul_th(i)=prfl(i,1)+psfl(i,1)
    4424      enddo
    4425   endif
    4426 
    4427 
    4428   !On effectue les sorties:
    4429 
    4430   CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
    4431        pplay, lmax_th, aerosol_couple,                 &
    4432        ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
    4433        ptconv, read_climoz, clevSTD,                   &
    4434        ptconvth, d_t, qx, d_qx, zmasse,                &
    4435        flag_aerosol, flag_aerosol_strat, ok_cdnc)
    4436 
    4437 
    4438 
    4439   include "write_histday_seri.h"
    4440 
    4441   include "write_paramLMDZ_phy.h"
     4480    ! Recupere des varibles calcule dans differents modules
     4481    ! pour ecriture dans histxxx.nc
     4482
     4483    ! Get some variables from module fonte_neige_mod
     4484    CALL fonte_neige_get_vars(pctsrf,  &
     4485         zxfqcalving, zxfqfonte, zxffonte)
     4486
     4487
     4488
     4489
     4490    !=============================================================
     4491    ! Separation entre thermiques et non thermiques dans les sorties
     4492    ! de fisrtilp
     4493    !=============================================================
     4494
     4495    if (iflag_thermals>=1) then
     4496       d_t_lscth=0.
     4497       d_t_lscst=0.
     4498       d_q_lscth=0.
     4499       d_q_lscst=0.
     4500       do k=1,klev
     4501          do i=1,klon
     4502             if (ptconvth(i,k)) then
     4503                d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
     4504                d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
     4505             else
     4506                d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
     4507                d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
     4508             endif
     4509          enddo
     4510       enddo
     4511
     4512       do i=1,klon
     4513          plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
     4514          plul_th(i)=prfl(i,1)+psfl(i,1)
     4515       enddo
     4516    endif
     4517
     4518
     4519    !On effectue les sorties:
     4520
     4521    CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
     4522         pplay, lmax_th, aerosol_couple,                 &
     4523         ok_ade, ok_aie, ivap, new_aod, ok_sync,         &
     4524         ptconv, read_climoz, clevSTD,                   &
     4525         ptconvth, d_t, qx, d_qx, zmasse,                &
     4526         flag_aerosol, flag_aerosol_strat, ok_cdnc)
     4527
     4528
     4529
     4530    include "write_histday_seri.h"
     4531
     4532    include "write_paramLMDZ_phy.h"
    44424533
    44434534#endif
    44444535
    44454536
    4446 !====================================================================
    4447 ! Arret du modele apres hgardfou en cas de detection d'un
    4448 ! plantage par hgardfou
    4449 !====================================================================
     4537    !====================================================================
     4538    ! Arret du modele apres hgardfou en cas de detection d'un
     4539    ! plantage par hgardfou
     4540    !====================================================================
    44504541
    44514542    IF (abortphy==1) THEN
    … …  
    44544545    ENDIF
    44554546
    4456 
    4457   ! 22.03.04 END
    4458   !
    4459   !====================================================================
    4460   ! Si c'est la fin, il faut conserver l'etat de redemarrage
    4461   !====================================================================
    4462   !
    4463 
    4464   IF (lafin) THEN
    4465      itau_phy = itau_phy + itap
    4466      CALL phyredem ("restartphy.nc")
    4467      !         open(97,form="unformatted",file="finbin")
    4468      !         write(97) u_seri,v_seri,t_seri,q_seri
    4469      !         close(97)
    4470      !$OMP MASTER
    4471      if (read_climoz >= 1) then
    4472         if (is_mpi_root) then
    4473            call nf95_close(ncid_climoz)
    4474         end if
    4475         deallocate(press_climoz) ! pointer
    4476      end if
    4477      !$OMP END MASTER
    4478   ENDIF
    4479 
    4480   !      first=.false.
    4481 
    4482 
    4483 END SUBROUTINE physiq
     4547    !--OB mass fixer
     4548    !--profile is corrected to force mass conservation of water
     4549    IF (mass_fixer) THEN
     4550    qql2(:)=0.0
     4551    DO i = 1, klon
     4552      DO k = 1, klev
     4553        qql2(i)=qql2(i)+(q_seri(i,k)+ql_seri(i,k))*zmasse(i,k)
     4554      ENDDO
     4555    ENDDO
     4556    DO i = 1, klon
     4557      !--compute ratio of what q+ql should be with conservation to what it is
     4558      corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
     4559      DO k = 1, klev
     4560        q_seri(i,k) =q_seri(i,k)*corrqql
     4561        ql_seri(i,k)=ql_seri(i,k)*corrqql
     4562      ENDDO
     4563    ENDDO
     4564    ENDIF
     4565    !--fin mass fixer
     4566
     4567    ! 22.03.04 END
     4568    !
     4569    !====================================================================
     4570    ! Si c'est la fin, il faut conserver l'etat de redemarrage
     4571    !====================================================================
     4572    !
     4573
     4574    IF (lafin) THEN
     4575       itau_phy = itau_phy + itap
     4576       CALL phyredem ("restartphy.nc")
     4577       !         open(97,form="unformatted",file="finbin")
     4578       !         write(97) u_seri,v_seri,t_seri,q_seri
     4579       !         close(97)
     4580       !$OMP MASTER
     4581       if (read_climoz >= 1) then
     4582          if (is_mpi_root) then
     4583             call nf95_close(ncid_climoz)
     4584          end if
     4585          deallocate(press_climoz) ! pointer
     4586       end if
     4587       !$OMP END MASTER
     4588    ENDIF
     4589
     4590    !      first=.false.
     4591
     4592
     4593  END SUBROUTINE physiq
    44844594
    44854595END MODULE physiq_mod

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

    r2408 r2488  
    383383!       & (1.0_JPRB - Z_CLDFRAC(I_LEV-1))   
    384384!    ENDIF
    385      if(istcld(i_lev).ne.1) then
     385     if(istcld(i_lev).ne.1.and.i_lev.ne.1) then
    386386        z_faccmb1(i_lev+1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
    387387               z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))
    … …  
    496496!    Z_FACCMB2D(I_LEV-1) = Z_FACCLD1D(I_LEV-1) * Z_FACCLR2D(I_LEV) *&
    497497!     & (1.0_JPRB - Z_CLDFRAC(I_LEV+1)) 
    498     if (istcldd(i_lev).ne.1.and.i_lev.ne.0) then
     498    if (istcldd(i_lev).ne.1.and.i_lev.ne.1) then
    499499       z_faccmb1d(i_lev-1) = max(0.,min(z_cldfrac(i_lev+1)-z_cldfrac(i_lev), &
    500500                            z_cldfrac(i_lev-1)-z_cldfrac(i_lev)))

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

    r1999 r2488  
    1 SUBROUTINE SURAYOLMD(PPRES)
     1SUBROUTINE SURAYOLMD
    22#ifdef DOC
    33
    … …  
    5353IMPLICIT NONE
    5454LOGICAL LLTRACE, LLDEBUG
    55 REAL PPRES(NFLEVG)
    5655
    5756LLTRACE=.TRUE.
    … …  
    6766WRITE(*,FMT='(''     SUPHY: '')')
    6867WRITE(*,FMT='('' ---------------- '')')
    69 !  CALL SUPHY(PPRES)
    7068  CALL SUPHY(6)    !!!!! A REVOIR (MPL) argument KULOUT=6 "en dur"
    7169

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

    r2435 r2488  
    2828    INTEGER,SAVE :: itaufin_phy      ! final iteration (in itau_phy steps)
    2929!$OMP THREADPRIVATE(itaufin_phy)
    30     REAL,SAVE    :: current_time ! current elapsed time (s) from the begining of the run
     30    REAL,SAVE    :: current_time ! current elapsed time (fraction of day) from the begining of the run
    3131!$OMP THREADPRIVATE(current_time)
    3232   
    … …  
    6161    CALL getin_p('raz_date', raz_date)
    6262
    63     current_time=0
     63    current_time=0.
    6464   
    6565    CALL phys_cal_init(annee_ref,day_ref)

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

    r2408 r2488  
    186186         sh,         & !sh
    187187         rh,         & !rh
    188          nbp_lon+1,  & !nx
     188         nbp_lon,    & !nx
    189189         nbp_lat,    & !ny
    190190         source )

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

    r2408 r2488  
    2121  ! **************************************************************
    2222
     23  USE ioipsl_getin_p_mod, ONLY : getin_p
    2324  USE dimphy
    2425  use mod_phys_lmdz_para
    … …  
    161162  REAL, SAVE ::  stark, wdens_ref, coefgw, alpk, crep_upper, crep_sol 
    162163  !$OMP THREADPRIVATE(stark, wdens_ref, coefgw, alpk, crep_upper, crep_sol)
     164
    163165  REAL delta_t_min
    164166  INTEGER nsub
    … …  
    286288
    287289 if (first) then
    288   stark = 0.33
    289   alpk = 0.25
    290   wdens_ref = 8.E-12
    291   coefgw = 4.
    292290  crep_upper = 0.9
    293291  crep_sol = 1.0
    294292
    295293  ! cc nrlmd Lecture du fichier wake_param.data
    296  !$OMP MASTER
    297   OPEN (99, FILE='wake_param.data', STATUS='old', FORM='formatted', ERR=9999)
    298   READ (99, *, END=9998) stark
    299   READ (99, *, END=9998) alpk
    300   READ (99, *, END=9998) wdens_ref
    301   READ (99, *, END=9998) coefgw
    302 9998 CONTINUE
    303   CLOSE (99)
    304 9999 CONTINUE
    305  !$OMP END MASTER
    306   CALL bcast(stark)
    307   CALL bcast(alpk)
    308   CALL bcast(wdens_ref)
    309   CALL bcast(coefgw)
     294  stark=0.33
     295  CALL getin_p('stark',stark)
     296  alpk=0.25
     297  CALL getin_p('alpk',alpk)
     298  wdens_ref=8.E-12
     299  CALL getin_p('wdens_ref',wdens_ref)
     300  coefgw=4.
     301  CALL getin_p('coefgw',coefgw)
     302
     303  WRITE(*,*) 'stark=', stark
     304  WRITE(*,*) 'alpk=', alpk
     305  WRITE(*,*) 'wdens_ref=', wdens_ref
     306  WRITE(*,*) 'coefgw=', coefgw
    310307
    311308  first=.false.
Note: See TracChangeset for help on using the changeset viewer.