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

Annotation of /trunk/dyn3d/integrd.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 178 - (hide annotations)
Fri Mar 11 18:47:26 2016 UTC (8 years, 2 months ago) by guez
Original Path: trunk/Sources/dyn3d/integrd.f
File size: 4271 byte(s) 
Moved variables date0, deltat, datasz_max, ncvar_ids, point, buff_pos,
buffer, regular from module histcom_var to modules where they are
defined.

Removed procedure ioipslmpp, useless for a sequential program.

Added argument datasz_max to histwrite_real (to avoid circular
dependency with histwrite).

Removed useless variables and computations everywhere.

Changed real litteral constants from default kind to double precision
in lwb, lwu, lwvn, sw1s, swtt, swtt1, swu.

Removed unused arguments: paer of sw, sw1s, sw2s, swclr; pcldsw of
sw1s, sw2s; pdsig, prayl of swr; co2_ppm of clmain, clqh; tsol of
transp_lay; nsrf of screenp; kcrit and kknu of gwstress; pstd of
orosetup.

Added output of relative humidity.
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 guez 161 dp, vcov, ucov, teta, q, ps, masse, 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 106 USE comgeom, ONLY : aire, aire_2d, apoln, apols
15 guez 40 USE dimens_m, ONLY : iim, jjm, llm
16 guez 67 USE disvert_m, ONLY : ap, bp
17     use massdair_m, only: massdair
18 guez 39 use nr_util, only: assert
19 guez 178 USE paramet_m, ONLY : iip1, iip2, ip1jm, llmp1
20 guez 71 use qminimum_m, only: qminimum
21 guez 3
22 guez 46 REAL vcovm1(ip1jm, llm), ucovm1((iim + 1) * (jjm + 1), llm)
23 guez 106 REAL, intent(inout):: tetam1(iim + 1, jjm + 1, llm)
24 guez 57 REAL, intent(inout):: psm1((iim + 1) * (jjm + 1))
25 guez 161 real, intent(inout):: massem1(iim + 1, jjm + 1, llm)
26 guez 91 REAL, intent(in):: dv(ip1jm, llm), dudyn((iim + 1) * (jjm + 1), llm)
27 guez 161 REAL, intent(in):: dteta(iim + 1, jjm + 1, llm), dp((iim + 1) * (jjm + 1))
28 guez 91 REAL, intent(inout):: vcov(ip1jm, llm), ucov((iim + 1) * (jjm + 1), llm)
29 guez 106 real, intent(inout):: teta(iim + 1, jjm + 1, llm)
30 guez 90 REAL q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nq)
31     REAL, intent(inout):: ps((iim + 1) * (jjm + 1))
32 guez 106 REAL, intent(inout):: masse(iim + 1, jjm + 1, llm)
33 guez 91 real, intent(in):: dt ! time step, in s
34 guez 32 LOGICAL, INTENT (IN) :: leapf
35 guez 3
36 guez 90 ! Local:
37 guez 161 REAL finvmaold(iim + 1, jjm + 1, llm)
38 guez 39 INTEGER nq
39 guez 106 REAL vscr(ip1jm), uscr((iim + 1) * (jjm + 1)), hscr(iim + 1, jjm + 1)
40 guez 46 real pscr((iim + 1) * (jjm + 1))
41     REAL p((iim + 1) * (jjm + 1), llmp1)
42 guez 32 REAL tpn, tps, tppn(iim), tpps(iim)
43 guez 46 REAL deltap((iim + 1) * (jjm + 1), llm)
44 guez 32 INTEGER l, ij, iq
45 guez 3
46 guez 32 !-----------------------------------------------------------------------
47 guez 3
48 guez 40 call assert(size(q, 1) == iim + 1, size(q, 2) == jjm + 1, &
49     size(q, 3) == llm, "integrd")
50     nq = size(q, 4)
51 guez 39
52 guez 32 DO l = 1, llm
53     DO ij = 1, iip1
54 guez 39 ucov(ij, l) = 0.
55     ucov(ij+ip1jm, l) = 0.
56 guez 32 uscr(ij) = 0.
57     uscr(ij+ip1jm) = 0.
58     END DO
59     END DO
60 guez 3
61 guez 46 ! Integration de ps :
62 guez 3
63 guez 46 pscr = ps
64     ps = psm1 + dt * dp
65 guez 3
66 guez 46 DO ij = 1, (iim + 1) * (jjm + 1)
67     IF (ps(ij) < 0.) THEN
68     PRINT *, 'integrd: au point ij = ', ij, &
69     ', negative surface pressure ', ps(ij)
70     STOP 1
71 guez 32 END IF
72     END DO
73 guez 3
74 guez 32 DO ij = 1, iim
75 guez 91 tppn(ij) = aire(ij) * ps(ij)
76 guez 46 tpps(ij) = aire(ij+ip1jm) * ps(ij+ip1jm)
77 guez 32 END DO
78 guez 90 tpn = sum(tppn)/apoln
79     tps = sum(tpps)/apols
80 guez 32 DO ij = 1, iip1
81     ps(ij) = tpn
82     ps(ij+ip1jm) = tps
83     END DO
84 guez 3
85 guez 39 ! Calcul de la nouvelle masse d'air au dernier temps integre t+1
86 guez 3
87 guez 37 forall (l = 1: llm + 1) p(:, l) = ap(l) + bp(l) * ps
88 guez 161 CALL massdair(p, finvmaold)
89 guez 3
90 guez 39 ! integration de ucov, vcov, h
91 guez 3
92 guez 39 DO l = 1, llm
93 guez 32 DO ij = iip2, ip1jm
94 guez 39 uscr(ij) = ucov(ij, l)
95 guez 91 ucov(ij, l) = ucovm1(ij, l) + dt * dudyn(ij, l)
96 guez 32 END DO
97 guez 3
98 guez 32 DO ij = 1, ip1jm
99 guez 39 vscr(ij) = vcov(ij, l)
100 guez 91 vcov(ij, l) = vcovm1(ij, l) + dt * dv(ij, l)
101 guez 32 END DO
102 guez 3
103 guez 106 hscr = teta(:, :, l)
104 guez 161 teta(:, :, l) = tetam1(:, :, l) * massem1(:, :, l) / finvmaold(:, :, l) &
105     + dt * dteta(:, :, l) / finvmaold(:, :, l)
106 guez 3
107 guez 39 ! Calcul de la valeur moyenne, unique aux poles pour teta
108 guez 106 teta(:, 1, l) = sum(aire_2d(:iim, 1) * teta(:iim, 1, l)) / apoln
109     teta(:, jjm + 1, l) = sum(aire_2d(:iim, jjm + 1) &
110     * teta(:iim, jjm + 1, l)) / apols
111 guez 3
112 guez 32 IF (leapf) THEN
113 guez 57 ucovm1(:, l) =uscr
114     vcovm1(:, l) = vscr
115 guez 106 tetam1(:, :, l) = hscr
116 guez 32 END IF
117     END DO
118 guez 3
119 guez 32 DO l = 1, llm
120 guez 46 DO ij = 1, (iim + 1) * (jjm + 1)
121 guez 39 deltap(ij, l) = p(ij, l) - p(ij, l+1)
122 guez 32 END DO
123     END DO
124 guez 3
125 guez 39 CALL qminimum(q, nq, deltap)
126 guez 3
127 guez 39 ! Calcul de la valeur moyenne, unique aux poles pour q
128 guez 32 DO iq = 1, nq
129     DO l = 1, llm
130 guez 106 q(:, 1, l, iq) = sum(aire_2d(:iim, 1) * q(:iim, 1, l, iq)) / apoln
131     q(:, jjm + 1, l, iq) = sum(aire_2d(:iim, jjm + 1) &
132     * q(:iim, jjm + 1, l, iq)) / apols
133 guez 32 END DO
134     END DO
135 guez 28
136 guez 39 ! Fin de l'integration de q
137 guez 28
138 guez 32 IF (leapf) THEN
139 guez 57 psm1 = pscr
140 guez 161 massem1 = masse
141 guez 32 END IF
142    
143 guez 161 masse = finvmaold
144    
145 guez 32 END SUBROUTINE integrd
146    
147     end module integrd_m
  ViewVC Help
Powered by ViewVC 1.1.21