source: LMDZ6/trunk/libf/dyn3dmem/fluxstokenc_p.f90 @ 5308

Last change on this file since 5308 was 5285, checked in by abarral, 4 days ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules

File size: 3.7 KB
Line 
1!
2! $Id: caladvtrac_p.F 1299 2010-01-20 14:27:21Z fairhead $
3!
4!
5!
6      SUBROUTINE fluxstokenc_p(pbaru,pbarv , &
7              masse,  teta, phi)
8  USE tracstoke_mod_h
9  USE parallel_lmdz
10  USE control_mod, ONLY : iapp_tracvl,planet_type,iphysiq
11  USE caladvtrac_mod
12  USE mod_hallo
13  USE bands
14  USE times
15  USE Vampir
16  USE write_field_loc
17
18  !
19  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
20USE paramet_mod_h
21IMPLICIT NONE
22  !
23  ! Auteurs:   F.Hourdin , P.Le Van, F.Forget, F.Codron
24  !
25  !=======================================================================
26  !
27  !   Shema de  Van Leer
28  !
29  !=======================================================================
30
31
32
33
34
35  !   Arguments:
36  !   ----------
37  REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)
38  REAL :: masse(ijb_u:ije_u,llm)
39  REAL :: teta( ijb_u:ije_u,llm)
40  REAL :: phi(ijb_u:ije_u,llm)
41
42  INTEGER,SAVE :: pasflx=0
43!$OMP THREADPRIVATE(pasflx)
44  INTEGER ::  ijb,ije,ijbu,ijbv,ijeu,ijev,j
45  INTEGER :: ij,l
46  TYPE(Request),SAVE :: Request_vanleer
47!$OMP THREADPRIVATE(Request_vanleer)
48
49
50
51  ! !write(*,*) 'caladvtrac 58: entree'
52  ijbu=ij_begin
53  ijeu=ij_end
54
55  ijbv=ij_begin-iip1
56  ijev=ij_end
57  if (pole_nord) ijbv=ij_begin
58  if (pole_sud)  ijev=ij_end-iip1
59
60  IF(pasflx.EQ.0) THEN
61!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
62  DO l=1,llm
63      tetac(ijbu:ijeu,l)=0.
64      phic(ijbu:ijeu,l)=0.
65      pbarucc(ijbu:ijeu,l)=0.
66      pbarvcc(ijbv:ijev,l)=0.
67    ENDDO
68!$OMP END DO NOWAIT
69  ENDIF
70
71  !   accumulation des flux de masse horizontaux
72!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
73  DO l=1,llm
74     DO ij = ijbu,ijeu
75        pbarucc(ij,l) = pbarucc(ij,l) + pbaru(ij,l)
76        tetac(ij,l) = tetac(ij,l) + teta(ij,l)
77        phic(ij,l) = phic(ij,l) + phi(ij,l)
78
79     ENDDO
80     DO ij = ijbv,ijev
81        pbarvcc(ij,l) = pbarvcc(ij,l) + pbarv(ij,l)
82     ENDDO
83  ENDDO
84!$OMP END DO NOWAIT
85
86  !   selection de la masse instantannee des mailles avant le transport.
87  IF(pasflx.EQ.0) THEN
88
89      ijb=ij_begin
90      ije=ij_end
91
92!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
93  DO l=1,llm
94      massec(ijb:ije,l)=masse(ijb:ije,l)
95   ENDDO
96!$OMP END DO NOWAIT
97
98  ENDIF
99
100  pasflx   = pasflx+1
101
102
103  !   Test pour savoir si on advecte a ce pas de temps
104
105  IF ( pasflx.EQ.(iphysiq*istphy) ) THEN
106  ! !write(*,*) 'caladvtrac 133'
107!$OMP MASTER
108  call suspend_timer(timer_caldyn)
109!$OMP END MASTER
110
111  ijb=ij_begin
112  ije=ij_end
113
114
115!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
116  DO l=1,llm
117        pbarucc(ijb:ije,l) = pbarucc(ijb:ije,l)/REAL(iphysiq*istphy)
118        tetac(ijb:ije,l) = tetac(ijb:ije,l)/REAL(iphysiq*istphy)
119        phic(ijb:ije,l) = phic(ijb:ije,l)/REAL(iphysiq*istphy)
120  ENDDO
121!$OMP ENDDO NOWAIT
122
123  if (pole_sud) ije=ij_end-iip1
124
125!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
126  DO l=1,llm
127        pbarvcc(ijb:ije,l) = pbarvcc(ijb:ije,l)/REAL(iphysiq*istphy)
128  ENDDO
129!$OMP ENDDO NOWAIT
130
131
132!$OMP BARRIER
133    call Register_Hallo_u(pbarucc,llm,1,1,1,1,Request_vanleer)
134    call Register_Hallo_v(pbarvcc,llm,1,1,1,1,Request_vanleer)
135    call SendRequest(Request_vanleer)
136!$OMP BARRIER
137    call WaitRequest(Request_vanleer)
138!$OMP BARRIER
139
140
141
142
143  !c   ..  Modif P.Le Van  ( 20/12/97 )  ....
144  !c
145
146  !   traitement des flux de masse avant advection.
147  ! 1. calcul de w
148  ! 2. groupement des mailles pres du pole.
149
150    CALL groupe_loc( massec, pbarucc,pbarvcc, pbarugg,pbarvgg,wgg )
151
152
153
154     ijb=ij_begin
155     ije=ij_end
156
157!$OMP BARRIER
158     CALL WriteField_u('pbarug',pbarugg)
159     CALL WriteField_v('pbarvg',pbarvgg)
160     CALL WriteField_u('wg',wgg)
161     CALL WriteField_u('tetag',tetac)
162     CALL WriteField_u('phig',phic)
163     CALL WriteField_u('masseg',massec)
164
165
166!$OMP MASTER
167    call Set_Distrib(distrib_caldyn)
168    call VTe(VThallo)
169    call resume_timer(timer_caldyn)
170!$OMP END MASTER
171
172
173!$OMP BARRIER
174      pasflx=0
175   ENDIF ! if iadvtr.EQ.iapp_tracvl
176
177END SUBROUTINE fluxstokenc_p
Note: See TracBrowser for help on using the repository browser.