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

Last change on this file since 5254 was 5246, checked in by abarral, 30 hours ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • 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
RevLine 
[524]1!
[1403]2! $Id: traceurpole.f90 5246 2024-10-21 12:58:45Z abarral $
[524]3!
[5246]4    subroutine traceurpole(q,masse)
[524]5
[5246]6      implicit none
[524]7
[5246]8  include "dimensions.h"
9  include "paramet.h"
10  include "comdissip.h"
11  include "comgeom2.h"
12  include "description.h"
[524]13
14
[5246]15  !   Arguments
16   integer :: iq
17   real :: masse(iip1,jjp1,llm)
18   real :: q(iip1,jjp1,llm)
[524]19
20
[5246]21  !   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  ! 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)
[524]37         enddo
[5246]38      qpoles(l)=sommemqs(l)/sommemasses(l)
39      enddo
[524]40
[5246]41  ! 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  ! 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
62end subroutine traceurpole
Note: See TracBrowser for help on using the repository browser.