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

Last change on this file since 5281 was 5281, checked in by abarral, 3 days ago

Turn comgeom.h comgeom2.h into modules

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