source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/divergf_loc.f90 @ 5214

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