source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/diverg_p.f90 @ 5411

Last change on this file since 5411 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
File size: 2.4 KB
RevLine 
[5105]1SUBROUTINE diverg_p(klevel,x,y,div)
[5159]2
[5105]3  ! P. Le Van
[5159]4
[5105]5  !  *********************************************************************
6  !  ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
7  ! x et y...
8  !          x et y  etant des composantes covariantes   ...
9  !  *********************************************************************
10  USE parallel_lmdz
[5123]11  USE lmdz_ssum_scopy, ONLY: ssum
[5136]12  USE lmdz_comgeom
[5123]13
[5159]14  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
15  USE lmdz_paramet
[5105]16  IMPLICIT NONE
[5159]17
[5105]18  !  x  et  y  sont des arguments  d'entree pour le s-prog
19  !    div      est  un argument  de sortie pour le s-prog
20  !
[5140]21
[5159]22
23
24
[5105]25  !    ..........          variables en arguments    ...................
[5159]26
[5105]27  INTEGER :: klevel
28  REAL :: x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )
29  INTEGER :: l,ij
[5159]30
[5105]31  !    ...............     variables  locales   .........................
[1632]32
[5105]33  REAL :: aiy1( iip1 ) , aiy2( iip1 )
34  REAL :: sumypn,sumyps
35  INTEGER :: ijb,ije
36  !    ...................................................................
[5159]37
38
[5105]39  ijb=ij_begin
40  ije=ij_end
[5117]41  IF (pole_nord) ijb=ij_begin+iip1
[5116]42  IF(pole_sud)  ije=ij_end-iip1
[1632]43
[5105]44!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
45  DO l = 1,klevel
[5159]46
[5105]47    DO  ij = ijb, ije - 1
48     div( ij + 1, l )     = &
49           cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) + &
50           cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)
51    ENDDO
[5159]52
[5105]53  ! ....  correction pour  div( 1,j,l)  ......
54  ! ....   div(1,j,l)= div(iip1,j,l) ....
[5159]55
[5105]56  !DIR$ IVDEP
57    DO  ij = ijb,ije,iip1
58     div( ij,l ) = div( ij + iim,l )
59    ENDDO
[5159]60
[5105]61  ! ....  calcul  aux poles  .....
[5159]62
[5117]63    IF (pole_nord) THEN
[5105]64      DO  ij  = 1,iim
65       aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )
66      ENDDO
67      sumypn = SSUM ( iim,aiy1,1 ) / apoln
[5159]68
[5105]69      DO  ij = 1,iip1
70       div(     ij    , l ) = - sumypn
71      ENDDO
72    endif
[1632]73
[5117]74   IF (pole_sud) THEN
[5105]75      DO  ij  = 1,iim
76       aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )
77      ENDDO
78      sumyps = SSUM ( iim,aiy2,1 ) / apols
[5159]79
[5105]80      DO  ij = 1,iip1
81       div( ij + ip1jm, l ) =   sumyps
82      ENDDO
83    endif
[1632]84
[5105]85
86  END DO
87!$OMP END DO NOWAIT
88  !
89
90  !cc        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
91
[5159]92
[5105]93!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
94    DO l = 1, klevel
95       DO ij = ijb,ije
96        div(ij,l) = div(ij,l) * unsaire(ij)
97      ENDDO
98    ENDDO
99!$OMP END DO NOWAIT
100  !
101
102END SUBROUTINE diverg_p
Note: See TracBrowser for help on using the repository browser.