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

Last change on this file since 5134 was 5134, checked in by abarral, 4 months ago

Replace academic.h, alpale.h, comdissip.h, comdissipn.h, comdissnew.h by modules
Remove unused clesph0.h

  • 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.2 KB
Line 
1! $Id: interpre.f90 5134 2024-07-26 15:56:37Z abarral $
2
3SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, &
4        apppm, bpppm, massebx, masseby, pbaru, pbarv, &
5        unatppm, vnatppm, psppm)
6
7  USE comconst_mod, ONLY: g
8  USE comvert_mod, ONLY: ap, bp
9  USE lmdz_description, ONLY: descript
10  USE lmdz_comdissip, ONLY: coefdis, tetavel, tetatemp, gamdissip, niterdis
11
12  IMPLICIT NONE
13
14  INCLUDE "dimensions.h"
15  INCLUDE "paramet.h"
16  INCLUDE "comgeom2.h"
17
18  !---------------------------------------------------
19  ! Arguments
20  REAL :: apppm(llm + 1), bpppm(llm + 1)
21  REAL :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
22  !---------------------------------------------------
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)
32  !---------------------------------------------------
33  ! Local
34  REAL :: vnat(iip1, jjp1, llm)
35  REAL :: unat(iip1, jjp1, llm)
36  REAL :: fluxw(iip1, jjp1, llm)
37  REAL :: smass(iip1, jjp1)
38  !----------------------------------------------------
39  INTEGER :: l, ij, i, j
40
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
45
46  do j = 1, jjp1
47    do i = 1, iip1
48      smass(i, j) = 0.
49    enddo
50  enddo
51
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
59
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
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
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)
74      enddo
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)
82      enddo
83    enddo
84  enddo
85
86  ! CALCUL DU FLUX MASSIQUE VERTICAL
87  ! Flux en l=1 (sol) nul
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
97  enddo
98
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
103
104  do l = 1, llm + 1
105    apppm(l) = ap(llm + 2 - l)
106    bpppm(l) = bp(llm + 2 - l)
107  enddo
108
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)
116      enddo
117    enddo
118  enddo
119
120  RETURN
121END SUBROUTINE interpre
122
123
124
125
126
127
Note: See TracBrowser for help on using the repository browser.