GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d_common/gradiv2.F Lines: 15 18 83.3 %
Date: 2023-06-30 12:51:15 Branches: 7 10 70.0 %

Line Branch Exec Source
1
!
2
! $Header$
3
!
4
676
      SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy )
5
c
6
c     P. Le Van
7
c
8
c   **********************************************************
9
c                                ld
10
c       calcul  de  (grad (div) )   du vect. v ....
11
c
12
c     xcov et ycov etant les composant.covariantes de v
13
c   **********************************************************
14
c     xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
15
c      gdx   et  gdy       sont des arguments de sortie pour le s-prog
16
c
17
c
18
      IMPLICIT NONE
19
c
20
      INCLUDE "dimensions.h"
21
      INCLUDE "paramet.h"
22
      INCLUDE "comgeom.h"
23
      INCLUDE "comdissipn.h"
24
c
25
c     ........    variables en arguments      ........
26
27
      INTEGER klevel
28
      REAL  xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
29
      REAL   gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
30
c
31
c     ........       variables locales       .........
32
c
33
      REAL div(ip1jmp1,llm)
34
      REAL signe, nugrads
35
      INTEGER l,ij,iter,ld
36
37
c    ........................................................
38
c
39
c
40
338
      CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
41
338
      CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
42
c
43
c
44
338
      signe   = (-1.)**ld
45
338
      nugrads = signe * cdivu
46
c
47
48
49
338
      CALL    divergf( klevel, gdx,   gdy , div )
50
51
338
      IF( ld.GT.1 )   THEN
52
53
        CALL laplacien ( klevel, div,  div     )
54
55
c    ......  Iteration de l'operateur laplacien_gam   .......
56
57
        DO iter = 1, ld -2
58
         CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1,
59
     *                       unsapolnga1, unsapolsga1,  div, div       )
60
        ENDDO
61
62
      ENDIF
63
64
65
338
       CALL filtreg( div   , jjp1, klevel, 2, 1, .TRUE., 1 )
66
338
       CALL  grad  ( klevel,  div,   gdx,  gdy             )
67
68
c
69
11620
       DO   l = 1, klevel
70
12297380
         DO  ij = 1, ip1jmp1
71
12297380
          gdx( ij,l ) = gdx( ij,l ) * nugrads
72
         ENDDO
73
11925412
         DO  ij = 1, ip1jm
74
11925074
          gdy( ij,l ) = gdy( ij,l ) * nugrads
75
         ENDDO
76
       ENDDO
77
c
78
338
       RETURN
79
       END