/[lmdze]/trunk/dyn3d/diverg.f90
ViewVC logotype

Diff of /trunk/dyn3d/diverg.f90

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/dyn3d/diverg.f revision 80 by guez, Fri Nov 15 18:45:49 2013 UTC trunk/dyn3d/diverg.f90 revision 81 by guez, Wed Mar 5 14:38:41 2014 UTC
# Line 1  Line 1 
1  !  
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/diverg.F,v 1.1.1.1 2004/05/19 12:53:06 lmdzadmin Exp $  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/diverg.F,v 1.1.1.1 2004/05/19
3  !  ! 12:53:06 lmdzadmin Exp $
4        SUBROUTINE diverg(klevel,x,y,div)  
5  c  SUBROUTINE diverg(klevel, x, y, div)
6  c     P. Le Van  
7  c    ! P. Le Van
8  c  *********************************************************************  
9  c  ... calcule la divergence a tous les niveaux d'1 vecteur de compos.    ! *********************************************************************
10  c     x et y...    ! ... calcule la divergence a tous les niveaux d'1 vecteur de compos.
11  c              x et y  etant des composantes covariantes   ...    ! x et y...
12  c  *********************************************************************    ! x et y  etant des composantes covariantes   ...
13        use dimens_m    ! *********************************************************************
14        use paramet_m    USE dimens_m
15        use comgeom    USE paramet_m
16        IMPLICIT NONE    USE comgeom
17  c    IMPLICIT NONE
18  c      x  et  y  sont des arguments  d'entree pour le s-prog  
19  c        div      est  un argument  de sortie pour le s-prog    ! x  et  y  sont des arguments  d'entree pour le s-prog
20  c    ! div      est  un argument  de sortie pour le s-prog
21  c  
22  c   ---------------------------------------------------------------------  
23  c    ! ---------------------------------------------------------------------
24  c    ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .  
25  c    ! ATTENTION : pendant ce s-pg , ne pas toucher au COMMON/scratch/  .
26  c   ---------------------------------------------------------------------  
27  c    ! ---------------------------------------------------------------------
28  c    ..........          variables en arguments    ...................  
29  c    ! ..........          variables en arguments    ...................
30        INTEGER klevel  
31        REAL x( ip1jmp1,klevel ),y( ip1jm,klevel ),div( ip1jmp1,klevel )    INTEGER klevel
32        INTEGER   l,ij    REAL x(ip1jmp1, klevel), y(ip1jm, klevel), div(ip1jmp1, klevel)
33  c    INTEGER l, ij
34  c    ...............     variables  locales   .........................  
35      ! ...............     variables  locales   .........................
36        REAL aiy1( iip1 ) , aiy2( iip1 )  
37        REAL sumypn,sumyps    REAL aiy1(iip1), aiy2(iip1)
38  c    ...................................................................    REAL sumypn, sumyps
39  c    ! ...................................................................
40        REAL      SSUM  
41  c    REAL ssum
42  c  
43        DO 10 l = 1,klevel  
44  c    DO l = 1, klevel
45          DO  ij = iip2, ip1jm - 1  
46           div( ij + 1, l )     =        DO ij = iip2, ip1jm - 1
47       *   cvusurcu( ij+1 ) * x( ij+1,l ) - cvusurcu( ij ) * x( ij , l) +        div(ij+1, l) = cvusurcu(ij+1)*x(ij+1, l) - cvusurcu(ij)*x(ij, l) + &
48       *   cuvsurcv(ij-iim) * y(ij-iim,l) - cuvsurcv(ij+1) * y(ij+1,l)          cuvsurcv(ij-iim)*y(ij-iim, l) - cuvsurcv(ij+1)*y(ij+1, l)
49          ENDDO      END DO
50  c  
51  c     ....  correction pour  div( 1,j,l)  ......      ! ....  correction pour  div( 1,j,l)  ......
52  c     ....   div(1,j,l)= div(iip1,j,l) ....      ! ....   div(1,j,l)= div(iip1,j,l) ....
53  c  
54  CDIR$ IVDEP      ! DIR$ IVDEP
55          DO  ij = iip2,ip1jm,iip1      DO ij = iip2, ip1jm, iip1
56           div( ij,l ) = div( ij + iim,l )        div(ij, l) = div(ij+iim, l)
57          ENDDO      END DO
58  c  
59  c     ....  calcul  aux poles  .....      ! ....  calcul  aux poles  .....
60  c  
61          DO  ij  = 1,iim      DO ij = 1, iim
62           aiy1(ij) =    cuvsurcv(    ij       ) * y(     ij     , l )        aiy1(ij) = cuvsurcv(ij)*y(ij, l)
63           aiy2(ij) =    cuvsurcv( ij+ ip1jmi1 ) * y( ij+ ip1jmi1, l )        aiy2(ij) = cuvsurcv(ij+ip1jmi1)*y(ij+ip1jmi1, l)
64          ENDDO      END DO
65          sumypn = SSUM ( iim,aiy1,1 ) / apoln      sumypn = ssum(iim, aiy1, 1)/apoln
66          sumyps = SSUM ( iim,aiy2,1 ) / apols      sumyps = ssum(iim, aiy2, 1)/apols
67  c  
68          DO  ij = 1,iip1      DO ij = 1, iip1
69           div(     ij    , l ) = - sumypn        div(ij, l) = -sumypn
70           div( ij + ip1jm, l ) =   sumyps        div(ij+ip1jm, l) = sumyps
71          ENDDO      END DO
72    10  CONTINUE    END DO
73  c  
74    
75  ccc        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )    ! cc        CALL filtreg( div, jjp1, klevel, 2, 2, .TRUE., 1 )
76          
77  c  
78          DO l = 1, klevel    DO l = 1, klevel
79             DO ij = iip2,ip1jm      DO ij = iip2, ip1jm
80              div(ij,l) = div(ij,l) * unsaire(ij)        div(ij, l) = div(ij, l)*unsaire(ij)
81            ENDDO      END DO
82          ENDDO    END DO
83  c  
84         RETURN    RETURN
85         END  END SUBROUTINE diverg
Legend:
Removed from v.80  
changed lines
  Added in v.81
  ViewVC Help
Powered by ViewVC 1.1.21