trunk/dyn3d/groupe.f

module groupe_m

  IMPLICIT NONE

contains

  SUBROUTINE groupe(pbaru, pbarv, pbarum, pbarvm, wm)

    ! From dyn3d/groupe.F, v 1.1.1.1 2004/05/19 12:53:06

    ! sous-programme servant a fitlrer les champs de flux de masse aux    
    ! 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 dimensions
    USE paramet_m
    USE comconst
    USE disvert_m
    USE comgeom
    use vitvert_m, only: vitvert

    INTEGER, PARAMETER:: ngroup = 3

    REAL pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
    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

    wm = vitvert(zconvmm)

  END SUBROUTINE groupe

end module groupe_m
1	guez	207	module groupe_m
2	guez	3
3	guez	207	IMPLICIT NONE
4	guez	3
5	guez	207	contains
6	guez	3
7	guez	207	SUBROUTINE groupe(pbaru, pbarv, pbarum, pbarvm, wm)
8	guez	3
9	guez	207	! From dyn3d/groupe.F, v 1.1.1.1 2004/05/19 12:53:06
10	guez	3
11	guez	207	! 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	guez	3
15	guez	207	! en entree: pbaru et pbarv
16			! en sortie: pbarum, pbarvm et wm.
17	guez	3
18	guez	207	! remarque, le wm est recalcule a partir des pbaru pbarv et on n'a
19			! donc pas besoin de w en entree.
20	guez	3
21	guez	265	USE dimensions
22	guez	207	USE paramet_m
23			USE comconst
24			USE disvert_m
25			USE comgeom
26			use vitvert_m, only: vitvert
27	guez	3
28	guez	207	INTEGER, PARAMETER:: ngroup = 3
29	guez	3
30	guez	207	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	guez	3
35	guez	207	REAL zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
36			REAL uu
37			INTEGER i, j, l
38			LOGICAL:: firstcall = .TRUE.
39	guez	3
40	guez	207	!------------------------------------------------------
41	guez	3
42	guez	207	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	guez	3
50	guez	207	! Champs 1D
51	guez	3
52	guez	207	CALL convflu(pbaru, pbarv, llm, zconvm)
53	guez	3
54	guez	207	CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
55			CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
56	guez	3
57	guez	207	CALL groupeun(jjp1, llm, zconvmm)
58			CALL groupeun(jjm, llm, pbarvm)
59	guez	3
60	guez	207	! Champs 3D
61	guez	3
62	guez	207	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	guez	3
75	guez	207	! 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	guez	252	wm = vitvert(zconvmm)
92	guez	207
93			END SUBROUTINE groupe
94
95			end module groupe_m