source: LMDZ5/branches/testing/libf/dyn3d_common/interpre.F @ 2854

Last change on this file since 2854 was 2641, checked in by Laurent Fairhead, 8 years ago

Merged trunk changes r2593:2640 into testing branch

  • 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.5 KB
RevLine 
[524]1!
[1403]2! $Id: interpre.F 2641 2016-09-29 21:26:46Z oboucher $
[524]3!
4       subroutine interpre(q,qppm,w,fluxwppm,masse,
5     s            apppm,bpppm,massebx,masseby,pbaru,pbarv,
6     s            unatppm,vnatppm,psppm)
7
[2641]8      USE comconst_mod, ONLY: g
9      USE comvert_mod, ONLY: ap, bp
[1403]10
[524]11       implicit none
12
[2641]13      include "dimensions.h"
14      include "paramet.h"
15      include "comdissip.h"
16      include "comgeom2.h"
17      include "description.h"
[524]18
19c---------------------------------------------------
20c Arguments     
21      real   apppm(llm+1),bpppm(llm+1)
22      real   q(iip1,jjp1,llm),qppm(iim,jjp1,llm)
23c---------------------------------------------------
24      real   masse(iip1,jjp1,llm)
25      real   massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)     
[2160]26      real   w(iip1,jjp1,llm)
[524]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)
33c---------------------------------------------------
34c Local
35      real   vnat(iip1,jjp1,llm)
36      real   unat(iip1,jjp1,llm)
37      real   fluxw(iip1,jjp1,llm)
38      real   smass(iip1,jjp1)
39c----------------------------------------------------
40      integer l,ij,i,j
41
42c       CALCUL DE LA PRESSION DE SURFACE
43c       Les coefficients ap et bp sont passés en common
44c       Calcul de la pression au sol en mb optimisée pour
45c       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       
67c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
68c Le programme ppm3d travaille avec les composantes
69c de vitesse et pas les flux, on doit donc passer de l'un à l'autre
70c 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
[2641]74                  vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv(i,j)
[524]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             
87c CALCUL DU FLUX MASSIQUE VERTICAL
88c 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)
94C               print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
95C     c                      'w(i,j,l)=',w(i,j,l)
96              enddo
97           enddo
98      enddo
99     
100c INVERSION DES NIVEAUX
101c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport
102c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
103c 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)
[2641]116                 qppm(i,j,l)=q(i,j,llm-l+1)
[524]117             enddo
118          enddo                               
119      enddo
120   
121      return
122      end
123
124
125
126
127
128
Note: See TracBrowser for help on using the repository browser.