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

Last change on this file since 5274 was 5272, checked in by abarral, 8 days ago

Turn paramet.h into a module

  • 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.4 KB
RevLine 
[524]1!
[1403]2! $Id: traceurpole.f90 5272 2024-10-24 15:53:15Z abarral $
[524]3!
[5246]4    subroutine traceurpole(q,masse)
[524]5
[5271]6      USE dimensions_mod, ONLY: iim, jjm, llm, ndm
[5272]7USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
8          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
[5271]9implicit none
[524]10
[5271]11
[5272]12
[5246]13  include "comdissip.h"
14  include "comgeom2.h"
15  include "description.h"
[524]16
17
[5246]18  !   Arguments
19   integer :: iq
20   real :: masse(iip1,jjp1,llm)
21   real :: q(iip1,jjp1,llm)
[524]22
23
[5246]24  !   Locals
25  integer :: i,j,l
26  real :: sommemassen(llm)
27  real :: sommemqn(llm)
28  real :: sommemasses(llm)
29  real :: sommemqs(llm)
30  real :: qpolen(llm),qpoles(llm)
31
32
[5271]33  ! On impose une seule valeur au p�le Sud j=jjm+1=jjp1
[5246]34  sommemasses=0
35  sommemqs=0
36      do l=1,llm
37         do i=1,iip1
38             sommemasses(l)=sommemasses(l)+masse(i,jjp1,l)
39             sommemqs(l)=sommemqs(l)+masse(i,jjp1,l)*q(i,jjp1,l)
[524]40         enddo
[5246]41      qpoles(l)=sommemqs(l)/sommemasses(l)
42      enddo
[524]43
[5271]44  ! On impose une seule valeur du traceur au p�le Nord j=1
[5246]45  sommemassen=0
46  sommemqn=0
47     do l=1,llm
48       do i=1,iip1
49           sommemassen(l)=sommemassen(l)+masse(i,1,l)
50           sommemqn(l)=sommemqn(l)+masse(i,1,l)*q(i,1,l)
51       enddo
52       qpolen(l)=sommemqn(l)/sommemassen(l)
53     enddo
54
[5271]55  ! On force le traceur � prendre cette valeur aux p�les
[5246]56    do l=1,llm
57        do i=1,iip1
58           q(i,1,l)=qpolen(l)
59           q(i,jjp1,l)=qpoles(l)
60         enddo
61    enddo
62
63
64  return
65end subroutine traceurpole
Note: See TracBrowser for help on using the repository browser.