source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/interpre.f90 @ 5133

Last change on this file since 5133 was 5116, checked in by abarral, 5 months ago

rename modules properly lmdz_*
move ismin, ismax, minmax into new lmdz_libmath.f90
(lint) uppercase fortran keywords

  • 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: 3.1 KB
RevLine 
[1403]1! $Id: interpre.f90 5116 2024-07-24 12:54:37Z abarral $
[5099]2
[5114]3SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, &
4        apppm, bpppm, massebx, masseby, pbaru, pbarv, &
5        unatppm, vnatppm, psppm)
[524]6
[5105]7  USE comconst_mod, ONLY: g
8  USE comvert_mod, ONLY: ap, bp
[5114]9  USE lmdz_description, ONLY: descript
[1403]10
[5114]11  IMPLICIT NONE
[524]12
[5105]13  include "dimensions.h"
14  include "paramet.h"
15  include "comdissip.h"
16  include "comgeom2.h"
[524]17
[5105]18  !---------------------------------------------------
19  ! Arguments
[5116]20  REAL :: apppm(llm + 1), bpppm(llm + 1)
21  REAL :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
[5105]22  !---------------------------------------------------
[5116]23  REAL :: masse(iip1, jjp1, llm)
24  REAL :: massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
25  REAL :: w(iip1, jjp1, llm)
26  REAL :: fluxwppm(iim, jjp1, llm)
27  REAL :: pbaru(iip1, jjp1, llm)
28  REAL :: pbarv(iip1, jjm, llm)
29  REAL :: unatppm(iim, jjp1, llm)
30  REAL :: vnatppm(iim, jjp1, llm)
31  REAL :: psppm(iim, jjp1)
[5105]32  !---------------------------------------------------
33  ! Local
[5116]34  REAL :: vnat(iip1, jjp1, llm)
35  REAL :: unat(iip1, jjp1, llm)
36  REAL :: fluxw(iip1, jjp1, llm)
37  REAL :: smass(iip1, jjp1)
[5105]38  !----------------------------------------------------
[5116]39  INTEGER :: l, ij, i, j
[524]40
[5114]41  ! CALCUL DE LA PRESSION DE SURFACE
42  ! Les coefficients ap et bp sont passés en common
43  ! Calcul de la pression au sol en mb optimisée pour
44  ! la vectorialisation
[5105]45
[5114]46  do j = 1, jjp1
47    do i = 1, iip1
48      smass(i, j) = 0.
49    enddo
50  enddo
[5105]51
[5114]52  do l = 1, llm
53    do j = 1, jjp1
54      do i = 1, iip1
55        smass(i, j) = smass(i, j) + masse(i, j, l)
56      enddo
57    enddo
58  enddo
[524]59
[5114]60  do j = 1, jjp1
61    do i = 1, iim
62      psppm(i, j) = smass(i, j) / aire(i, j) * g * 0.01
63    END DO
64  END DO
[5105]65
66  ! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
67  ! Le programme ppm3d travaille avec les composantes
68  ! de vitesse et pas les flux, on doit donc passer de l'un à l'autre
69  ! Dans le même temps, on fait le changement d'orientation du vent en v
[5114]70  do l = 1, llm
71    do j = 1, jjm
72      do i = 1, iip1
73        vnat(i, j, l) = -pbarv(i, j, l) / masseby(i, j, l) * cv(i, j)
[524]74      enddo
[5114]75    enddo
76    do  i = 1, iim
77      vnat(i, jjp1, l) = 0.
78    enddo
79    do j = 1, jjp1
80      do i = 1, iip1
81        unat(i, j, l) = pbaru(i, j, l) / massebx(i, j, l) * cu(i, j)
[524]82      enddo
[5114]83    enddo
[5105]84  enddo
[524]85
[5105]86  ! CALCUL DU FLUX MASSIQUE VERTICAL
87  ! Flux en l=1 (sol) nul
[5114]88  fluxw = 0.
89  do l = 1, llm
90    do j = 1, jjp1
91      do i = 1, iip1
92        fluxw(i, j, l) = w(i, j, l) * g * 0.01 / aire(i, j)
93        ! PRINT*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
94        ! c                      'w(i,j,l)=',w(i,j,l)
95      enddo
96    enddo
[5105]97  enddo
[524]98
[5105]99  ! INVERSION DES NIVEAUX
100  ! le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport
101  ! de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
102  ! On passe donc des niveaux du LMDZ à ceux de Lin
[524]103
[5114]104  do l = 1, llm + 1
105    apppm(l) = ap(llm + 2 - l)
106    bpppm(l) = bp(llm + 2 - l)
[5105]107  enddo
[524]108
[5114]109  do l = 1, llm
110    do j = 1, jjp1
111      do i = 1, iim
112        unatppm(i, j, l) = unat(i, j, llm - l + 1)
113        vnatppm(i, j, l) = vnat(i, j, llm - l + 1)
114        fluxwppm(i, j, l) = fluxw(i, j, llm - l + 1)
115        qppm(i, j, l) = q(i, j, llm - l + 1)
[5105]116      enddo
[5114]117    enddo
[5105]118  enddo
[524]119
[5116]120  RETURN
121END SUBROUTINE interpre
[524]122
[5105]123
124
125
126
127
Note: See TracBrowser for help on using the repository browser.