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

Diff of /trunk/dyn3d/integrd.f90

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

revision 346 by guez, Thu Jun 13 14:40:06 2019 UTC revision 347 by guez, Fri Dec 20 16:30:51 2019 UTC
# Line 11  contains Line 11  contains
11      ! Author: P. Le Van      ! Author: P. Le Van
12      ! Objet: incrémentation des tendances dynamiques      ! Objet: incrémentation des tendances dynamiques
13    
14      USE comgeom, ONLY : aire, aire_2d, apoln, apols      ! Libraries:
15        use nr_util, only: assert    
16    
17        USE comgeom, ONLY : aire_2d, apoln, apols
18      USE dimensions, ONLY : iim, jjm, llm      USE dimensions, ONLY : iim, jjm, llm
19      USE disvert_m, ONLY : ap, bp      USE disvert_m, ONLY : ap, bp
20      use massdair_m, only: massdair      use massdair_m, only: massdair
21      use nr_util, only: assert      USE paramet_m, ONLY : ip1jm
     USE paramet_m, ONLY : iip1, iip2, ip1jm, llmp1  
22      use qminimum_m, only: qminimum      use qminimum_m, only: qminimum
23    
24      REAL vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)      REAL, intent(inout):: vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)
25      REAL, intent(inout):: tetam1(iim + 1, jjm + 1, llm)      REAL, intent(inout):: tetam1(iim + 1, jjm + 1, llm)
26      REAL, intent(inout):: psm1((iim + 1) * (jjm + 1))      REAL, intent(inout):: psm1(:, :) ! (iim + 1, jjm + 1)
27      real, intent(inout):: massem1(iim + 1, jjm + 1, llm)      real, intent(inout):: massem1(iim + 1, jjm + 1, llm)
28      REAL, intent(in):: dv(ip1jm, llm), du((iim + 1) * (jjm + 1), llm)      REAL, intent(in):: dv(ip1jm, llm), du((iim + 1) * (jjm + 1), llm)
29      REAL, intent(in):: dteta(iim + 1, jjm + 1, llm), dp((iim + 1) * (jjm + 1))      REAL, intent(in):: dteta(iim + 1, jjm + 1, llm)
30        REAL, intent(in):: dp(:, :) ! (iim + 1, jjm + 1)
31      REAL, intent(inout):: vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)      REAL, intent(inout):: vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)
32      real, intent(inout):: teta(iim + 1, jjm + 1, llm)      real, intent(inout):: teta(iim + 1, jjm + 1, llm)
33      REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)      REAL, intent(inout):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)
34      REAL, intent(inout):: ps((iim + 1) * (jjm + 1))      REAL, intent(inout):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol, en Pa
35      REAL, intent(inout):: masse(iim + 1, jjm + 1, llm)      REAL, intent(inout):: masse(iim + 1, jjm + 1, llm)
36      real, intent(in):: dt ! time step, in s      real, intent(in):: dt ! time step, in s
37      LOGICAL, INTENT (IN) :: leapf      LOGICAL, INTENT (IN) :: leapf
# Line 37  contains Line 40  contains
40      REAL finvmaold(iim + 1, jjm + 1, llm)      REAL finvmaold(iim + 1, jjm + 1, llm)
41      INTEGER nq      INTEGER nq
42      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)
43      real pscr((iim + 1) * (jjm + 1))      real pscr(iim + 1, jjm + 1)
44      REAL p((iim + 1) * (jjm + 1), llmp1)      REAL p(iim + 1, jjm + 1, llm + 1)
45      REAL tpn, tps, tppn(iim), tpps(iim)      REAL deltap(iim + 1, jjm + 1, llm)
46      REAL deltap((iim + 1) * (jjm + 1), llm)      INTEGER l, ij, iq, i, j
     INTEGER l, ij, iq  
47    
48      !-----------------------------------------------------------------------      !-----------------------------------------------------------------------
49    
# Line 50  contains Line 52  contains
52      nq = size(q, 4)      nq = size(q, 4)
53    
54      DO l = 1, llm      DO l = 1, llm
55         DO ij = 1, iip1         DO ij = 1, iim + 1
56            ucov(ij, l) = 0.            ucov(ij, l) = 0.
57            ucov(ij+ip1jm, l) = 0.            ucov(ij+ip1jm, l) = 0.
58            uscr(ij) = 0.            uscr(ij) = 0.
# Line 63  contains Line 65  contains
65      pscr = ps      pscr = ps
66      ps = psm1 + dt * dp      ps = psm1 + dt * dp
67    
68      DO ij = 1, (iim + 1) * (jjm + 1)      DO j = 1, jjm + 1
69         IF (ps(ij) < 0.) THEN         do i = 1, iim + 1
70            PRINT *, 'integrd: au point ij = ', ij, &            IF (ps(i, j) < 0.) THEN
71                 ', negative surface pressure ', ps(ij)               PRINT *, 'integrd: au point i, j = ', i, j, &
72            STOP 1                    ', negative surface pressure ', ps(i, j)
73         END IF               STOP 1
74      END DO            END IF
75           END DO
76        end DO
77    
78      DO ij = 1, iim      ps(:, 1) = sum(aire_2d(:iim, 1) * ps(:iim, 1)) / apoln
79         tppn(ij) = aire(ij) * ps(ij)      ps(:, jjm + 1) = sum(aire_2d(:iim, jjm + 1) * ps(:iim, jjm + 1)) / apols
80         tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)      
     END DO  
     tpn = sum(tppn)/apoln  
     tps = sum(tpps)/apols  
     DO ij = 1, iip1  
        ps(ij) = tpn  
        ps(ij+ip1jm) = tps  
     END DO  
81    
82      ! Calcul de la nouvelle masse d'air au dernier temps integre t+1      ! Calcul de la nouvelle masse d'air au dernier temps integre t+1
83    
84      forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps      forall (l = 1: llm + 1) p(:, :, l) = ap(l) + bp(l) * ps
85      CALL massdair(p, finvmaold)      CALL massdair(p, finvmaold)
86    
87      ! integration de ucov, vcov, h      ! integration de ucov, vcov, h
88    
89      DO l = 1, llm      DO l = 1, llm
90         DO ij = iip2, ip1jm         DO ij = iim + 2, ip1jm
91            uscr(ij) = ucov(ij, l)            uscr(ij) = ucov(ij, l)
92            ucov(ij, l) = ucovm1(ij, l) + dt * du(ij, l)            ucov(ij, l) = ucovm1(ij, l) + dt * du(ij, l)
93         END DO         END DO
# Line 116  contains Line 113  contains
113         END IF         END IF
114      END DO      END DO
115    
116      DO l = 1, llm      forall (l = 1:llm) deltap(:, :, l) = p(:, :, l) - p(:, :, l + 1)
        DO ij = 1, (iim + 1) * (jjm + 1)  
           deltap(ij, l) = p(ij, l) - p(ij, l+1)  
        END DO  
     END DO  
   
117      CALL qminimum(q, nq, deltap)      CALL qminimum(q, nq, deltap)
118    
119      ! Calcul de la valeur moyenne, unique aux poles pour q      ! Calcul de la valeur moyenne, unique aux poles pour q
# Line 133  contains Line 125  contains
125         END DO         END DO
126      END DO      END DO
127    
     ! Fin de l'integration de q  
   
128      IF (leapf) THEN      IF (leapf) THEN
129         psm1 = pscr         psm1 = pscr
130         massem1 = masse         massem1 = masse
Legend:
Removed from v.346  
changed lines
  Added in v.347
  ViewVC Help
Powered by ViewVC 1.1.21