/[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 64 by guez, Wed Aug 29 14:47:17 2012 UTC trunk/dyn3d/integrd.f 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    
     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
     ! 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)  
22    
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 48  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 87  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 125  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 156  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.64  
changed lines
  Added in v.90
  ViewVC Help
Powered by ViewVC 1.1.21