/[lmdze]/trunk/libf/dyn3d/integrd.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/integrd.f90

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

revision 39 by guez, Tue Jan 25 15:11:05 2011 UTC revision 40 by guez, Tue Feb 22 13:49:36 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 ps(ip1jmp1), masse(ip1jmp1, llm)
26    
27      REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)      REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)
# Line 49  contains Line 49  contains
49    
50      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
51    
52      call assert(size(q, 1) == ip1jmp1, size(q, 2) == llm, "integrd")      call assert(size(q, 1) == iim + 1, size(q, 2) == jjm + 1, &
53      nq = size(q, 3)           size(q, 3) == llm, "integrd")
54        nq = size(q, 4)
55    
56      DO l = 1, llm      DO l = 1, llm
57         DO ij = 1, iip1         DO ij = 1, iip1
# Line 149  contains Line 150  contains
150      DO iq = 1, nq      DO iq = 1, nq
151         DO l = 1, llm         DO l = 1, llm
152            DO ij = 1, iim            DO ij = 1, iim
153               qppn(ij) = aire(ij)*q(ij, l, iq)               qppn(ij) = aire(ij)*q(ij, 1, l, iq)
154               qpps(ij) = aire(ij+ip1jm)*q(ij+ip1jm, l, iq)               qpps(ij) = aire(ij+ip1jm)*q(ij, jjm + 1, l, iq)
155            END DO            END DO
156            qpn = ssum(iim, qppn, 1)/apoln            qpn = ssum(iim, qppn, 1)/apoln
157            qps = ssum(iim, qpps, 1)/apols            qps = ssum(iim, qpps, 1)/apols
158    
159            DO ij = 1, iip1            DO ij = 1, iip1
160               q(ij, l, iq) = qpn               q(ij, 1, l, iq) = qpn
161               q(ij+ip1jm, l, iq) = qps               q(ij, jjm + 1, l, iq) = qps
162            END DO            END DO
163         END DO         END DO
164      END DO      END DO
Legend:
Removed from v.39  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.21