/[lmdze]/trunk/dyn3d/interpre.f
ViewVC logotype

Diff of /trunk/dyn3d/interpre.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/dyn3d/interpre.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/dyn3d/interpre.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 1  Line 1 
1  !  
2  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/interpre.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $  ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/interpre.F,v 1.1.1.1 2004/05/19
3  !  ! 12:53:07 lmdzadmin Exp $
4         subroutine interpre(q,qppm,w,fluxwppm,masse,  
5       s            apppm,bpppm,massebx,masseby,pbaru,pbarv,  SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, apppm, bpppm, massebx, &
6       s            unatppm,vnatppm,psppm)      masseby, pbaru, pbarv, unatppm, vnatppm, psppm)
7    
8         use dimens_m    USE dimens_m
9        use paramet_m    USE paramet_m
10        use comconst    USE comconst
11        use comvert    USE disvert_m
12        use conf_gcm_m    USE conf_gcm_m
13        use logic    USE conf_gcm_m
14        use comgeom    USE comgeom
15        use temps    USE temps
16        use ener    USE ener
17        use comdissip    IMPLICIT NONE
18         implicit none  
19      ! ---------------------------------------------------
20  c---------------------------------------------------    ! Arguments
21  c Arguments        REAL apppm(llm+1), bpppm(llm+1)
22        real   apppm(llm+1),bpppm(llm+1)    REAL q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
23        real   q(iip1,jjp1,llm),qppm(iim,jjp1,llm)    ! ---------------------------------------------------
24  c---------------------------------------------------    REAL masse(iip1, jjp1, llm)
25        real   masse(iip1,jjp1,llm)    REAL massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
26        real   massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)          REAL w(iip1, jjp1, llm+1)
27        real   w(iip1,jjp1,llm+1)    REAL fluxwppm(iim, jjp1, llm)
28        real   fluxwppm(iim,jjp1,llm)    REAL, INTENT (IN) :: pbaru(iip1, jjp1, llm)
29        real   pbaru(iip1,jjp1,llm )    REAL, INTENT (IN) :: pbarv(iip1, jjm, llm)
30        real   pbarv(iip1,jjm,llm)    REAL unatppm(iim, jjp1, llm)
31        real   unatppm(iim,jjp1,llm)    REAL vnatppm(iim, jjp1, llm)
32        real   vnatppm(iim,jjp1,llm)    REAL psppm(iim, jjp1)
33        real   psppm(iim,jjp1)    ! ---------------------------------------------------
34  c---------------------------------------------------    ! Local
35  c Local    REAL vnat(iip1, jjp1, llm)
36        real   vnat(iip1,jjp1,llm)    REAL unat(iip1, jjp1, llm)
37        real   unat(iip1,jjp1,llm)    REAL fluxw(iip1, jjp1, llm)
38        real   fluxw(iip1,jjp1,llm)    REAL smass(iip1, jjp1)
39        real   smass(iip1,jjp1)    ! ----------------------------------------------------
40  c----------------------------------------------------    INTEGER l, ij, i, j
41        integer l,ij,i,j  
42      ! CALCUL DE LA PRESSION DE SURFACE
43  c       CALCUL DE LA PRESSION DE SURFACE    ! Les coefficients ap et bp sont passés en common
44  c       Les coefficients ap et bp sont passés en common    ! Calcul de la pression au sol en mb optimisée pour
45  c       Calcul de la pression au sol en mb optimisée pour    ! la vectorialisation
46  c       la vectorialisation  
47                        DO j = 1, jjp1
48           do j=1,jjp1      DO i = 1, iip1
49               do i=1,iip1        smass(i, j) = 0.
50                  smass(i,j)=0.      END DO
51               enddo    END DO
52           enddo  
53      DO l = 1, llm
54           do l=1,llm      DO j = 1, jjp1
55               do j=1,jjp1        DO i = 1, iip1
56                   do i=1,iip1          smass(i, j) = smass(i, j) + masse(i, j, l)
57                      smass(i,j)=smass(i,j)+masse(i,j,l)        END DO
58                   enddo      END DO
59               enddo    END DO
60           enddo  
61            DO j = 1, jjp1
62           do j=1,jjp1      DO i = 1, iim
63               do i=1,iim        psppm(i, j) = smass(i, j)/aire_2d(i, j)*g*0.01
64                   psppm(i,j)=smass(i,j)/aire_2d(i,j)*g*0.01      END DO
65               end do    END DO
66           end do                          
67            ! RECONSTRUCTION DES CHAMPS CONTRAVARIANTS
68  c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS    ! Le programme ppm3d travaille avec les composantes
69  c Le programme ppm3d travaille avec les composantes    ! de vitesse et pas les flux, on doit donc passer de l'un à l'autre
70  c de vitesse et pas les flux, on doit donc passer de l'un à l'autre    ! Dans le même temps, on fait le changement d'orientation du vent en v
71  c Dans le même temps, on fait le changement d'orientation du vent en v    DO l = 1, llm
72        do l=1,llm      DO j = 1, jjm
73            do j=1,jjm        DO i = 1, iip1
74                do i=1,iip1          vnat(i, j, l) = -pbarv(i, j, l)/masseby(i, j, l)*cv_2d(i, j)
75                    vnat(i,j,l)=-pbarv(i,j,l)/masseby(i,j,l)*cv_2d(i,j)                    END DO
76                enddo      END DO
77            enddo      DO i = 1, iim
78            do  i=1,iim        vnat(i, jjp1, l) = 0.
79            vnat(i,jjp1,l)=0.      END DO
80            enddo      DO j = 1, jjp1
81            do j=1,jjp1        DO i = 1, iip1
82                do i=1,iip1          unat(i, j, l) = pbaru(i, j, l)/massebx(i, j, l)*cu_2d(i, j)
83                    unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu_2d(i,j)        END DO
84                enddo      END DO
85            enddo    END DO
86        enddo  
87                    ! CALCUL DU FLUX MASSIQUE VERTICAL
88  c CALCUL DU FLUX MASSIQUE VERTICAL    ! Flux en l=1 (sol) nul
89  c Flux en l=1 (sol) nul    fluxw = 0.
90        fluxw=0.            DO l = 1, llm
91        do l=1,llm      DO j = 1, jjp1
92             do j=1,jjp1        DO i = 1, iip1
93                do i=1,iip1                        fluxw(i, j, l) = w(i, j, l)*g*0.01/aire_2d(i, j)
94                 fluxw(i,j,l)=w(i,j,l)*g*0.01/aire_2d(i,j)        END DO
95  C               print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),      END DO
96  C     c                      'w(i,j,l)=',w(i,j,l)    END DO
97                enddo  
98             enddo    ! INVERSION DES NIVEAUX
99        enddo    ! le programme ppm3d travaille avec une 3ème coordonnée inversée par
100            ! rapport
101  c INVERSION DES NIVEAUX    ! de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
102  c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport    ! On passe donc des niveaux du LMDZ à ceux de Lin
103  c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface  
104  c On passe donc des niveaux du LMDZ à ceux de Lin    DO l = 1, llm + 1
105            apppm(l) = ap(llm+2-l)
106        do l=1,llm+1      bpppm(l) = bp(llm+2-l)
107            apppm(l)=ap(llm+2-l)    END DO
108            bpppm(l)=bp(llm+2-l)          
109        enddo    DO l = 1, llm
110            DO j = 1, jjp1
111        do l=1,llm        DO i = 1, iim
112            do j=1,jjp1          unatppm(i, j, l) = unat(i, j, llm-l+1)
113               do i=1,iim              vnatppm(i, j, l) = vnat(i, j, llm-l+1)
114                   unatppm(i,j,l)=unat(i,j,llm-l+1)          fluxwppm(i, j, l) = fluxw(i, j, llm-l+1)
115                   vnatppm(i,j,l)=vnat(i,j,llm-l+1)          qppm(i, j, l) = q(i, j, llm-l+1)
116                   fluxwppm(i,j,l)=fluxw(i,j,llm-l+1)        END DO
117                   qppm(i,j,l)=q(i,j,llm-l+1)                                    END DO
118               enddo    END DO
119            enddo                                  
120        enddo    RETURN
121      END SUBROUTINE interpre
       return  
       end  
122    
123    
124    
Legend:
Removed from v.3  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21