source: LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F90 @ 5117

Last change on this file since 5117 was 5117, checked in by abarral, 2 months ago

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 2.4 KB
Line 
1! $Header$
2
3SUBROUTINE groupe(pext, pbaru, pbarv, pbarum, pbarvm, wm)
4
5  USE comconst_mod, ONLY: ngroup
6
7  IMPLICIT NONE
8
9  !   sous-programme servant a fitlrer les champs de flux de masse aux
10  !   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
11  !   et a mesure qu'on se rapproche du pole.
12  !
13  !   en entree: pext, pbaru et pbarv
14  !
15  !   en sortie:  pbarum,pbarvm et wm.
16  !
17  !   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
18  !   pas besoin de w en entree.
19
20  include "dimensions.h"
21  include "paramet.h"
22  include "comgeom2.h"
23
24  ! integer ngroup
25  ! parameter (ngroup=3)
26
27  REAL :: pbaru(iip1, jjp1, llm), pbarv(iip1, jjm, llm)
28  REAL :: pext(iip1, jjp1, llm)
29
30  REAL :: pbarum(iip1, jjp1, llm), pbarvm(iip1, jjm, llm)
31  REAL :: wm(iip1, jjp1, llm)
32
33  REAL :: zconvm(iip1, jjp1, llm), zconvmm(iip1, jjp1, llm)
34
35  REAL :: uu
36
37  INTEGER :: i, j, l
38
39  LOGICAL :: firstcall, groupe_ok
40  save firstcall, groupe_ok
41
42  data firstcall/.TRUE./
43  data groupe_ok/.TRUE./
44
45  IF (iim==1) THEN
46    groupe_ok = .FALSE.
47  ENDIF
48
49  IF (firstcall) THEN
50    IF (groupe_ok) THEN
51      IF(mod(iim, 2**ngroup)/=0) &
52              CALL abort_gcm('groupe', 'probleme du nombre de point', 1)
53    endif
54    firstcall = .FALSE.
55  ENDIF
56
57
58  !   Champs 1D
59
60  CALL convflu(pbaru, pbarv, llm, zconvm)
61
62  CALL scopy(ijp1llm, zconvm, 1, zconvmm, 1)
63  CALL scopy(ijmllm, pbarv, 1, pbarvm, 1)
64
65  IF (groupe_ok) THEN
66    CALL groupeun(jjp1, llm, zconvmm)
67    CALL groupeun(jjm, llm, pbarvm)
68
69    !   Champs 3D
70    do l = 1, llm
71      do j = 2, jjm
72        uu = pbaru(iim, j, l)
73        do i = 1, iim
74          uu = uu + pbarvm(i, j, l) - pbarvm(i, j - 1, l) - zconvmm(i, j, l)
75          pbarum(i, j, l) = uu
76          ! zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
77          !    *                      yflu(i,j,l)-yflu(i,j-1,l)
78        enddo
79        pbarum(iip1, j, l) = pbarum(1, j, l)
80      enddo
81    enddo
82
83  else
84    pbarum(:, :, :) = pbaru(:, :, :)
85    pbarvm(:, :, :) = pbarv(:, :, :)
86  ENDIF
87
88  !    integration de la convergence de masse de haut  en bas ......
89  do l = 1, llm
90    do j = 1, jjp1
91      do i = 1, iip1
92        zconvmm(i, j, l) = zconvmm(i, j, l)
93      enddo
94    enddo
95  enddo
96  do  l = llm - 1, 1, -1
97    do j = 1, jjp1
98      do i = 1, iip1
99        zconvmm(i, j, l) = zconvmm(i, j, l) + zconvmm(i, j, l + 1)
100      enddo
101    enddo
102  enddo
103
104  CALL vitvert(zconvmm, wm)
105
106
107END SUBROUTINE  groupe
108
Note: See TracBrowser for help on using the repository browser.