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