--- trunk/libf/dyn3d/Dissipation/gradiv2.f90 2011/12/12 13:25:01 55 +++ trunk/dyn3d/Dissipation/gradiv2.f 2014/03/05 14:57:53 82 @@ -4,61 +4,61 @@ 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. + ! Calcul du gradient de la divergence du vecteur v. - USE dimens_m, ONLY : llm - USE paramet_m, ONLY : ip1jm, ip1jmp1, jjp1 - USE comgeom, ONLY : cuvscvgam1, cvuscugam1, unsair_gam1, unsapolnga1, & + USE comgeom, ONLY: cuvscvgam1, cvuscugam1, unsair_gam1, unsapolnga1, & unsapolsga1 - USE filtreg_m, ONLY : filtreg - - INTEGER, intent(in):: klevel - - ! composantes covariantes de v: - REAL, intent(in):: xcov(ip1jmp1,klevel), ycov(ip1jm,klevel) + USE dimens_m, ONLY: iim, jjm, llm + use divergf_m, only: divergf + USE filtreg_m, ONLY: filtreg + use grad_m, only: grad + use laplacien_m, only: laplacien + 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, intent(in):: ld - REAL, intent(out):: 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 + REAL nugrads, div(iim + 1, jjm + 1, llm) + INTEGER iter, klevel !-------------------------------------------------------------- - gdx = xcov - gdy = ycov + 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") - CALL divergf(klevel, gdx, gdy, div) + CALL divergf(klevel, xcov, ycov, div) - IF(ld.GT.1) THEN - CALL laplacien (klevel, div, div) + IF (ld > 1) THEN + CALL laplacien(klevel, 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.) + 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