groupe.f90 Source File

!
! $Header$
!
subroutine groupe(pext,pbaru,pbarv,pbarum,pbarvm,wm)

  USE comgeom2_mod_h
  use comconst_mod, only: ngroup

  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
USE paramet_mod_h
implicit none

  !   sous-programme servant a fitlrer les champs de flux de masse aux
  !   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
  !   et a mesure qu'on se rapproche du pole.
  !
  !   en entree: pext, pbaru et pbarv
  !
  !   en sortie:  pbarum,pbarvm et wm.
  !
  !   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
  !   pas besoin de w en entree.




  ! integer ngroup
  ! parameter (ngroup=3)


  real :: pbaru(iip1,jjp1,llm),pbarv(iip1,jjm,llm)
  real :: pext(iip1,jjp1,llm)

  real :: pbarum(iip1,jjp1,llm),pbarvm(iip1,jjm,llm)
  real :: wm(iip1,jjp1,llm)

  real :: zconvm(iip1,jjp1,llm),zconvmm(iip1,jjp1,llm)

  real :: uu

  integer :: i,j,l

  logical :: firstcall,groupe_ok
  save firstcall,groupe_ok

  data firstcall/.true./
  data groupe_ok/.true./

  if (iim==1) then
     groupe_ok=.false.
  endif

  if (firstcall) then
     if (groupe_ok) then
        if(mod(iim,2**ngroup).ne.0) &
              CALL abort_gcm('groupe','probleme du nombre de point',1)
     endif
     firstcall=.false.
  endif


  !   Champs 1D

  call convflu(pbaru,pbarv,llm,zconvm)

  call scopy(ijp1llm,zconvm,1,zconvmm,1)
  call scopy(ijmllm,pbarv,1,pbarvm,1)

  if (groupe_ok) then
  call groupeun(jjp1,llm,zconvmm)
  call groupeun(jjm,llm,pbarvm)

  !   Champs 3D
  do l=1,llm
     do j=2,jjm
        uu=pbaru(iim,j,l)
        do i=1,iim
           uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
           pbarum(i,j,l)=uu
  ! zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
  !    *                      yflu(i,j,l)-yflu(i,j-1,l)
        enddo
        pbarum(iip1,j,l)=pbarum(1,j,l)
     enddo
  enddo

  else
     pbarum(:,:,:)=pbaru(:,:,:)
     pbarvm(:,:,:)=pbarv(:,:,:)
  endif

  !    integration de la convergence de masse de haut  en bas ......
  do l=1,llm
     do j=1,jjp1
        do i=1,iip1
           zconvmm(i,j,l)=zconvmm(i,j,l)
        enddo
     enddo
  enddo
  do  l = llm-1,1,-1
      do j=1,jjp1
         do i=1,iip1
            zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
         enddo
      enddo
  enddo

  CALL vitvert(zconvmm,wm)

  return
end subroutine groupe