/[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 178 by guez, Fri Mar 11 18:47:26 2016 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(rg, ome, plat, plon, phis, dragu, liftu, phyu, dragv, &    subroutine aaam_bud(rg, ome, phis, dragu, liftu, phyu, dragv, liftv, phyv, &
8         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      USE suphec_m, ONLY: ra
19    
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 58  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 88  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 111  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 131  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 151  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

Legend:
Removed from v.178  
changed lines
  Added in v.227

  ViewVC Help
Powered by ViewVC 1.1.21