source: LMDZ6/trunk/libf/dyn3d_common/interpre.f90 @ 5272

Last change on this file since 5272 was 5272, checked in by abarral, 23 hours ago

Turn paramet.h into a module

  • 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!
2! $Id: interpre.f90 5272 2024-10-24 15:53:15Z abarral $
3!
4 subroutine interpre(q,qppm,w,fluxwppm,masse, &
5         apppm,bpppm,massebx,masseby,pbaru,pbarv, &
6         unatppm,vnatppm,psppm)
7
8  USE comconst_mod, ONLY: g
9  USE comvert_mod, ONLY: ap, bp
10
11   USE dimensions_mod, ONLY: iim, jjm, llm, ndm
12USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
13          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
14implicit none
15
16
17
18  include "comdissip.h"
19  include "comgeom2.h"
20  include "description.h"
21
22  !---------------------------------------------------
23  ! Arguments
24  real :: apppm(llm+1),bpppm(llm+1)
25  real :: q(iip1,jjp1,llm),qppm(iim,jjp1,llm)
26  !---------------------------------------------------
27  real :: masse(iip1,jjp1,llm)
28  real :: massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)
29  real :: w(iip1,jjp1,llm)
30  real :: fluxwppm(iim,jjp1,llm)
31  real :: pbaru(iip1,jjp1,llm )
32  real :: pbarv(iip1,jjm,llm)
33  real :: unatppm(iim,jjp1,llm)
34  real :: vnatppm(iim,jjp1,llm)
35  real :: psppm(iim,jjp1)
36  !---------------------------------------------------
37  ! Local
38  real :: vnat(iip1,jjp1,llm)
39  real :: unat(iip1,jjp1,llm)
40  real :: fluxw(iip1,jjp1,llm)
41  real :: smass(iip1,jjp1)
42  !----------------------------------------------------
43  integer :: l,ij,i,j
44
45    ! CALCUL DE LA PRESSION DE SURFACE
46    ! Les coefficients ap et bp sont pass�s en common
47    ! Calcul de la pression au sol en mb optimis�e pour
48    ! la vectorialisation
49
50     do j=1,jjp1
51         do i=1,iip1
52            smass(i,j)=0.
53         enddo
54     enddo
55
56     do l=1,llm
57         do j=1,jjp1
58             do i=1,iip1
59                smass(i,j)=smass(i,j)+masse(i,j,l)
60             enddo
61         enddo
62     enddo
63
64     do j=1,jjp1
65         do i=1,iim
66             psppm(i,j)=smass(i,j)/aire(i,j)*g*0.01
67         end do
68     end do
69
70  ! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
71  ! Le programme ppm3d travaille avec les composantes
72  ! de vitesse et pas les flux, on doit donc passer de l'un � l'autre
73  ! Dans le m�me temps, on fait le changement d'orientation du vent en v
74  do l=1,llm
75      do j=1,jjm
76          do i=1,iip1
77              vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)
78          enddo
79      enddo
80      do  i=1,iim
81      vnat(i,jjp1,l)=0.
82      enddo
83      do j=1,jjp1
84          do i=1,iip1
85              unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j)
86          enddo
87      enddo
88  enddo
89
90  ! CALCUL DU FLUX MASSIQUE VERTICAL
91  ! Flux en l=1 (sol) nul
92  fluxw=0.
93  do l=1,llm
94       do j=1,jjp1
95          do i=1,iip1
96           fluxw(i,j,l)=w(i,j,l)*g*0.01/aire(i,j)
97            ! print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
98  ! c                      'w(i,j,l)=',w(i,j,l)
99          enddo
100       enddo
101  enddo
102
103  ! INVERSION DES NIVEAUX
104  ! le programme ppm3d travaille avec une 3�me coordonn�e invers�e par rapport
105  ! de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
106  ! On passe donc des niveaux du LMDZ � ceux de Lin
107
108  do l=1,llm+1
109      apppm(l)=ap(llm+2-l)
110      bpppm(l)=bp(llm+2-l)
111  enddo
112
113  do l=1,llm
114      do j=1,jjp1
115         do i=1,iim
116             unatppm(i,j,l)=unat(i,j,llm-l+1)
117             vnatppm(i,j,l)=vnat(i,j,llm-l+1)
118             fluxwppm(i,j,l)=fluxw(i,j,llm-l+1)
119             qppm(i,j,l)=q(i,j,llm-l+1)
120         enddo
121      enddo
122  enddo
123
124  return
125end subroutine interpre
126
127
128
129
130
131
Note: See TracBrowser for help on using the repository browser.