1 | ! $Id: interpre.f90 5116 2024-07-24 12:54:37Z abarral $ |
---|
2 | |
---|
3 | SUBROUTINE 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 | |
---|
11 | IMPLICIT NONE |
---|
12 | |
---|
13 | include "dimensions.h" |
---|
14 | include "paramet.h" |
---|
15 | include "comdissip.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 |
---|
121 | END SUBROUTINE interpre |
---|
122 | |
---|
123 | |
---|
124 | |
---|
125 | |
---|
126 | |
---|
127 | |
---|