--- trunk/libf/dyn3d/Dissipation/nxgraro2.f 2012/08/29 14:47:17 64 +++ trunk/libf/dyn3d/Dissipation/nxgraro2.f90 2012/09/20 09:57:03 65 @@ -1,70 +1,61 @@ -! -! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/nxgraro2.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $ -! - SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry, crot ) -c -c P.Le Van . -c *********************************************************** -c lr -c calcul de ( nxgrad (rot) ) du vect. v .... -c -c xcov et ycov etant les compos. covariantes de v -c *********************************************************** -c xcov , ycov et lr sont des arguments d'entree pour le s-prog -c grx et gry sont des arguments de sortie pour le s-prog -c -c - use dimens_m - use paramet_m - use filtreg_m, only: filtreg - IMPLICIT NONE -c -c -c ...... variables en arguments ....... -c - INTEGER klevel - REAL, intent(in):: xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel ) - REAL, intent(out):: grx( ip1jmp1,klevel ), gry( ip1jm,klevel ) - real, intent(in):: crot -c -c ...... variables locales ........ -c - REAL rot(ip1jm,llm) , signe, nugradrs - INTEGER l,ij,iter - integer, intent(in):: lr -c ........................................................ -c -c -c - signe = (-1.)**lr - nugradrs = signe * crot -c - grx = xcov - gry = ycov -c - CALL rotatf ( klevel, grx, gry, rot ) -c - CALL laplacien_rot ( klevel, rot, rot,grx,gry ) - -c -c ..... Iteration de l'operateur laplacien_rotgam ..... -c - DO iter = 1, lr -2 - CALL laplacien_rotgam ( klevel, rot, rot ) - ENDDO -c -c - CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.) - CALL nxgrad ( klevel, rot, grx, gry ) -c - DO l = 1, klevel - DO ij = 1, ip1jm - gry( ij,l ) = gry( ij,l ) * nugradrs - ENDDO - DO ij = 1, ip1jmp1 - grx( ij,l ) = grx( ij,l ) * nugradrs - ENDDO - ENDDO -c - RETURN - END +module nxgraro2_m + + IMPLICIT NONE + +contains + + SUBROUTINE nxgraro2(xcov, ycov, lr, grx, gry, crot) + + ! From LMDZ4/libf/dyn3d/nxgraro2.F, version 1.1.1.1 2004/05/19 12:53:06 + + ! P. Le Van + ! Calcul de nxgrad(rot) du vecteur v + + USE dimens_m, ONLY: iim, jjm + USE filtreg_m, ONLY: filtreg + use nr_util, only: assert, assert_eq + + ! Composantes covariantes de v : + REAL, intent(in):: xcov(:, :, :) ! (iim + 1, jjm + 1, :) + REAL, intent(in):: ycov(:, :, :) ! (iim + 1, jjm, :) + + integer, intent(in):: lr + REAL, intent(out):: grx(:, :, :) ! (iim + 1, jjm + 1, :) + REAL, intent(out):: gry(:, :, :) ! (iim + 1, jjm, :) + real, intent(in):: crot + + ! Variables locales + + INTEGER klevel, iter + REAL rot(iim + 1, jjm, size(xcov, 3)) , nugradrs + + !---------------------------------------------------------- + + call assert((/size(xcov, 1), size(ycov, 1), size(grx, 1), size(gry, 1)/) & + == iim + 1, "nxgraro2 iim") + call assert((/size(xcov, 2) - 1, size(ycov, 2), size(grx, 2) - 1, & + size(gry, 2)/) == jjm, "nxgraro2 jjm") + klevel = assert_eq(size(xcov, 3), size(ycov, 3), size(grx, 3), & + size(gry, 3), "nxgraro2 klevel") + + grx = xcov + gry = ycov + + CALL rotatf(klevel, grx, gry, rot) + CALL laplacien_rot(klevel, rot, rot, grx, gry) + + ! Itération de l'opérateur laplacien_rotgam + DO iter = 1, lr - 2 + CALL laplacien_rotgam(klevel, rot, rot) + ENDDO + + CALL filtreg(rot, jjm, klevel, 2, 1, .FALSE.) + CALL nxgrad(klevel, rot, grx, gry) + + nugradrs = (-1.)**lr * crot + grx = grx * nugradrs + gry = gry * nugradrs + + END SUBROUTINE nxgraro2 + +end module nxgraro2_m