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

Diff of /trunk/phylmd/aaam_bud.f90

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

trunk/libf/phylmd/aaam_bud.f revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/phylmd/aaam_bud.f90 revision 328 by guez, Thu Jun 13 14:40:06 2019 UTC
# Line 1  Line 1 
1        subroutine aaam_bud (iam,nlon,nlev,rjour,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 rjour---input-R-Jour compte depuis le debut de la simu (run.def)      INTEGER nlev ! number of vertical levels
40  c rsec----input-R-Seconde de la journee      INTEGER i, j, k, l
41  c rea-----input-R-Earth radius      REAL dlat, dlon ! latitude and longitude increments (radians)
42  c rg------input-R-gravity constant  
43  c ome-----input-R-Earth rotation rate      REAL raam(3) ! wind AAM (components 1 & 2: equatorial; component 3: axial)
44  c plat ---input-R-Latitude en degres      REAL oaam(3) ! mass AAM (components 1 & 2: equatorial; component 3: axial)
45  c plon ---input-R-Longitude en degres      REAL tmou(3) ! resolved mountain torque (3 components)
46  c phis ---input-R-Geopotential at the ground      REAL tsso(3) ! parameterised moutain drag torque (3 components)
47  c dragu---input-R-orodrag stress (zonal)      REAL tbls(3) ! parameterised boundary layer torque (3 components)
48  c liftu---input-R-orolift stress (zonal)  
49  c phyu----input-R-Stress total de la physique (zonal)      REAL ZS(801, 401) ! topographic height
50  c dragv---input-R-orodrag stress (Meridional)      REAL PS(801, 401) ! surface pressure
51  c liftv---input-R-orolift stress (Meridional)      REAL UB(801, 401), VB(801, 401) ! barotropic wind, zonal and meridional
52  c phyv----input-R-Stress total de la physique (Meridional)      REAL SSOU(801, 401), SSOV(801, 401)
53  c p-------input-R-Pressure (Pa) at model half levels      REAL BLSU(801, 401), BLSV(801, 401)
54  c u-------input-R-Horizontal wind (m/s)      REAL ZLON(801), ZLAT(401) ! longitude and latitude in radians
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      call assert(size(phis) == (/size(dragu), size(liftu), size(phyu), &
59  c Implicit Arguments:           size(dragv), size(liftv), size(phyv), size(p, 1), size(u, 1), &
60  c ===================           size(v, 1)/), "aaam_bud nlon")
61  c      nlev = assert_eq(size(p, 2) - 1, size(u, 2), size(v, 2), "aaam_bud nlev")
62  c iim--common-I: Number of longitude intervals  
63  c jjm--common-I: Number of latitude intervals      if (iim + 1 > 801 .or. jjm + 1 > 401) then
64  c klon-common-I: Number of points seen by the physics         print *, ' Problème de dimension dans aaam_bud'
65  c                iim*(jjm-1)+2 for instance         stop 1
66  c klev-common-I: Number of vertical layers      endif
67  c======================================================================  
68  c Local Variables:      dlat = pi / jjm
69  c ================      dlon = 2 * pi / real(iim)
70  c dlat-----R: Latitude increment (Radians)  
71  c dlon-----R: Longitude increment (Radians)      oaam = 0.
72  c raam  ---R: Wind AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)      raam = 0.
73  c oaam  ---R: Mass AAM (3 Components, 1 & 2 Equatoriales; 3 Axiale)      tmou = 0.
74  c tmou-----R: Resolved Mountain torque (3 components)      tsso = 0.
75  c tsso-----R: Parameterised Moutain drag torque (3 components)      tbls = 0.
76  c tbls-----R: Parameterised Boundary layer torque (3 components)  
77  c      ! Mountain height, pressure and barotropic wind:
78  c LOCAL ARRAY:  
79  c ===========      ! North pole values (j = 1):
80  c zs    ---R: Topographic height  
81  c ps    ---R: Surface Pressure        ub(1, 1) = 0.
82  c ub    ---R: Barotropic wind zonal      vb(1, 1) = 0.
83  c vb    ---R: Barotropic wind meridional      do k = 1, nlev
84  c zlat  ---R: Latitude in radians         ub(1, 1) = ub(1, 1) + u(1, k) * (p(1, k) - p(1, k + 1)) / rg
85  c zlon  ---R: Longitude in radians         vb(1, 1) = vb(1, 1) + v(1, k) * (p(1, k) - p(1, k + 1)) / rg
86  c======================================================================      enddo
87    
88  c      zlat(1) = rlat(1) * pi / 180.
89  c ARGUMENTS  
90  c      do i = 1, iim + 1
91        INTEGER iam,nlon,nlev         zs(i, 1) = phis(1) / rg
92        REAL rjour         ps(i, 1) = p(1, 1)
93        real, intent(in):: rsec         ub(i, 1) = ub(1, 1)
94        real rea         vb(i, 1) = vb(1, 1)
95        real, intent(in):: rg         ssou(i, 1) = dragu(1) + liftu(1)
96        real ome         ssov(i, 1) = dragv(1) + liftv(1)
97        REAL, intent(in):: plat(nlon),plon(nlon)         blsu(i, 1) = phyu(1) - dragu(1) - liftu(1)
98        real phis(nlon)         blsv(i, 1) = phyv(1) - dragv(1) - liftv(1)
99        REAL dragu(nlon),liftu(nlon),phyu(nlon)                  enddo
100        REAL dragv(nlon),liftv(nlon),phyv(nlon)              
101        REAL, intent(in):: p(nlon,nlev+1)      l = 1
102        real u(nlon,nlev), v(nlon,nlev)      do j = 2, jjm
103  c         ! Values at Greenwich (Periodicity)
104  c Variables locales:  
105  c         zs(iim + 1, j) = phis(l + 1) / rg
106        INTEGER i,j,k,l         ps(iim + 1, j) = p(l + 1, 1)
107        REAL xpi,hadley,hadday         ssou(iim + 1, j) = dragu(l + 1) + liftu(l + 1)
108        REAL dlat,dlon         ssov(iim + 1, j) = dragv(l + 1) + liftv(l + 1)
109        REAL raam(3),oaam(3),tmou(3),tsso(3),tbls(3)         blsu(iim + 1, j) = phyu(l + 1) - dragu(l + 1) - liftu(l + 1)
110        integer iax         blsv(iim + 1, j) = phyv(l + 1) - dragv(l + 1) - liftv(l + 1)
111  cIM ajout aam, torsfc         zlon(iim + 1) = - rlon(l + 1) * pi / 180.
112  c aam = composante axiale du Wind AAM raam         zlat(j) = rlat(l + 1) * pi / 180.
113  c torsfc = composante axiale de (tmou+tsso+tbls)  
114        REAL aam, torsfc         ub(iim + 1, j) = 0.
115           vb(iim + 1, j) = 0.
116        REAL ZS(801,401),PS(801,401)         do k = 1, nlev
117        REAL UB(801,401),VB(801,401)            ub(iim + 1, j) = ub(iim + 1, j) &
118        REAL SSOU(801,401),SSOV(801,401)                 + u(l + 1, k) * (p(l + 1, k) - p(l + 1, k + 1)) / rg
119        REAL BLSU(801,401),BLSV(801,401)            vb(iim + 1, j) = vb(iim + 1, j) &
120        REAL ZLON(801),ZLAT(401)                 + v(l + 1, k) * (p(l + 1, k) - p(l + 1, k + 1)) / rg
121  C         enddo
122  C  PUT AAM QUANTITIES AT ZERO:  
123  C         do i = 1, iim
124        if(iim+1.gt.801.or.jjm+1.gt.401)then            l = l + 1
125        print *,' Pb de dimension dans aaam_bud'            zs(i, j) = phis(l) / rg
126        stop            ps(i, j) = p(l, 1)
127        endif            ssou(i, j) = dragu(l) + liftu(l)
128              ssov(i, j) = dragv(l) + liftv(l)
129        xpi=acos(-1.)            blsu(i, j) = phyu(l) - dragu(l) - liftu(l)
130        hadley=1.e18            blsv(i, j) = phyv(l) - dragv(l) - liftv(l)
131        hadday=1.e18*24.*3600.            zlon(i) = rlon(l) * pi / 180.
132        dlat=xpi/float(jjm)  
133        dlon=2.*xpi/float(iim)            ub(i, j) = 0.
134                    vb(i, j) = 0.
135        do iax=1,3            do k = 1, nlev
136        oaam(iax)=0.               ub(i, j) = ub(i, j) + u(l, k) * (p(l, k) - p(l, k + 1)) / rg
137        raam(iax)=0.               vb(i, j) = vb(i, j) + v(l, k) * (p(l, k) - p(l, k + 1)) / rg
138        tmou(iax)=0.            enddo
139        tsso(iax)=0.         enddo
140        tbls(iax)=0.      enddo
141        enddo  
142        ! South Pole
143  C MOUNTAIN HEIGHT, PRESSURE AND BAROTROPIC WIND:  
144        l = l + 1
145  C North pole values (j=1):      ub(1, jjm + 1) = 0.
146        vb(1, jjm + 1) = 0.
147        l=1      do k = 1, nlev
148           ub(1, jjm + 1) = ub(1, jjm + 1) + u(l, k) * (p(l, k) - p(l, k + 1)) / rg
149          ub(1,1)=0.         vb(1, jjm + 1) = vb(1, jjm + 1) + v(l, k) * (p(l, k) - p(l, k + 1)) / rg
150          vb(1,1)=0.      enddo
151          do k=1,nlev      zlat(jjm + 1) = rlat(l) * pi / 180.
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      do i = 1, iim + 1
154          enddo         zs(i, jjm + 1) = phis(l) / rg
155           ps(i, jjm + 1) = p(l, 1)
156            zlat(1)=plat(l)*xpi/180.         ssou(i, jjm + 1) = dragu(l) + liftu(l)
157           ssov(i, jjm + 1) = dragv(l) + liftv(l)
158          do i=1,iim+1         blsu(i, jjm + 1) = phyu(l) - dragu(l) - liftu(l)
159           blsv(i, jjm + 1) = phyv(l) - dragv(l) - liftv(l)
160            zs(i,1)=phis(l)/rg         ub(i, jjm + 1) = ub(1, jjm + 1)
161            ps(i,1)=p(l,1)         vb(i, jjm + 1) = vb(1, jjm + 1)
162            ub(i,1)=ub(1,1)                                  enddo
163            vb(i,1)=vb(1,1)                              
164            ssou(i,1)=dragu(l)+liftu(l)      ! Moment angulaire
165            ssov(i,1)=dragv(l)+liftv(l)  
166            blsu(i,1)=phyu(l)-dragu(l)-liftu(l)      DO j = 1, jjm
167            blsv(i,1)=phyv(l)-dragv(l)-liftv(l)         DO i = 1, iim
168              raam(1) = raam(1) - ra**3 * dlon * dlat * 0.5 * (cos(zlon(i )) &
169          enddo                 * sin(zlat(j )) * cos(zlat(j )) * ub(i , j ) + cos(zlon(i )) &
170                   * 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        do j = 2,jjm                 * vb(i , j ) + sin(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1))
173    
174  C Values at Greenwich (Periodicity)            oaam(1) = oaam(1) - ome * ra**4 * dlon * dlat / rg * 0.5 &
175                   * (cos(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) &
176        zs(iim+1,j)=phis(l+1)/rg                 * ps(i , j ) + cos(zlon(i )) * cos(zlat(j + 1))**2 &
177        ps(iim+1,j)=p(l+1,1)                 * sin(zlat(j + 1)) * ps(i , j + 1))
178            ssou(iim+1,j)=dragu(l+1)+liftu(l+1)  
179            ssov(iim+1,j)=dragv(l+1)+liftv(l+1)            raam(2) = raam(2) - ra**3 * dlon * dlat * 0.5 * (sin(zlon(i )) &
180            blsu(iim+1,j)=phyu(l+1)-dragu(l+1)-liftu(l+1)                 * sin(zlat(j )) * cos(zlat(j )) * ub(i , j ) + sin(zlon(i )) &
181            blsv(iim+1,j)=phyv(l+1)-dragv(l+1)-liftv(l+1)                 * sin(zlat(j + 1)) * cos(zlat(j + 1)) * ub(i , j + 1)) &
182        zlon(iim+1)=-plon(l+1)*xpi/180.                 - ra**3 * dlon * dlat * 0.5 * (cos(zlon(i )) * cos(zlat(j )) &
183        zlat(j)=plat(l+1)*xpi/180.                 * vb(i , j ) + cos(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1))
184    
185        ub(iim+1,j)=0.            oaam(2) = oaam(2) - ome * ra**4 * dlon * dlat / rg * 0.5 &
186        vb(iim+1,j)=0.                 * (sin(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) &
187           do k=1,nlev                 * ps(i , j ) + sin(zlon(i )) * cos(zlat(j + 1))**2 &
188           ub(iim+1,j)=ub(iim+1,j)+u(l+1,k)*(p(l+1,k)-p(l+1,k+1))/rg                 * sin(zlat(j + 1)) * ps(i , j + 1))
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            raam(3) = raam(3) + ra**3 * dlon * dlat * 0.5 * (cos(zlat(j))**2 &
191                         * ub(i, j) + cos(zlat(j + 1))**2 * ub(i, j + 1))
192    
193        do i=1,iim            oaam(3) = oaam(3) + ome * ra**4 * dlon * dlat / rg * 0.5 &
194                   * (cos(zlat(j))**3 * ps(i, j) + cos(zlat(j + 1))**3 &
195        l=l+1                 * ps(i, j + 1))
196        zs(i,j)=phis(l)/rg         ENDDO
197        ps(i,j)=p(l,1)      ENDDO
198            ssou(i,j)=dragu(l)+liftu(l)  
199            ssov(i,j)=dragv(l)+liftv(l)      ! Couple des montagnes :
200            blsu(i,j)=phyu(l)-dragu(l)-liftu(l)  
201            blsv(i,j)=phyv(l)-dragv(l)-liftv(l)      DO j = 1, jjm
202        zlon(i)=plon(l)*xpi/180.         DO i = 1, iim
203              tmou(1) = tmou(1) - ra**2 * dlon * 0.5 * sin(zlon(i)) &
204        ub(i,j)=0.                 * (zs(i, j) - zs(i, j + 1)) &
205        vb(i,j)=0.                 * (cos(zlat(j + 1)) * ps(i, j + 1) + cos(zlat(j)) * ps(i, j))
206           do k=1,nlev            tmou(2) = tmou(2) + ra**2 * dlon * 0.5 * cos(zlon(i)) &
207           ub(i,j)=ub(i,j)+u(l,k)*(p(l,k)-p(l,k+1))/rg                 * (zs(i, j) - zs(i, j + 1)) &
208           vb(i,j)=vb(i,j)+v(l,k)*(p(l,k)-p(l,k+1))/rg                 * (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        enddo         DO i = 1, iim
214              tmou(1) = tmou(1) + ra**2 * dlat * 0.5 * sin(zlat(j)) &
215                   * (zs(i + 1, j) - zs(i, j)) &
216  C South Pole                 * (cos(zlon(i + 1)) * ps(i + 1, j) + cos(zlon(i)) * ps(i, j))
217              tmou(2) = tmou(2) + ra**2 * dlat * 0.5 * sin(zlat(j)) &
218        l=l+1                 * (zs(i + 1, j) - zs(i, j)) &
219        ub(1,jjm+1)=0.                 * (sin(zlon(i + 1)) * ps(i + 1, j) + sin(zlon(i)) * ps(i, j))
220        vb(1,jjm+1)=0.            tmou(3) = tmou(3) - ra**2 * dlat * 0.5* cos(zlat(j)) &
221        do k=1,nlev                 * (zs(i + 1, j) - zs(i, j)) * (ps(i + 1, j) + ps(i, j))
222           ub(1,jjm+1)=ub(1,jjm+1)+u(l,k)*(p(l,k)-p(l,k+1))/rg         ENDDO
223           vb(1,jjm+1)=vb(1,jjm+1)+v(l,k)*(p(l,k)-p(l,k+1))/rg      ENDDO
224        enddo  
225        zlat(jjm+1)=plat(l)*xpi/180.      ! Couples des differentes friction au sol :
226    
227        do i=1,iim+1      DO j = 2, jjm
228        zs(i,jjm+1)=phis(l)/rg         DO i = 1, iim
229        ps(i,jjm+1)=p(l,1)            tsso(1) = tsso(1) - ra**3 * cos(zlat(j)) * dlon * dlat* &
230            ssou(i,jjm+1)=dragu(l)+liftu(l)                 ssou(i, j) * sin(zlat(j)) * cos(zlon(i)) &
231            ssov(i,jjm+1)=dragv(l)+liftv(l)                 + ra**3 * cos(zlat(j)) * dlon * dlat* &
232            blsu(i,jjm+1)=phyu(l)-dragu(l)-liftu(l)                 ssov(i, j) * sin(zlon(i))
233            blsv(i,jjm+1)=phyv(l)-dragv(l)-liftv(l)  
234        ub(i,jjm+1)=ub(1,jjm+1)                                          tsso(2) = tsso(2) - ra**3 * cos(zlat(j)) * dlon * dlat* &
235        vb(i,jjm+1)=vb(1,jjm+1)                                                 ssou(i, j) * sin(zlat(j)) * sin(zlon(i)) &
236        enddo                 - ra**3 * cos(zlat(j)) * dlon * dlat* &
237                   ssov(i, j) * cos(zlon(i))
238  C  
239  C  MOMENT ANGULAIRE            tsso(3) = tsso(3) + ra**3 * cos(zlat(j)) * dlon * dlat* &
240  C                 ssou(i, j) * cos(zlat(j))
241          DO j=1,jjm      
242          DO i=1,iim            tbls(1) = tbls(1) - ra**3 * cos(zlat(j)) * dlon * dlat* &
243                   blsu(i, j) * sin(zlat(j)) * cos(zlon(i)) &
244             raam(1)=raam(1)-rea**3*dlon*dlat*0.5*                 + ra**3 * cos(zlat(j)) * dlon * dlat* &
245       c    (cos(zlon(i  ))*sin(zlat(j  ))*cos(zlat(j  ))*ub(i  ,j  )                 blsv(i, j) * sin(zlon(i))
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*            tbls(2) = tbls(2) - ra**3 * cos(zlat(j)) * dlon * dlat* &
248       c    (sin(zlon(i  ))*cos(zlat(j  ))*vb(i  ,j  )                 blsu(i, j) * sin(zlat(j)) * sin(zlon(i)) &
249       c    +sin(zlon(i  ))*cos(zlat(j+1))*vb(i  ,j+1))                 - ra**3 * cos(zlat(j)) * dlon * dlat* &
250                   blsv(i, j) * cos(zlon(i))
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  )            tbls(3) = tbls(3) + ra**3 * cos(zlat(j)) * dlon * dlat* &
253       c   +cos(zlon(i  ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i  ,j+1))                 blsu(i, j) * cos(zlat(j))
254           ENDDO
255             raam(2)=raam(2)-rea**3*dlon*dlat*0.5*      ENDDO
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))      aam = raam(3)
258       c                    -rea**3*dlon*dlat*0.5*      torsfc = tmou(3) + tsso(3) + tbls(3)
259       c    (cos(zlon(i  ))*cos(zlat(j  ))*vb(i  ,j  )  
260       c    +cos(zlon(i  ))*cos(zlat(j+1))*vb(i  ,j+1))    END subroutine aaam_bud
261    
262             oaam(2)=oaam(2)-ome*rea**4*dlon*dlat/rg*0.5*  end module aaam_bud_m
      c   (sin(zlon(i  ))*cos(zlat(j  ))**2*sin(zlat(j  ))*ps(i  ,j  )  
      c   +sin(zlon(i  ))*cos(zlat(j+1))**2*sin(zlat(j+1))*ps(i  ,j+1))  
   
            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.3  
changed lines
  Added in v.328
  ViewVC Help
Powered by ViewVC 1.1.21