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

Last change on this file since 5282 was 5282, checked in by abarral, 6 hours ago

Turn iniprint.h clesphys.h into modules
Remove unused description.h

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