/[lmdze]/trunk/Sources/dyn3d/diverg_gam.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/diverg_gam.f

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

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