source: LMDZ6/trunk/libf/dyn3d_common/traceurpole.f90 @ 5285

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

As discussed internally, remove generic ONLY: ... for new _mod_h 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
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 1.3 KB
Line 
1!
2! $Id: traceurpole.f90 5285 2024-10-28 13:33:29Z abarral $
3!
4    subroutine traceurpole(q,masse)
5
6      USE comgeom2_mod_h
7  USE comdissip_mod_h
8  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
9USE paramet_mod_h
10implicit none
11
12
13
14  !   Arguments
15   integer :: iq
16   real :: masse(iip1,jjp1,llm)
17   real :: q(iip1,jjp1,llm)
18
19
20  !   Locals
21  integer :: i,j,l
22  real :: sommemassen(llm)
23  real :: sommemqn(llm)
24  real :: sommemasses(llm)
25  real :: sommemqs(llm)
26  real :: qpolen(llm),qpoles(llm)
27
28
29  ! On impose une seule valeur au p�le Sud j=jjm+1=jjp1
30  sommemasses=0
31  sommemqs=0
32      do l=1,llm
33         do i=1,iip1
34             sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
35             sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
36         enddo
37      qpoles(l)=sommemqs(l)/sommemasses(l)
38      enddo
39
40  ! On impose une seule valeur du traceur au p�le Nord j=1
41  sommemassen=0
42  sommemqn=0
43     do l=1,llm
44       do i=1,iip1
45           sommemassen(l)=sommemassen(l)+masse(i,1,l)
46           sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
47       enddo
48       qpolen(l)=sommemqn(l)/sommemassen(l)
49     enddo
50
51  ! On force le traceur � prendre cette valeur aux p�les
52    do l=1,llm
53        do i=1,iip1
54           q(i,1,l)=qpolen(l)
55           q(i,jjp1,l)=qpoles(l)
56         enddo
57    enddo
58
59
60  return
61end subroutine traceurpole
Note: See TracBrowser for help on using the repository browser.