source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/divergf.f90 @ 5195

Last change on this file since 5195 was 5159, checked in by abarral, 5 months 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: 2.0 KB
RevLine 
[5099]1
[524]2! $Header$
[5099]3
[5105]4SUBROUTINE divergf(klevel,x,y,div)
[5159]5
[5105]6  ! P. Le Van
[5159]7
[5105]8  !  *********************************************************************
9  !  ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
10  ! x et y...
11  !          x et y  etant des composantes covariantes   ...
12  !  *********************************************************************
[5106]13  USE lmdz_filtreg, ONLY: filtreg
[5123]14  USE lmdz_ssum_scopy, ONLY: ssum
[5136]15  USE lmdz_comgeom
[5123]16
[5159]17  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
18  USE lmdz_paramet
[5105]19  IMPLICIT NONE
[5159]20
[5105]21  !  x  et  y  sont des arguments  d'entree pour le s-prog
22  !    div      est  un argument  de sortie pour le s-prog
[5140]23
[5159]24
25
26
[5105]27  !    ..........          variables en arguments    ...................
[5159]28
[5105]29  INTEGER :: klevel
30  REAL :: x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
31  INTEGER :: l,ij
[5159]32
[5105]33  !    ...............     variables  locales   .........................
[524]34
[5105]35  REAL :: aiy1( iip1 ) , aiy2( iip1 )
36  REAL :: sumypn,sumyps
37  !    ...................................................................
[5123]38
[5159]39
[5105]40  DO l = 1,klevel
[5159]41
[5105]42    DO  ij = iip2, ip1jm - 1
43     div( ij + 1, l )     = &
44           cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) + &
45           cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)
46    ENDDO
[5159]47
[5105]48  ! ....  correction pour  div( 1,j,l)  ......
49  ! ....   div(1,j,l)= div(iip1,j,l) ....
[5159]50
[5105]51  !DIR$ IVDEP
52    DO  ij = iip2,ip1jm,iip1
53     div( ij,l ) = div( ij + iim,l )
54    ENDDO
[5159]55
[5105]56  ! ....  calcul  aux poles  .....
[5159]57
[5105]58    DO  ij  = 1,iim
59     aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
60     aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
61    ENDDO
62    sumypn = SSUM ( iim,aiy1,1 ) / apoln
63    sumyps = SSUM ( iim,aiy2,1 ) / apols
[5159]64
[5105]65    DO  ij = 1,iip1
66     div(     ij    , l ) = - sumypn
67     div( ij + ip1jm, l ) =   sumyps
68    ENDDO
69  END DO
70  !
[524]71
[5105]72    CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
73
[5159]74
[5105]75    DO l = 1, klevel
76       DO ij = iip2,ip1jm
77        div(ij,l) = div(ij,l) * unsaire(ij)
78      ENDDO
79    ENDDO
[5159]80
[5105]81   RETURN
82END SUBROUTINE divergf
Note: See TracBrowser for help on using the repository browser.