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

Diff of /trunk/Sources/phylmd/aaam_bud.f

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

revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC revision 227 by guez, Thu Nov 2 15:47:03 2017 UTC
# Line 4  module aaam_bud_m Line 4  module aaam_bud_m
4    
5  contains  contains
6    
7    subroutine aaam_bud(rea, rg, ome, plat, plon, phis, dragu, liftu, phyu, &    subroutine aaam_bud(rg, ome, phis, dragu, liftu, phyu, dragv, liftv, phyv, &
8         dragv, liftv, phyv, p, u, v, aam, torsfc)         p, u, v, aam, torsfc)
9    
10      ! Author: F. Lott (LMD/CNRS). Date: 2003/10/20. Object: Compute      ! Author: F. Lott (LMD/CNRS). Date: 2003/10/20. Object: Compute
11      ! different terms of the axial AAAM budget and mountain torque.      ! different terms of the axial AAAM budget and mountain torque.
# Line 14  contains Line 14  contains
14    
15      USE dimens_m, ONLY : iim, jjm      USE dimens_m, ONLY : iim, jjm
16      use nr_util, only: assert_eq, assert, pi      use nr_util, only: assert_eq, assert, pi
17        use phyetat0_m, only: rlat, rlon
18        USE suphec_m, ONLY: ra
19    
     real, intent(in):: rea ! Earth radius  
20      real, intent(in):: rg ! gravity constant      real, intent(in):: rg ! gravity constant
21      real, intent(in):: ome ! Earth rotation rate      real, intent(in):: ome ! Earth rotation rate
   
     REAL, intent(in):: plat(:), plon(:)  
     ! (nlon) latitude and longitude in degrees  
   
22      real, intent(in):: phis(:) ! (nlon) Geopotential at the ground      real, intent(in):: phis(:) ! (nlon) Geopotential at the ground
23      REAL, intent(in):: dragu(:) ! (nlon) orodrag stress (zonal)      REAL, intent(in):: dragu(:) ! (nlon) orodrag stress (zonal)
24      REAL, intent(in):: liftu(:) ! (nlon) orolift stress (zonal)      REAL, intent(in):: liftu(:) ! (nlon) orolift stress (zonal)
# Line 41  contains Line 38  contains
38    
39      INTEGER nlev ! number of vertical levels      INTEGER nlev ! number of vertical levels
40      INTEGER i, j, k, l      INTEGER i, j, k, l
     REAL hadley, hadday  
41      REAL dlat, dlon ! latitude and longitude increments (radians)      REAL dlat, dlon ! latitude and longitude increments (radians)
42    
43      REAL raam(3) ! wind AAM (components 1 & 2: equatorial; component 3: axial)      REAL raam(3) ! wind AAM (components 1 & 2: equatorial; component 3: axial)
# Line 59  contains Line 55  contains
55    
56      !-------------------------------------------------------------------      !-------------------------------------------------------------------
57    
58      call assert(size(plat) == (/size(plon), size(phis), size(dragu), &      call assert(size(phis) == (/size(dragu), size(liftu), size(phyu), &
59           size(liftu), size(phyu), size(dragv), size(liftv), size(phyv), &           size(dragv), size(liftv), size(phyv), size(p, 1), size(u, 1), &
60           size(p, 1), size(u, 1), size(v, 1)/), "aaam_bud nlon")           size(v, 1)/), "aaam_bud nlon")
61      nlev = assert_eq(size(p, 2) - 1, size(u, 2), size(v, 2), "aaam_bud nlev")      nlev = assert_eq(size(p, 2) - 1, size(u, 2), size(v, 2), "aaam_bud nlev")
62    
63      if (iim + 1 > 801 .or. jjm + 1 > 401) then      if (iim + 1 > 801 .or. jjm + 1 > 401) then
# Line 69  contains Line 65  contains
65         stop 1         stop 1
66      endif      endif
67    
     hadley = 1e18  
     hadday = 1e18 * 24. * 3600.  
