/[lmdze]/trunk/dyn3d/fxhyp.f
ViewVC logotype

Diff of /trunk/dyn3d/fxhyp.f

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

revision 123 by guez, Thu Feb 5 12:41:08 2015 UTC revision 124 by guez, Thu Feb 5 15:19:37 2015 UTC
# Line 19  contains Line 19  contains
19    
20      USE dimens_m, ONLY: iim      USE dimens_m, ONLY: iim
21      use fxhyp_loop_ik_m, only: fxhyp_loop_ik, nmax      use fxhyp_loop_ik_m, only: fxhyp_loop_ik, nmax
22      use nr_util, only: pi_d, twopi_d, arth      use nr_util, only: pi, pi_d, twopi_d, arth
23        use principal_cshift_m, only: principal_cshift
24      use serre, only: clon, grossismx, dzoomx, taux      use serre, only: clon, grossismx, dzoomx, taux
25    
26      REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)      REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
27      real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)      real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
28    
29      ! Local:      ! Local:
   
30      real rlonm025(iim + 1), rlonp025(iim + 1)      real rlonm025(iim + 1), rlonp025(iim + 1)
31      REAL dzoom      REAL dzoom
32      DOUBLE PRECISION xlon(iim)      real d_rlonv(iim)
33      DOUBLE PRECISION xtild(0:2 * nmax)      DOUBLE PRECISION xtild(0:2 * nmax)
34      DOUBLE PRECISION fhyp(nmax:2 * nmax), ffdx, beta, Xprimt(0:2 * nmax)      DOUBLE PRECISION fhyp(nmax:2 * nmax), ffdx, beta, Xprimt(0:2 * nmax)
35      DOUBLE PRECISION Xf(0:2 * nmax), xxpr(2 * nmax)      DOUBLE PRECISION Xf(0:2 * nmax), xxpr(2 * nmax)
36      DOUBLE PRECISION xzoom, fa, fb      DOUBLE PRECISION xzoom, fa, fb
37      INTEGER i      INTEGER i, is2
38      DOUBLE PRECISION xmoy, fxm      DOUBLE PRECISION xmoy, fxm
39      DOUBLE PRECISION decalx      DOUBLE PRECISION decalx
40    
# Line 152  contains Line 152  contains
152      END IF      END IF
153    
154      xzoom = clon * pi_d / 180d0      xzoom = clon * pi_d / 180d0
155      call fxhyp_loop_ik(1, decalx, xf, xtild, Xprimt, xzoom, rlonm025, &      call fxhyp_loop_ik(1, decalx, xf, xtild, Xprimt, xzoom, rlonm025(:iim), &
156           xprimm025, xuv = - 0.25d0)           xprimm025(:iim), xuv = - 0.25d0)
157      call fxhyp_loop_ik(2, decalx, xf, xtild, Xprimt, xzoom, rlonv, xprimv, &      call fxhyp_loop_ik(2, decalx, xf, xtild, Xprimt, xzoom, rlonv(:iim), &
158           xuv = 0d0)           xprimv(:iim), xuv = 0d0)
159      call fxhyp_loop_ik(3, decalx, xf, xtild, Xprimt, xzoom, rlonu, xprimu, &      call fxhyp_loop_ik(3, decalx, xf, xtild, Xprimt, xzoom, rlonu(:iim), &
160           xuv = 0.5d0)           xprimu(:iim), xuv = 0.5d0)
161      call fxhyp_loop_ik(4, decalx, xf, xtild, Xprimt, xzoom, rlonp025, &      call fxhyp_loop_ik(4, decalx, xf, xtild, Xprimt, xzoom, rlonp025(:iim), &
162           xprimp025, xuv = 0.25d0)           xprimp025(:iim), xuv = 0.25d0)
163    
164      print *      is2 = 0
165    
166      forall (i = 1: iim) xlon(i) = rlonv(i + 1) - rlonv(i)      IF (MINval(rlonm025(:iim)) < - pi - 0.1 &
167      print *, "Minimum longitude step:", MINval(xlon) * 180. / pi_d, "degrees"           .or. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
168      print *, "Maximum longitude step:", MAXval(xlon) * 180. / pi_d, "degrees"         IF (clon <= 0.) THEN
169              is2 = 1
170    
171              do while (rlonm025(is2) < - pi .and. is2 < iim)
172                 is2 = is2 + 1
173              end do
174    
175              if (rlonm025(is2) < - pi) then
176                 print *, 'Rlonm025 plus petit que - pi !'
177                 STOP 1
178              end if
179           ELSE
180              is2 = iim
181    
182              do while (rlonm025(is2) > pi .and. is2 > 1)
183                 is2 = is2 - 1
184              end do
185    
186              if (rlonm025(is2) > pi) then
187                 print *, 'Rlonm025 plus grand que pi !'
188                 STOP 1
189              end if
190           END IF
191        END IF
192    
193        call principal_cshift(is2, rlonm025, xprimm025)
194        call principal_cshift(is2, rlonv, xprimv)
195        call principal_cshift(is2, rlonu, xprimu)
196        call principal_cshift(is2, rlonp025, xprimp025)
197    
198        forall (i = 1: iim) d_rlonv(i) = rlonv(i + 1) - rlonv(i)
199        print *, "Minimum longitude step:", MINval(d_rlonv) * 180. / pi, "degrees"
200        print *, "Maximum longitude step:", MAXval(d_rlonv) * 180. / pi, "degrees"
201    
202      DO i = 1, iim + 1      DO i = 1, iim + 1
203         IF (rlonp025(i) < rlonv(i)) THEN         IF (rlonp025(i) < rlonv(i)) THEN
Legend:
Removed from v.123  
changed lines
  Added in v.124
  ViewVC Help
Powered by ViewVC 1.1.21