/[lmdze]/trunk/libf/phylmd/aaam_bud.f90
ViewVC logotype

Annotation of /trunk/libf/phylmd/aaam_bud.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (hide annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 2 months ago) by guez
Original Path: trunk/libf/phylmd/aaam_bud.f
File size: 10819 byte(s)
Initial import
1 guez 3 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

  ViewVC Help
Powered by ViewVC 1.1.21