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

Diff of /trunk/dyn3d/fxyhyper.f

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

trunk/libf/dyn3d/fxyhyper.f90 revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/dyn3d/fxyhyper.f revision 82 by guez, Wed Mar 5 14:57:53 2014 UTC
# Line 1  Line 1 
1  SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy  ,    &  module fxyhyper_m
      xzoom, grossx, dzoomx,taux  , &  
      rlatu,yprimu,rlatv,yprimv,rlatu1,  yprimu1,  rlatu2,  yprimu2  ,  &  
      rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025)  
2    
   ! From dyn3d/fxyhyper.F,v 1.1.1.1 2004/05/19 12:53:06  
   
   use dimens_m  
   use paramet_m  
3    IMPLICIT NONE    IMPLICIT NONE
   !  
   !      Auteur :  P. Le Van .  
   !  
   !      d'apres  formulations de R. Sadourny .  
   !  
   !  
   !     Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp )  
   !            par des  fonctions  a tangente hyperbolique .  
   !  
   !     Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom  
   !                      et  yzoom )   :    
   !  
   !     a) le grossissement du zoom  :  grossy  ( en y ) et grossx ( en x )  
   !     b) l' extension     du zoom  :  dzoomy  ( en y ) et dzoomx ( en x )  
   !     c) la raideur de la transition du zoom  :   taux et tauy    
   !  
   !  N.B : Il vaut mieux avoir   :   grossx * dzoomx <  pi    ( radians )  
   ! ******  
   !                  et              grossy * dzoomy <  pi/2  ( radians )  
   !  
   
   
   !   .....  Arguments  ...  
   !  
   REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy  
   REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm), &  
        rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)  
   REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1), &  
        rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1)  
   double precision dxmin, dxmax , dymin, dymax  
   
   !   ....   var. locales   .....  
   !  
   INTEGER i,j  
   !  
   
   CALL fyhyp ( yzoom, grossy, dzoomy,tauy  ,  &  
        rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 , &  
        dymin,dymax                                               )  
   
   CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv, &  
        xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax         )  
   
   
   DO i = 1, iip1  
      IF(rlonp025(i).LT.rlonv(i))  THEN  
         print *, ' Attention !  rlonp025 < rlonv',i  
         STOP  
      ENDIF  
   
      IF(rlonv(i).LT.rlonm025(i))  THEN  
         print *, ' Attention !  rlonm025 > rlonv',i  
         STOP  
      ENDIF  
   
      IF(rlonp025(i).GT.rlonu(i))  THEN  
         print *, ' Attention !  rlonp025 > rlonu',i  
         STOP  
      ENDIF  
   ENDDO  
   
   print *, '  *** TEST DE COHERENCE  OK    POUR   FX **** '  
   
   !  
   DO j = 1, jjm  
      !  
      IF(rlatu1(j).LE.rlatu2(j))   THEN  
         print *,'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j  
         STOP 13  
      ENDIF  
      !  
      IF(rlatu2(j).LE.rlatu(j+1))  THEN  
         print *,'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j  
         STOP 14  
      ENDIF  
      !  
      IF(rlatu(j).LE.rlatu1(j))    THEN  
         print *,' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j  
         STOP 15  
      ENDIF  
      !  
      IF(rlatv(j).LE.rlatu2(j))    THEN  
         print *,' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j  
         STOP 16  
      ENDIF  
      !  
      IF(rlatv(j).ge.rlatu1(j))    THEN  
         print *,' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j  
         STOP 17  
      ENDIF  
      !  
      IF(rlatv(j).ge.rlatu(j))     THEN  
         print *, ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j  
         STOP 18  
      ENDIF  
      !  
   ENDDO  
   !  
   print *, '  *** TEST DE COHERENCE  OK    POUR   FY **** '  
   !  
   print 18  
   print *, '  Latitudes  '  
   print *, ' *********** '  
   print 18  
   print 3, dymin, dymax  
   print *, ' Si cette derniere est trop lache , modifiez les parametres  grossism , tau , dzoom pour Y et repasser ! '  
   !  
   print 18  
   print *, '  Longitudes  '  
   print *, ' ************ '  
   print 18  
   print 3,  dxmin, dxmax  
   print *, ' Si cette derniere est trop lache , modifiez les parametres  grossism , tau , dzoom pour Y et repasser ! '  
   print 18  
   
 3 Format(1x, ' Au centre du zoom , la longueur de la maille est', &  
        ' d environ ',f0.2 ,' degres  ', /, &  
        ' alors que la maille en dehors de la zone du zoom est ', &  
        "d'environ", f0.2,' degres ' )  
 18 FORMAT(/)  
