--- trunk/libf/dyn3d/gradiv2.f90 2011/12/06 15:07:04 54 +++ trunk/libf/dyn3d/Dissipation/gradiv2.f90 2012/01/30 12:54:02 57 @@ -4,64 +4,62 @@ contains - SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy, cdivu) + SUBROUTINE gradiv2(xcov, ycov, ld, gdx, gdy, cdivu) ! From LMDZ4/libf/dyn3d/gradiv2.F, version 1.1.1.1 2004/05/19 12:53:07 - ! P. Le Van - ! calcul de grad div du vecteur v - ! xcov et ycov etant les composantes covariantes de v - ! xcont, ycont et ld sont des arguments d'entree pour le sous-programme - ! gdx et gdy sont des arguments de sortie pour le sous-programme - - use dimens_m - use paramet_m - use comgeom - use filtreg_m, only: filtreg + ! Calcul de grad div du vecteur v. - ! variables en arguments + USE dimens_m, ONLY : iim, jjm, llm + use divergf_m, only: divergf + USE comgeom, ONLY : cuvscvgam1, cvuscugam1, unsair_gam1, unsapolnga1, & + unsapolsga1 + USE filtreg_m, ONLY : filtreg + use nr_util, only: assert_eq, assert + + ! Composantes covariantes de v : + REAL, intent(in):: xcov(:, :, :) ! (iim + 1, jjm + 1, klevel) + REAL, intent(in):: ycov(:, :, :) ! (iim + 1, jjm, klevel) - INTEGER klevel - REAL xcov( ip1jmp1,klevel), ycov( ip1jm,klevel) integer, intent(in):: ld - REAL gdx( ip1jmp1,klevel), gdy( ip1jm,klevel) + REAL, intent(out):: gdx(:, :, :) ! (iim + 1, jjm + 1, klevel) + REAL, intent(out):: gdy(:, :, :) ! (iim + 1, jjm, klevel) real, intent(in):: cdivu - ! variables locales - - REAL div(ip1jmp1,llm) - REAL nugrads - INTEGER l,ij,iter + ! Variables locales : + REAL nugrads, div(iim + 1, jjm + 1, llm) + INTEGER iter, klevel !-------------------------------------------------------------- - CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1) - CALL SCOPY( ip1jm * klevel, ycov, 1, gdy, 1) + call assert((/size(xcov, 1), size(ycov, 1), size(gdx, 1), size(gdy, 1)/) & + == iim + 1, "gradiv2 iim") + call assert((/size(xcov, 2) - 1, size(ycov, 2), size(gdx, 2) - 1, & + size(gdy, 2)/) == jjm, "gradiv2 iim") + klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(gdx, 3), & + size(gdy, 3), "gradiv2 klevel") + + gdx = xcov + gdy = ycov - CALL divergf( klevel, gdx, gdy, div) + CALL divergf(klevel, gdx, gdy, div) - IF( ld.GT.1) THEN - CALL laplacien ( klevel, div, div) + IF (ld > 1) THEN + CALL laplacien(klevel, div, div) - ! Iteration de l'operateur laplacien_gam + ! Itération de l'opérateur laplacien_gam DO iter = 1, ld -2 - CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1, & + CALL laplacien_gam(klevel, cuvscvgam1, cvuscugam1, unsair_gam1, & unsapolnga1, unsapolsga1, div, div) - ENDDO + END DO ENDIF - CALL filtreg( div, jjp1, klevel, 2, 1, .TRUE., 1) - CALL grad ( klevel, div, gdx, gdy) + CALL filtreg(div, jjm + 1, klevel, 2, 1, .TRUE., 1) + CALL grad(klevel, div, gdx, gdy) nugrads = (-1.)**ld * cdivu - DO l = 1, klevel - DO ij = 1, ip1jmp1 - gdx( ij,l) = gdx( ij,l) * nugrads - ENDDO - DO ij = 1, ip1jm - gdy( ij,l) = gdy( ij,l) * nugrads - ENDDO - ENDDO + gdx = gdx * nugrads + gdy = gdy * nugrads END SUBROUTINE gradiv2