[1403] | 1 | ! $Id: interpre.f90 5195 2024-09-16 13:18:00Z abarral $ |
---|
[5099] | 2 | |
---|
[5114] | 3 | SUBROUTINE 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 |
---|
[5134] | 9 | USE lmdz_comdissip, ONLY: coefdis, tetavel, tetatemp, gamdissip, niterdis |
---|
[5136] | 10 | USE lmdz_comgeom2 |
---|
[1403] | 11 | |
---|
[5159] | 12 | USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm |
---|
| 13 | USE lmdz_paramet |
---|
[5114] | 14 | IMPLICIT NONE |
---|
[524] | 15 | |
---|
| 16 | |
---|
[5159] | 17 | |
---|
| 18 | |
---|
[5105] | 19 | !--------------------------------------------------- |
---|
| 20 | ! Arguments |
---|
[5116] | 21 | REAL :: apppm(llm + 1), bpppm(llm + 1) |
---|
| 22 | REAL :: q(iip1, jjp1, llm), qppm(iim, jjp1, llm) |
---|
[5105] | 23 | !--------------------------------------------------- |
---|
[5116] | 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) |
---|
[5105] | 33 | !--------------------------------------------------- |
---|
| 34 | ! Local |
---|
[5116] | 35 | REAL :: vnat(iip1, jjp1, llm) |
---|
| 36 | REAL :: unat(iip1, jjp1, llm) |
---|
| 37 | REAL :: fluxw(iip1, jjp1, llm) |
---|
| 38 | REAL :: smass(iip1, jjp1) |
---|
[5105] | 39 | !---------------------------------------------------- |
---|
[5116] | 40 | INTEGER :: l, ij, i, j |
---|
[524] | 41 | |
---|
[5114] | 42 | ! CALCUL DE LA PRESSION DE SURFACE |
---|
| 43 | ! Calcul de la pression au sol en mb optimisée pour |
---|
| 44 | ! la vectorialisation |
---|
[5105] | 45 | |
---|
[5158] | 46 | DO j = 1, jjp1 |
---|
| 47 | DO i = 1, iip1 |
---|
[5114] | 48 | smass(i, j) = 0. |
---|
| 49 | enddo |
---|
| 50 | enddo |
---|
[5105] | 51 | |
---|
[5158] | 52 | DO l = 1, llm |
---|
| 53 | DO j = 1, jjp1 |
---|
| 54 | DO i = 1, iip1 |
---|
[5114] | 55 | smass(i, j) = smass(i, j) + masse(i, j, l) |
---|
| 56 | enddo |
---|
| 57 | enddo |
---|
| 58 | enddo |
---|
[524] | 59 | |
---|
[5158] | 60 | DO j = 1, jjp1 |
---|
| 61 | DO i = 1, iim |
---|
[5114] | 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 |
---|
[5158] | 70 | DO l = 1, llm |
---|
| 71 | DO j = 1, jjm |
---|
| 72 | DO i = 1, iip1 |
---|
[5114] | 73 | vnat(i, j, l) = -pbarv(i, j, l) / masseby(i, j, l) * cv(i, j) |
---|
[524] | 74 | enddo |
---|
[5114] | 75 | enddo |
---|
[5158] | 76 | DO i = 1, iim |
---|
[5114] | 77 | vnat(i, jjp1, l) = 0. |
---|
| 78 | enddo |
---|
[5158] | 79 | DO j = 1, jjp1 |
---|
| 80 | DO i = 1, iip1 |
---|
[5114] | 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. |
---|
[5158] | 89 | DO l = 1, llm |
---|
| 90 | DO j = 1, jjp1 |
---|
| 91 | DO i = 1, iip1 |
---|
[5114] | 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 | |
---|
[5158] | 104 | DO l = 1, llm + 1 |
---|
[5114] | 105 | apppm(l) = ap(llm + 2 - l) |
---|
| 106 | bpppm(l) = bp(llm + 2 - l) |
---|
[5105] | 107 | enddo |
---|
[524] | 108 | |
---|
[5158] | 109 | DO l = 1, llm |
---|
| 110 | DO j = 1, jjp1 |
---|
| 111 | DO i = 1, iim |
---|
[5114] | 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 |
---|
| 121 | END SUBROUTINE interpre |
---|
[524] | 122 | |
---|
[5105] | 123 | |
---|
| 124 | |
---|
| 125 | |
---|
| 126 | |
---|
| 127 | |
---|