| 1 |
subroutine aaam_bud (iam,nlon,nlev,rjour,rsec, |
| 2 |
i rea,rg,ome, |
| 3 |
i plat,plon,phis, |
| 4 |
i dragu,liftu,phyu, |
| 5 |
i dragv,liftv,phyv, |
| 6 |
i p, u, v, |
| 7 |
o aam, torsfc) |
| 8 |
c |
| 9 |
use dimens_m |
| 10 |
use dimphy |
| 11 |
implicit none |
| 12 |
c====================================================================== |
| 13 |
c Auteur(s): F.Lott (LMD/CNRS) date: 20031020 |
| 14 |
c Object: Compute different terms of the axial AAAM Budget. |
| 15 |
C No outputs, every AAM quantities are written on the IAM |
| 16 |
C File. |
| 17 |
c |
| 18 |
c Modif : I.Musat (LMD/CNRS) date : 20041020 |
| 19 |
c Outputs : axial components of wind AAM "aam" and total surface torque "torsfc", |
| 20 |
c but no write in the iam file. |
| 21 |
c |
| 22 |
C WARNING: Only valid for regular rectangular grids. |
| 23 |
C REMARK: CALL DANS PHYSIQ AFTER lift_noro: |
| 24 |
C CALL aaam_bud (27,klon,klev,rjourvrai,gmtime, |
| 25 |
C C ra,rg,romega, |
| 26 |
C C rlat,rlon,pphis, |
| 27 |
C C zustrdr,zustrli,zustrph, |
| 28 |
C C zvstrdr,zvstrli,zvstrph, |
| 29 |
C C paprs,u,v) |
| 30 |
C |
| 31 |
C====================================================================== |
| 32 |
c Explicit Arguments: |
| 33 |
c ================== |
| 34 |
c iam-----input-I-File number where AAMs and torques are written |
| 35 |
c It is a formatted file that has been opened |
| 36 |
c in physiq.F |
| 37 |
c nlon----input-I-Total number of horizontal points that get into physics |
| 38 |
c nlev----input-I-Number of vertical levels |
| 39 |
c rjour---input-R-Jour compte depuis le debut de la simu (run.def) |
| 40 |
c rsec----input-R-Seconde de la journee |
| 41 |
c rea-----input-R-Earth radius |
| 42 |
c rg------input-R-gravity constant |
| 43 |
c ome-----input-R-Earth rotation rate |
| 44 |
c plat ---input-R-Latitude en degres |
| 45 |
c plon ---input-R-Longitude en degres |
| 46 |
c phis ---input-R-Geopotential at the ground |
| 47 |
c dragu---input-R-orodrag stress (zonal) |
| 48 |
c liftu---input-R-orolift stress (zonal) |
| 49 |
c phyu----input-R-Stress total de la physique (zonal) |
| 50 |
c dragv---input-R-orodrag stress (Meridional) |
| 51 |
c liftv---input-R-orolift stress (Meridional) |
| 52 |
c phyv----input-R-Stress total de la physique (Meridional) |
| 53 |
c p-------input-R-Pressure (Pa) at model half levels |
| 54 |
c u-------input-R-Horizontal wind (m/s) |
| 55 |
c v-------input-R-Meridional wind (m/s) |
| 56 |
c aam-----output-R-Axial Wind AAM (=raam(3)) |
| 57 |
c torsfc--output-R-Total surface torque (=tmou(3)+tsso(3)+tbls(3)) |
| 58 |
c |
| 59 |
c Implicit Arguments: |
| 60 |
c =================== |
| 61 |
c |
| 62 |
c iim--common-I: Number of longitude intervals |
| 63 |
c jjm--common-I: Number of latitude intervals |
| 64 |
c klon-common-I: Number of points seen by the physics |
| 65 |
c iim*(jjm-1)+2 for instance |
| 66 |
c klev-common-I: Number of vertical layers |
| 67 |
c====================================================================== |
| 68 |
c Local Variables: |
| 69 |
c ================ |
| 70 |
c dlat-----R: Latitude increment (Radians) |
| 71 |
c dlon-----R: Longitude increment (Radians) |
| 72 |
c raam ---R: Wind AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale) |
| 73 |
c oaam ---R: Mass AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale) |
| 74 |
c tmou-----R: Resolved Mountain torque (3 components) |
| 75 |
c tsso-----R: Parameterised Moutain drag torque (3 components) |
| 76 |
c tbls-----R: Parameterised Boundary layer torque (3 components) |
| 77 |
c |
| 78 |
c LOCAL ARRAY: |
| 79 |
c =========== |
| 80 |
c zs ---R: Topographic height |
| 81 |
c ps ---R: Surface Pressure |
| 82 |
c ub ---R: Barotropic wind zonal |
| 83 |
c vb ---R: Barotropic wind meridional |
| 84 |
c zlat ---R: Latitude in radians |
| 85 |
c zlon ---R: Longitude in radians |
| 86 |
c====================================================================== |
| 87 |
|
| 88 |
c |
| 89 |
c ARGUMENTS |
| 90 |
c |
| 91 |
INTEGER iam,nlon,nlev |
| 92 |
REAL rjour |
| 93 |
real, intent(in):: rsec |
| 94 |
real rea |
| 95 |
real, intent(in):: rg |
| 96 |
real ome |
| 97 |
REAL, intent(in):: plat(nlon),plon(nlon) |
| 98 |
real phis(nlon) |
| 99 |
REAL dragu(nlon),liftu(nlon),phyu(nlon) |
| 100 |
REAL dragv(nlon),liftv(nlon),phyv(nlon) |
| 101 |
REAL, intent(in):: p(nlon,nlev+1) |
| 102 |
real u(nlon,nlev), v(nlon,nlev) |
| 103 |
c |
| 104 |
c Variables locales: |
| 105 |
c |
| 106 |
INTEGER i,j,k,l |
| 107 |
REAL xpi,hadley,hadday |
| 108 |
REAL dlat,dlon |
| 109 |
REAL raam(3),oaam(3),tmou(3),tsso(3),tbls(3) |
| 110 |
integer iax |
| 111 |
cIM ajout aam, torsfc |
| 112 |
c aam = composante axiale du Wind AAM raam |
| 113 |
c torsfc = composante axiale de (tmou+tsso+tbls) |
| 114 |
REAL aam, torsfc |
| 115 |
|
| 116 |
REAL ZS(801,401),PS(801,401) |
| 117 |
REAL UB(801,401),VB(801,401) |
| 118 |
REAL SSOU(801,401),SSOV(801,401) |
| 119 |
REAL BLSU(801,401),BLSV(801,401) |
| 120 |
REAL ZLON(801),ZLAT(401) |
| 121 |
C |
| 122 |
C PUT AAM QUANTITIES AT ZERO: |
| 123 |
C |
| 124 |
if(iim+1.gt.801.or.jjm+1.gt.401)then |
| 125 |
print *,' Pb de dimension dans aaam_bud' |
| 126 |
stop |
| 127 |
endif |
| 128 |
|
| 129 |
xpi=acos(-1.) |
| 130 |
hadley=1.e18 |
| 131 |
hadday=1.e18*24.*3600. |
| 132 |
dlat=xpi/float(jjm) |
| 133 |
dlon=2.*xpi/float(iim) |
| 134 |
|
| 135 |
do iax=1,3 |
| 136 |
oaam(iax)=0. |
| 137 |
raam(iax)=0. |
| 138 |
tmou(iax)=0. |
| 139 |
tsso(iax)=0. |
| 140 |
tbls(iax)=0. |
| 141 |
enddo |
| 142 |
|
| 143 |
C MOUNTAIN HEIGHT, PRESSURE AND BAROTROPIC WIND: |
| 144 |
|
| 145 |
C North pole values (j=1): |
| 146 |
|
| 147 |
l=1 |
| 148 |
|
| 149 |
ub(1,1)=0. |
| 150 |
vb(1,1)=0. |
| 151 |
do k=1,nlev |
| 152 |
ub(1,1)=ub(1,1)+u(l,k)*(p(l,k)-p(l,k+1))/rg |
| 153 |
vb(1,1)=vb(1,1)+v(l,k)*(p(l,k)-p(l,k+1))/rg |
| 154 |
enddo |
| 155 |
|
| 156 |
zlat(1)=plat(l)*xpi/180. |
| 157 |
|
| 158 |
do i=1,iim+1 |
| 159 |
|
| 160 |
zs(i,1)=phis(l)/rg |
| 161 |
ps(i,1)=p(l,1) |
| 162 |
ub(i,1)=ub(1,1) |
| 163 |
vb(i,1)=vb(1,1) |
| 164 |
ssou(i,1)=dragu(l)+liftu(l) |
| 165 |
ssov(i,1)=dragv(l)+liftv(l) |
| 166 |
blsu(i,1)=phyu(l)-dragu(l)-liftu(l) |
| 167 |
blsv(i,1)=phyv(l)-dragv(l)-liftv(l) |
| 168 |
|
| 169 |
enddo |
| 170 |
|
| 171 |
|
| 172 |
do j = 2,jjm |
| 173 |
|
| 174 |
C Values at Greenwich (Periodicity) |
| 175 |
|
| 176 |
zs(iim+1,j)=phis(l+1)/rg |
| 177 |
ps(iim+1,j)=p(l+1,1) |
| 178 |
ssou(iim+1,j)=dragu(l+1)+liftu(l+1) |
| 179 |
ssov(iim+1,j)=dragv(l+1)+liftv(l+1) |
| 180 |
blsu(iim+1,j)=phyu(l+1)-dragu(l+1)-liftu(l+1) |
| 181 |
blsv(iim+1,j)=phyv(l+1)-dragv(l+1)-liftv(l+1) |
| 182 |
zlon(iim+1)=-plon(l+1)*xpi/180. |
| 183 |
zlat(j)=plat(l+1)*xpi/180. |
| 184 |
|
| 185 |
ub(iim+1,j)=0. |
| 186 |
vb(iim+1,j)=0. |
| 187 |
do k=1,nlev |
| 188 |
ub(iim+1,j)=ub(iim+1,j)+u(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg |
| 189 |
vb(iim+1,j)=vb(iim+1,j)+v(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg |
| 190 |
enddo |
| 191 |
|
| 192 |
|
| 193 |
do i=1,iim |
| 194 |
|
| 195 |
l=l+1 |
| 196 |
zs(i,j)=phis(l)/rg |
| 197 |
ps(i,j)=p(l,1) |
| 198 |
ssou(i,j)=dragu(l)+liftu(l) |
| 199 |
ssov(i,j)=dragv(l)+liftv(l) |
| 200 |
blsu(i,j)=phyu(l)-dragu(l)-liftu(l) |
| 201 |
blsv(i,j)=phyv(l)-dragv(l)-liftv(l) |
| 202 |
zlon(i)=plon(l)*xpi/180. |
| 203 |
|
| 204 |
ub(i,j)=0. |
| 205 |
vb(i,j)=0. |
| 206 |
do k=1,nlev |
| 207 |
ub(i,j)=ub(i,j)+u(l,k)*(p(l,k)-p(l,k+1))/rg |
| 208 |
vb(i,j)=vb(i,j)+v(l,k)*(p(l,k)-p(l,k+1))/rg |
| 209 |
enddo |
| 210 |
|
| 211 |
enddo |
| 212 |
|
| 213 |
enddo |
| 214 |
|
| 215 |
|
| 216 |
C South Pole |
| 217 |
|
| 218 |
l=l+1 |
| 219 |
ub(1,jjm+1)=0. |
| 220 |
vb(1,jjm+1)=0. |
| 221 |
do k=1,nlev |
| 222 |
ub(1,jjm+1)=ub(1,jjm+1)+u(l,k)*(p(l,k)-p(l,k+1))/rg |
| 223 |
vb(1,jjm+1)=vb(1,jjm+1)+v(l,k)*(p(l,k)-p(l,k+1))/rg |
| 224 |
enddo |
| 225 |
zlat(jjm+1)=plat(l)*xpi/180. |
| 226 |
|
| 227 |
do i=1,iim+1 |
| 228 |
zs(i,jjm+1)=phis(l)/rg |
| 229 |
ps(i,jjm+1)=p(l,1) |
| 230 |
ssou(i,jjm+1)=dragu(l)+liftu(l) |
| 231 |
ssov(i,jjm+1)=dragv(l)+liftv(l) |
| 232 |
blsu(i,jjm+1)=phyu(l)-dragu(l)-liftu(l) |
| 233 |
blsv(i,jjm+1)=phyv(l)-dragv(l)-liftv(l) |
| 234 |
ub(i,jjm+1)=ub(1,jjm+1) |
| 235 |
vb(i,jjm+1)=vb(1,jjm+1) |
| 236 |
enddo |
| 237 |
|
| 238 |
C |
| 239 |
C MOMENT ANGULAIRE |
| 240 |
C |
| 241 |
DO j=1,jjm |
| 242 |
DO i=1,iim |
| 243 |
|
| 244 |
raam(1)=raam(1)-rea**3*dlon*dlat*0.5* |
| 245 |
c (cos(zlon(i ))*sin(zlat(j ))*cos(zlat(j ))*ub(i ,j ) |
| 246 |
c +cos(zlon(i ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i ,j+1)) |
| 247 |
c +rea**3*dlon*dlat*0.5* |
| 248 |
c (sin(zlon(i ))*cos(zlat(j ))*vb(i ,j ) |
| 249 |
c +sin(zlon(i ))*cos(zlat(j+1))*vb(i ,j+1)) |
| 250 |
|
| 251 |
oaam(1)=oaam(1)-ome*rea**4*dlon*dlat/rg*0.5* |
| 252 |
c (cos(zlon(i ))*cos(zlat(j ))**2*sin(zlat(j ))*ps(i ,j ) |
| 253 |
c +cos(zlon(i ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i ,j+1)) |
| 254 |
|
| 255 |
raam(2)=raam(2)-rea**3*dlon*dlat*0.5* |
| 256 |
c (sin(zlon(i ))*sin(zlat(j ))*cos(zlat(j ))*ub(i ,j ) |
| 257 |
c +sin(zlon(i ))*sin(zlat(j+1))*cos(zlat(j+1))*ub(i ,j+1)) |
| 258 |
c -rea**3*dlon*dlat*0.5* |
| 259 |
c (cos(zlon(i ))*cos(zlat(j ))*vb(i ,j ) |
| 260 |
c +cos(zlon(i ))*cos(zlat(j+1))*vb(i ,j+1)) |
| 261 |
|
| 262 |
oaam(2)=oaam(2)-ome*rea**4*dlon*dlat/rg*0.5* |
| 263 |
c (sin(zlon(i ))*cos(zlat(j ))**2*sin(zlat(j ))*ps(i ,j ) |
| 264 |
c +sin(zlon(i ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i ,j+1)) |
| 265 |
|
| 266 |
raam(3)=raam(3)+rea**3*dlon*dlat*0.5* |
| 267 |
c (cos(zlat(j))**2*ub(i,j)+cos(zlat(j+1))**2*ub(i,j+1)) |
| 268 |
|
| 269 |
oaam(3)=oaam(3)+ome*rea**4*dlon*dlat/rg*0.5* |
| 270 |
c (cos(zlat(j))**3*ps(i,j)+cos(zlat(j+1))**3*ps(i,j+1)) |
| 271 |
|
| 272 |
ENDDO |
| 273 |
ENDDO |
| 274 |
|
| 275 |
C |
| 276 |
C COUPLE DES MONTAGNES: |
| 277 |
C |
| 278 |
|
| 279 |
DO j=1,jjm |
| 280 |
DO i=1,iim |
| 281 |
tmou(1)=tmou(1)-rea**2*dlon*0.5*sin(zlon(i)) |
| 282 |
c *(zs(i,j)-zs(i,j+1)) |
| 283 |
c *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) |
| 284 |
tmou(2)=tmou(2)+rea**2*dlon*0.5*cos(zlon(i)) |
| 285 |
c *(zs(i,j)-zs(i,j+1)) |
| 286 |
c *(cos(zlat(j+1))*ps(i,j+1)+cos(zlat(j))*ps(i,j)) |
| 287 |
ENDDO |
| 288 |
ENDDO |
| 289 |
|
| 290 |
DO j=2,jjm |
| 291 |
DO i=1,iim |
| 292 |
tmou(1)=tmou(1)+rea**2*dlat*0.5*sin(zlat(j)) |
| 293 |
c *(zs(i+1,j)-zs(i,j)) |
| 294 |
c *(cos(zlon(i+1))*ps(i+1,j)+cos(zlon(i))*ps(i,j)) |
| 295 |
tmou(2)=tmou(2)+rea**2*dlat*0.5*sin(zlat(j)) |
| 296 |
c *(zs(i+1,j)-zs(i,j)) |
| 297 |
c *(sin(zlon(i+1))*ps(i+1,j)+sin(zlon(i))*ps(i,j)) |
| 298 |
tmou(3)=tmou(3)-rea**2*dlat*0.5* |
| 299 |
c cos(zlat(j))*(zs(i+1,j)-zs(i,j))*(ps(i+1,j)+ps(i,j)) |
| 300 |
ENDDO |
| 301 |
ENDDO |
| 302 |
|
| 303 |
C |
| 304 |
C COUPLES DES DIFFERENTES FRICTION AU SOL: |
| 305 |
C |
| 306 |
l=1 |
| 307 |
DO j=2,jjm |
| 308 |
DO i=1,iim |
| 309 |
l=l+1 |
| 310 |
tsso(1)=tsso(1)-rea**3*cos(zlat(j))*dlon*dlat* |
| 311 |
c ssou(i,j) *sin(zlat(j))*cos(zlon(i)) |
| 312 |
c +rea**3*cos(zlat(j))*dlon*dlat* |
| 313 |
c ssov(i,j) *sin(zlon(i)) |
| 314 |
|
| 315 |
tsso(2)=tsso(2)-rea**3*cos(zlat(j))*dlon*dlat* |
| 316 |
c ssou(i,j) *sin(zlat(j))*sin(zlon(i)) |
| 317 |
c -rea**3*cos(zlat(j))*dlon*dlat* |
| 318 |
c ssov(i,j) *cos(zlon(i)) |
| 319 |
|
| 320 |
tsso(3)=tsso(3)+rea**3*cos(zlat(j))*dlon*dlat* |
| 321 |
c ssou(i,j) *cos(zlat(j)) |
| 322 |
|
| 323 |
tbls(1)=tbls(1)-rea**3*cos(zlat(j))*dlon*dlat* |
| 324 |
c blsu(i,j) *sin(zlat(j))*cos(zlon(i)) |
| 325 |
c +rea**3*cos(zlat(j))*dlon*dlat* |
| 326 |
c blsv(i,j) *sin(zlon(i)) |
| 327 |
|
| 328 |
tbls(2)=tbls(2)-rea**3*cos(zlat(j))*dlon*dlat* |
| 329 |
c blsu(i,j) *sin(zlat(j))*sin(zlon(i)) |
| 330 |
c -rea**3*cos(zlat(j))*dlon*dlat* |
| 331 |
c blsv(i,j) *cos(zlon(i)) |
| 332 |
|
| 333 |
tbls(3)=tbls(3)+rea**3*cos(zlat(j))*dlon*dlat* |
| 334 |
c blsu(i,j) *cos(zlat(j)) |
| 335 |
|
| 336 |
ENDDO |
| 337 |
ENDDO |
| 338 |
|
| 339 |
|
| 340 |
100 format(F12.5,15(1x,F12.5)) |
| 341 |
|
| 342 |
aam=raam(3) |
| 343 |
torsfc= tmou(3)+tsso(3)+tbls(3) |
| 344 |
c |
| 345 |
RETURN |
| 346 |
END |
Parent Directory
| 
Revision Log