Sources/dyn3d/groupe.f

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 dimens_m
  USE paramet_m
  USE comconst
  USE disvert_m
  USE comgeom
  use vitvert_m, only: vitvert

  IMPLICIT NONE

  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

  CALL vitvert(zconvmm, wm)

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