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

Diff of /trunk/dyn3d/integrd.f

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

trunk/libf/dyn3d/integrd.f90 revision 47 by guez, Fri Jul 1 15:00:48 2011 UTC trunk/dyn3d/integrd.f revision 91 by guez, Wed Mar 26 17:18:58 2014 UTC
# Line 4  module integrd_m Line 4  module integrd_m
4    
5  contains  contains
6    
7    SUBROUTINE integrd(vcovm1, ucovm1, tetam1, psm1, massem1, dv, dudyn, &    SUBROUTINE integrd(vcovm1, ucovm1, tetam1, psm1, massem1, dv, dudyn, dteta, &
8         dteta, dp, vcov, ucov, teta, q, ps, masse, finvmaold, dt, leapf)         dp, vcov, ucov, teta, q, ps, masse, finvmaold, dt, leapf)
9    
10      ! From dyn3d/integrd.F, version 1.1.1.1 2004/05/19 12:53:05      ! From dyn3d/integrd.F, version 1.1.1.1, 2004/05/19 12:53:05
11      ! Author: P. Le Van      ! Author: P. Le Van
12      ! Objet: incrémentation des tendances dynamiques      ! Objet: incrémentation des tendances dynamiques
13    
     USE comvert, ONLY : ap, bp  
14      USE comgeom, ONLY : aire, apoln, apols      USE comgeom, ONLY : aire, apoln, apols
15      USE dimens_m, ONLY : iim, jjm, llm      USE dimens_m, ONLY : iim, jjm, llm
16        USE disvert_m, ONLY : ap, bp
17      USE filtreg_m, ONLY : filtreg      USE filtreg_m, ONLY : filtreg
18        use massdair_m, only: massdair
19      use nr_util, only: assert      use nr_util, only: assert
20      USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1, jjp1, llmp1      USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1, jjp1, llmp1
21        use qminimum_m, only: qminimum
22    
23      ! Arguments:      REAL vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)
24        REAL, intent(inout):: tetam1((iim + 1) * (jjm + 1), llm)
25      REAL vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)      REAL, intent(inout):: psm1((iim + 1) * (jjm + 1))
26        real massem1((iim + 1) * (jjm + 1), llm)
27        REAL, intent(in):: dv(ip1jm, llm), dudyn((iim + 1) * (jjm + 1), llm)
28        REAL dteta((iim + 1) * (jjm + 1), llm), dp((iim + 1) * (jjm + 1))
29        REAL, intent(inout):: vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)
30      real, intent(inout):: teta((iim + 1) * (jjm + 1), llm)      real, intent(inout):: teta((iim + 1) * (jjm + 1), llm)
31      REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)      REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)
32      REAL, intent(inout):: ps((iim + 1) * (jjm + 1))      REAL, intent(inout):: ps((iim + 1) * (jjm + 1))
33      REAL masse((iim + 1) * (jjm + 1), llm)      REAL masse((iim + 1) * (jjm + 1), llm)
   
     REAL vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)  
     REAL tetam1((iim + 1) * (jjm + 1), llm), psm1((iim + 1) * (jjm + 1))  
     real massem1((iim + 1) * (jjm + 1), llm)  
   
     REAL dv(ip1jm, llm), dudyn((iim + 1) * (jjm + 1), llm)  
     REAL dteta((iim + 1) * (jjm + 1), llm), dp((iim + 1) * (jjm + 1))  
34      REAL finvmaold((iim + 1) * (jjm + 1), llm)      REAL finvmaold((iim + 1) * (jjm + 1), llm)
35        real, intent(in):: dt ! time step, in s
36      LOGICAL, INTENT (IN) :: leapf      LOGICAL, INTENT (IN) :: leapf
     real, intent(in):: dt  
   
     ! Local variables:  
37    
38        ! Local:
39      INTEGER nq      INTEGER nq
40      REAL vscr(ip1jm), uscr((iim + 1) * (jjm + 1)), hscr((iim + 1) * (jjm + 1))      REAL vscr(ip1jm), uscr((iim + 1) * (jjm + 1)), hscr((iim + 1) * (jjm + 1))
41      real pscr((iim + 1) * (jjm + 1))      real pscr((iim + 1) * (jjm + 1))
# Line 47  contains Line 45  contains
45      REAL tpn, tps, tppn(iim), tpps(iim)      REAL tpn, tps, tppn(iim), tpps(iim)
46      REAL qpn, qps, qppn(iim), qpps(iim)      REAL qpn, qps, qppn(iim), qpps(iim)
47      REAL deltap((iim + 1) * (jjm + 1), llm)      REAL deltap((iim + 1) * (jjm + 1), llm)
   
48      INTEGER l, ij, iq      INTEGER l, ij, iq
49    
     REAL ssum  
   
