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 comvert
  USE comgeom

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