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

Diff of /trunk/Sources/dyn3d/fxhyp.f

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

revision 122 by guez, Tue Feb 3 19:30:48 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 42  contains Line 42  contains
42    
43      print *, "Call sequence information: fxhyp"      print *, "Call sequence information: fxhyp"
44    
     xzoom = clon * pi_d / 180d0  
   
     IF (grossismx == 1.) THEN  
        decalx = 1d0  
     else  
        decalx = 0.75d0  
     END IF  
   
45      dzoom = dzoomx * twopi_d      dzoom = dzoomx * twopi_d
46      xtild = arth(- pi_d, pi_d / nmax, 2 * nmax + 1)      xtild = arth(- pi_d, pi_d / nmax, 2 * nmax + 1)
47    
# Line 153  contains Line 145  contains
145    
146      Xf(2 * nmax) = pi_d      Xf(2 * nmax) = pi_d
147    
148      call fxhyp_loop_ik(1, decalx, xf, xtild, Xprimt, xzoom, rlonm025, &      IF (grossismx == 1.) THEN
149           xprimm025, xuv = - 0.25d0)         decalx = 1d0
150      call fxhyp_loop_ik(2, decalx, xf, xtild, Xprimt, xzoom, rlonv, xprimv, &      else
151           xuv = 0d0)         decalx = 0.75d0
152      call fxhyp_loop_ik(3, decalx, xf, xtild, Xprimt, xzoom, rlonu, xprimu, &      END IF
153           xuv = 0.5d0)  
154      call fxhyp_loop_ik(4, decalx, xf, xtild, Xprimt, xzoom, rlonp025, &      xzoom = clon * pi_d / 180d0
155           xprimp025, xuv = 0.25d0)      call fxhyp_loop_ik(1, decalx, xf, xtild, Xprimt, xzoom, rlonm025(:iim), &
156             xprimm025(:iim), xuv = - 0.25d0)
157      print *      call fxhyp_loop_ik(2, decalx, xf, xtild, Xprimt, xzoom, rlonv(:iim), &
158             xprimv(:iim), xuv = 0d0)
159      forall (i = 1: iim) xlon(i) = rlonv(i + 1) - rlonv(i)      call fxhyp_loop_ik(3, decalx, xf, xtild, Xprimt, xzoom, rlonu(:iim), &
160      print *, "Minimum longitude step:", MINval(xlon) * 180. / pi_d, "degrees"           xprimu(:iim), xuv = 0.5d0)
161      print *, "Maximum longitude step:", MAXval(xlon) * 180. / pi_d, "degrees"      call fxhyp_loop_ik(4, decalx, xf, xtild, Xprimt, xzoom, rlonp025(:iim), &
162             xprimp025(:iim), xuv = 0.25d0)
163    
164        is2 = 0
165    
166        IF (MINval(rlonm025(:iim)) < - pi - 0.1 &
167             .or. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
168           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.122  
changed lines
  Added in v.124
  ViewVC Help
Powered by ViewVC 1.1.21