source: LMDZ6/trunk/libf/dyn3d_common/gradiv2.f90 @ 5423

Last change on this file since 5423 was 5285, checked in by abarral, 2 months ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.8 KB
Line 
1!
2! $Header$
3!
4SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy )
5  !
6  ! P. Le Van
7  !
8  !   **********************************************************
9  !                            ld
10  !   calcul  de  (grad (div) )   du vect. v ....
11  !
12  ! xcov et ycov etant les composant.covariantes de v
13  !   **********************************************************
14  ! xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
15  !  gdx   et  gdy       sont des arguments de sortie pour le s-prog
16  !
17  !
18  USE comgeom_mod_h
19  USE comdissipn_mod_h
20  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
21USE paramet_mod_h
22IMPLICIT NONE
23  !
24
25
26  !
27  ! ........    variables en arguments      ........
28
29  INTEGER :: klevel
30  REAL :: xcov( ip1jmp1,klevel ), ycov( ip1jm,klevel )
31  REAL :: gdx( ip1jmp1,klevel ),  gdy( ip1jm,klevel )
32  !
33  ! ........       variables locales       .........
34  !
35  REAL :: div(ip1jmp1,llm)
36  REAL :: signe, nugrads
37  INTEGER :: l,ij,iter,ld
38
39  !    ........................................................
40  !
41  !
42  CALL SCOPY( ip1jmp1 * klevel, xcov, 1, gdx, 1 )
43  CALL SCOPY(   ip1jm * klevel, ycov, 1, gdy, 1 )
44  !
45  !
46  signe   = (-1.)**ld
47  nugrads = signe * cdivu
48  !
49
50
51  CALL    divergf( klevel, gdx,   gdy , div )
52
53  IF( ld.GT.1 )   THEN
54
55    CALL laplacien ( klevel, div,  div     )
56
57  !    ......  Iteration de l'operateur laplacien_gam   .......
58
59    DO iter = 1, ld -2
60     CALL laplacien_gam ( klevel,cuvscvgam1,cvuscugam1,unsair_gam1, &
61           unsapolnga1, unsapolsga1,  div, div       )
62    ENDDO
63
64  ENDIF
65
66
67   CALL filtreg( div   , jjp1, klevel, 2, 1, .TRUE., 1 )
68   CALL  grad  ( klevel,  div,   gdx,  gdy             )
69
70  !
71   DO   l = 1, klevel
72     DO  ij = 1, ip1jmp1
73      gdx( ij,l ) = gdx( ij,l ) * nugrads
74     ENDDO
75     DO  ij = 1, ip1jm
76      gdy( ij,l ) = gdy( ij,l ) * nugrads
77     ENDDO
78   ENDDO
79  !
80   RETURN
81END SUBROUTINE gradiv2
Note: See TracBrowser for help on using the repository browser.