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