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

Annotation of /trunk/dyn3d/integrd.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 91 - (hide annotations)
Wed Mar 26 17:18:58 2014 UTC (10 years, 2 months ago) by guez
File size: 4783 byte(s) 
Removed unused variables lock_startdate and time_stamp of module
calendar.

Noticed that physiq does not change the surface pressure. So removed
arguments ps and dpfi of subroutine addfi. dpfi was always 0. The
computation of ps in addfi included some averaging at the poles. In
principle, this does not change ps but in practice it does because of
finite numerical precision. So the results of the simulation are
changed. Removed arguments ps and dpfi of calfis. Removed argument
d_ps of physiq.

du at the poles is not computed by dudv1, so declare only the
corresponding latitudes in dudv1. caldyn passes only a section of the
array dudyn as argument.

Removed variable niadv of module iniadvtrac_m.

Declared arguments of exner_hyb as assumed-shape arrays and made all
other horizontal sizes in exner_hyb dynamic. This allows the external
program test_disvert to use exner_hyb at a single horizontal position.
1 guez 32 module integrd_m
2 guez 3
3 guez 32 IMPLICIT NONE
4 guez 3
5 guez 32 contains
6 guez 3
7 guez 90 SUBROUTINE integrd(vcovm1, ucovm1, tetam1, psm1, massem1, dv, dudyn, dteta, &
8     dp, vcov, ucov, teta, q, ps, masse, finvmaold, dt, leapf)
9 guez 3
10 guez 90 ! From dyn3d/integrd.F, version 1.1.1.1, 2004/05/19 12:53:05
11 guez 46 ! Author: P. Le Van
12 guez 39 ! Objet: incrémentation des tendances dynamiques
13 guez 3
14 guez 32 USE comgeom, ONLY : aire, apoln, apols
15 guez 40 USE dimens_m, ONLY : iim, jjm, llm
16 guez 67 USE disvert_m, ONLY : ap, bp
17 guez 32 USE filtreg_m, ONLY : filtreg
18 guez 67 use massdair_m, only: massdair
19 guez 39 use nr_util, only: assert
20 guez 46 USE paramet_m, ONLY : iip1, iip2, ip1jm, ip1jmp1, jjp1, llmp1
21 guez 71 use qminimum_m, only: qminimum
22 guez 3
23 guez 46 REAL vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)
24 guez 57 REAL, intent(inout):: tetam1((iim + 1) * (jjm + 1), llm)
25     REAL, intent(inout):: psm1((iim + 1) * (jjm + 1))
26 guez 46 real massem1((iim + 1) * (jjm + 1), llm)
27 guez 91 REAL, intent(in):: dv(ip1jm, llm), dudyn((iim + 1) * (jjm + 1), llm)
28 guez 46 REAL dteta((iim + 1) * (jjm + 1), llm), dp((iim + 1) * (jjm + 1))
29 guez 91 REAL, intent(inout):: vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)
30 guez 90 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 guez 46 REAL finvmaold((iim + 1) * (jjm + 1), llm)
35 guez 91 real, intent(in):: dt ! time step, in s
36 guez 32 LOGICAL, INTENT (IN) :: leapf
37 guez 3
38 guez 90 ! Local:
39 guez 39 INTEGER nq
40 guez 46 REAL vscr(ip1jm), uscr((iim + 1) * (jjm + 1)), hscr((iim + 1) * (jjm + 1))
41     real pscr((iim + 1) * (jjm + 1))
42     REAL massescr((iim + 1) * (jjm + 1), llm)
43     real finvmasse((iim + 1) * (jjm + 1), llm)
44     REAL p((iim + 1) * (jjm + 1), llmp1)
45 guez 32 REAL tpn, tps, tppn(iim), tpps(iim)
46     REAL qpn, qps, qppn(iim), qpps(iim)
47 guez 46 REAL deltap((iim + 1) * (jjm + 1), llm)
48 guez 32 INTEGER l, ij, iq
49 guez 3
50 guez 32 !-----------------------------------------------------------------------
51 guez 3
52 guez 40 call assert(size(q, 1) == iim + 1, size(q, 2) == jjm + 1, &
53     size(q, 3) == llm, "integrd")
54     nq = size(q, 4)
55 guez 39
56 guez 32 DO l = 1, llm
57     DO ij = 1, iip1
58 guez 39 ucov(ij, l) = 0.
59     ucov(ij+ip1jm, l) = 0.
60 guez 32 uscr(ij) = 0.
61     uscr(ij+ip1jm) = 0.
62     END DO
63     END DO
64 guez 3
65 guez 46 massescr = masse
66 guez 3
67 guez 46 ! Integration de ps :
68 guez 3
69 guez 46 pscr = ps
70     ps = psm1 + dt * dp
71 guez 3
72 guez 46 DO ij = 1, (iim + 1) * (jjm + 1)
73     IF (ps(ij) < 0.) THEN
74     PRINT *, 'integrd: au point ij = ', ij, &
75     ', negative surface pressure ', ps(ij)
76     STOP 1
77 guez 32 END IF
78     END DO
79 guez 3
80 guez 32 DO ij = 1, iim
81 guez 91 tppn(ij) = aire(ij) * ps(ij)
82 guez 46 tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
83 guez 32 END DO
84 guez 90 tpn = sum(tppn)/apoln
85     tps = sum(tpps)/apols
86 guez 32 DO ij = 1, iip1
87     ps(ij) = tpn
88     ps(ij+ip1jm) = tps
89     END DO
90 guez 3
91 guez 39 ! Calcul de la nouvelle masse d'air au dernier temps integre t+1
92 guez 3
93 guez 37 forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
94 guez 39 CALL massdair(p, masse)
95 guez 3
96 guez 46 finvmasse = masse
97 guez 64 CALL filtreg(finvmasse, jjp1, llm, -2, 2, .TRUE.)
98 guez 3
99 guez 39 ! integration de ucov, vcov, h
100 guez 3
101 guez 39 DO l = 1, llm
102 guez 32 DO ij = iip2, ip1jm
103 guez 39 uscr(ij) = ucov(ij, l)
104 guez 91 ucov(ij, l) = ucovm1(ij, l) + dt * dudyn(ij, l)
105 guez 32 END DO
106 guez 3
107 guez 32 DO ij = 1, ip1jm
108 guez 39 vscr(ij) = vcov(ij, l)
109 guez 91 vcov(ij, l) = vcovm1(ij, l) + dt * dv(ij, l)
110 guez 32 END DO
111 guez 3
112 guez 57 hscr = teta(:, l)
113     teta(:, l) = tetam1(:, l) * massem1(:, l) / masse(:, l) &
114     + dt * dteta(:, l) / masse(:, l)
115 guez 3
116 guez 39 ! Calcul de la valeur moyenne, unique aux poles pour teta
117 guez 3
118 guez 32 DO ij = 1, iim
119 guez 91 tppn(ij) = aire(ij) * teta(ij, l)
120     tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm, l)
121 guez 32 END DO
122 guez 90 tpn = sum(tppn)/apoln
123     tps = sum(tpps)/apols
124 guez 3
125 guez 32 DO ij = 1, iip1
126 guez 39 teta(ij, l) = tpn
127     teta(ij+ip1jm, l) = tps
128 guez 32 END DO
129 guez 3
130 guez 32 IF (leapf) THEN
131 guez 57 ucovm1(:, l) =uscr
132     vcovm1(:, l) = vscr
133     tetam1(:, l) = hscr
134 guez 32 END IF
135     END DO
136 guez 3
137 guez 32 DO l = 1, llm
138 guez 46 DO ij = 1, (iim + 1) * (jjm + 1)
139 guez 39 deltap(ij, l) = p(ij, l) - p(ij, l+1)
140 guez 32 END DO
141     END DO
142 guez 3
143 guez 39 CALL qminimum(q, nq, deltap)
144 guez 3
145 guez 39 ! Calcul de la valeur moyenne, unique aux poles pour q
146 guez 3
147 guez 32 DO iq = 1, nq
148     DO l = 1, llm
149     DO ij = 1, iim
150 guez 91 qppn(ij) = aire(ij) * q(ij, 1, l, iq)
151     qpps(ij) = aire(ij+ip1jm) * q(ij, jjm + 1, l, iq)
152 guez 32 END DO
153 guez 90 qpn = sum(qppn)/apoln
154     qps = sum(qpps)/apols
155 guez 28
156 guez 32 DO ij = 1, iip1
157 guez 40 q(ij, 1, l, iq) = qpn
158     q(ij, jjm + 1, l, iq) = qps
159 guez 32 END DO
160     END DO
161     END DO
162 guez 28
163 guez 57 finvmaold = finvmasse
164 guez 28
165 guez 39 ! Fin de l'integration de q
166 guez 28
167 guez 32 IF (leapf) THEN
168 guez 57 psm1 = pscr
169     massem1 = massescr
170 guez 32 END IF
171    
172     END SUBROUTINE integrd
173    
174     end module integrd_m
  ViewVC Help
Powered by ViewVC 1.1.21