GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d_common/interpre.F Lines: 0 36 0.0 %
Date: 2023-06-30 12:56:34 Branches: 0 40 0.0 %

Line Branch Exec Source
1
!
2
! $Id: interpre.F 2622 2016-09-04 06:12:02Z emillour $
3
!
4
       subroutine interpre(q,qppm,w,fluxwppm,masse,
5
     s            apppm,bpppm,massebx,masseby,pbaru,pbarv,
6
     s            unatppm,vnatppm,psppm)
7
8
      USE comconst_mod, ONLY: g
9
      USE comvert_mod, ONLY: ap, bp
10
11
       implicit none
12
13
      include "dimensions.h"
14
      include "paramet.h"
15
      include "comdissip.h"
16
      include "comgeom2.h"
17
      include "description.h"
18
19
c---------------------------------------------------
20
c Arguments
21
      real   apppm(llm+1),bpppm(llm+1)
22
      real   q(iip1,jjp1,llm),qppm(iim,jjp1,llm)
23
c---------------------------------------------------
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
c---------------------------------------------------
34
c 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
c----------------------------------------------------
40
      integer l,ij,i,j
41
42
c       CALCUL DE LA PRESSION DE SURFACE
43
c       Les coefficients ap et bp sont pass�s en common
44
c       Calcul de la pression au sol en mb optimis�e pour
45
c       la vectorialisation
46
47
         do j=1,jjp1
48
             do i=1,iip1
49
                smass(i,j)=0.
50
             enddo
51
         enddo
52
53
         do l=1,llm
54
             do j=1,jjp1
55
                 do i=1,iip1
56
                    smass(i,j)=smass(i,j)+masse(i,j,l)
57
                 enddo
58
             enddo
59
         enddo
60
61
         do j=1,jjp1
62
             do i=1,iim
63
                 psppm(i,j)=smass(i,j)/aire(i,j)*g*0.01
64
             end do
65
         end do
66
67
c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
68
c Le programme ppm3d travaille avec les composantes
69
c de vitesse et pas les flux, on doit donc passer de l'un � l'autre
70
c Dans le m�me temps, on fait le changement d'orientation du vent en v
71
      do l=1,llm
72
          do j=1,jjm
73
              do i=1,iip1
74
                  vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)
75
              enddo
76
          enddo
77
          do  i=1,iim
78
          vnat(i,jjp1,l)=0.
79
          enddo
80
          do j=1,jjp1
81
              do i=1,iip1
82
                  unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu(i,j)
83
              enddo
84
          enddo
85
      enddo
86
87
c CALCUL DU FLUX MASSIQUE VERTICAL
88
c Flux en l=1 (sol) nul
89
      fluxw=0.
90
      do l=1,llm
91
           do j=1,jjp1
92
              do i=1,iip1
93
               fluxw(i,j,l)=w(i,j,l)*g*0.01/aire(i,j)
94
C               print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
95
C     c                      'w(i,j,l)=',w(i,j,l)
96
              enddo
97
           enddo
98
      enddo
99
100
c INVERSION DES NIVEAUX
101
c le programme ppm3d travaille avec une 3�me coordonn�e invers�e par rapport
102
c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
103
c On passe donc des niveaux du LMDZ � ceux de Lin
104
105
      do l=1,llm+1
106
          apppm(l)=ap(llm+2-l)
107
          bpppm(l)=bp(llm+2-l)
108
      enddo
109
110
      do l=1,llm
111
          do j=1,jjp1
112
             do i=1,iim
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)
117
             enddo
118
          enddo
119
      enddo
120
121
      return
122
      end
123
124
125
126
127
128