/[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 32 by guez, Tue Apr 6 17:52:58 2010 UTC trunk/dyn3d/interpre.f revision 108 by guez, Tue Sep 16 14:00:41 2014 UTC
# Line 1  Line 1 
1  !  module interpre_m
 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/interpre.F,v 1.1.1.1 2004/05/19 12:53:07 lmdzadmin Exp $  
 !  
        subroutine interpre(q,qppm,w,fluxwppm,masse,  
      s            apppm,bpppm,massebx,masseby,pbaru,pbarv,  
      s            unatppm,vnatppm,psppm)  
   
        use dimens_m  
       use paramet_m  
       use comconst  
       use comvert  
       use conf_gcm_m  
       use logic  
       use comgeom  
       use temps  
       use ener  
        implicit none  
   
 c---------------------------------------------------  
 c Arguments      
       real   apppm(llm+1),bpppm(llm+1)  
       real   q(iip1,jjp1,llm),qppm(iim,jjp1,llm)  
 c---------------------------------------------------  
       real   masse(iip1,jjp1,llm)  
       real   massebx(iip1,jjp1,llm),masseby(iip1,jjm,llm)        
       real   w(iip1,jjp1,llm+1)  
       real   fluxwppm(iim,jjp1,llm)  
       real, intent(in)::   pbaru(iip1,jjp1,llm )  
       real, intent(in)::   pbarv(iip1,jjm,llm)  
       real   unatppm(iim,jjp1,llm)  
       real   vnatppm(iim,jjp1,llm)  
       real   psppm(iim,jjp1)  
 c---------------------------------------------------  
 c Local  
       real   vnat(iip1,jjp1,llm)  
       real   unat(iip1,jjp1,llm)  
       real   fluxw(iip1,jjp1,llm)  
       real   smass(iip1,jjp1)  
 c----------------------------------------------------  
       integer l,ij,i,j  
   
 c       CALCUL DE LA PRESSION DE SURFACE  
 c       Les coefficients ap et bp sont passés en common  
 c       Calcul de la pression au sol en mb optimisée pour  
 c       la vectorialisation  
                     
          do j=1,jjp1  
              do i=1,iip1  
                 smass(i,j)=0.  
              enddo  
          enddo  
   
          do l=1,llm  
              do j=1,jjp1  
                  do i=1,iip1  
                     smass(i,j)=smass(i,j)+masse(i,j,l)  
                  enddo  
              enddo  
          enddo  
         
          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                          
         
 c RECONSTRUCTION DES CHAMPS CONTRAVARIANTS  
 c Le programme ppm3d travaille avec les composantes  
 c de vitesse et pas les flux, on doit donc passer de l'un à l'autre  
 c 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)              
               enddo  
           enddo  
           do  i=1,iim  
           vnat(i,jjp1,l)=0.  
           enddo  
           do j=1,jjp1  
               do i=1,iip1  
                   unat(i,j,l)=pbaru(i,j,l)/massebx(i,j,l)*cu_2d(i,j)  
               enddo  
           enddo  
       enddo  
                 
 c CALCUL DU FLUX MASSIQUE VERTICAL  
 c 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)  
               enddo  
            enddo  
       enddo  
         
 c INVERSION DES NIVEAUX  
 c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport  
 c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface  
 c 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)          
       enddo  
       
       do l=1,llm  
           do j=1,jjp1  
              do i=1,iim      
                  unatppm(i,j,l)=unat(i,j,llm-l+1)  
                  vnatppm(i,j,l)=vnat(i,j,llm-l+1)  
                  fluxwppm(i,j,l)=fluxw(i,j,llm-l+1)  
                  qppm(i,j,l)=q(i,j,llm-l+1)                                
              enddo  
           enddo                                  
       enddo  
     
       return  
       end  
2    
3      IMPLICIT NONE
4    
5    contains
6    
7      SUBROUTINE interpre(q, qppm, w, fluxwppm, masse, apppm, bpppm, massebx, &
8           masseby, pbaru, pbarv, unatppm, vnatppm, psppm)
9    
10        ! From LMDZ4/libf/dyn3d/interpre.F,v 1.1.1.1 2004/05/19 12:53:07
11    
12        USE dimens_m
13        USE paramet_m
14        USE comconst
15        USE disvert_m
16        USE conf_gcm_m
17        USE conf_gcm_m
18        USE comgeom
19        USE temps
20    
21        ! ---------------------------------------------------
22        ! Arguments
23        REAL apppm(llm+1), bpppm(llm+1)
24        REAL q(iip1, jjp1, llm), qppm(iim, jjp1, llm)
25        ! ---------------------------------------------------
26        REAL masse(iip1, jjp1, llm)
27        REAL massebx(iip1, jjp1, llm), masseby(iip1, jjm, llm)
28        REAL w(iip1, jjp1, llm)
29        REAL fluxwppm(iim, jjp1, llm)
30        REAL, INTENT (IN) :: pbaru(iip1, jjp1, llm)
31        REAL, INTENT (IN) :: pbarv(iip1, jjm, llm)
32        REAL unatppm(iim, jjp1, llm)
33        REAL vnatppm(iim, jjp1, llm)
34        REAL psppm(iim, jjp1)
35        ! ---------------------------------------------------
36        ! Local
37        REAL vnat(iip1, jjp1, llm)
38        REAL unat(iip1, jjp1, llm)
39        REAL fluxw(iip1, jjp1, llm)
40        REAL smass(iip1, jjp1)
41        ! ----------------------------------------------------
42        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    
49        DO j = 1, jjp1
50           DO i = 1, iip1
51              smass(i, j) = 0.
52           END DO
53        END DO
54    
55        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
62    
63        DO j = 1, jjp1
64           DO i = 1, iim
65              psppm(i, j) = smass(i, j)/aire_2d(i, j)*g*0.01
66           END DO
67        END DO
68    
69        ! 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
121    
122      END SUBROUTINE interpre
123    
124    end module interpre_m

Legend:
Removed from v.32  
changed lines
  Added in v.108

  ViewVC Help
Powered by ViewVC 1.1.21