source: trunk/LMDZ.COMMON/libf/dyn3d_common/interpre.F @ 3493

Last change on this file since 3493 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

File size: 3.6 KB
RevLine 
[1]1!
2! $Id: interpre.F 1403 2010-07-01 09:02:53Z fairhead $
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 control_mod
[1422]9      USE comvert_mod, ONLY: ap,bp
10      USE comconst_mod, ONLY: g
[1]11
12       implicit none
13
14#include "dimensions.h"
15c#include "paramr2.h"
16#include "paramet.h"
17#include "comdissip.h"
18#include "comgeom2.h"
19
20c---------------------------------------------------
21c Arguments     
22      real   apppm(llm+1),bpppm(llm+1)
23      real   q(iip1,jjp1,llm),qppm(iim,jjp1,llm)
24c---------------------------------------------------
25      real   masse(iip1,jjp1,llm)
26      real   massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)     
[1391]27      real   w(iip1,jjp1,llm)
[1]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)
34c---------------------------------------------------
35c Local
36      real   vnat(iip1,jjp1,llm)
37      real   unat(iip1,jjp1,llm)
38      real   fluxw(iip1,jjp1,llm)
39      real   smass(iip1,jjp1)
40c----------------------------------------------------
41      integer l,ij,i,j
42
43c       CALCUL DE LA PRESSION DE SURFACE
44c       Les coefficients ap et bp sont passés en common
45c       Calcul de la pression au sol en mb optimisée pour
46c       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       
68c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
69c Le programme ppm3d travaille avec les composantes
70c de vitesse et pas les flux, on doit donc passer de l'un à l'autre
71c 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             
88c CALCUL DU FLUX MASSIQUE VERTICAL
89c 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)
95C               print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
96C     c                      'w(i,j,l)=',w(i,j,l)
97              enddo
98           enddo
99      enddo
100     
101c INVERSION DES NIVEAUX
102c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport
103c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
104c 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
123      end
124
125
126
127
128
129
Note: See TracBrowser for help on using the repository browser.