source: LMDZ6/trunk/libf/dyn3dmem/groupe_loc.f90 @ 5407

Last change on this file since 5407 was 5324, checked in by abarral, 5 weeks ago

[WIP] Remove uses of DEBUGIO cpp key (deprecated)

  • 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
File size: 2.6 KB
Line 
1subroutine groupe_loc(pext,pbaru,pbarv,pbarum,pbarvm,wm)
2  USE comgeom2_mod_h
3  USE parallel_lmdz
4  USE Write_field_loc
5  USE groupe_mod
6  USE comconst_mod, ONLY: ngroup
7  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
8USE paramet_mod_h
9implicit none
10
11  !   sous-programme servant a fitlrer les champs de flux de masse aux
12  !   poles en "regroupant" les mailles 2 par 2 puis 4 par 4 etc. au fur
13  !   et a mesure qu'on se rapproche du pole.
14  !
15  !   en entree: pext, pbaru et pbarv
16  !
17  !   en sortie:  pbarum,pbarvm et wm.
18  !
19  !   remarque, le wm est recalcule a partir des pbaru pbarv et on n'a donc
20  !   pas besoin de w en entree.
21
22
23
24
25  ! integer ngroup
26  ! parameter (ngroup=3)
27
28
29  real :: pbaru(iip1,jjb_u:jje_u,llm),pbarv(iip1,jjb_v:jje_v,llm)
30  real :: pext(iip1,jjb_u:jje_u,llm)
31
32  real :: pbarum(iip1,jjb_u:jje_u,llm),pbarvm(iip1,jjb_v:jje_v,llm)
33  real :: wm(iip1,jjb_u:jje_u,llm)
34
35
36  real :: uu
37
38  integer :: i,j,l
39
40  logical :: firstcall
41  save firstcall
42!$OMP THREADPRIVATE(firstcall)
43
44  integer :: ijb,ije,jjb,jje
45
46  !   Champs 1D
47
48  call convflu_loc(pbaru,pbarv,llm,zconvm)
49
50  !
51  !  call scopy(ijp1llm,zconvm,1,zconvmm,1)
52  !  call scopy(ijmllm,pbarv,1,pbarvm,1)
53
54  jjb=jj_begin
55  jje=jj_end
56
57!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
58  do l=1,llm
59    zconvmm(:,jjb:jje,l)=zconvm(:,jjb:jje,l)
60  enddo
61!$OMP END DO NOWAIT
62
63  call groupeun_loc(jjp1,llm,jjb_u,jje_u,jjb,jje,zconvmm)
64
65  jjb=jj_begin-1
66  jje=jj_end
67  if (pole_nord) jjb=jj_begin
68  if (pole_sud)  jje=jj_end-1
69!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
70  do l=1,llm
71    pbarvm(:,jjb:jje,l)=pbarv(:,jjb:jje,l)
72  enddo
73!$OMP END DO NOWAIT
74
75  call groupeun_loc(jjm,llm,jjb_v,jje_v,jjb,jje,pbarvm)
76  !   Champs 3D
77
78  jjb=jj_begin
79  jje=jj_end
80  if (pole_nord) jjb=jj_begin+1
81  if (pole_sud)  jje=jj_end-1
82
83!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
84  do l=1,llm
85     do j=jjb,jje
86        uu=pbaru(iim,j,l)
87        do i=1,iim
88           uu=uu+pbarvm(i,j,l)-pbarvm(i,j-1,l)-zconvmm(i,j,l)
89           pbarum(i,j,l)=uu
90  ! zconvm(i,j,l ) =  xflu(i-1,j,l)-xflu(i,j,l)+
91  !    *                      yflu(i,j,l)-yflu(i,j-1,l)
92        enddo
93        pbarum(iip1,j,l)=pbarum(1,j,l)
94     enddo
95  enddo
96!$OMP END DO NOWAIT
97  !    integration de la convergence de masse de haut  en bas ......
98
99  jjb=jj_begin
100  jje=jj_end
101
102!$OMP BARRIER
103!$OMP MASTER
104  do  l = llm-1,1,-1
105      do j=jjb,jje
106         do i=1,iip1
107            zconvmm(i,j,l)=zconvmm(i,j,l)+zconvmm(i,j,l+1)
108         enddo
109      enddo
110  enddo
111
112  if (.not. pole_sud) then
113    zconvmm(:,jj_end+1,:)=0
114  !ym   wm(:,jj_end+1,:)=0
115  endif
116
117!$OMP END MASTER
118!$OMP BARRIER
119
120  CALL vitvert_loc(zconvmm,wm)
121
122  return
123end subroutine groupe_loc
124
Note: See TracBrowser for help on using the repository browser.