68      dlat = pi / jjm      dlat = pi / jjm
69      dlon = 2 * pi / real(iim)      dlon = 2 * pi / real(iim)
70    
# Line 91  contains Line 85  contains
85         vb(1, 1) = vb(1, 1) + v(1, k) * (p(1, k) - p(1, k + 1)) / rg         vb(1, 1) = vb(1, 1) + v(1, k) * (p(1, k) - p(1, k + 1)) / rg
86      enddo      enddo
87    
88      zlat(1) = plat(1) * pi / 180.      zlat(1) = rlat(1) * pi / 180.
89    
90      do i = 1, iim + 1      do i = 1, iim + 1
91         zs(i, 1) = phis(1) / rg         zs(i, 1) = phis(1) / rg
# Line 114  contains Line 108  contains
108         ssov(iim + 1, j) = dragv(l + 1) + liftv(l + 1)         ssov(iim + 1, j) = dragv(l + 1) + liftv(l + 1)
109         blsu(iim + 1, j) = phyu(l + 1) - dragu(l + 1) - liftu(l + 1)         blsu(iim + 1, j) = phyu(l + 1) - dragu(l + 1) - liftu(l + 1)
110         blsv(iim + 1, j) = phyv(l + 1) - dragv(l + 1) - liftv(l + 1)         blsv(iim + 1, j) = phyv(l + 1) - dragv(l + 1) - liftv(l + 1)
111         zlon(iim + 1) = - plon(l + 1) * pi / 180.         zlon(iim + 1) = - rlon(l + 1) * pi / 180.
112         zlat(j) = plat(l + 1) * pi / 180.         zlat(j) = rlat(l + 1) * pi / 180.
113    
114         ub(iim + 1, j) = 0.         ub(iim + 1, j) = 0.
115         vb(iim + 1, j) = 0.         vb(iim + 1, j) = 0.
# Line 134  contains Line 128  contains
128            ssov(i, j) = dragv(l) + liftv(l)            ssov(i, j) = dragv(l) + liftv(l)
129            blsu(i, j) = phyu(l) - dragu(l) - liftu(l)            blsu(i, j) = phyu(l) - dragu(l) - liftu(l)
130            blsv(i, j) = phyv(l) - dragv(l) - liftv(l)            blsv(i, j) = phyv(l) - dragv(l) - liftv(l)
131            zlon(i) = plon(l) * pi / 180.            zlon(i) = rlon(l) * pi / 180.
132    
133            ub(i, j) = 0.            ub(i, j) = 0.
134            vb(i, j) = 0.            vb(i, j) = 0.
# Line 154  contains Line 148  contains
148         ub(1, jjm + 1) = ub(1, jjm + 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
149         vb(1, jjm + 1) = vb(1, jjm + 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
150      enddo      enddo
151      zlat(jjm + 1) = plat(l) * pi / 180.      zlat(jjm + 1) = rlat(l) * pi / 180.
152    
153      do i = 1, iim + 1      do i = 1, iim + 1
154         zs(i, jjm + 1) = phis(l) / rg         zs(i, jjm + 1) = phis(l) / rg
# Line 171  contains Line 165  contains
165    
166      DO j = 1, jjm      DO j = 1, jjm
167         DO i = 1, iim         DO i = 1, iim
168            raam(1) = raam(1) - rea**3 * dlon * dlat * 0.5 * (cos(zlon(i )) &            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 )) &                 * 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)) &                 * sin(zlat(j + 1)) * cos(zlat(j + 1)) * ub(i , j + 1)) &
171                 + rea**3 * dlon * dlat * 0.5 * (sin(zlon(i )) * cos(zlat(j )) &                 + ra**3 * dlon * dlat * 0.5 * (sin(zlon(i )) * cos(zlat(j )) &
172                 * vb(i , j ) + sin(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1))                 * vb(i , j ) + sin(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1))
173    
174            oaam(1) = oaam(1) - ome * rea**4 * dlon * dlat / rg * 0.5 &            oaam(1) = oaam(1) - ome * ra**4 * dlon * dlat / rg * 0.5 &
175                 * (cos(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) &                 * (cos(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) &
176                 * ps(i , j ) + cos(zlon(i )) * cos(zlat(j + 1))**2 &                 * ps(i , j ) + cos(zlon(i )) * cos(zlat(j + 1))**2 &
177                 * sin(zlat(j + 1)) * ps(i , j + 1))                 * sin(zlat(j + 1)) * ps(i , j + 1))
178    
179            raam(2) = raam(2) - rea**3 * dlon * dlat * 0.5 * (sin(zlon(i )) &            raam(2) = raam(2) - ra**3 * dlon * dlat * 0.5 * (sin(zlon(i )) &
180                 * sin(zlat(j )) * cos(zlat(j )) * ub(i , j ) + sin(zlon(i )) &                 * sin(zlat(j )) * cos(zlat(j )) * ub(i , j ) + sin(zlon(i )) &
181                 * sin(zlat(j + 1)) * cos(zlat(j + 1)) * ub(i , j + 1)) &                 * sin(zlat(j + 1)) * cos(zlat(j + 1)) * ub(i , j + 1)) &
182                 - rea**3 * dlon * dlat * 0.5 * (cos(zlon(i )) * cos(zlat(j )) &                 - ra**3 * dlon * dlat * 0.5 * (cos(zlon(i )) * cos(zlat(j )) &
183                 * vb(i , j ) + cos(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1))                 * vb(i , j ) + cos(zlon(i )) * cos(zlat(j + 1)) * vb(i , j + 1))
184    
185            oaam(2) = oaam(2) - ome * rea**4 * dlon * dlat / rg * 0.5 &            oaam(2) = oaam(2) - ome * ra**4 * dlon * dlat / rg * 0.5 &
186                 * (sin(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) &                 * (sin(zlon(i )) * cos(zlat(j ))**2 * sin(zlat(j )) &
187                 * ps(i , j ) + sin(zlon(i )) * cos(zlat(j + 1))**2 &                 * ps(i , j ) + sin(zlon(i )) * cos(zlat(j + 1))**2 &
188                 * sin(zlat(j + 1)) * ps(i , j + 1))                 * sin(zlat(j + 1)) * ps(i , j + 1))
189    
190            raam(3) = raam(3) + rea**3 * dlon * dlat * 0.5 * (cos(zlat(j))**2 &            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))                 * ub(i, j) + cos(zlat(j + 1))**2 * ub(i, j + 1))
192    
193            oaam(3) = oaam(3) + ome * rea**4 * dlon * dlat / rg * 0.5 &            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 &                 * (cos(zlat(j))**3 * ps(i, j) + cos(zlat(j + 1))**3 &
195                 * ps(i, j + 1))                 * ps(i, j + 1))
196         ENDDO         ENDDO
# Line 206  contains Line 200  contains
200    
201      DO j = 1, jjm      DO j = 1, jjm
202         DO i = 1, iim         DO i = 1, iim
203            tmou(1) = tmou(1) - rea**2 * dlon * 0.5 * sin(zlon(i)) &            tmou(1) = tmou(1) - ra**2 * dlon * 0.5 * sin(zlon(i)) &
204                 * (zs(i, j) - zs(i, j + 1)) &                 * (zs(i, j) - zs(i, j + 1)) &
205                 * (cos(zlat(j + 1)) * ps(i, j + 1) + cos(zlat(j)) * ps(i, j))                 * (cos(zlat(j + 1)) * ps(i, j + 1) + cos(zlat(j)) * ps(i, j))
206            tmou(2) = tmou(2) + rea**2 * dlon * 0.5 * cos(zlon(i)) &            tmou(2) = tmou(2) + ra**2 * dlon * 0.5 * cos(zlon(i)) &
207                 * (zs(i, j) - zs(i, j + 1)) &                 * (zs(i, j) - zs(i, j + 1)) &
208                 * (cos(zlat(j + 1)) * ps(i, j + 1) + cos(zlat(j)) * ps(i, j))                 * (cos(zlat(j + 1)) * ps(i, j + 1) + cos(zlat(j)) * ps(i, j))
209         ENDDO         ENDDO
# Line 217  contains Line 211  contains
211    
212      DO j = 2, jjm      DO j = 2, jjm
213         DO i = 1, iim         DO i = 1, iim
214            tmou(1) = tmou(1) + rea**2 * dlat * 0.5 * sin(zlat(j)) &            tmou(1) = tmou(1) + ra**2 * dlat * 0.5 * sin(zlat(j)) &
215                 * (zs(i + 1, j) - zs(i, j)) &                 * (zs(i + 1, j) - zs(i, j)) &
216                 * (cos(zlon(i + 1)) * ps(i + 1, j) + cos(zlon(i)) * ps(i, j))                 * (cos(zlon(i + 1)) * ps(i + 1, j) + cos(zlon(i)) * ps(i, j))
217            tmou(2) = tmou(2) + rea**2 * dlat * 0.5 * sin(zlat(j)) &            tmou(2) = tmou(2) + ra**2 * dlat * 0.5 * sin(zlat(j)) &
218                 * (zs(i + 1, j) - zs(i, j)) &                 * (zs(i + 1, j) - zs(i, j)) &
219                 * (sin(zlon(i + 1)) * ps(i + 1, j) + sin(zlon(i)) * ps(i, j))                 * (sin(zlon(i + 1)) * ps(i + 1, j) + sin(zlon(i)) * ps(i, j))
220            tmou(3) = tmou(3) - rea**2 * dlat * 0.5* cos(zlat(j)) &            tmou(3) = tmou(3) - ra**2 * dlat * 0.5* cos(zlat(j)) &
221                 * (zs(i + 1, j) - zs(i, j)) * (ps(i + 1, j) + ps(i, j))                 * (zs(i + 1, j) - zs(i, j)) * (ps(i + 1, j) + ps(i, j))
222         ENDDO         ENDDO
223      ENDDO      ENDDO
# Line 232  contains Line 226  contains
226    
227      DO j = 2, jjm      DO j = 2, jjm
228         DO i = 1, iim         DO i = 1, iim
229            tsso(1) = tsso(1) - rea**3 * cos(zlat(j)) * dlon * dlat* &            tsso(1) = tsso(1) - ra**3 * cos(zlat(j)) * dlon * dlat* &
230                 ssou(i, j) * sin(zlat(j)) * cos(zlon(i)) &                 ssou(i, j) * sin(zlat(j)) * cos(zlon(i)) &
231                 + rea**3 * cos(zlat(j)) * dlon * dlat* &                 + ra**3 * cos(zlat(j)) * dlon * dlat* &
232                 ssov(i, j) * sin(zlon(i))                 ssov(i, j) * sin(zlon(i))
233    
234            tsso(2) = tsso(2) - rea**3 * cos(zlat(j)) * dlon * dlat* &            tsso(2) = tsso(2) - ra**3 * cos(zlat(j)) * dlon * dlat* &
235                 ssou(i, j) * sin(zlat(j)) * sin(zlon(i)) &                 ssou(i, j) * sin(zlat(j)) * sin(zlon(i)) &
236                 - rea**3 * cos(zlat(j)) * dlon * dlat* &                 - ra**3 * cos(zlat(j)) * dlon * dlat* &
237                 ssov(i, j) * cos(zlon(i))                 ssov(i, j) * cos(zlon(i))
238    
239            tsso(3) = tsso(3) + rea**3 * cos(zlat(j)) * dlon * dlat* &            tsso(3) = tsso(3) + ra**3 * cos(zlat(j)) * dlon * dlat* &
240                 ssou(i, j) * cos(zlat(j))                 ssou(i, j) * cos(zlat(j))
241    
242            tbls(1) = tbls(1) - rea**3 * cos(zlat(j)) * dlon * dlat* &            tbls(1) = tbls(1) - ra**3 * cos(zlat(j)) * dlon * dlat* &
243                 blsu(i, j) * sin(zlat(j)) * cos(zlon(i)) &                 blsu(i, j) * sin(zlat(j)) * cos(zlon(i)) &
244                 + rea**3 * cos(zlat(j)) * dlon * dlat* &                 + ra**3 * cos(zlat(j)) * dlon * dlat* &
245                 blsv(i, j) * sin(zlon(i))                 blsv(i, j) * sin(zlon(i))
246    
247            tbls(2) = tbls(2) - rea**3 * cos(zlat(j)) * dlon * dlat* &            tbls(2) = tbls(2) - ra**3 * cos(zlat(j)) * dlon * dlat* &
248                 blsu(i, j) * sin(zlat(j)) * sin(zlon(i)) &                 blsu(i, j) * sin(zlat(j)) * sin(zlon(i)) &
249                 - rea**3 * cos(zlat(j)) * dlon * dlat* &                 - ra**3 * cos(zlat(j)) * dlon * dlat* &
250                 blsv(i, j) * cos(zlon(i))                 blsv(i, j) * cos(zlon(i))
251    
252            tbls(3) = tbls(3) + rea**3 * cos(zlat(j)) * dlon * dlat* &            tbls(3) = tbls(3) + ra**3 * cos(zlat(j)) * dlon * dlat* &
253                 blsu(i, j) * cos(zlat(j))                 blsu(i, j) * cos(zlat(j))
254         ENDDO         ENDDO
255      ENDDO      ENDDO
Legend:
Removed from v.134  
changed lines
  Added in v.227
  ViewVC Help
Powered by ViewVC 1.1.21