GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d_common/nxgraro2.F Lines: 17 17 100.0 %
Date: 2023-06-30 12:56:34 Branches: 7 8 87.5 %

Line Branch Exec Source
1
!
2
! $Header$
3
!
4
338
       SUBROUTINE nxgraro2 (klevel,xcov, ycov, lr, grx, gry )
5
c
6
c      P.Le Van .
7
c   ***********************************************************
8
c                                 lr
9
c      calcul de  ( nxgrad (rot) )   du vect. v  ....
10
c
11
c       xcov et ycov  etant les compos. covariantes de  v
12
c   ***********************************************************
13
c     xcov , ycov et lr  sont des arguments  d'entree pour le s-prog
14
c      grx   et  gry     sont des arguments de sortie pour le s-prog
15
c
16
c
17
      IMPLICIT NONE
18
c
19
      INCLUDE "dimensions.h"
20
      INCLUDE "paramet.h"
21
      INCLUDE "comdissipn.h"
22
c
23
c    ......  variables en arguments  .......
24
c
25
      INTEGER klevel
26
      REAL xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
27
      REAL  grx( ip1jmp1,klevel ),  gry( ip1jm,klevel )
28
c
29
c    ......   variables locales     ........
30
c
31
      REAL rot(ip1jm,llm) , signe, nugradrs
32
      INTEGER l,ij,iter,lr
33
c    ........................................................
34
c
35
c
36
c
37
338
      signe    = (-1.)**lr
38
338
      nugradrs = signe * crot
39
c
40
338
      CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 )
41
338
      CALL SCOPY (  ip1jm * klevel, ycov, 1, gry, 1 )
42
c
43
338
      CALL     rotatf     ( klevel, grx, gry, rot )
44
c
45
338
      CALL laplacien_rot ( klevel, rot, rot,grx,gry      )
46
47
c
48
c    .....   Iteration de l'operateur laplacien_rotgam  .....
49
c
50
338
      DO  iter = 1, lr -2
51
338
        CALL laplacien_rotgam ( klevel, rot, rot )
52
      ENDDO
53
c
54
c
55
338
      CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,1)
56
338
      CALL nxgrad ( klevel, rot, grx, gry )
57
c
58
11620
      DO    l = 1, klevel
59
11925074
         DO  ij = 1, ip1jm
60
11925074
          gry( ij,l ) = gry( ij,l ) * nugradrs
61
         ENDDO
62
12297718
         DO  ij = 1, ip1jmp1
63
12297380
          grx( ij,l ) = grx( ij,l ) * nugradrs
64
         ENDDO
65
      ENDDO
66
c
67
338
      RETURN
68
      END