source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divgrad2_loc.f90 @ 5449

SUBROUTINE divgrad2_loc( klevel, h, deltapres, lh, divgra_out )

  ! P. Le Van

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

  ! .....   calcul de  (div( grad ))   de (  pext * h ) .....
  !   ****************************************************************
  !   h ,klevel,lh et pext  sont des arguments  d'entree pour le s-prg
  !     divgra     est  un argument  de sortie pour le s-prg

  USE parallel_lmdz
  USE times
  USE mod_hallo
  USE divgrad2_mod
  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
  USE lmdz_comgeom2

USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
  USE lmdz_paramet
  IMPLICIT NONE
  !



  !    .......    variables en arguments   .......

  INTEGER :: klevel
  REAL :: h( ijb_u:ije_u,klevel ), deltapres( ijb_u:ije_u,klevel )
  REAL :: divgra_out( ijb_u:ije_u,klevel)
  !    .......    variables  locales    ..........

  REAL :: signe, nudivgrs, sqrtps( ijb_u:ije_u,llm )
  INTEGER :: l,ij,iter,lh
  !    ...................................................................
  Type(Request),SAVE :: request_dissip
!$OMP THREADPRIVATE(request_dissip)
  INTEGER :: ijb,ije



  signe    = (-1.)**lh
  nudivgrs = signe * cdivh

   ! CALL SCOPY ( ip1jmp1 * klevel, h, 1, divgra, 1 )
  ijb=ij_begin
  ije=ij_end
!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO l = 1, klevel
    divgra(ijb:ije,l)=h(ijb:ije,l)
  ENDDO
!$OMP END DO NOWAIT

!$OMP BARRIER
   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
   CALL SendRequest(Request_dissip)
!$OMP BARRIER
   CALL WaitRequest(Request_dissip)
!$OMP BARRIER

  CALL laplacien_loc( klevel, divgra, divgra )

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO l = 1, klevel
   DO ij = ijb, ije
    sqrtps( ij,l ) = SQRT( deltapres(ij,l) )
   ENDDO
  ENDDO
!$OMP END DO NOWAIT


!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO l = 1, klevel
    DO ij = ijb, ije
     divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
    ENDDO
  ENDDO
!$OMP END DO NOWAIT

  !    ........    Iteration de l'operateur  laplacien_gam    ........

  DO  iter = 1, lh - 2
!$OMP BARRIER
   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
   CALL SendRequest(Request_dissip)
!$OMP BARRIER
   CALL WaitRequest(Request_dissip)

!$OMP BARRIER


   CALL laplacien_gam_loc(klevel,cuvscvgam2,cvuscugam2,unsair_gam2, &
         unsapolnga2, unsapolsga2,  divgra, divgra )
  ENDDO

  !    ...............................................................

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO l = 1, klevel
    DO ij = ijb, ije
      divgra(ij,l) = divgra(ij,l) * sqrtps(ij,l)
    ENDDO
  ENDDO
!$OMP END DO NOWAIT

!$OMP BARRIER
   CALL Register_Hallo_u(divgra,llm,1,1,1,1,Request_dissip)
   CALL SendRequest(Request_dissip)
!$OMP BARRIER
   CALL WaitRequest(Request_dissip)
!$OMP BARRIER

  CALL laplacien_loc ( klevel, divgra, divgra )

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO l  = 1,klevel
  DO ij = ijb,ije
  divgra_out(ij,l) =  nudivgrs * divgra(ij,l) / deltapres(ij,l)
  ENDDO
  ENDDO
!$OMP END DO NOWAIT


END SUBROUTINE divgrad2_loc