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

Diff of /trunk/dyn3d/integrd.f

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

revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC revision 90 by guez, Wed Mar 12 21:16:36 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    
# Line 20  contains Line 20  contains
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      use qminimum_m, only: qminimum
22    
     ! Arguments:  
   
     REAL vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)  
     real, intent(inout):: teta((iim + 1) * (jjm + 1), llm)  
     REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)  
     REAL, intent(inout):: ps((iim + 1) * (jjm + 1))  
     REAL masse((iim + 1) * (jjm + 1), llm)  
   
23      REAL vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)      REAL vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)
24      REAL, intent(inout):: tetam1((iim + 1) * (jjm + 1), llm)      REAL, intent(inout):: tetam1((iim + 1) * (jjm + 1), llm)
25      REAL, intent(inout):: psm1((iim + 1) * (jjm + 1))      REAL, intent(inout):: psm1((iim + 1) * (jjm + 1))
26      real massem1((iim + 1) * (jjm + 1), llm)      real massem1((iim + 1) * (jjm + 1), llm)
   
27      REAL dv(ip1jm, llm), dudyn((iim + 1) * (jjm + 1), llm)      REAL dv(ip1jm, llm), dudyn((iim + 1) * (jjm + 1), llm)
28      REAL dteta((iim + 1) * (jjm + 1), llm), dp((iim + 1) * (jjm + 1))      REAL dteta((iim + 1) * (jjm + 1), llm), dp((iim + 1) * (jjm + 1))
29        REAL vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)
30        real, intent(inout):: teta((iim + 1) * (jjm + 1), llm)
31        REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)
32        REAL, intent(inout):: ps((iim + 1) * (jjm + 1))
33        REAL masse((iim + 1) * (jjm + 1), llm)
34      REAL finvmaold((iim + 1) * (jjm + 1), llm)      REAL finvmaold((iim + 1) * (jjm + 1), llm)
     LOGICAL, INTENT (IN) :: leapf  
35      real, intent(in):: dt      real, intent(in):: dt
36        LOGICAL, INTENT (IN) :: leapf
37    
38      ! Local variables:      ! 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 50  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 89  contains Line 81  contains
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 127  contains Line 119  contains
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 158  contains Line 150  contains
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
Legend:
Removed from v.82  
changed lines
  Added in v.90
  ViewVC Help
Powered by ViewVC 1.1.21