/[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 39 by guez, Tue Jan 25 15:11:05 2011 UTC revision 41 by guez, Tue Feb 22 15:09:57 2011 UTC
# Line 13  contains Line 13  contains
13    
14      USE comvert, ONLY : ap, bp      USE comvert, ONLY : ap, bp
15      USE comgeom, ONLY : aire, apoln, apols      USE comgeom, ONLY : aire, apoln, apols
16      USE dimens_m, ONLY : iim, llm      USE dimens_m, ONLY : iim, jjm, llm
17      USE filtreg_m, ONLY : filtreg      USE filtreg_m, ONLY : filtreg
18      use nr_util, only: assert      use nr_util, only: assert
19      USE paramet_m, ONLY : iip1, iip2, ijp1llm, ip1jm, ip1jmp1, jjp1, llmp1      USE paramet_m, ONLY : iip1, iip2, ijp1llm, ip1jm, ip1jmp1, jjp1, llmp1
# Line 21  contains Line 21  contains
21      ! Arguments:      ! Arguments:
22    
23      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
24      REAL q(:, :, :) ! (ip1jmp1, llm, nq)      REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)
25      REAL ps(ip1jmp1), masse(ip1jmp1, llm)      REAL, intent(inout):: ps(ip1jmp1)
26        REAL masse(ip1jmp1, llm)
27    
28      REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)      REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)
29      REAL tetam1(ip1jmp1, llm), psm1(ip1jmp1), massem1(ip1jmp1, llm)      REAL tetam1(ip1jmp1, llm), psm1(ip1jmp1), massem1(ip1jmp1, llm)
# Line 49  contains Line 50  contains
50    
51      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
52    
53      call assert(size(q, 1) == ip1jmp1, size(q, 2) == llm, "integrd")      call assert(size(q, 1) == iim + 1, size(q, 2) == jjm + 1, &
54      nq = size(q, 3)           size(q, 3) == llm, "integrd")
55        nq = size(q, 4)
56    
57      DO l = 1, llm      DO l = 1, llm
58         DO ij = 1, iip1         DO ij = 1, iip1
# Line 149  contains Line 151  contains
151      DO iq = 1, nq      DO iq = 1, nq
152         DO l = 1, llm         DO l = 1, llm
153            DO ij = 1, iim            DO ij = 1, iim
154               qppn(ij) = aire(ij)*q(ij, l, iq)               qppn(ij) = aire(ij)*q(ij, 1, l, iq)
155               qpps(ij) = aire(ij+ip1jm)*q(ij+ip1jm, l, iq)               qpps(ij) = aire(ij+ip1jm)*q(ij, jjm + 1, l, iq)
156            END DO            END DO
157            qpn = ssum(iim, qppn, 1)/apoln            qpn = ssum(iim, qppn, 1)/apoln
158            qps = ssum(iim, qpps, 1)/apols            qps = ssum(iim, qpps, 1)/apols
159    
160            DO ij = 1, iip1            DO ij = 1, iip1
161               q(ij, l, iq) = qpn               q(ij, 1, l, iq) = qpn
162               q(ij+ip1jm, l, iq) = qps               q(ij, jjm + 1, l, iq) = qps
163            END DO            END DO
164         END DO         END DO
165      END DO      END DO
Legend:
Removed from v.39  
changed lines
  Added in v.41
  ViewVC Help
Powered by ViewVC 1.1.21