source: trunk/LMDZ.MARS/libf/phymars/calltherm_mars.F90 @ 222

!
! $Id: calltherm.F90 1428 2010-09-13 08:43:37Z fairhead $
!
      subroutine calltherm_mars(dtime,zzlev,zzlay  &
     &      ,pplay,paprs,pphi  &
     &      ,u_seri,v_seri,t_seri,pq_therm,q2_therm  &
     &      ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs,dq2_therm  &
     &      ,fm_therm,entr_therm,detr_therm,lmax,zmax,&
     &   zw2,fraca,zpopsk,ztla,heatFlux,heatFlux_down,&
     &     buoyancyOut,buoyancyEst,hfmax,wmax)

       USE ioipsl_getincom
      implicit none

#include "dimensions.h"
#include "dimphys.h"

      REAL dtime
      LOGICAL logexpr0, logexpr2(ngridmx,nlayermx), logexpr1(ngridmx)
      REAL fact
      INTEGER nbptspb

      REAL, INTENT(IN) :: zzlay(ngridmx,nlayermx)
      REAL, INTENT(IN) :: zzlev(ngridmx,nlayermx+1)

      REAL u_seri(ngridmx,nlayermx),v_seri(ngridmx,nlayermx)
      REAL t_seri(ngridmx,nlayermx),pq_therm(ngridmx,nlayermx,nqmx)
      REAL q2_therm(ngridmx,nlayermx)
      REAL paprs(ngridmx,nlayermx+1)
      REAL pplay(ngridmx,nlayermx)
      REAL pphi(ngridmx,nlayermx)
      real zlev(ngridmx,nlayermx+1) 
!test: on sort lentr et a* pour alimenter KE
      REAL zw2(ngridmx,nlayermx+1),fraca(ngridmx,nlayermx+1)
      REAL zzw2(ngridmx,nlayermx+1)

!FH Update Thermiques
      REAL d_t_ajs(ngridmx,nlayermx), d_q_ajs(ngridmx,nlayermx,nqmx)
      REAL d_u_ajs(ngridmx,nlayermx),d_v_ajs(ngridmx,nlayermx)
      REAL dq2_therm(ngridmx,nlayermx), dq2_the(ngridmx,nlayermx)
      real fm_therm(ngridmx,nlayermx+1)
      real entr_therm(ngridmx,nlayermx),detr_therm(ngridmx,nlayermx)

!********************************************************
!     declarations
      real zpopsk(ngridmx,nlayermx)
      real ztla(ngridmx,nlayermx)
      real wmax(ngridmx)
      real hfmax(ngridmx)
      integer lmax(ngridmx)
      real zmax(ngridmx)

!nouvelles variables pour la convection
!RC
      !on garde le zmax du pas de temps precedent
!********************************************************


! variables locales
      REAL d_t_the(ngridmx,nlayermx), d_q_the(ngridmx,nlayermx,nqmx)
      REAL d_u_the(ngridmx,nlayermx),d_v_the(ngridmx,nlayermx)
!
      integer isplit,nsplit_thermals
      real r_aspect_thermals

      real zfm_therm(ngridmx,nlayermx+1),zdt
      real zentr_therm(ngridmx,nlayermx),zdetr_therm(ngridmx,nlayermx)
      real heatFlux(ngridmx,nlayermx)
      real heatFlux_down(ngridmx,nlayermx)
      real buoyancyOut(ngridmx,nlayermx)
      real buoyancyEst(ngridmx,nlayermx)
      real zheatFlux(ngridmx,nlayermx)
      real zheatFlux_down(ngridmx,nlayermx)
      real zbuoyancyOut(ngridmx,nlayermx)
      real zbuoyancyEst(ngridmx,nlayermx)

      character (len=20) :: modname='calltherm'
      character (len=80) :: abort_message

      integer i,k
      logical, save :: first=.true.

      REAL tstart,tstop


!  Modele du thermique
!  ===================
 
         r_aspect_thermals=2.
         nsplit_thermals=40
         call getin("nsplit_thermals",nsplit_thermals)

         fm_therm(:,:)=0.
         detr_therm(:,:)=0.
         entr_therm(:,:)=0.

         heatFlux(:,:)=0.
         heatFlux_down(:,:)=0.
         buoyancyOut(:,:)=0.
         buoyancyEst(:,:)=0.

         zw2(:,:)=0.

         zdt=dtime/REAL(nsplit_thermals)

         do isplit=1,nsplit_thermals

