*=*=*=*= nxgraro2.html =*=*=*=*
SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry ) c *********************************************************** c c Auteur : P.Le Van 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 IMPLICIT NONE c #include "dimensions.h" #include "paramet.h" #include "comdissipn.h" c INTEGER klevel REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel ) REAL grx( ip1jmp1,klevel ), gry( ip1jm,klevel ) c REAL rot(ip1jm,llm) REAL signe,nugradrs INTEGER l,ij,iter,lr c c EXTERNAL filtreg EXTERNAL SCOPY, rotat, nxgrad, rotatst, nxgradst c c signe = (-1.)**lr nugradrs = signe * crot c CALL SCOPY ( ip1jmp1*klevel, xcov, 1, grx, 1 ) CALL SCOPY ( ip1jm*klevel, ycov, 1, gry, 1 ) c CALL rotat (klevel,grx, gry, rot ) CALL filtreg( rot, jjm, klevel, 2,1, .false.,1) c DO 1 iter = 1, lr -1 CALL nxgradst (klevel,rot, grx, gry ) CALL rotatst (klevel,grx, gry, rot ) 1 CONTINUE c CALL filtreg( rot, jjm, klevel, 2,1, .false.,1) CALL nxgrad(klevel,rot,grx, gry ) c DO 5 l = 1, klevel DO 2 ij = 1, ip1jm gry( ij,l ) = gry( ij,l ) * nugradrs 2 CONTINUE DO 3 ij = 1, ip1jmp1 grx( ij,l ) = grx( ij,l ) * nugradrs 3 CONTINUE 5 CONTINUE c RETURN END