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

Last change on this file since 5185 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules

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