!         call cpu_time(tstart)


! On reinitialise les flux de masse a zero pour le cumul en
! cas de splitting

         zfm_therm(:,:)=0.
         zentr_therm(:,:)=0.
         zdetr_therm(:,:)=0.

         zheatFlux(:,:)=0.
         zheatFlux_down(:,:)=0.
         zbuoyancyOut(:,:)=0.
         zbuoyancyEst(:,:)=0.

         zzw2(:,:)=0.

         d_t_the(:,:)=0.
         d_u_the(:,:)=0.
         d_v_the(:,:)=0.
         dq2_the(:,:)=0.
         if (nqmx .ne. 0) then
            d_q_the(:,:,:)=0.
         endif

             CALL thermcell_main_mars(zdt  &
     &      ,pplay,paprs,pphi,zzlev,zzlay  &
     &      ,u_seri,v_seri,t_seri,pq_therm,q2_therm  &
     &      ,d_u_the,d_v_the,d_t_the,d_q_the,dq2_the  &
     &      ,zfm_therm,zentr_therm,zdetr_therm,lmax,zmax  &
     &      ,r_aspect_thermals &
     &      ,zzw2,fraca,zpopsk &
     &      ,ztla,zheatFlux,zheatFlux_down &
     &      ,zbuoyancyOut,zbuoyancyEst)

      fact=1./REAL(nsplit_thermals)
!  transformation de la derivee en tendance

            d_t_the(:,:)=d_t_the(:,:)*dtime*fact
            d_u_the(:,:)=d_u_the(:,:)*fact
            d_v_the(:,:)=d_v_the(:,:)*fact
            dq2_the(:,:)=dq2_the(:,:)*fact            

            if (nqmx .ne. 0) then
               d_q_the(:,:,:)=d_q_the(:,:,:)*fact
            endif

            fm_therm(:,:)=fm_therm(:,:)  &
     &      +zfm_therm(:,:)*fact
            entr_therm(:,:)=entr_therm(:,:)  &
     &       +zentr_therm(:,:)*fact
            detr_therm(:,:)=detr_therm(:,:)  &
     &       +zdetr_therm(:,:)*fact

            heatFlux(:,:)=heatFlux(:,:) &
     &       +zheatFlux(:,:)*fact
            heatFlux_down(:,:)=heatFlux_down(:,:) &
     &       +zheatFlux_down(:,:)*fact
            buoyancyOut(:,:)=buoyancyOut(:,:) &
     &       +zbuoyancyOut(:,:)*fact
            buoyancyEst(:,:)=buoyancyEst(:,:) &
     &       +zbuoyancyEst(:,:)*fact

            zw2(:,:)=zw2(:,:) + zzw2(:,:)*fact

!  accumulation de la tendance
      
            d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_the(:,:)
            d_u_ajs(:,:)=d_u_ajs(:,:)+d_u_the(:,:)
            d_v_ajs(:,:)=d_v_ajs(:,:)+d_v_the(:,:)
            d_q_ajs(:,:,:)=d_q_ajs(:,:,:)+d_q_the(:,:,:)
            dq2_therm(:,:)=dq2_therm(:,:)+dq2_the(:,:)
!  incrementation des variables meteo
      
            t_seri(:,:) = t_seri(:,:) + d_t_the(:,:)
            u_seri(:,:) = u_seri(:,:) + d_u_the(:,:)
            v_seri(:,:) = v_seri(:,:) + d_v_the(:,:)
            pq_therm(:,:,:) = pq_therm(:,:,:) + d_q_the(:,:,:)
            q2_therm(:,:) = q2_therm(:,:) + dq2_therm(:,:)


!         call cpu_time(tstop)
!         print*,'elapsed time in thermals : ',tstop-tstart

         enddo ! isplit

     
!****************************************************************

!          do i=1,ngridmx
!             do k=1,nlayermx
!                if (ztla(i,k) .lt. 1.e-10) fraca(i,k) =0.
!               print*,'youpi je sers a quelque chose !'
!             enddo
!          enddo
        
          DO i=1,ngridmx
            hfmax(i)=MAXVAL(heatFlux(i,:)+heatFlux_down(i,:))
            wmax(i)=MAXVAL(zw2(i,:))
          ENDDO
 
      return

      end