nxgraro2_loc.f90 Source File

 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 comdissipn_mod_h
  USE write_Field_p
  USE parallel_lmdz
  USE times
  USE mod_hallo
  USE mod_filtreg_p
  USE nxgraro2_mod
  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
USE paramet_mod_h
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
  !
  RETURN
END SUBROUTINE nxgraro2_loc