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	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 disvert_m
19	USE comgeom
20	use vitvert_m, only: vitvert
21
22	IMPLICIT NONE
23
24	INTEGER, PARAMETER:: ngroup = 3
25
26	REAL pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
27	REAL pext(iip1, jjp1, llm)
28
29	REAL, intent(out):: pbarum(iip1, jjp1, llm)
30	real pbarvm(iip1, jjm, llm)
31	REAL wm(iip1, jjp1, llm)
32
33	REAL zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
34	REAL uu
35	INTEGER i, j, l
36	LOGICAL:: firstcall = .TRUE.
37
38	!------------------------------------------------------
39
40	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
48	! Champs 1D
49
50	CALL convflu(pbaru, pbarv, llm, zconvm)
51
52	CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
53	CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
54
55	CALL groupeun(jjp1, llm, zconvmm)
56	CALL groupeun(jjm, llm, pbarvm)
57
58	! Champs 3D
59
60	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
73	! 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
89	CALL vitvert(zconvmm, wm)
90
91	END SUBROUTINE groupe