/[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 66 by guez, Thu Sep 20 13:00:41 2012 UTC trunk/dyn3d/integrd.f revision 91 by guez, Wed Mar 26 17:18:58 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 disvert_m, 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, intent(in):: 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, intent(inout):: 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)
35        real, intent(in):: dt ! time step, in s
36      LOGICAL, INTENT (IN) :: leapf      LOGICAL, INTENT (IN) :: leapf
     real, intent(in):: dt  
   
     ! Local variables:  
37    
38        ! 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 84  contains Line 78  contains
78      END DO      END DO
79    
80      DO ij = 1, iim      DO ij = 1, iim
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 107  contains Line 101  contains
101      DO l = 1, llm      DO l = 1, llm
102         DO ij = iip2, ip1jm         DO ij = iip2, ip1jm
103            uscr(ij) = ucov(ij, l)            uscr(ij) = ucov(ij, l)
104            ucov(ij, l) = ucovm1(ij, l) + dt*dudyn(ij, l)            ucov(ij, l) = ucovm1(ij, l) + dt * dudyn(ij, l)
105         END DO         END DO
106    
107         DO ij = 1, ip1jm         DO ij = 1, ip1jm
108            vscr(ij) = vcov(ij, l)            vscr(ij) = vcov(ij, l)
109            vcov(ij, l) = vcovm1(ij, l) + dt*dv(ij, l)            vcov(ij, l) = vcovm1(ij, l) + dt * dv(ij, l)
110         END DO         END DO
111    
112         hscr = teta(:, l)         hscr = teta(:, l)
# Line 122  contains Line 116  contains
116         ! Calcul de la valeur moyenne, unique aux poles pour teta         ! Calcul de la valeur moyenne, unique aux poles pour teta
117    
118         DO ij = 1, iim         DO ij = 1, iim
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 153  contains Line 147  contains
147      DO iq = 1, nq      DO iq = 1, nq
148         DO l = 1, llm         DO l = 1, llm
149            DO ij = 1, iim            DO ij = 1, iim
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.66  
changed lines
  Added in v.91
  ViewVC Help
Powered by ViewVC 1.1.21