/[lmdze]/trunk/phylmd/aaam_bud.f
ViewVC logotype

Diff of /trunk/phylmd/aaam_bud.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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