Changeset 4678


Ignore:
Timestamp:
Sep 8, 2023, 1:55:07 AM (16 months ago)
Author:
fhourdin
Message:

Petits nettoyages sur les thermiques

Location:
LMDZ6/trunk/libf/phylmd
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/calltherm.F90

    r4657 r4678  
    44      subroutine calltherm(dtime  &
    55     &      ,pplay,paprs,pphi,weak_inversion  &
    6      &      ,u_seri,v_seri,t_seri,q_seri,zqsat,debut  &
     6     &      ,u_seri_,v_seri_,t_seri_,q_seri_,zqsat,debut  &
    77     &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  &
    88     &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
    … …  
    5555      INTEGER nbptspb
    5656
    57       REAL u_seri(klon,klev),v_seri(klon,klev)
    58       REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev)
     57      REAL, DIMENSION(klon,klev), INTENT(IN) :: u_seri_,v_seri_
     58      REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri_,q_seri_
     59      REAL, DIMENSION(klon,klev) :: u_seri,v_seri
     60      REAL, DIMENSION(klon,klev) :: t_seri,q_seri
     61      REAL, DIMENSION(klon,klev) :: qmemoire
    5962      REAL weak_inversion(klon)
    6063      REAL paprs(klon,klev+1)
    … …  
    165168        first=.false.
    166169      endif
     170
     171      u_seri(:,:)=u_seri_(:,:)
     172      v_seri(:,:)=v_seri_(:,:)
     173      t_seri(:,:)=t_seri_(:,:)
     174      q_seri(:,:)=q_seri_(:,:)
    167175
    168176! Incrementer le compteur de la physique

  • LMDZ6/trunk/libf/phylmd/lmdz_thermcell_main.F90

    r4590 r4678  
    22! $Id$
    33!
     4! A REGARDER !!!!!!!!!!!!!!!!!
     5! ATTENTION : zpspsk est inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023)
    46CONTAINS
    57
    68      subroutine thermcell_main(itap,ngrid,nlay,ptimestep  &
    79     &                  ,pplay,pplev,pphi,debut  &
    8      &                  ,pu,pv,pt,po  &
     10     &                  ,pu,pv,pt,p_o  &
    911     &                  ,pduadj,pdvadj,pdtadj,pdoadj  &
    1012     &                  ,fm0,entr0,detr0,zqta,zqla,lmax  &
    … …  
    104106      real, intent(in) ::  ptimestep
    105107      real, intent(in), dimension(ngrid,nlay)    :: pt,pu,pv,pplay,pphi
    106 ! ATTENTION : po et zpspsk sont inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023)
    107       real, intent(inout), dimension(ngrid,nlay)    :: po
     108! ATTENTION : zpspsk est inout et out mais c'est pas forcement pour de bonnes raisons (FH, 2023)
     109      real, intent(in), dimension(ngrid,nlay)    :: p_o
    108110      real, intent(out), dimension(ngrid,nlay)    :: zpspsk
    109111      real, intent(in), dimension(ngrid,nlay+1)  :: pplev
    … …  
    142144      integer,dimension(ngrid) :: lmin,lmix,lmix_bis,nivcon
    143145      real, dimension(ngrid,nlay) :: ztva_est
    144       real, dimension(ngrid,nlay) :: deltaz,zlay,zh,zdthladj,zu,zv,zo,zl,zva,zua,zoa
     146      real, dimension(ngrid,nlay) :: deltaz,zlay,zh,zdthladj,zu,zv,z_o,zl,zva,zua,z_oa
    145147      real, dimension(ngrid,nlay) :: zta,zha,q2,wq,wthl,wthv,thetath2,wth2
    146148      real, dimension(ngrid,nlay) :: rho,masse
    … …  
    200202!   --------------------------------------------------------------------
    201203!
    202       CALL thermcell_env(ngrid,nlay,po,pt,pu,pv,pplay,  &
    203      &           pplev,zo,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
     204      CALL thermcell_env(ngrid,nlay,p_o,pt,pu,pv,pplay,  &
     205     &           pplev,z_o,zh,zl,ztv,zthl,zu,zv,zpspsk,zqsat,lev_out)
    204206       
    205207      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_env'
    … …  
    215217!  wh,wt,wo ...
    216218!
    217 !                       + + + + + + + + + + +  zh,zu,zv,zo,rho
     219!                       + + + + + + + + + + +  zh,zu,zv,z_o,rho
    218220!
    219221!
    … …  
    343345      if (iflag_thermals_ed<=9) then
    344346!         print*,'THERM NOUVELLE/NOUVELLE Arnaud'
    345          CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
     347         CALL thermcell_plume_6A(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,&
    346348     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
    347349     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
    … …  
    351353      elseif (iflag_thermals_ed<=19) then
    352354!        print*,'THERM RIO et al 2010, version d Arnaud'
    353          CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
     355         CALL thermcell_plume_5B(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,&
    354356     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
    355357     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
    … …  
    357359     &    ,lev_out,lunout1,igout)
    358360      else
    359          CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,po,zl,rhobarz,&
     361         CALL thermcell_plume(itap,ngrid,nlay,ptimestep,ztv,zthl,p_o,zl,rhobarz,&
    360362     &    zlev,pplev,pphi,zpspsk,alim_star,alim_star_tot,  &
    361363     &    lalim,f0,detr_star,entr_star,f_star,csc,ztva,  &
    … …  
    366368      if (prt_level.ge.1) print*,'apres thermcell_plume ',lev_out
    367369
    368       call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
    369       call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
     370      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_plum lalim ')
     371      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_plum lmix  ')
    370372
    371373      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_plume'
    … …  
    395397
    396398
    397       call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
    398       call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
    399       call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
    400       call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
     399      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lalim ')
     400      call test_ltherm(ngrid,nlay,pplay,lmin ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmin  ')
     401      call test_ltherm(ngrid,nlay,pplay,lmix ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmix  ')
     402      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_heig lmax  ')
    401403
    402404      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_height'
    … …  
    411413
    412414 
    413 call test_ltherm(ngrid,nlay,pplay,lmin,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
    414 call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
     415call test_ltherm(ngrid,nlay,pplay,lmin,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_dry  lmin  ')
     416call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_dry  lalim ')
    415417
    416418      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_dry'
    … …  
    477479
    478480      if (prt_level.ge.1) print*,'thermcell_main apres thermcell_flux'
    479       call test_ltherm(ngrid,nlay,pplay,lalim,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
    480       call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,po,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
     481      call test_ltherm(ngrid,nlay,pplay,lalim,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_flux lalim ')
     482      call test_ltherm(ngrid,nlay,pplay,lmax ,ztv,p_o,ztva,zqla,f_star,zw2,'thermcell_flux lmax  ')
    481483
    482484!------------------------------------------------------------------
    … …  
    523525        ! we want to transport potential temperature, total water and momentum
    524526        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zthl,zdthladj)
    525         CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,po,pdoadj)
     527        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,p_o,pdoadj)
    526528        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zu,pduadj)
    527529        CALL thermcell_updown_dq(ngrid,nlay,ptimestep,lmax,entr0,detr0,entrdn,detrdn,masse,zv,pdvadj)
    … …  
    531533        call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
    532534        &                    zthl,zdthladj,zta,lev_out)
     535
     536        do ll=1,nlay
     537           print*,'Z_O ',ll,z_o(1,ll),p_o(1,ll)-z_o(1,ll)
     538           do ig=1,ngrid
     539              z_o(ig,ll)=p_o(ig,ll)
     540           enddo
     541        enddo
    533542        call thermcell_dq(ngrid,nlay,dqimpl,ptimestep,fm0,entr0,masse,  &
    534         &                   po,pdoadj,zoa,lev_out)
     543        &                   z_o,pdoadj,z_oa,lev_out)
    535544
    536545#ifdef ISO
    … …  
    565574          if (iso_HDO.gt.0) then
    566575              call iso_verif_aberrant_encadre(xtpo(iso_hdo,ig,ll) &
    567      &           /po(ig,ll),'thermcell_main 610')
     576     &           /p_o(ig,ll),'thermcell_main 610')
    568577          endif
    569578        enddo
    … …  
    623632!nouveau calcul
    624633      do ig=1,ngrid
    625       CHI=zh(ig,1)/(1669.0-122.0*zo(ig,1)/zqsat(ig,1)-zh(ig,1))
    626       pcon(ig)=pplay(ig,1)*(zo(ig,1)/zqsat(ig,1))**CHI
     634      CHI=zh(ig,1)/(1669.0-122.0*z_o(ig,1)/zqsat(ig,1)-zh(ig,1))
     635      pcon(ig)=pplay(ig,1)*(z_o(ig,1)/zqsat(ig,1))**CHI
    627636      enddo
    628637!IM   do k=1,nlay
    … …  
    685694            wth3(ig,l)=zf2*(1-2.*fraca(ig,l))/(1-fraca(ig,l))  &
    686695     &                *zw2(ig,l)*zw2(ig,l)*zw2(ig,l)
    687             q2(ig,l)=zf2*(zqta(ig,l)*1000.-po(ig,l)*1000.)**2
    688 !test: on calcul q2/po=ratqsc
    689             ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(po(ig,l)*1000.))
     696            q2(ig,l)=zf2*(zqta(ig,l)*1000.-p_o(ig,l)*1000.)**2
     697!test: on calcul q2/p_o=ratqsc
     698            ratqscth(ig,l)=sqrt(max(q2(ig,l),1.e-6)/(p_o(ig,l)*1000.))
    690699         enddo
    691700      enddo
    … …  
    693702      do l=1,nlay
    694703         do ig=1,ngrid
    695       wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-po(ig,l)*1000.)
     704      wq(ig,l)=fraca(ig,l)*zw2(ig,l)*(zqta(ig,l)*1000.-p_o(ig,l)*1000.)
    696705      wthl(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztla(ig,l)-zthl(ig,l))
    697706      wthv(ig,l)=fraca(ig,l)*zw2(ig,l)*(ztva(ig,l)-ztv(ig,l))
    … …  
    728737         do l=1,nlay
    729738            do ig=1,ngrid
    730                ratqsdiff(ig,l)=sqrt(vardiff)/(po(ig,l)*1000.)   
     739               ratqsdiff(ig,l)=sqrt(vardiff)/(p_o(ig,l)*1000.)   
    731740            enddo
    732741         enddo
    … …  
    741750!/////////////////////////////////////////////////////////////////////////////
    742751!=============================================================================
    743       subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,po,ztva, &  ! in
     752      subroutine test_ltherm(ngrid,nlay,pplay,long,ztv,p_o,ztva, &  ! in
    744753    &            zqla,f_star,zw2,comment)                          ! in
    745754!=============================================================================
    … …  
    748757
    749758      integer i, k, ngrid,nlay
    750       real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,po,ztva,zqla
     759      real, intent(in), dimension(ngrid,nlay) :: pplay,ztv,p_o,ztva,zqla
    751760      real, intent(in), dimension(ngrid,nlay) :: f_star,zw2
    752761      integer, intent(in), dimension(ngrid) :: long
    … …  
    768777               print*,'  K  P(MB)  THV(K)     Qenv(g/kg)THVA        QLA(g/kg)   F*        W2'
    769778               do k=1,nlay
    770                   write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*po(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
     779                  write(6,'(i3,7f10.3)') k,pplay(i,k),ztv(i,k),1000*p_o(i,k),ztva(i,k),1000*zqla(i,k),f_star(i,k),zw2(i,k)
    771780               enddo
    772781           endif

  • LMDZ6/trunk/libf/phylmd/lmdz_thermcell_plume_6A.F90

    r4590 r4678  
    734734      REAL ztv(ngrid,nlay)
    735735      REAL zthl(ngrid,nlay)
    736       REAL po(ngrid,nlay)
     736      REAL, INTENT(IN) :: po(ngrid,nlay)
    737737      REAL zl(ngrid,nlay)
    738738      REAL rhobarz(ngrid,nlay)

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

    r4677 r4678  
    12551255    INTEGER ieru
    12561256
     1257print*,'COUCOU COUCOU'
    12571258    !======================================================================!
    12581259    ! Bifurcation vers un nouveau moniteur physique pour experimenter      !
Note: See TracChangeset for help on using the changeset viewer.