1 |
|
|
! |
2 |
|
|
! $Id: traceurpole.F 2622 2016-09-04 06:12:02Z emillour $ |
3 |
|
|
! |
4 |
|
|
subroutine traceurpole(q,masse) |
5 |
|
|
|
6 |
|
|
implicit none |
7 |
|
|
|
8 |
|
|
include "dimensions.h" |
9 |
|
|
include "paramet.h" |
10 |
|
|
include "comdissip.h" |
11 |
|
|
include "comgeom2.h" |
12 |
|
|
include "description.h" |
13 |
|
|
|
14 |
|
|
|
15 |
|
|
c Arguments |
16 |
|
|
integer iq |
17 |
|
|
real masse(iip1,jjp1,llm) |
18 |
|
|
real q(iip1,jjp1,llm) |
19 |
|
|
|
20 |
|
|
|
21 |
|
|
c Locals |
22 |
|
|
integer i,j,l |
23 |
|
|
real sommemassen(llm) |
24 |
|
|
real sommemqn(llm) |
25 |
|
|
real sommemasses(llm) |
26 |
|
|
real sommemqs(llm) |
27 |
|
|
real qpolen(llm),qpoles(llm) |
28 |
|
|
|
29 |
|
|
|
30 |
|
|
c On impose une seule valeur au p�le Sud j=jjm+1=jjp1 |
31 |
|
|
sommemasses=0 |
32 |
|
|
sommemqs=0 |
33 |
|
|
do l=1,llm |
34 |
|
|
do i=1,iip1 |
35 |
|
|
sommemasses(l)=sommemasses(l)+masse(i,jjp1,l) |
36 |
|
|
sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l) |
37 |
|
|
enddo |
38 |
|
|
qpoles(l)=sommemqs(l)/sommemasses(l) |
39 |
|
|
enddo |
40 |
|
|
|
41 |
|
|
c On impose une seule valeur du traceur au p�le Nord j=1 |
42 |
|
|
sommemassen=0 |
43 |
|
|
sommemqn=0 |
44 |
|
|
do l=1,llm |
45 |
|
|
do i=1,iip1 |
46 |
|
|
sommemassen(l)=sommemassen(l)+masse(i,1,l) |
47 |
|
|
sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l) |
48 |
|
|
enddo |
49 |
|
|
qpolen(l)=sommemqn(l)/sommemassen(l) |
50 |
|
|
enddo |
51 |
|
|
|
52 |
|
|
c On force le traceur � prendre cette valeur aux p�les |
53 |
|
|
do l=1,llm |
54 |
|
|
do i=1,iip1 |
55 |
|
|
q(i,1,l)=qpolen(l) |
56 |
|
|
q(i,jjp1,l)=qpoles(l) |
57 |
|
|
enddo |
58 |
|
|
enddo |
59 |
|
|
|
60 |
|
|
|
61 |
|
|
return |
62 |
|
|
end |