50      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
51    
52      call assert(size(q, 1) == iim + 1, size(q, 2) == jjm + 1, &      call assert(size(q, 1) == iim + 1, size(q, 2) == jjm + 1, &
# Line 83  contains Line 78  contains
78      END DO      END DO
79    
80      DO ij = 1, iim      DO ij = 1, iim
81         tppn(ij) = aire(ij)*ps(ij)         tppn(ij) = aire(ij) * ps(ij)
82         tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)         tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
83      END DO      END DO
84      tpn = ssum(iim, tppn, 1)/apoln      tpn = sum(tppn)/apoln
85      tps = ssum(iim, tpps, 1)/apols      tps = sum(tpps)/apols
86      DO ij = 1, iip1      DO ij = 1, iip1
87         ps(ij) = tpn         ps(ij) = tpn
88         ps(ij+ip1jm) = tps         ps(ij+ip1jm) = tps
# Line 99  contains Line 94  contains
94      CALL massdair(p, masse)      CALL massdair(p, masse)
95    
96      finvmasse = masse      finvmasse = masse
97      CALL filtreg(finvmasse, jjp1, llm, -2, 2, .TRUE., 1)      CALL filtreg(finvmasse, jjp1, llm, -2, 2, .TRUE.)
98    
99      ! integration de ucov, vcov, h      ! integration de ucov, vcov, h
100    
101      DO l = 1, llm      DO l = 1, llm
102         DO ij = iip2, ip1jm         DO ij = iip2, ip1jm
103            uscr(ij) = ucov(ij, l)            uscr(ij) = ucov(ij, l)
104            ucov(ij, l) = ucovm1(ij, l) + dt*dudyn(ij, l)            ucov(ij, l) = ucovm1(ij, l) + dt * dudyn(ij, l)
105         END DO         END DO
106    
107         DO ij = 1, ip1jm         DO ij = 1, ip1jm
108            vscr(ij) = vcov(ij, l)            vscr(ij) = vcov(ij, l)
109            vcov(ij, l) = vcovm1(ij, l) + dt*dv(ij, l)            vcov(ij, l) = vcovm1(ij, l) + dt * dv(ij, l)
110         END DO         END DO
111    
112         DO ij = 1, (iim + 1) * (jjm + 1)         hscr = teta(:, l)
113            hscr(ij) = teta(ij, l)         teta(:, l) = tetam1(:, l) * massem1(:, l) / masse(:, l) &
114            teta(ij, l) = tetam1(ij, l) * massem1(ij, l) / masse(ij, l) &              + dt * dteta(:, l) / masse(:, l)
                + dt * dteta(ij, l) / masse(ij, l)  
        END DO  
115    
116         ! Calcul de la valeur moyenne, unique aux poles pour teta         ! Calcul de la valeur moyenne, unique aux poles pour teta
117    
118         DO ij = 1, iim         DO ij = 1, iim
119            tppn(ij) = aire(ij)*teta(ij, l)            tppn(ij) = aire(ij) * teta(ij, l)
120            tpps(ij) = aire(ij+ip1jm)*teta(ij+ip1jm, l)            tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm, l)
121         END DO         END DO
122         tpn = ssum(iim, tppn, 1)/apoln         tpn = sum(tppn)/apoln
123         tps = ssum(iim, tpps, 1)/apols         tps = sum(tpps)/apols
124    
125         DO ij = 1, iip1         DO ij = 1, iip1
126            teta(ij, l) = tpn            teta(ij, l) = tpn
# Line 135  contains Line 128  contains
128         END DO         END DO
129    
130         IF (leapf) THEN         IF (leapf) THEN
131            CALL scopy((iim + 1) * (jjm + 1), uscr(1), 1, ucovm1(1, l), 1)            ucovm1(:, l)  =uscr
132            CALL scopy(ip1jm, vscr(1), 1, vcovm1(1, l), 1)            vcovm1(:, l) = vscr
133            CALL scopy((iim + 1) * (jjm + 1), hscr(1), 1, tetam1(1, l), 1)            tetam1(:, l) = hscr
134         END IF         END IF
135      END DO      END DO
136    
# Line 154  contains Line 147  contains
147      DO iq = 1, nq      DO iq = 1, nq
148         DO l = 1, llm         DO l = 1, llm
149            DO ij = 1, iim            DO ij = 1, iim
150               qppn(ij) = aire(ij)*q(ij, 1, l, iq)               qppn(ij) = aire(ij) * q(ij, 1, l, iq)
151               qpps(ij) = aire(ij+ip1jm)*q(ij, jjm + 1, l, iq)               qpps(ij) = aire(ij+ip1jm) * q(ij, jjm + 1, l, iq)
152            END DO            END DO
153            qpn = ssum(iim, qppn, 1)/apoln            qpn = sum(qppn)/apoln
154            qps = ssum(iim, qpps, 1)/apols            qps = sum(qpps)/apols
155    
156            DO ij = 1, iip1            DO ij = 1, iip1
157               q(ij, 1, l, iq) = qpn               q(ij, 1, l, iq) = qpn
# Line 167  contains Line 160  contains
160         END DO         END DO
161      END DO      END DO
162    
163      CALL scopy((iim + 1) * (jjm + 1) * llm, finvmasse, 1, finvmaold, 1)      finvmaold = finvmasse
164    
165      ! Fin de l'integration de q      ! Fin de l'integration de q
166    
167      IF (leapf) THEN      IF (leapf) THEN
168         CALL scopy((iim + 1) * (jjm + 1), pscr, 1, psm1, 1)         psm1 = pscr
169         CALL scopy((iim + 1) * (jjm + 1)*llm, massescr, 1, massem1, 1)         massem1 = massescr
170      END IF      END IF
171    
172    END SUBROUTINE integrd    END SUBROUTINE integrd
Legend:
Removed from v.47  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21