source: LMDZ5/branches/IPSLCM5A2.1/libf/dyn3d_common/traceurpole.F @ 3482

Last change on this file since 3482 was 2603, checked in by Ehouarn Millour, 8 years ago

Cleanup in the dynamics: turn logic.h into module logic_mod.F90
EM

  • 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: 1.5 KB
Line 
1!
2! $Id: traceurpole.F 2603 2016-07-25 09:31:56Z acozic $
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 "ener.h"
13      include "description.h"
14
15
16c   Arguments
17       integer iq
18       real masse(iip1,jjp1,llm)
19       real q(iip1,jjp1,llm)
20       
21
22c   Locals
23      integer i,j,l
24      real sommemassen(llm)
25      real sommemqn(llm)
26      real sommemasses(llm)
27      real sommemqs(llm)
28      real qpolen(llm),qpoles(llm)
29
30   
31c On impose une seule valeur au pôle Sud j=jjm+1=jjp1       
32      sommemasses=0
33      sommemqs=0
34          do l=1,llm
35             do i=1,iip1         
36                 sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
37                 sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
38             enddo         
39          qpoles(l)=sommemqs(l)/sommemasses(l)
40          enddo
41
42c On impose une seule valeur du traceur au pôle Nord j=1
43      sommemassen=0
44      sommemqn=0 
45         do l=1,llm
46           do i=1,iip1             
47               sommemassen(l)=sommemassen(l)+masse(i,1,l)
48               sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
49           enddo
50           qpolen(l)=sommemqn(l)/sommemassen(l)
51         enddo
52   
53c On force le traceur à prendre cette valeur aux pôles
54        do l=1,llm
55            do i=1,iip1
56               q(i,1,l)=qpolen(l)
57               q(i,jjp1,l)=qpoles(l)
58             enddo
59        enddo
60
61     
62      return
63      end           
Note: See TracBrowser for help on using the repository browser.