trunk/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	SUBROUTINE groupe(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: 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, intent(out):: pbarum(iip1, jjp1, llm)
28	real pbarvm(iip1, jjm, llm)
29	REAL wm(iip1, jjp1, llm)
30
31	REAL zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
32	REAL uu
33	INTEGER i, j, l
34	LOGICAL:: firstcall = .TRUE.
35
36	!------------------------------------------------------
37
38	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
46	! Champs 1D
47
48	CALL convflu(pbaru, pbarv, llm, zconvm)
49
50	CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
51	CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
52
53	CALL groupeun(jjp1, llm, zconvmm)
54	CALL groupeun(jjm, llm, pbarvm)
55
56	! Champs 3D
57
58	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
71	! 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
87	CALL vitvert(zconvmm, wm)
88
89	END SUBROUTINE groupe