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

 SUBROUTINE nxgraro2_loc(klevel,xcov,ycov,lr,grx_out,gry_out)

  !  P.Le Van .
  !   ***********************************************************
  !                             lr
  !  calcul de  ( nxgrad (rot) )   du vect. v  ....

  !   xcov et ycov  etant les compos. covariantes de  v
  !   ***********************************************************
  ! xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
  !  grx   et  gry     sont des arguments de sortie pour le s-prog


  USE write_Field_p
  USE parallel_lmdz
  USE times
  USE mod_hallo
  USE lmdz_filtreg_p
  USE nxgraro2_mod
  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh

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



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

  INTEGER :: klevel
  REAL :: xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel )
  REAL :: grx_out( ijb_u:ije_u,klevel ),gry_out(ijb_v:ije_v,klevel)

  !    ......   variables locales     ........

  REAL :: signe, nugradrs
  INTEGER :: l,ij,iter,lr
  Type(Request),SAVE :: Request_dissip
!$OMP THREADPRIVATE(Request_dissip)
  !    ........................................................

  INTEGER :: ijb,ije,jjb,jje



  signe    = (-1.)**lr
  nugradrs = signe * crot

  !  CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
  !  CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )

  ijb=ij_begin
  ije=ij_end

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO    l = 1, klevel
    grx(ijb:ije,l)=xcov(ijb:ije,l)
  ENDDO
!$OMP END DO NOWAIT

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

  ijb=ij_begin
  ije=ij_end
  IF(pole_sud) ije=ij_end-iip1

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO    l = 1, klevel
    gry(ijb:ije,l)=ycov(ijb:ije,l)
  ENDDO
!$OMP END DO NOWAIT


  CALL     rotatf_loc ( klevel, grx, gry, rot )
   ! CALL write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/)))

!$OMP BARRIER
   CALL Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip)
   CALL SendRequest(Request_dissip)
!$OMP BARRIER
   CALL WaitRequest(Request_dissip)
!$OMP BARRIER

  CALL laplacien_rot_loc ( klevel, rot, rot,grx,gry      )
    ! CALL write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/)))

  !    .....   Iteration de l'operateur laplacien_rotgam  .....

  DO  iter = 1, lr -2
!$OMP BARRIER
   CALL Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip)
   CALL SendRequest(Request_dissip)
!$OMP BARRIER
   CALL WaitRequest(Request_dissip)
!$OMP BARRIER

    CALL laplacien_rotgam_loc( klevel, rot, rot )
  ENDDO

    ! CALL write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/)))



  jjb=jj_begin
  jje=jj_end
  IF (pole_sud) jje=jj_end-1

  CALL filtreg_p( rot, jjb_v,jje_v, jjb,jje,jjm, &
        klevel, 2,1, .FALSE.,1)
!$OMP BARRIER
   CALL Register_Hallo_v(rot,llm,1,0,0,1,Request_dissip)
   CALL SendRequest(Request_dissip)
!$OMP BARRIER
   CALL WaitRequest(Request_dissip)
!$OMP BARRIER

  CALL nxgrad_loc ( klevel, rot, grx, gry )


  ijb=ij_begin
  ije=ij_end

!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
  DO    l = 1, klevel

     IF(pole_sud) ije=ij_end-iip1
     DO  ij = ijb, ije
      gry_out( ij,l ) = gry( ij,l ) * nugradrs
     ENDDO

     IF(pole_sud) ije=ij_end
     DO  ij = ijb, ije
      grx_out( ij,l ) = grx( ij,l ) * nugradrs
     ENDDO

  ENDDO
!$OMP END DO NOWAIT
  !

END SUBROUTINE nxgraro2_loc