| 1 | ! $Id: interpre.f90 5195 2024-09-16 13:18:00Z 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_comdissip, ONLY: coefdis, tetavel, tetatemp, gamdissip, niterdis |
|---|
| 10 | USE lmdz_comgeom2 |
|---|
| 11 | |
|---|
| 12 | USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm |
|---|
| 13 | USE lmdz_paramet |
|---|
| 14 | IMPLICIT NONE |
|---|
| 15 | |
|---|
| 16 | |
|---|
| 17 | |
|---|
| 18 | |
|---|
| 19 | !--------------------------------------------------- |
|---|
| 20 | ! Arguments |
|---|
| 21 | REAL :: apppm(llm + 1), bpppm(llm + 1) |
|---|
| 22 | REAL :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm) |
|---|
| 23 | !--------------------------------------------------- |
|---|
| 24 | REAL :: masse(iip1, jjp1, llm) |
|---|
| 25 | REAL :: massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm) |
|---|
| 26 | REAL :: w(iip1, jjp1, llm) |
|---|
| 27 | REAL :: fluxwppm(iim, jjp1, llm) |
|---|
| 28 | REAL :: pbaru(iip1, jjp1, llm) |
|---|
| 29 | REAL :: pbarv(iip1, jjm, llm) |
|---|
| 30 | REAL :: unatppm(iim, jjp1, llm) |
|---|
| 31 | REAL :: vnatppm(iim, jjp1, llm) |
|---|
| 32 | REAL :: psppm(iim, jjp1) |
|---|
| 33 | !--------------------------------------------------- |
|---|
| 34 | ! Local |
|---|
| 35 | REAL :: vnat(iip1, jjp1, llm) |
|---|
| 36 | REAL :: unat(iip1, jjp1, llm) |
|---|
| 37 | REAL :: fluxw(iip1, jjp1, llm) |
|---|
| 38 | REAL :: smass(iip1, jjp1) |
|---|
| 39 | !---------------------------------------------------- |
|---|
| 40 | INTEGER :: l, ij, i, j |
|---|
| 41 | |
|---|
| 42 | ! CALCUL DE LA PRESSION DE SURFACE |
|---|
| 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 | |
|---|