1 |
subroutine aaam_bud (iam,nlon,nlev,rsec, |
module aaam_bud_m |
2 |
i rea,rg,ome, |
|
3 |
i plat,plon,phis, |
implicit none |
4 |
i dragu,liftu,phyu, |
|
5 |
i dragv,liftv,phyv, |
contains |
6 |
i p, u, v, |
|
7 |
o aam, torsfc) |
subroutine aaam_bud(rg, ome, plat, plon, phis, dragu, liftu, phyu, dragv, & |
8 |
c |
liftv, phyv, p, u, v, aam, torsfc) |
9 |
use dimens_m |
|
10 |
use dimphy |
! Author: F. Lott (LMD/CNRS). Date: 2003/10/20. Object: Compute |
11 |
implicit none |
! different terms of the axial AAAM budget and mountain torque. |
12 |
c====================================================================== |
! Only valid for regular rectangular grids. Should be called after |
13 |
c Auteur(s): F.Lott (LMD/CNRS) date: 20031020 |
! "lift_noro". |
14 |
c Object: Compute different terms of the axial AAAM Budget. |
|
15 |
C No outputs, every AAM quantities are written on the IAM |
USE dimens_m, ONLY : iim, jjm |
16 |
C File. |
use nr_util, only: assert_eq, assert, pi |
17 |
c |
USE suphec_m, ONLY: ra |
18 |
c Modif : I.Musat (LMD/CNRS) date : 20041020 |
|
19 |
c Outputs : axial components of wind AAM "aam" and total surface torque |
real, intent(in):: rg ! gravity constant |
20 |
C "torsfc", |
real, intent(in):: ome ! Earth rotation rate |
21 |
c but no write in the iam file. |
|
22 |
c |
REAL, intent(in):: plat(:), plon(:) |
23 |
C WARNING: Only valid for regular rectangular grids. |
! (nlon) latitude and longitude in degrees |
24 |
C REMARK: CALL DANS PHYSIQ AFTER lift_noro: |
|
25 |
C CALL aaam_bud (27,klon,klev, gmtime, |
real, intent(in):: phis(:) ! (nlon) Geopotential at the ground |
26 |
C C ra,rg,romega, |
REAL, intent(in):: dragu(:) ! (nlon) orodrag stress (zonal) |
27 |
C C rlat,rlon,pphis, |
REAL, intent(in):: liftu(:) ! (nlon) orolift stress (zonal) |
28 |
C C zustrdr,zustrli,zustrph, |
REAL, intent(in):: phyu(:) ! (nlon) Stress total de la physique (zonal) |
29 |
C C zvstrdr,zvstrli,zvstrph, |
REAL, intent(in):: dragv(:) ! (nlon) orodrag stress (Meridional) |
30 |
C C paprs,u,v) |
REAL, intent(in):: liftv(:) ! (nlon) orolift stress (Meridional) |
31 |
C |
REAL, intent(in):: phyv(:) ! (nlon) Stress total de la physique (Meridional) |
32 |
C====================================================================== |
|
33 |
c Explicit Arguments: |
REAL, intent(in):: p(:, :) |
34 |
c ================== |
! (nlon, nlev + 1) pressure (Pa) at model half levels |
35 |
c iam-----input-I-File number where AAMs and torques are written |
|
36 |
c It is a formatted file that has been opened |
real, intent(in):: u(:, :), v(:, :) ! (nlon, nlev) horizontal wind (m/s) |
37 |
c in physiq.F |
REAL, intent(out):: aam ! axial component of wind AAM |
38 |
c nlon----input-I-Total number of horizontal points that get into physics |
REAL, intent(out):: torsfc ! axial component of total surface torque |
39 |
c nlev----input-I-Number of vertical levels |
|
40 |
c rsec----input-R-Seconde de la journee |
! Local Variables: |
41 |
c rea-----input-R-Earth radius |
|
42 |
c rg------input-R-gravity constant |
INTEGER nlev ! number of vertical levels |
43 |
c ome-----input-R-Earth rotation rate |
INTEGER i, j, k, l |
44 |
c plat ---input-R-Latitude en degres |
REAL dlat, dlon ! latitude and longitude increments (radians) |
45 |
c plon ---input-R-Longitude en degres |
|
46 |
c phis ---input-R-Geopotential at the ground |
REAL raam(3) ! wind AAM (components 1 & 2: equatorial; component 3: axial) |
47 |
c dragu---input-R-orodrag stress (zonal) |
REAL oaam(3) ! mass AAM (components 1 & 2: equatorial; component 3: axial) |
48 |
c liftu---input-R-orolift stress (zonal) |
REAL tmou(3) ! resolved mountain torque (3 components) |
49 |
c phyu----input-R-Stress total de la physique (zonal) |
REAL tsso(3) ! parameterised moutain drag torque (3 components) |
50 |
c dragv---input-R-orodrag stress (Meridional) |
REAL tbls(3) ! parameterised boundary layer torque (3 components) |
51 |
c liftv---input-R-orolift stress (Meridional) |
|
52 |
c phyv----input-R-Stress total de la physique (Meridional) |
REAL ZS(801, 401) ! topographic height |
53 |
c p-------input-R-Pressure (Pa) at model half levels |
REAL PS(801, 401) ! surface pressure |
54 |
c u-------input-R-Horizontal wind (m/s) |
REAL UB(801, 401), VB(801, 401) ! barotropic wind, zonal and meridional |
55 |
c v-------input-R-Meridional wind (m/s) |
REAL SSOU(801, 401), SSOV(801, 401) |
56 |
c aam-----output-R-Axial Wind AAM (=raam(3)) |
REAL BLSU(801, 401), BLSV(801, 401) |
57 |
c torsfc--output-R-Total surface torque (=tmou(3)+tsso(3)+tbls(3)) |
REAL ZLON(801), ZLAT(401) ! longitude and latitude in radians |
58 |
c |
|
59 |
c Implicit Arguments: |
!------------------------------------------------------------------- |
60 |
c =================== |
|
61 |
c |
call assert(size(plat) == (/size(plon), size(phis), size(dragu), & |
62 |
c iim--common-I: Number of longitude intervals |
size(liftu), size(phyu), size(dragv), size(liftv), size(phyv), & |
63 |
c jjm--common-I: Number of latitude intervals |
size(p, 1), size(u, 1), size(v, 1)/), "aaam_bud nlon") |
64 |
c klon-common-I: Number of points seen by the physics |
nlev = assert_eq(size(p, 2) - 1, size(u, 2), size(v, 2), "aaam_bud nlev") |
65 |
c iim*(jjm-1)+2 for instance |
|
66 |
c klev-common-I: Number of vertical layers |
if (iim + 1 > 801 .or. jjm + 1 > 401) then |
67 |
c====================================================================== |
print *, ' Problème de dimension dans aaam_bud' |
68 |
c Local Variables: |
stop 1 |
69 |
c ================ |
endif |
70 |
c dlat-----R: Latitude increment (Radians) |
|
71 |
c dlon-----R: Longitude increment (Radians) |
dlat = pi / jjm |
72 |
c raam ---R: Wind AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale) |
dlon = 2 * pi / real(iim) |
73 |
c oaam ---R: Mass AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale) |
|
74 |
c tmou-----R: Resolved Mountain torque (3 components) |
oaam = 0. |
75 |
c tsso-----R: Parameterised Moutain drag torque (3 components) |
raam = 0. |
76 |
c tbls-----R: Parameterised Boundary layer torque (3 components) |
tmou = 0. |
77 |
c |
tsso = 0. |
78 |
c LOCAL ARRAY: |
tbls = 0. |
79 |
c =========== |
|
80 |
c zs ---R: Topographic height |
! Mountain height, pressure and barotropic wind: |
81 |
c ps ---R: Surface Pressure |
|
82 |
c ub ---R: Barotropic wind zonal |
! North pole values (j = 1): |
83 |
c vb ---R: Barotropic wind meridional |
|
84 |
c zlat ---R: Latitude in radians |
ub(1, 1) = 0. |
85 |
c zlon ---R: Longitude in radians |
vb(1, 1) = 0. |
86 |
c====================================================================== |
do k = 1, nlev |
87 |
|
ub(1, 1) = ub(1, 1) + u(1, k) * (p(1, k) - p(1, k + 1)) / rg |
88 |
c |
vb(1, 1) = vb(1, 1) + v(1, k) * (p(1, k) - p(1, k + 1)) / rg |
89 |
c ARGUMENTS |
enddo |
90 |
c |
|
91 |
INTEGER iam,nlon,nlev |
zlat(1) = plat(1) * pi / 180. |
92 |
real, intent(in):: rsec |
|
93 |
real rea |
do i = 1, iim + 1 |
94 |
real, intent(in):: rg |
zs(i, 1) = phis(1) / rg |
95 |
real ome |
ps(i, 1) = p(1, 1) |
96 |
REAL, intent(in):: plat(nlon),plon(nlon) |
ub(i, 1) = ub(1, 1) |
97 |
real phis(nlon) |
vb(i, 1) = vb(1, 1) |
98 |
REAL dragu(nlon),liftu(nlon),phyu(nlon) |
ssou(i, 1) = dragu(1) + liftu(1) |
99 |
REAL dragv(nlon),liftv(nlon),phyv(nlon) |
ssov(i, 1) = dragv(1) + liftv(1) |
100 |
REAL, intent(in):: p(nlon,nlev+1) |
blsu(i, 1) = phyu(1) - dragu(1) - liftu(1) |
101 |
real u(nlon,nlev), v(nlon,nlev) |
blsv(i, 1) = phyv(1) - dragv(1) - liftv(1) |
102 |
c |
enddo |
103 |
c Variables locales: |
|
104 |
c |
l = 1 |
105 |
INTEGER i,j,k,l |
do j = 2, jjm |
106 |
REAL xpi,hadley,hadday |
! Values at Greenwich (Periodicity) |
107 |
REAL dlat,dlon |
|
108 |
REAL raam(3),oaam(3),tmou(3),tsso(3),tbls(3) |
zs(iim + 1, j) = phis(l + 1) / rg |
109 |
integer iax |
ps(iim + 1, j) = p(l + 1, 1) |
110 |
cIM ajout aam, torsfc |
ssou(iim + 1, j) = dragu(l + 1) + liftu(l + 1) |
111 |
c aam = composante axiale du Wind AAM raam |
ssov(iim + 1, j) = dragv(l + 1) + liftv(l + 1) |
112 |
c torsfc = composante axiale de (tmou+tsso+tbls) |
blsu(iim + 1, j) = phyu(l + 1) - dragu(l + 1) - liftu(l + 1) |
113 |
REAL aam, torsfc |
blsv(iim + 1, j) = phyv(l + 1) - dragv(l + 1) - liftv(l + 1) |
114 |
|
zlon(iim + 1) = - plon(l + 1) * pi / 180. |
115 |
REAL ZS(801,401),PS(801,401) |
zlat(j) = plat(l + 1) * pi / 180. |
116 |
REAL UB(801,401),VB(801,401) |
|
117 |
REAL SSOU(801,401),SSOV(801,401) |
ub(iim + 1, j) = 0. |
118 |
REAL BLSU(801,401),BLSV(801,401) |
vb(iim + 1, j) = 0. |
119 |
REAL ZLON(801),ZLAT(401) |
do k = 1, nlev |
120 |
C |
ub(iim + 1, j) = ub(iim + 1, j) & |
121 |
C PUT AAM QUANTITIES AT ZERO: |
+ u(l + 1, k) * (p(l + 1, k) - p(l + 1, k + 1)) / rg |
122 |
C |
vb(iim + 1, j) = vb(iim + 1, j) & |
123 |
if(iim+1.gt.801.or.jjm+1.gt.401)then |
+ v(l + 1, k) * (p(l + 1, k) - p(l + 1, k + 1)) / rg |
124 |
print *,' Pb de dimension dans aaam_bud' |
enddo |
125 |
stop |
|
126 |
endif |
do i = 1, iim |
127 |
|
l = l + 1 |
128 |
xpi=acos(-1.) |
zs(i, j) = phis(l) / rg |
129 |
hadley=1.e18 |
ps(i, j) = p(l, 1) |
130 |
hadday=1.e18*24.*3600. |
ssou(i, j) = dragu(l) + liftu(l) |
131 |
dlat=xpi/float(jjm) |
ssov(i, j) = dragv(l) + liftv(l) |
132 |
dlon=2.*xpi/float(iim) |
blsu(i, j) = phyu(l) - dragu(l) - liftu(l) |
133 |
|
blsv(i, j) = phyv(l) - dragv(l) - liftv(l) |
134 |
do iax=1,3 |
zlon(i) = plon(l) * pi / 180. |
135 |
oaam(iax)=0. |
|
136 |
raam(iax)=0. |
ub(i, j) = 0. |
137 |
tmou(iax)=0. |
vb(i, j) = 0. |
138 |
tsso(iax)=0. |
do k = 1, nlev |
139 |
tbls(iax)=0. |
ub(i, j) = ub(i, j) + u(l, k) * (p(l, k) - p(l, k + 1)) / rg |
140 |
enddo |
vb(i, j) = vb(i, j) + v(l, k) * (p(l, k) - p(l, k + 1)) / rg |
141 |
|
enddo |
142 |
C MOUNTAIN HEIGHT, PRESSURE AND BAROTROPIC WIND: |
enddo |
143 |
|
enddo |
144 |
C North pole values (j=1): |
|
145 |
|
! South Pole |
146 |
l=1 |
|
147 |
|
l = l + 1 |
148 |
ub(1,1)=0. |
ub(1, jjm + 1) = 0. |
149 |
vb(1,1)=0. |
vb(1, jjm + 1) = 0. |
150 |
do k=1,nlev |
do k = 1, nlev |
151 |
ub(1,1)=ub(1,1)+u(l,k)*(p(l,k)-p(l,k+1))/rg |
ub(1, jjm + 1) = ub(1, jjm + 1) + u(l, k) * (p(l, k) - p(l, k + 1)) / rg |
152 |
vb(1,1)=vb(1,1)+v(l,k)*(p(l,k)-p(l,k+1))/rg |
vb(1, jjm + 1) = vb(1, jjm + 1) + v(l, k) * (p(l, k) - p(l, k + 1)) / rg |
153 |
enddo |
enddo |
154 |
|
zlat(jjm + 1) = plat(l) * pi / 180. |
155 |
zlat(1)=plat(l)*xpi/180. |
|
156 |
|
do i = 1, iim + 1 |
157 |
do i=1,iim+1 |
zs(i, jjm + 1) = phis(l) / rg |
158 |
|
ps(i, jjm + 1) = p(l, 1) |
159 |
zs(i,1)=phis(l)/rg |
ssou(i, jjm + 1) = dragu(l) + liftu(l) |
160 |
ps(i,1)=p(l,1) |
ssov(i, jjm + 1) = dragv(l) + liftv(l) |
161 |
ub(i,1)=ub(1,1) |
blsu(i, jjm + 1) = phyu(l) - dragu(l) - liftu(l) |
162 |
vb(i,1)=vb(1,1) |
blsv(i, jjm + 1) = phyv(l) - dragv(l) - liftv(l) |
163 |
ssou(i,1)=dragu(l)+liftu(l) |
ub(i, jjm + 1) = ub(1, jjm + 1) |
164 |
ssov(i,1)=dragv(l)+liftv(l) |
vb(i, jjm + 1) = vb(1, jjm + 1) |
165 |
blsu(i,1)=phyu(l)-dragu(l)-liftu(l) |
enddo |
166 |
blsv(i,1)=phyv(l)-dragv(l)-liftv(l) |
|
167 |
|
! Moment angulaire |
168 |
enddo |
|
169 |
|
DO j = 1, jjm |
170 |
|
DO i = 1, iim |
171 |
do j = 2,jjm |
raam(1) = raam(1) - ra**3 * dlon * dlat * 0.5 * (cos(zlon(i )) & |
172 |
|
* sin(zlat(j )) * cos(zlat(j )) * ub(i , j ) + cos(zlon(i )) & |
173 |
C Values at Greenwich (Periodicity) |
* sin(zlat(j + 1)) * cos(zlat(j + 1)) * ub(i , j + 1)) & |
174 |
|
+ ra**3 * dlon * dlat * 0.5 * (sin(zlon(i )) * cos(zlat(j )) & |
175 |
zs(iim+1,j)=phis(l+1)/rg |
* vb(i , j ) + sin(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1)) |
176 |
ps(iim+1,j)=p(l+1,1) |
|
177 |
ssou(iim+1,j)=dragu(l+1)+liftu(l+1) |
oaam(1) = oaam(1) - ome * ra**4 * dlon * dlat / rg * 0.5 & |
178 |
ssov(iim+1,j)=dragv(l+1)+liftv(l+1) |
* (cos(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) & |
179 |
blsu(iim+1,j)=phyu(l+1)-dragu(l+1)-liftu(l+1) |
* ps(i , j ) + cos(zlon(i )) * cos(zlat(j + 1))**2 & |
180 |
blsv(iim+1,j)=phyv(l+1)-dragv(l+1)-liftv(l+1) |
* sin(zlat(j + 1)) * ps(i , j + 1)) |
181 |
zlon(iim+1)=-plon(l+1)*xpi/180. |
|
182 |
zlat(j)=plat(l+1)*xpi/180. |
raam(2) = raam(2) - ra**3 * dlon * dlat * 0.5 * (sin(zlon(i )) & |
183 |
|
* sin(zlat(j )) * cos(zlat(j )) * ub(i , j ) + sin(zlon(i )) & |
184 |
ub(iim+1,j)=0. |
* sin(zlat(j + 1)) * cos(zlat(j + 1)) * ub(i , j + 1)) & |
185 |
vb(iim+1,j)=0. |
- ra**3 * dlon * dlat * 0.5 * (cos(zlon(i )) * cos(zlat(j )) & |
186 |
do k=1,nlev |
* vb(i , j ) + cos(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1)) |
187 |
ub(iim+1,j)=ub(iim+1,j)+u(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg |
|
188 |
vb(iim+1,j)=vb(iim+1,j)+v(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg |
oaam(2) = oaam(2) - ome * ra**4 * dlon * dlat / rg * 0.5 & |
189 |
enddo |
* (sin(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) & |
190 |
|
* ps(i , j ) + sin(zlon(i )) * cos(zlat(j + 1))**2 & |
191 |
|
* sin(zlat(j + 1)) * ps(i , j + 1)) |
192 |
do i=1,iim |
|
193 |
|
raam(3) = raam(3) + ra**3 * dlon * dlat * 0.5 * (cos(zlat(j))**2 & |
194 |
l=l+1 |
* ub(i, j) + cos(zlat(j + 1))**2 * ub(i, j + 1)) |
195 |
zs(i,j)=phis(l)/rg |
|
196 |
ps(i,j)=p(l,1) |
oaam(3) = oaam(3) + ome * ra**4 * dlon * dlat / rg * 0.5 & |
197 |
ssou(i,j)=dragu(l)+liftu(l) |
* (cos(zlat(j))**3 * ps(i, j) + cos(zlat(j + 1))**3 & |
198 |
ssov(i,j)=dragv(l)+liftv(l) |
* ps(i, j + 1)) |
199 |
blsu(i,j)=phyu(l)-dragu(l)-liftu(l) |
ENDDO |
200 |
blsv(i,j)=phyv(l)-dragv(l)-liftv(l) |
ENDDO |
201 |
zlon(i)=plon(l)*xpi/180. |
|
202 |
|
! Couple des montagnes : |
203 |
ub(i,j)=0. |
|
204 |
vb(i,j)=0. |
DO j = 1, jjm |
205 |
do k=1,nlev |
DO i = 1, iim |
206 |
ub(i,j)=ub(i,j)+u(l,k)*(p(l,k)-p(l,k+1))/rg |
tmou(1) = tmou(1) - ra**2 * dlon * 0.5 * sin(zlon(i)) & |
207 |
vb(i,j)=vb(i,j)+v(l,k)*(p(l,k)-p(l,k+1))/rg |
* (zs(i, j) - zs(i, j + 1)) & |
208 |
enddo |
* (cos(zlat(j + 1)) * ps(i, j + 1) + cos(zlat(j)) * ps(i, j)) |
209 |
|
tmou(2) = tmou(2) + ra**2 * dlon * 0.5 * cos(zlon(i)) & |
210 |
enddo |
* (zs(i, j) - zs(i, j + 1)) & |
211 |
|
* (cos(zlat(j + 1)) * ps(i, j + 1) + cos(zlat(j)) * ps(i, j)) |
212 |
enddo |
ENDDO |
213 |
|
ENDDO |
214 |
|
|
215 |
C South Pole |
DO j = 2, jjm |
216 |
|
DO i = 1, iim |
217 |
l=l+1 |
tmou(1) = tmou(1) + ra**2 * dlat * 0.5 * sin(zlat(j)) & |
218 |
ub(1,jjm+1)=0. |
* (zs(i + 1, j) - zs(i, j)) & |
219 |
vb(1,jjm+1)=0. |
* (cos(zlon(i + 1)) * ps(i + 1, j) + cos(zlon(i)) * ps(i, j)) |
220 |
do k=1,nlev |
tmou(2) = tmou(2) + ra**2 * dlat * 0.5 * sin(zlat(j)) & |
221 |
ub(1,jjm+1)=ub(1,jjm+1)+u(l,k)*(p(l,k)-p(l,k+1))/rg |
* (zs(i + 1, j) - zs(i, j)) & |
222 |
vb(1,jjm+1)=vb(1,jjm+1)+v(l,k)*(p(l,k)-p(l,k+1))/rg |
* (sin(zlon(i + 1)) * ps(i + 1, j) + sin(zlon(i)) * ps(i, j)) |
223 |
enddo |
tmou(3) = tmou(3) - ra**2 * dlat * 0.5* cos(zlat(j)) & |
224 |
zlat(jjm+1)=plat(l)*xpi/180. |
* (zs(i + 1, j) - zs(i, j)) * (ps(i + 1, j) + ps(i, j)) |
225 |
|
ENDDO |
226 |
do i=1,iim+1 |
ENDDO |
227 |
zs(i,jjm+1)=phis(l)/rg |
|
228 |
ps(i,jjm+1)=p(l,1) |
! Couples des differentes friction au sol : |
229 |
ssou(i,jjm+1)=dragu(l)+liftu(l) |
|
230 |
ssov(i,jjm+1)=dragv(l)+liftv(l) |
DO j = 2, jjm |
231 |
blsu(i,jjm+1)=phyu(l)-dragu(l)-liftu(l) |
DO i = 1, iim |
232 |
blsv(i,jjm+1)=phyv(l)-dragv(l)-liftv(l) |
tsso(1) = tsso(1) - ra**3 * cos(zlat(j)) * dlon * dlat* & |
233 |
ub(i,jjm+1)=ub(1,jjm+1) |
ssou(i, j) * sin(zlat(j)) * cos(zlon(i)) & |
234 |
vb(i,jjm+1)=vb(1,jjm+1) |
+ ra**3 * cos(zlat(j)) * dlon * dlat* & |
235 |
enddo |
ssov(i, j) * sin(zlon(i)) |
236 |
|
|
237 |
C |
tsso(2) = tsso(2) - ra**3 * cos(zlat(j)) * dlon * dlat* & |
238 |
C MOMENT ANGULAIRE |
ssou(i, j) * sin(zlat(j)) * sin(zlon(i)) & |
239 |
C |
- ra**3 * cos(zlat(j)) * dlon * dlat* & |
240 |
DO j=1,jjm |
ssov(i, j) * cos(zlon(i)) |
241 |
DO i=1,iim |
|
242 |
|
tsso(3) = tsso(3) + ra**3 * cos(zlat(j)) * dlon * dlat* & |
243 |
raam(1)=raam(1)-rea**3*dlon*dlat*0.5* |
ssou(i, j) * cos(zlat(j)) |
244 |
c (cos(zlon(i ))*sin(zlat(j ))*cos(zlat(j ))*ub(i ,j ) |
|
245 |
c +cos(zlon(i ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i ,j+1)) |
tbls(1) = tbls(1) - ra**3 * cos(zlat(j)) * dlon * dlat* & |
246 |
c +rea**3*dlon*dlat*0.5* |
blsu(i, j) * sin(zlat(j)) * cos(zlon(i)) & |
247 |
c (sin(zlon(i ))*cos(zlat(j ))*vb(i ,j ) |
+ ra**3 * cos(zlat(j)) * dlon * dlat* & |
248 |
c +sin(zlon(i ))*cos(zlat(j+1))*vb(i ,j+1)) |
blsv(i, j) * sin(zlon(i)) |
249 |
|
|
250 |
oaam(1)=oaam(1)-ome*rea**4*dlon*dlat/rg*0.5* |
tbls(2) = tbls(2) - ra**3 * cos(zlat(j)) * dlon * dlat* & |
251 |
c (cos(zlon(i ))*cos(zlat(j ))**2*sin(zlat(j ))*ps(i ,j ) |
blsu(i, j) * sin(zlat(j)) * sin(zlon(i)) & |
252 |
c +cos(zlon(i ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i ,j+1)) |
- ra**3 * cos(zlat(j)) * dlon * dlat* & |
253 |
|
blsv(i, j) * cos(zlon(i)) |
254 |
raam(2)=raam(2)-rea**3*dlon*dlat*0.5* |
|
255 |
c (sin(zlon(i ))*sin(zlat(j ))*cos(zlat(j ))*ub(i ,j ) |
tbls(3) = tbls(3) + ra**3 * cos(zlat(j)) * dlon * dlat* & |
256 |
c +sin(zlon(i ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i ,j+1)) |
blsu(i, j) * cos(zlat(j)) |
257 |
c -rea**3*dlon*dlat*0.5* |
ENDDO |
258 |
c (cos(zlon(i ))*cos(zlat(j ))*vb(i ,j ) |
ENDDO |
259 |
c +cos(zlon(i ))*cos(zlat(j+1))*vb(i ,j+1)) |
|
260 |
|
aam = raam(3) |
261 |
oaam(2)=oaam(2)-ome*rea**4*dlon*dlat/rg*0.5* |
torsfc = tmou(3) + tsso(3) + tbls(3) |
262 |
c (sin(zlon(i ))*cos(zlat(j ))**2*sin(zlat(j ))*ps(i ,j ) |
|
263 |
c +sin(zlon(i ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i ,j+1)) |
END subroutine aaam_bud |
264 |
|
|
265 |
raam(3)=raam(3)+rea**3*dlon*dlat*0.5* |
end module aaam_bud_m |
|
c (cos(zlat(j))**2*ub(i,j)+cos(zlat(j+1))**2*ub(i,j+1)) |
|
|
|
|
|
oaam(3)=oaam(3)+ome*rea**4*dlon*dlat/rg*0.5* |
|
|
c (cos(zlat(j))**3*ps(i,j)+cos(zlat(j+1))**3*ps(i,j+1)) |
|
|
|
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
C |
|
|
C COUPLE DES MONTAGNES: |
|
|
C |
|
|
|
|
|
DO j=1,jjm |
|
|
DO i=1,iim |
|
|
tmou(1)=tmou(1)-rea**2*dlon*0.5*sin(zlon(i)) |
|
|
c *(zs(i,j)-zs(i,j+1)) |
|
|
c *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) |
|
|
tmou(2)=tmou(2)+rea**2*dlon*0.5*cos(zlon(i)) |
|
|
c *(zs(i,j)-zs(i,j+1)) |
|
|
c *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
DO j=2,jjm |
|
|
DO i=1,iim |
|
|
tmou(1)=tmou(1)+rea**2*dlat*0.5*sin(zlat(j)) |
|
|
c *(zs(i+1,j)-zs(i,j)) |
|
|
c *(cos(zlon(i+1))*ps(i+1,j)+cos(zlon(i))*ps(i,j)) |
|
|
tmou(2)=tmou(2)+rea**2*dlat*0.5*sin(zlat(j)) |
|
|
c *(zs(i+1,j)-zs(i,j)) |
|
|
c *(sin(zlon(i+1))*ps(i+1,j)+sin(zlon(i))*ps(i,j)) |
|
|
tmou(3)=tmou(3)-rea**2*dlat*0.5* |
|
|
c cos(zlat(j))*(zs(i+1,j)-zs(i,j))*(ps(i+1,j)+ps(i,j)) |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
C |
|
|
C COUPLES DES DIFFERENTES FRICTION AU SOL: |
|
|
C |
|
|
l=1 |
|
|
DO j=2,jjm |
|
|
DO i=1,iim |
|
|
l=l+1 |
|
|
tsso(1)=tsso(1)-rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c ssou(i,j) *sin(zlat(j))*cos(zlon(i)) |
|
|
c +rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c ssov(i,j) *sin(zlon(i)) |
|
|
|
|
|
tsso(2)=tsso(2)-rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c ssou(i,j) *sin(zlat(j))*sin(zlon(i)) |
|
|
c -rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c ssov(i,j) *cos(zlon(i)) |
|
|
|
|
|
tsso(3)=tsso(3)+rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c ssou(i,j) *cos(zlat(j)) |
|
|
|
|
|
tbls(1)=tbls(1)-rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c blsu(i,j) *sin(zlat(j))*cos(zlon(i)) |
|
|
c +rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c blsv(i,j) *sin(zlon(i)) |
|
|
|
|
|
tbls(2)=tbls(2)-rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c blsu(i,j) *sin(zlat(j))*sin(zlon(i)) |
|
|
c -rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c blsv(i,j) *cos(zlon(i)) |
|
|
|
|
|
tbls(3)=tbls(3)+rea**3*cos(zlat(j))*dlon*dlat* |
|
|
c blsu(i,j) *cos(zlat(j)) |
|
|
|
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
|
|
|
100 format(F12.5,15(1x,F12.5)) |
|
|
|
|
|
aam=raam(3) |
|
|
torsfc= tmou(3)+tsso(3)+tbls(3) |
|
|
c |
|
|
RETURN |
|
|
END |
|