source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradiv2.f90 @ 5159

Last change on this file since 5159 was 5159, checked in by abarral, 7 weeks ago

Put dimensions.h and paramet.h into 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.9 KB
RevLine 
[524]1! $Header$
[5099]2
[5119]3SUBROUTINE gradiv2(klevel, xcov, ycov, ld, gdx, gdy)
[5159]4
[5105]5  ! P. Le Van
[5159]6
[5105]7  !   **********************************************************
8  !                            ld
9  !   calcul  de  (grad (div) )   du vect. v ....
[5159]10
[5105]11  ! xcov et ycov etant les composant.covariantes de v
12  !   **********************************************************
13  ! xcont , ycont et ld  sont des arguments  d'entree pour le s-prog
14  !  gdx   et  gdy       sont des arguments de sortie pour le s-prog
[5159]15
16
[5106]17  USE lmdz_filtreg, ONLY: filtreg
[5119]18  USE lmdz_ssum_scopy, ONLY: scopy
[5134]19  USE lmdz_comdissipn, ONLY: tetaudiv, tetaurot, tetah, cdivu, crot, cdivh
[5136]20  USE lmdz_comgeom
[5119]21
[5159]22USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
23  USE lmdz_paramet
[5105]24  IMPLICIT NONE
25  !
[5159]26
27
28
[5105]29  ! ........    variables en arguments      ........
[524]30
[5105]31  INTEGER :: klevel
[5119]32  REAL :: xcov(ip1jmp1, klevel), ycov(ip1jm, klevel)
33  REAL :: gdx(ip1jmp1, klevel), gdy(ip1jm, klevel)
[5159]34
[5105]35  ! ........       variables locales       .........
[5159]36
[5119]37  REAL :: div(ip1jmp1, llm)
[5105]38  REAL :: signe, nugrads
[5119]39  INTEGER :: l, ij, iter, ld
[524]40
[5105]41  !    ........................................................
[5159]42
43
[5119]44  CALL SCOPY(ip1jmp1 * klevel, xcov, 1, gdx, 1)
45  CALL SCOPY(ip1jm * klevel, ycov, 1, gdy, 1)
[5159]46
47
[5119]48  signe = (-1.)**ld
[5105]49  nugrads = signe * cdivu
50  !
[524]51
[5119]52  CALL    divergf(klevel, gdx, gdy, div)
[524]53
[5119]54  IF(ld>1)   THEN
[524]55
[5119]56    CALL laplacien (klevel, div, div)
[524]57
[5119]58    !    ......  Iteration de l'operateur laplacien_gam   .......
[524]59
[5119]60    DO iter = 1, ld - 2
61      CALL laplacien_gam (klevel, cuvscvgam1, cvuscugam1, unsair_gam1, &
62              unsapolnga1, unsapolsga1, div, div)
[5105]63    ENDDO
[524]64
[5105]65  ENDIF
[524]66
[5119]67  CALL filtreg(div, jjp1, klevel, 2, 1, .TRUE., 1)
68  CALL  grad  (klevel, div, gdx, gdy)
[524]69
[5159]70
[5119]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
[5159]79
[5119]80  RETURN
[5105]81END SUBROUTINE gradiv2
Note: See TracBrowser for help on using the repository browser.