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 END SUBROUTINE divgrad2_loc