/[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 57 by guez, Mon Jan 30 12:54:02 2012 UTC trunk/dyn3d/interpre.f revision 104 by guez, Thu Sep 4 10:05:52 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 conf_gcm_m    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, intent(in)::   pbaru(iip1,jjp1,llm )    REAL, INTENT (IN) :: pbarv(iip1, jjm, llm)
29        real, intent(in)::   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, ij, 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                enddo      END DO
95             enddo    END DO
96        enddo  
97            ! INVERSION DES NIVEAUX
98  c INVERSION DES NIVEAUX    ! le programme ppm3d travaille avec une 3ème coordonnée inversée par
99  c le programme ppm3d travaille avec une 3ème coordonnée inversée par rapport    ! rapport
100  c de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface    ! de celle du LMDZ: z=1<=>niveau max, z=llm+1<=>surface
101  c On passe donc des niveaux du LMDZ à ceux de Lin    ! On passe donc des niveaux du LMDZ à ceux de Lin
102        
103        do l=1,llm+1    DO l = 1, llm + 1
104            apppm(l)=ap(llm+2-l)      apppm(l) = ap(llm+2-l)
105            bpppm(l)=bp(llm+2-l)              bpppm(l) = bp(llm+2-l)
106        enddo    END DO
107        
108        do l=1,llm    DO l = 1, llm
109            do j=1,jjp1      DO j = 1, jjp1
110               do i=1,iim            DO i = 1, iim
111                   unatppm(i,j,l)=unat(i,j,llm-l+1)          unatppm(i, j, l) = unat(i, j, llm-l+1)
112                   vnatppm(i,j,l)=vnat(i,j,llm-l+1)          vnatppm(i, j, l) = vnat(i, j, llm-l+1)
113                   fluxwppm(i,j,l)=fluxw(i,j,llm-l+1)          fluxwppm(i, j, l) = fluxw(i, j, llm-l+1)
114                   qppm(i,j,l)=q(i,j,llm-l+1)                                        qppm(i, j, l) = q(i, j, llm-l+1)
115               enddo        END DO
116            enddo                                      END DO
117        enddo    END DO
118      
119        return    RETURN
120        end  END SUBROUTINE interpre
121    
122    
123    
Legend:
Removed from v.57  
changed lines
  Added in v.104
  ViewVC Help
Powered by ViewVC 1.1.21