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

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

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

revision 206 by guez, Thu Jun 18 13:49:26 2015 UTC revision 207 by guez, Thu Sep 1 10:30:53 2016 UTC
# Line 1  Line 1 
1  SUBROUTINE groupe(pbaru, pbarv, pbarum, pbarvm, wm)  module groupe_m
2    
3    ! From dyn3d/groupe.F, v 1.1.1.1 2004/05/19 12:53:06    IMPLICIT NONE
4    
5    ! sous-programme servant a fitlrer les champs de flux de masse aux      contains
   ! poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur    
   ! et a mesure qu'on se rapproche du pole.                              
   
   ! en entree: pbaru et pbarv                                      
   ! en sortie:  pbarum, pbarvm et wm.                                      
   
   ! remarque, le wm est recalcule a partir des pbaru pbarv et on n'a      
   ! donc pas besoin de w en entree.  
   
   USE dimens_m  
   USE paramet_m  
   USE comconst  
   USE disvert_m  
   USE comgeom  
   use vitvert_m, only: vitvert  
6    
7    IMPLICIT NONE    SUBROUTINE groupe(pbaru, pbarv, pbarum, pbarvm, wm)
8    
9        ! From dyn3d/groupe.F, v 1.1.1.1 2004/05/19 12:53:06
10    
11    INTEGER, PARAMETER:: ngroup = 3      ! sous-programme servant a fitlrer les champs de flux de masse aux    
12        ! poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur  
13        ! et a mesure qu'on se rapproche du pole.                            
14    
15        ! en entree: pbaru et pbarv                                    
16        ! en sortie:  pbarum, pbarvm et wm.                                    
17    
18        ! remarque, le wm est recalcule a partir des pbaru pbarv et on n'a    
19        ! donc pas besoin de w en entree.
20    
21        USE dimens_m
22        USE paramet_m
23        USE comconst
24        USE disvert_m
25        USE comgeom
26        use vitvert_m, only: vitvert
27    
28        INTEGER, PARAMETER:: ngroup = 3
29    
30        REAL pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
31        REAL, intent(out):: pbarum(iip1, jjp1, llm)
32        real pbarvm(iip1, jjm, llm)
33        REAL wm(iip1, jjp1, llm)
34    
35        REAL zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
36        REAL uu
37        INTEGER i, j, l
38        LOGICAL:: firstcall = .TRUE.
39    
40        !------------------------------------------------------
41    
42        IF (firstcall) THEN
43           IF (mod(iim, 2**ngroup) /= 0) then
44              print *, 'groupe: bad iim'
45              STOP 1
46           end IF
47           firstcall = .FALSE.
48        END IF
49    
50        ! Champs 1D                                                          
51    
52        CALL convflu(pbaru, pbarv, llm, zconvm)
53    
54        CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
55        CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
56    
57        CALL groupeun(jjp1, llm, zconvmm)
58        CALL groupeun(jjm, llm, pbarvm)
59    
60        ! Champs 3D                                                          
61    
62        DO l = 1, llm
63           DO j = 2, jjm
64              uu = pbaru(iim, j, l)
65              DO i = 1, iim
66                 uu = uu + pbarvm(i, j, l) - pbarvm(i, j-1, l) - zconvmm(i, j, l)
67                 pbarum(i, j, l) = uu
68              END DO
69              pbarum(iip1, j, l) = pbarum(1, j, l)
70           END DO
71        END DO
72        pbarum(:, 1, :) = 0
73        pbarum(:, jjm + 1, :) = 0
74    
75        ! integration de la convergence de masse de haut  en bas
76        DO l = 1, llm
77           DO j = 1, jjp1
78              DO i = 1, iip1
79                 zconvmm(i, j, l) = zconvmm(i, j, l)
80              END DO
81           END DO
82        END DO
83        DO l = llm - 1, 1, -1
84           DO j = 1, jjp1
85              DO i = 1, iip1
86                 zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l+1)
87              END DO
88           END DO
89        END DO
90    
91    REAL pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)      CALL vitvert(zconvmm, wm)
   REAL, intent(out):: pbarum(iip1, jjp1, llm)  
   real pbarvm(iip1, jjm, llm)  
   REAL wm(iip1, jjp1, llm)  
   
   REAL zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)  
   REAL uu  
   INTEGER i, j, l  
   LOGICAL:: firstcall = .TRUE.  
   
   !------------------------------------------------------  
   
   IF (firstcall) THEN  
      IF (mod(iim, 2**ngroup) /= 0) then  
         print *, 'groupe: bad iim'  
         STOP 1  
      end IF  
      firstcall = .FALSE.  
   END IF  
   
   ! Champs 1D                                                            
   
   CALL convflu(pbaru, pbarv, llm, zconvm)  
   
   CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)  
   CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)  
   
   CALL groupeun(jjp1, llm, zconvmm)  
   CALL groupeun(jjm, llm, pbarvm)  
   
   ! Champs 3D                                                            
   
   DO l = 1, llm  
      DO j = 2, jjm  
         uu = pbaru(iim, j, l)  
         DO i = 1, iim  
            uu = uu + pbarvm(i, j, l) - pbarvm(i, j-1, l) - zconvmm(i, j, l)  
            pbarum(i, j, l) = uu  
         END DO  
         pbarum(iip1, j, l) = pbarum(1, j, l)  
      END DO  
   END DO  
   pbarum(:, 1, :) = 0  
   pbarum(:, jjm + 1, :) = 0  
   
   ! integration de la convergence de masse de haut  en bas  
   DO l = 1, llm  
      DO j = 1, jjp1  
         DO i = 1, iip1  
            zconvmm(i, j, l) = zconvmm(i, j, l)  
         END DO  
      END DO  
   END DO  
   DO l = llm - 1, 1, -1  
      DO j = 1, jjp1  
         DO i = 1, iip1  
            zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l+1)  
         END DO  
      END DO  
   END DO  
92    
93    CALL vitvert(zconvmm, wm)    END SUBROUTINE groupe
94    
95  END SUBROUTINE groupe  end module groupe_m
Legend:
Removed from v.206  
changed lines
  Added in v.207
  ViewVC Help
Powered by ViewVC 1.1.21