Directory: | ./ |
---|---|
File: | dyn/advect.f |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 56 | 56 | 100.0% |
Branches: | 38 | 38 | 100.0% |
Line | Branch | Exec | Source |
---|---|---|---|
1 | ! | ||
2 | ! $Header$ | ||
3 | ! | ||
4 | 2881 | SUBROUTINE advect(ucov,vcov,teta,w,massebx,masseby,du,dv,dteta) | |
5 | |||
6 | USE comconst_mod, ONLY: daysec | ||
7 | USE logic_mod, ONLY: conser | ||
8 | USE ener_mod, ONLY: gtot | ||
9 | |||
10 | IMPLICIT NONE | ||
11 | c======================================================================= | ||
12 | c | ||
13 | c Auteurs: P. Le Van , Fr. Hourdin . | ||
14 | c ------- | ||
15 | c | ||
16 | c Objet: | ||
17 | c ------ | ||
18 | c | ||
19 | c ************************************************************* | ||
20 | c .... calcul des termes d'advection vertic.pour u,v,teta,q ... | ||
21 | c ************************************************************* | ||
22 | c ces termes sont ajoutes a du,dv,dteta et dq . | ||
23 | c Modif F.Forget 03/94 : on retire q de advect | ||
24 | c | ||
25 | c======================================================================= | ||
26 | c----------------------------------------------------------------------- | ||
27 | c Declarations: | ||
28 | c ------------- | ||
29 | |||
30 | include "dimensions.h" | ||
31 | include "paramet.h" | ||
32 | include "comgeom.h" | ||
33 | |||
34 | c Arguments: | ||
35 | c ---------- | ||
36 | |||
37 | REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm) | ||
38 | REAL massebx(ip1jmp1,llm),masseby(ip1jm,llm),w(ip1jmp1,llm) | ||
39 | REAL dv(ip1jm,llm),du(ip1jmp1,llm),dteta(ip1jmp1,llm) | ||
40 | |||
41 | c Local: | ||
42 | c ------ | ||
43 | |||
44 | REAL uav(ip1jmp1,llm),vav(ip1jm,llm),wsur2(ip1jmp1) | ||
45 | REAL unsaire2(ip1jmp1), ge(ip1jmp1) | ||
46 | REAL deuxjour, ww, gt, uu, vv | ||
47 | |||
48 | INTEGER ij,l | ||
49 | |||
50 | REAL SSUM | ||
51 | |||
52 | c----------------------------------------------------------------------- | ||
53 | c 2. Calculs preliminaires: | ||
54 | c ------------------------- | ||
55 | |||
56 |
2/2✓ Branch 0 taken 81 times.
✓ Branch 1 taken 2800 times.
|
2881 | IF (conser) THEN |
57 | 81 | deuxjour = 2. * daysec | |
58 | |||
59 |
2/2✓ Branch 0 taken 88209 times.
✓ Branch 1 taken 81 times.
|
88290 | DO 1 ij = 1, ip1jmp1 |
60 | 88209 | unsaire2(ij) = unsaire(ij) * unsaire(ij) | |
61 | 81 | 1 CONTINUE | |
62 | END IF | ||
63 | |||
64 | |||
65 | c------------------ -yy ---------------------------------------------- | ||
66 | c . Calcul de u | ||
67 | |||
68 |
2/2✓ Branch 0 taken 112359 times.
✓ Branch 1 taken 2881 times.
|
115240 | DO l=1,llm |
69 |
2/2✓ Branch 0 taken 118651104 times.
✓ Branch 1 taken 112359 times.
|
118763463 | DO ij = iip2, ip1jmp1 |
70 | 118763463 | uav(ij,l) = 0.25 * ( ucov(ij,l) + ucov(ij-iip1,l) ) | |
71 | ENDDO | ||
72 |
2/2✓ Branch 0 taken 114943257 times.
✓ Branch 1 taken 112359 times.
|
115055616 | DO ij = iip2, ip1jm |
73 | 115055616 | uav(ij,l) = uav(ij,l) + uav(ij+iip1,l) | |
74 | ENDDO | ||
75 |
2/2✓ Branch 0 taken 3707847 times.
✓ Branch 1 taken 112359 times.
|
3823087 | DO ij = 1, iip1 |
76 | 3707847 | uav(ij ,l) = 0. | |
77 | 3820206 | uav(ip1jm+ij,l) = 0. | |
78 | ENDDO | ||
79 | ENDDO | ||
80 | |||
81 | c------------------ -xx ---------------------------------------------- | ||
82 | c . Calcul de v | ||
83 | |||
84 |
2/2✓ Branch 0 taken 2881 times.
✓ Branch 1 taken 112359 times.
|
115240 | DO l=1,llm |
85 |
2/2✓ Branch 0 taken 118538745 times.
✓ Branch 1 taken 112359 times.
|
118651104 | DO ij = 2, ip1jm |
86 | 118651104 | vav(ij,l) = 0.25 * ( vcov(ij,l) + vcov(ij-1,l) ) | |
87 | ENDDO | ||
88 | 3595488 | DO ij = 1,ip1jm,iip1 | |
89 |
2/2✓ Branch 0 taken 3483129 times.
✓ Branch 1 taken 112359 times.
|
3595488 | vav(ij,l) = vav(ij+iim,l) |
90 | ENDDO | ||
91 |
2/2✓ Branch 0 taken 118538745 times.
✓ Branch 1 taken 112359 times.
|
118651104 | DO ij = 1, ip1jm-1 |
92 | 118651104 | vav(ij,l) = vav(ij,l) + vav(ij+1,l) | |
93 | ENDDO | ||
94 | 2881 | DO ij = 1, ip1jm, iip1 | |
95 |
2/2✓ Branch 0 taken 3483129 times.
✓ Branch 1 taken 112359 times.
|
3595488 | vav(ij+iim,l) = vav(ij,l) |
96 | ENDDO | ||
97 | ENDDO | ||
98 | |||
99 | c----------------------------------------------------------------------- | ||
100 | |||
101 | c | ||
102 |
2/2✓ Branch 0 taken 109478 times.
✓ Branch 1 taken 2881 times.
|
112359 | DO 20 l = 1, llmm1 |
103 | |||
104 | |||
105 | c ...... calcul de - w/2. au niveau l+1 ....... | ||
106 | |||
107 |
2/2✓ Branch 0 taken 119221542 times.
✓ Branch 1 taken 109478 times.
|
119331020 | DO 5 ij = 1, ip1jmp1 |
108 | 119221542 | wsur2( ij ) = - 0.5 * w( ij,l+1 ) | |
109 | 109478 | 5 CONTINUE | |
110 | |||
111 | |||
112 | c ..................... calcul pour du .................. | ||
113 | |||
114 |
2/2✓ Branch 0 taken 111886516 times.
✓ Branch 1 taken 109478 times.
|
111995994 | DO 6 ij = iip2 ,ip1jm-1 |
115 | 111886516 | ww = wsur2 ( ij ) + wsur2( ij+1 ) | |
116 | 111886516 | uu = 0.5 * ( ucov(ij,l) + ucov(ij,l+1) ) | |
117 | 111886516 | du(ij,l) = du(ij,l) - ww * ( uu - uav(ij, l ) )/massebx(ij, l ) | |
118 | 111886516 | du(ij,l+1)= du(ij,l+1) + ww * ( uu - uav(ij,l+1) )/massebx(ij,l+1) | |
119 | 109478 | 6 CONTINUE | |
120 | |||
121 | c ..... correction pour du(iip1,j,l) ........ | ||
122 | c ..... du(iip1,j,l)= du(1,j,l) ..... | ||
123 | |||
124 | CDIR$ IVDEP | ||
125 | 3393818 | DO 7 ij = iip1 +iip1, ip1jm, iip1 | |
126 | 3393818 | du( ij, l ) = du( ij -iim, l ) | |
127 |
2/2✓ Branch 0 taken 3284340 times.
✓ Branch 1 taken 109478 times.
|
3393818 | du( ij,l+1 ) = du( ij -iim,l+1 ) |
128 | 109478 | 7 CONTINUE | |
129 | |||
130 | c ................. calcul pour dv ..................... | ||
131 | |||
132 |
2/2✓ Branch 0 taken 115608768 times.
✓ Branch 1 taken 109478 times.
|
115718246 | DO 8 ij = 1, ip1jm |
133 | 115608768 | ww = wsur2( ij+iip1 ) + wsur2( ij ) | |
134 | 115608768 | vv = 0.5 * ( vcov(ij,l) + vcov(ij,l+1) ) | |
135 | 115608768 | dv(ij,l) = dv(ij, l ) - ww * (vv - vav(ij, l ) )/masseby(ij, l ) | |
136 | 115608768 | dv(ij,l+1)= dv(ij,l+1) + ww * (vv - vav(ij,l+1) )/masseby(ij,l+1) | |
137 | 109478 | 8 CONTINUE | |
138 | |||
139 | c | ||
140 | |||
141 | c ............................................................ | ||
142 | c ............... calcul pour dh ................... | ||
143 | c ............................................................ | ||
144 | |||
145 | c ---z | ||
146 | c calcul de - d( teta * w ) qu'on ajoute a dh | ||
147 | c ............... | ||
148 | |||
149 |
2/2✓ Branch 0 taken 119221542 times.
✓ Branch 1 taken 109478 times.
|
119331020 | DO 15 ij = 1, ip1jmp1 |
150 | 119221542 | ww = wsur2(ij) * (teta(ij,l) + teta(ij,l+1) ) | |
151 | 119221542 | dteta(ij, l ) = dteta(ij, l ) - ww | |
152 | 119221542 | dteta(ij,l+1) = dteta(ij,l+1) + ww | |
153 | 109478 | 15 CONTINUE | |
154 | |||
155 |
2/2✓ Branch 0 taken 106400 times.
✓ Branch 1 taken 3078 times.
|
109478 | IF( conser) THEN |
156 |
2/2✓ Branch 0 taken 3351942 times.
✓ Branch 1 taken 3078 times.
|
3355020 | DO 17 ij = 1,ip1jmp1 |
157 | 3351942 | ge(ij) = wsur2(ij) * wsur2(ij) * unsaire2(ij) | |
158 | 3078 | 17 CONTINUE | |
159 | 3078 | gt = SSUM( ip1jmp1,ge,1 ) | |
160 | 3078 | gtot(l) = deuxjour * SQRT( gt/ip1jmp1 ) | |
161 | END IF | ||
162 | |||
163 | 2881 | 20 CONTINUE | |
164 | |||
165 | 2881 | RETURN | |
166 | END | ||
167 |