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

Last change on this file was 5195, checked in by abarral, 2 months ago

Correct r5192, some lmdz_description cases were missing

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