4    
5  END SUBROUTINE fxyhyper  contains
6    
7      SUBROUTINE fxyhyper(yzoom, grossy, dzoomy, tauy, xzoom, grossx, dzoomx, &
8           taux, rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, yprimu2, &
9           rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, xprimp025)
10    
11        ! From dyn3d/fxyhyper.F, version 1.1.1.1 2004/05/19 12:53:06
12    
13        USE dimens_m, ONLY: jjm
14        use fxhyp_m, only: fxhyp
15        USE paramet_m, ONLY: iip1, jjp1
16    
17        ! Auteur : P. Le Van d'après formulations de R. Sadourny
18    
19        ! Cette procédure calcule les latitudes (routine fyhyp) et
20        ! longitudes (fxhyp) par des fonctions à tangente hyperbolique.
21    
22        ! Il y a trois paramètres, en plus des coordonnées du centre du
23        ! zoom (xzoom et yzoom) :
24    
25        ! a) le grossissement du zoom : grossy (en y) et grossx (en x)
26        ! b) l' extension du zoom : dzoomy (en y) et dzoomx (en x)
27        ! c) la raideur de la transition du zoom : taux et tauy
28    
29        ! Nota bene : il vaut mieux avoir : grossx * dzoomx < pi (radians)
30        ! et grossy * dzoomy < pi/2 (radians)
31    
32        REAL yzoom, grossy, dzoomy, tauy, xzoom, grossx, dzoomx, taux
33        REAL rlatu(jjp1), yprimu(jjp1), rlatv(jjm), yprimv(jjm)
34        real rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)
35        REAL rlonu(iip1), xprimu(iip1), rlonv(iip1), xprimv(iip1)
36        REAL rlonm025(iip1), xprimm025(iip1), rlonp025(iip1), xprimp025(iip1)
37    
38        ! Variables locales :
39    
40        double precision dxmin, dxmax, dymin, dymax
41        INTEGER i, j
42    
43        !----------------------------------------------------------
44    
45        CALL fyhyp(yzoom, grossy, dzoomy, tauy, rlatu, yprimu, rlatv, yprimv, &
46             rlatu2, yprimu2, rlatu1, yprimu1, dymin, dymax)
47        CALL fxhyp(xzoom, grossx, dzoomx, taux, rlonm025, xprimm025, rlonv, &
48             xprimv, rlonu, xprimu, rlonp025, xprimp025, dxmin, dxmax)
49    
50        DO i = 1, iip1
51           IF(rlonp025(i).LT.rlonv(i)) THEN
52              print *, ' Attention ! rlonp025 < rlonv', i
53              STOP 1
54           ENDIF
55    
56           IF(rlonv(i).LT.rlonm025(i)) THEN
57              print *, ' Attention ! rlonm025 > rlonv', i
58              STOP 1
59           ENDIF
60    
61           IF(rlonp025(i).GT.rlonu(i)) THEN
62              print *, ' Attention ! rlonp025 > rlonu', i
63              STOP 1
64           ENDIF
65        ENDDO
66    
67        print *, 'Test de coherence ok pour fx'
68    
69        DO j = 1, jjm
70           IF(rlatu1(j).LE.rlatu2(j)) THEN
71              print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j
72              STOP 13
73           ENDIF
74    
75           IF(rlatu2(j).LE.rlatu(j+1)) THEN
76              print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j
77              STOP 14
78           ENDIF
79    
80           IF(rlatu(j).LE.rlatu1(j)) THEN
81              print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j
82              STOP 15
83           ENDIF
84    
85           IF(rlatv(j).LE.rlatu2(j)) THEN
86              print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j
87              STOP 16
88           ENDIF
89    
90           IF(rlatv(j).ge.rlatu1(j)) THEN
91              print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j
92              STOP 17
93           ENDIF
94    
95           IF(rlatv(j).ge.rlatu(j)) THEN
96              print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j
97              STOP 18
98           ENDIF
99        ENDDO
100    
101        print *, 'Test de coherence ok pour fy'
102    
103        print *, 'Latitudes'
104        print 3, dymin, dymax
105        print *, 'Si cette derniere est trop lache, modifiez les parametres'
106        print *, 'grossism, tau, dzoom pour Y et repasser ! '
107    
108        print *, ' Longitudes '
109        print 3, dxmin, dxmax
110        print *, 'Si cette derniere est trop lache, modifiez les parametres'
111        print *, 'grossism, tau, dzoom pour Y et repasser ! '
112    
113    3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &
114             ' d environ ', f0.2, ' degres ', /, &
115             ' alors que la maille en dehors de la zone du zoom est ', &
116             "d'environ", f0.2, ' degres ')
117    
118      END SUBROUTINE fxyhyper
119    
120    end module fxyhyper_m
Legend:
Removed from v.3  
changed lines
  Added in v.82
  ViewVC Help
Powered by ViewVC 1.1.21