source: LMDZ6/branches/blowing_snow/libf/dyn3d_common/traceurpole.F @ 5420

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

Some code tidying: turn ener.h into ener_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 2622 2016-09-04 06:12:02Z fhourdin $
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
15c   Arguments
16       integer iq
17       real masse(iip1,jjp1,llm)
18       real q(iip1,jjp1,llm)
19       
20
21c   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   
30c 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
41c 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   
52c 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           
Note: See TracBrowser for help on using the repository browser.