SUBROUTINE gradiv2_loc(klevel, xcov, ycov, ld, gdx_out, gdy_out ) ! ! P. Le Van ! ! ********************************************************** ! ld ! calcul de (grad (div) ) du vect. v .... ! ! xcov et ycov etant les composant.covariantes de v ! ********************************************************** ! xcont , ycont et ld sont des arguments d'entree pour le s-prog ! gdx et gdy sont des arguments de sortie pour le s-prog ! ! USE parallel_lmdz USE times USE Write_field_p USE mod_hallo USE mod_filtreg_p USE gradiv2_mod IMPLICIT NONE ! INCLUDE "dimensions.h" INCLUDE "paramet.h" INCLUDE "comgeom.h" INCLUDE "comdissipn.h" ! ! ........ variables en arguments ........ INTEGER :: klevel REAL :: xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel ) REAL :: gdx_out( ijb_u:ije_u,klevel ), gdy_out( ijb_v:ije_v,klevel) ! ! ........ variables locales ......... ! REAL :: tmp_div2(ijb_u:ije_u,llm) REAL :: signe, nugrads INTEGER :: l,ij,iter,ld INTEGER :: ijb,ije,jjb,jje Type(Request),SAVE :: request_dissip !$OMP THREADPRIVATE(request_dissip) ! ........................................................ ! ! ! CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 ) ! CALL SCOPY( ip1jm * klevel, ycov, 1, gdy, 1 ) ijb=ij_begin ije=ij_end !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, klevel gdx(ijb:ije,l)=xcov(ijb:ije,l) ENDDO !$OMP END DO NOWAIT ijb=ij_begin ije=ij_end if(pole_sud) ije=ij_end-iip1 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, klevel gdy(ijb:ije,l)=ycov(ijb:ije,l) ENDDO !$OMP END DO NOWAIT !$OMP BARRIER CALL Register_Hallo_v(gdy,llm,1,0,0,1,Request_dissip) CALL SendRequest(Request_dissip) !$OMP BARRIER CALL WaitRequest(Request_dissip) !$OMP BARRIER ! ! signe = (-1.)**ld nugrads = signe * cdivu ! CALL divergf_loc( klevel, gdx, gdy , div ) ! CALL write_field3d_p('div1',reshape(div,(/iip1,jjp1,llm/))) IF( ld>1 ) THEN !$OMP BARRIER CALL Register_Hallo_u(div,llm,1,1,1,1,Request_dissip) CALL SendRequest(Request_dissip) !$OMP BARRIER CALL WaitRequest(Request_dissip) !$OMP BARRIER CALL laplacien_loc( klevel, div, div ) ! ...... Iteration de l'operateur laplacien_gam ....... ! CALL write_field3d_p('div2',reshape(div,(/iip1,jjp1,llm/))) DO iter = 1, ld -2 !$OMP BARRIER CALL Register_Hallo_u(div,llm,1,1,1,1,Request_dissip) CALL SendRequest(Request_dissip) !$OMP BARRIER CALL WaitRequest(Request_dissip) !$OMP BARRIER CALL laplacien_gam_loc(klevel,cuvscvgam1,cvuscugam1, & unsair_gam1,unsapolnga1, unsapolsga1, & div, div ) ENDDO ! CALL write_field3d_p('div3',reshape(div,(/iip1,jjp1,llm/))) ENDIF jjb=jj_begin jje=jj_end CALL filtreg_p( div ,jjb_u,jje_u,jjb,jje, jjp1, & klevel, 2, 1, .TRUE., 1 ) ! CALL exchange_Hallo(div,ip1jmp1,llm,0,1) !$OMP BARRIER CALL Register_Hallo_u(div,llm,1,1,1,1,Request_dissip) CALL SendRequest(Request_dissip) !$OMP BARRIER CALL WaitRequest(Request_dissip) !$OMP BARRIER CALL grad_loc( klevel, div, gdx, gdy ) ! ijb=ij_begin ije=ij_end !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) DO l = 1, klevel if (pole_sud) ije=ij_end DO ij = ijb, ije gdx_out( ij,l ) = gdx( ij,l ) * nugrads ENDDO if (pole_sud) ije=ij_end-iip1 DO ij = ijb, ije gdy_out( ij,l ) = gdy( ij,l ) * nugrads ENDDO ENDDO !$OMP END DO NOWAIT ! END SUBROUTINE gradiv2_loc