source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/traceurpole.f90 @ 5185

Last change on this file since 5185 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into 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
RevLine 
[1403]1! $Id: traceurpole.f90 5159 2024-08-02 19:58:25Z abarral $
[5099]2
[5114]3SUBROUTINE traceurpole(q, masse)
4  USE lmdz_description, ONLY: descript
[5134]5  USE lmdz_comdissip, ONLY: coefdis, tetavel, tetatemp, gamdissip, niterdis
[5136]6  USE lmdz_comgeom2
[5134]7
[5159]8USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
9  USE lmdz_paramet
[5114]10  IMPLICIT NONE
[524]11
12
13
[5159]14
15
[5105]16  !   Arguments
[5116]17  INTEGER :: iq
18  REAL :: masse(iip1, jjp1, llm)
19  REAL :: q(iip1, jjp1, llm)
[524]20
21
[5105]22  !   Locals
[5116]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)
[5105]29
30
31  ! On impose une seule valeur au pôle Sud j=jjm+1=jjp1
[5114]32  sommemasses = 0
33  sommemqs = 0
[5158]34  DO l = 1, llm
35    DO i = 1, iip1
[5114]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
[524]41
[5105]42  ! On impose une seule valeur du traceur au pôle Nord j=1
[5114]43  sommemassen = 0
44  sommemqn = 0
[5158]45  DO l = 1, llm
46    DO i = 1, iip1
[5114]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
[5105]52
53  ! On force le traceur à prendre cette valeur aux pôles
[5158]54  DO l = 1, llm
55    DO i = 1, iip1
[5114]56      q(i, 1, l) = qpolen(l)
57      q(i, jjp1, l) = qpoles(l)
[5105]58    enddo
[5114]59  enddo
[5105]60
[5116]61  RETURN
62END SUBROUTINE traceurpole
Note: See TracBrowser for help on using the repository browser.