trunk/dyn3d/groupe.f

SUBROUTINE groupe(pext, 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: pext, 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 pext(iip1, jjp1, 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	31	SUBROUTINE groupe(pext, 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	31	! en entree: pext, pbaru et pbarv
10			! 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 pext(iip1, jjp1, llm)
28	guez	3
29	guez	31	REAL, intent(out):: pbarum(iip1, jjp1, llm)
30			real pbarvm(iip1, jjm, llm)
31			REAL wm(iip1, jjp1, llm)
32	guez	3
33	guez	31	REAL zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
34			REAL uu
35			INTEGER i, j, l
36			LOGICAL:: firstcall = .TRUE.
37	guez	3
38	guez	31	!------------------------------------------------------
39	guez	3
40	guez	31	IF (firstcall) THEN
41			IF (mod(iim, 2**ngroup) /= 0) then
42			print *, 'groupe: bad iim'
43			STOP 1
44			end IF
45			firstcall = .FALSE.
46			END IF
47	guez	3
48	guez	31	! Champs 1D
49	guez	3
50	guez	31	CALL convflu(pbaru, pbarv, llm, zconvm)
51	guez	3
52	guez	31	CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
53			CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
54	guez	3
55	guez	31	CALL groupeun(jjp1, llm, zconvmm)
56			CALL groupeun(jjm, llm, pbarvm)
57	guez	3
58	guez	31	! Champs 3D
59	guez	3
60	guez	31	DO l = 1, llm
61			DO j = 2, jjm
62			uu = pbaru(iim, j, l)
63			DO i = 1, iim
64			uu = uu + pbarvm(i, j, l) - pbarvm(i, j-1, l) - zconvmm(i, j, l)
65			pbarum(i, j, l) = uu
66			END DO
67			pbarum(iip1, j, l) = pbarum(1, j, l)
68			END DO
69			END DO
70			pbarum(:, 1, :) = 0
71			pbarum(:, jjm + 1, :) = 0
72	guez	3
73	guez	31	! integration de la convergence de masse de haut en bas
74			DO l = 1, llm
75			DO j = 1, jjp1
76			DO i = 1, iip1
77			zconvmm(i, j, l) = zconvmm(i, j, l)
78			END DO
79			END DO
80			END DO
81			DO l = llm - 1, 1, -1
82			DO j = 1, jjp1
83			DO i = 1, iip1
84			zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l+1)
85			END DO
86			END DO
87			END DO
88	guez	3
89	guez	31	CALL vitvert(zconvmm, wm)
90	guez	3
91	guez	31	END SUBROUTINE groupe