Ignore:
Timestamp:
Mar 10, 2022, 7:23:47 PM (2 years ago)
Author:
fhourdin
Message:

Reecriture des thermiques

File:
1 edited

Legend:

Unmodified
Added
Removed

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

    r2346 r4089  
    77     &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs  &
    88     &      ,fm_therm,entr_therm,detr_therm,zqasc,clwcon0,lmax,ratqscth,  &
    9      &       ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, &
     9     &       ratqsdiff,zqsatth,ale_bl,alp_bl,lalim_conv,wght_th, &
    1010     &       zmax0,f0,zw2,fraca,ztv,zpspsk,ztla,zthl &
    1111!!! nrlmd le 10/04/2012
    … …  
    1717     &      ,alp_bl_conv,alp_bl_stat &
    1818!!! fin nrlmd le 10/04/2012
    19      &      ,zqla,ztva )
     19     &      ,zqla,ztva &
     20#ifdef ISO         
     21     &      ,xt_seri,d_xt_ajs &
     22#ifdef DIAGISO         
     23     &      ,q_the,xt_the &
     24#endif
     25#endif         
     26     &   )
    2027
    2128      USE dimphy
    2229      USE indice_sol_mod
    2330      USE print_control_mod, ONLY: prt_level,lunout
     31#ifdef ISO
     32      use infotrac_phy, ONLY: ntraciso
     33#ifdef ISOVERIF
     34      USE isotopes_mod, ONLY: iso_eau,iso_HDO
     35      USE isotopes_verif_mod, ONLY: iso_verif_aberrant_enc_vect2D, &
     36        iso_verif_egalite_vect2D
     37#endif   
     38#endif
    2439
    2540      implicit none
    26       include "thermcell.h"
     41      include "clesphys.h"
     42      include "thermcell_old.h"
    2743
    2844
    … …  
    7995      real zqsatth(klon,klev) 
    8096!nouvelles variables pour la convection
    81       real Ale_bl(klon)
    82       real Alp_bl(klon)
    83       real Ale(klon)
    84       real Alp(klon)
     97      real ale_bl(klon)
     98      real alp_bl(klon)
     99      real ale(klon)
     100      real alp(klon)
    85101!RC
    86102      !on garde le zmax du pas de temps precedent
    … …  
    102118!********************************************************
    103119
     120      real, dimension(klon) :: pcon
     121      real, dimension(klon,klev) :: rhobarz,wth3
     122      integer,dimension(klon) :: lalim
     123      real, dimension(klon,klev+1) :: fm
     124      real, dimension(klon,klev) :: alim_star
     125      real, dimension(klon) :: zmax
     126
     127
     128
    104129
    105130! variables locales
    … …  
    115140      character (len=80) :: abort_message
    116141
    117       integer i,k
     142      integer i,k,isplit
    118143      logical, save :: first=.true.
     144      logical :: new_thermcell
     145
     146#ifdef ISO
     147      REAL xt_seri(ntraciso,klon,klev),xtmemoire(ntraciso,klon,klev)
     148      REAL d_xt_ajs(ntraciso,klon,klev)
     149      real d_xt_the(ntraciso,klon,klev)
     150#ifdef DIAGISO
     151      real q_the(klon,klev)
     152      real xt_the(ntraciso,klon,klev)
     153#endif
     154      real qprec(klon,klev)
     155      integer ixt
     156#endif
     157
     158
    119159!$OMP THREADPRIVATE(first)
    120160!********************************************************
    … …  
    144184         detr_therm(:,:)=0.
    145185
    146          Ale_bl(:)=0.
    147          Alp_bl(:)=0.
     186         ale_bl(:)=0.
     187         alp_bl(:)=0.
    148188         if (prt_level.ge.10) then
    149189          print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion'
    … …  
    159199                logexpr2(i,k)=.not.q_seri(i,k).ge.1.e-15
    160200               if (logexpr2(i,k)) then
     201#ifdef ISO
     202                qprec(i,k)=q_seri(i,k)
     203#endif
    161204                q_seri(i,k)=1.e-15
    162205                nbptspb=nbptspb+1
     206#ifdef ISO
     207                do ixt=1,ntraciso
     208                  xt_seri(ixt,i,k)=1.e-15*(xt_seri(ixt,i,k)/qprec(i,k))
     209                  ! xt_seri(ixt,i,k)=1.e-15*(Rdefault(index_iso(ixt)))
     210                enddo
     211#endif
    163212               endif
    164213!               if (logexpr0) &
    … …  
    169218         if(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
    170219
     220
     221         new_thermcell=iflag_thermals>=15.and.iflag_thermals<=18
     222#ifdef ISO
     223      if (.not.new_thermcell) then
     224           CALL abort_gcm('calltherm 234','isos pas prevus ici',1)
     225      endif
     226#ifdef ISOVERIF
     227      if (iso_eau.gt.0) then
     228       call iso_verif_egalite_vect2D( &
     229     &           xt_seri,q_seri, &
     230     &           'calltherm 174',ntraciso,klon,klev)
     231      endif !if (iso_eau.gt.0) then
     232#endif   
     233#endif
    171234         zdt=dtime/REAL(nsplit_thermals)
     235
     236
    172237         do isplit=1,nsplit_thermals
    173238
    … …  
    207272              abort_message = 'cas non prevu dans calltherm'
    208273              CALL abort_physic (modname,abort_message,1)
    209 
    210 !           CALL thermcell_pluie(klon,klev,zdt  &
    211 !   &      ,pplay,paprs,pphi,zlev  &
    212 !    &      ,u_seri,v_seri,t_seri,q_seri  &
    213 !    &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
    214 !    &      ,zfm_therm,zentr_therm,zqla  &
    215 !    &      ,r_aspect_thermals,l_mix_thermals,w2di_thermals  &
    216 !    &      ,tau_thermals,3)
    217274          else if (iflag_thermals.eq.12) then
    218275            CALL calcul_sec(klon,klev,zdt  &
    … …  
    223280     &      ,tau_thermals)
    224281          else if (iflag_thermals==13.or.iflag_thermals==14) then
    225             CALL thermcellV0_main(itap,klon,klev,zdt  &
    226      &      ,pplay,paprs,pphi,debut  &
    227      &      ,u_seri,v_seri,t_seri,q_seri  &
    228      &      ,d_u_the,d_v_the,d_t_the,d_q_the  &
    229      &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
    230      &      ,ratqscth,ratqsdiff,zqsatth  &
    231      &      ,r_aspect_thermals,l_mix_thermals  &
    232      &      ,tau_thermals,Ale,Alp,lalim_conv,wght_th &
    233      &      ,zmax0,f0,zw2,fraca)
    234           else if (iflag_thermals>=15.and.iflag_thermals<=18) then
    235 
    236 !            print*,'THERM iflag_thermas_ed=',iflag_thermals_ed
     282              abort_message = 'thermcellV0_main enleve svn>2084'
     283              CALL abort_physic (modname,abort_message,1)
     284          else if (new_thermcell) then
    237285            CALL thermcell_main(itap,klon,klev,zdt  &
    238286     &      ,pplay,paprs,pphi,debut  &
    … …  
    241289     &      ,zfm_therm,zentr_therm,zdetr_therm,zqasc,zqla,lmax  &
    242290     &      ,ratqscth,ratqsdiff,zqsatth  &
    243 !    &      ,r_aspect_thermals,l_mix_thermals &
    244 !    &      ,tau_thermals,iflag_thermals_ed,iflag_coupl &
    245      &      ,Ale,Alp,lalim_conv,wght_th &
    246291     &      ,zmax0,f0,zw2,fraca,ztv,zpspsk &
    247      &      ,ztla,zthl &
    248 !!! nrlmd le 10/04/2012
    249      &      ,pbl_tke,pctsrf,omega,airephy &
    250      &      ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
    251      &      ,n2,s2,ale_bl_stat &
    252      &      ,therm_tke_max,env_tke_max &
    253      &      ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
    254      &      ,alp_bl_conv,alp_bl_stat &
    255 !!! fin nrlmd le 10/04/2012
    256      &      ,ztva )
     292     &      ,ztla,zthl,ztva &
     293     &      ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &
     294#ifdef ISO         
     295     &      ,xt_seri,d_xt_the &
     296#endif         
     297     &   )
     298
     299            CALL thermcell_alp(klon,klev,zdt  &                      ! in
     300     &        ,pplay,paprs  &                                        ! in
     301     &        ,zfm_therm,zentr_therm,lmax  &                         ! in
     302     &        ,pbl_tke,pctsrf,omega,airephy &                        ! in
     303     &        ,zw2,fraca &                                           ! in
     304     &        ,pcon,rhobarz,wth3,wmax_sec,lalim,fm,alim_star,zmax &  ! in
     305     &        ,ale,alp,lalim_conv,wght_th &                          ! out
     306     &        ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &! out
     307     &        ,n2,s2,ale_bl_stat &                                   ! out
     308     &        ,therm_tke_max,env_tke_max &                           ! out
     309     &        ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &          ! out
     310     &        ,alp_bl_conv,alp_bl_stat &                             ! out
     311     &        )
     312
    257313           if (prt_level.gt.10) write(lunout,*)'Apres thermcell_main OK'
    258314         else
    … …  
    303359            detr_therm(:,k)=detr_therm(:,k)  &
    304360     &       +zdetr_therm(:,k)*fact(:)
     361#ifdef ISO
     362            do ixt=1,ntraciso
     363              d_xt_the(ixt,:,k)=d_xt_the(ixt,:,k)*dtime*fact(:)
     364            enddo
     365#endif
    305366      ENDDO
    306367       fm_therm(:,klev+1)=0.
    … …  
    313374            d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
    314375            d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_the(:,:)
     376#ifdef ISO
     377            d_xt_ajs(:,:,:)=d_xt_ajs(:,:,:)+d_xt_the(:,:,:)
     378#endif
    315379
    316380!  incrementation des variables meteo
    … …  
    320384            qmemoire(:,:)=q_seri(:,:)
    321385            q_seri(:,:) = q_seri(:,:) + d_q_the(:,:)
     386#ifdef ISO
     387            xtmemoire(:,:,:)=xt_seri(:,:,:)
     388            xt_seri(:,:,:) = xt_seri(:,:,:) + d_xt_the(:,:,:)
     389#ifdef ISOVERIF
     390!      write(*,*) 'calltherm 350 tmp: ajout d_xt_the'
     391      if (iso_HDO.gt.0) then
     392!      i=479
     393!      k=4
     394!      write(*,*) 'xt_seri(iso_hdo,i,k),q_seri(i,k)=', &
     395!     &   xt_seri(iso_hdo,i,k),q_seri(i,k)
     396!      write(*,*) 'd_xt_the(iso_hdo,i,k),d_q_the(i,k)=', &
     397!     &   d_xt_the(iso_hdo,i,k),d_q_the(i,k)
     398      call iso_verif_aberrant_enc_vect2D( &
     399     &        xt_seri,q_seri, &
     400     &        'calltherm 353, apres ajout d_xt_the',ntraciso,klon,klev)
     401      endif     
     402#endif
     403#endif
    322404           if (prt_level.gt.10) write(lunout,*)'Apres apres thermcell_main OK'
    323405
    324406       DO i=1,klon
    325407            fm_therm(i,klev+1)=0.
    326             Ale_bl(i)=Ale_bl(i)+Ale(i)/REAL(nsplit_thermals)
    327 !            write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i)
    328             Alp_bl(i)=Alp_bl(i)+Alp(i)/REAL(nsplit_thermals)
    329 !            write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i)
    330         if(prt_level.GE.10) print*,'calltherm i Alp_bl Alp Ale_bl Ale',i,Alp_bl(i),Alp(i),Ale_bl(i),Ale(i)
     408            ale_bl(i)=ale_bl(i)+ale(i)/REAL(nsplit_thermals)
     409!            write(22,*)'ALE CALLTHERM',ale_bl(i),ale(i)
     410            alp_bl(i)=alp_bl(i)+alp(i)/REAL(nsplit_thermals)
     411!            write(23,*)'ALP CALLTHERM',alp_bl(i),alp(i)
     412        if(prt_level.GE.10) print*,'calltherm i alp_bl alp ale_bl ale',i,alp_bl(i),alp(i),ale_bl(i),ale(i)
    331413       ENDDO
    332414
    … …  
    341423                q_seri(i,k)=1.e-15
    342424                nbptspb=nbptspb+1
     425#ifdef ISO
     426                do ixt=1,ntraciso
     427                  xt_seri(ixt,i,k)=1.e-15*(xtmemoire(ixt,i,k)/qmemoire(i,k))
     428                enddo
     429#endif
    343430!                if (prt_level.ge.10) then
    344431!                  print*,'WARN eau<0 apres therm i=',i,'  k=',k  &
    … …  
    348435            ENDDO
    349436            ENDDO
     437#ifdef ISO
     438#ifdef ISOVERIF
     439      if (iso_HDO.gt.0) then
     440      call iso_verif_aberrant_enc_vect2D( &
     441     &        xt_seri,q_seri, &
     442     &        'calltherm 393, apres bidouille q<0',ntraciso,klon,klev)
     443      endif     
     444#endif
     445#endif
     446
    350447        IF(nbptspb.GT.0) print*,'Number of points with q_seri(i,k)<=0 ',nbptspb   
    351448! tests sur les valeurs de la temperature
Note: See TracChangeset for help on using the changeset viewer.