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

Diff of /trunk/dyn3d/interpre.f

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

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