/[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 43 by guez, Fri Apr 8 12:43:31 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
20    
21      ! Arguments:      ! Arguments:
22    
23      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)      REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
24      REAL q(:, :, :) ! (ip1jmp1, llm, nq)      real, intent(inout):: teta(ip1jmp1, llm)
25      REAL ps(ip1jmp1), masse(ip1jmp1, llm)      REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)
26        REAL, intent(inout):: ps(ip1jmp1)
27        REAL masse(ip1jmp1, llm)
28    
29      REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)      REAL vcovm1(ip1jm, llm), ucovm1(ip1jmp1, llm)
30      REAL tetam1(ip1jmp1, llm), psm1(ip1jmp1), massem1(ip1jmp1, llm)      REAL tetam1(ip1jmp1, llm), psm1(ip1jmp1), massem1(ip1jmp1, llm)
# Line 49  contains Line 51  contains
51    
52      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
53    
54      call assert(size(q, 1) == ip1jmp1, size(q, 2) == llm, "integrd")      call assert(size(q, 1) == iim + 1, size(q, 2) == jjm + 1, &
55      nq = size(q, 3)           size(q, 3) == llm, "integrd")
56        nq = size(q, 4)
57    
58      DO l = 1, llm      DO l = 1, llm
59         DO ij = 1, iip1         DO ij = 1, iip1
# Line 111  contains Line 114  contains
114    
115         DO ij = 1, ip1jmp1         DO ij = 1, ip1jmp1
116            hscr(ij) = teta(ij, l)            hscr(ij) = teta(ij, l)
117            teta(ij, l) = tetam1(ij, l)*massem1(ij, l)/masse(ij, l) + &            teta(ij, l) = tetam1(ij, l)*massem1(ij, l)/masse(ij, l) &
118                 dt*dteta(ij, l)/masse(ij, l)                 + dt*dteta(ij, l)/masse(ij, l)
119         END DO         END DO
120    
121         ! Calcul de la valeur moyenne, unique aux poles pour teta         ! Calcul de la valeur moyenne, unique aux poles pour teta
# Line 149  contains Line 152  contains
152      DO iq = 1, nq      DO iq = 1, nq
153         DO l = 1, llm         DO l = 1, llm
154            DO ij = 1, iim            DO ij = 1, iim
155               qppn(ij) = aire(ij)*q(ij, l, iq)               qppn(ij) = aire(ij)*q(ij, 1, l, iq)
156               qpps(ij) = aire(ij+ip1jm)*q(ij+ip1jm, l, iq)               qpps(ij) = aire(ij+ip1jm)*q(ij, jjm + 1, l, iq)
157            END DO            END DO
158            qpn = ssum(iim, qppn, 1)/apoln            qpn = ssum(iim, qppn, 1)/apoln
159            qps = ssum(iim, qpps, 1)/apols            qps = ssum(iim, qpps, 1)/apols
160    
161            DO ij = 1, iip1            DO ij = 1, iip1
162               q(ij, l, iq) = qpn               q(ij, 1, l, iq) = qpn
163               q(ij+ip1jm, l, iq) = qps               q(ij, jjm + 1, l, iq) = qps
164            END DO            END DO
165         END DO         END DO
166      END DO      END DO
Legend:
Removed from v.39  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.21