source: LMDZ6/trunk/libf/dyn3dmem/divgrad2_loc.f90

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
  IMPLICIT NONE
  !
  INCLUDE "dimensions.h"
  INCLUDE "paramet.h"
  INCLUDE "comgeom2.h"
  INCLUDE "comdissipn.h"

  !    .......    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

  RETURN
END SUBROUTINE divgrad2_loc