/[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 118 by guez, Thu Dec 18 17:30:24 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(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
8           yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &
9           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 fyhyp_m, only: fyhyp
16        USE paramet_m, ONLY: iip1
17        use serre, only: clat, grossismy, dzoomy, tauy, clon, grossismx, dzoomx, &
18             taux
19    
20        ! Auteur : P. Le Van d'après les formulations de R. Sadourny
21    
22        ! f(x, y) à dérivée tangente hyperbolique
23    
24        ! Cette procédure calcule les latitudes (routine fyhyp) et
25        ! longitudes (fxhyp) par des fonctions tangente hyperbolique.
26    
27        ! Il y a trois paramètres, en plus des coordonnées du centre du
28        ! zoom (clon et clat) :
29    
30        ! a) le grossissement du zoom : grossismy (en y) et grossismx (en x)
31        ! b) l'extension du zoom : dzoomy (en y) et dzoomx (en x)
32        ! c) la raideur de la transition du zoom : taux et tauy
33    
34        ! Nota bene : il vaut mieux avoir : grossismx * dzoomx < pi (radians)
35        ! et grossismy * dzoomy < pi/2 (radians)
36    
37        REAL rlatu(:), yprimu(:) ! (jjm + 1)
38        real rlatv(:), yprimv(:) ! (jjm)
39        real rlatu1(:), yprimu1(:), rlatu2(:), yprimu2(:) ! (jjm)
40        REAL rlonu(:), xprimu(:), rlonv(:), xprimv(:) ! (iim + 1)
41        REAL rlonm025(:), xprimm025(:), rlonp025(:), xprimp025(:) ! (iim + 1)
42    
43        ! Local:
44    
45        double precision dxmin, dxmax, dymin, dymax
46        INTEGER i, j
47    
48        !----------------------------------------------------------
49    
50        CALL fyhyp(clat, grossismy, dzoomy, tauy, rlatu, yprimu, rlatv, yprimv, &
51             rlatu2, yprimu2, rlatu1, yprimu1, dymin, dymax)
52        CALL fxhyp(clon, grossismx, dzoomx, taux, rlonm025, xprimm025, rlonv, &
53             xprimv, rlonu, xprimu, rlonp025, xprimp025, dxmin, dxmax)
54    
55        DO i = 1, iip1
56           IF (rlonp025(i).LT.rlonv(i)) THEN
57              print *, ' Attention ! rlonp025 < rlonv', i
58              STOP 1
59           ENDIF
60    
61           IF (rlonv(i).LT.rlonm025(i)) THEN
62              print *, ' Attention ! rlonm025 > rlonv', i
63              STOP 1
64           ENDIF
65    
66           IF (rlonp025(i).GT.rlonu(i)) THEN
67              print *, ' Attention ! rlonp025 > rlonu', i
68              STOP 1
69           ENDIF
70        ENDDO
71    
72        print *, 'Test de coherence ok pour fx'
73    
74        DO j = 1, jjm
75           IF (rlatu1(j).LE.rlatu2(j)) THEN
76              print *, 'Attention ! rlatu1 < rlatu2 ', rlatu1(j), rlatu2(j), j
77              STOP 13
78           ENDIF
79    
80           IF (rlatu2(j).LE.rlatu(j+1)) THEN
81              print *, 'Attention ! rlatu2 < rlatup1 ', rlatu2(j), rlatu(j+1), j
82              STOP 14
83           ENDIF
84    
85           IF (rlatu(j).LE.rlatu1(j)) THEN
86              print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j
87              STOP 15
88           ENDIF
89    
90           IF (rlatv(j).LE.rlatu2(j)) THEN
91              print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j
92              STOP 16
93           ENDIF
94    
95           IF (rlatv(j).ge.rlatu1(j)) THEN
96              print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j
97              STOP 17
98           ENDIF
99    
100           IF (rlatv(j).ge.rlatu(j)) THEN
101              print *, ' Attention ! rlatv > rlatu ', rlatv(j), rlatu(j), j
102              STOP 18
103           ENDIF
104        ENDDO
105    
106        print *, 'Test de coherence ok pour fy'
107    
108        print *, 'Latitudes'
109        print 3, dymin, dymax
110        print *, 'Si cette derniere est trop lache, modifiez les parametres'
111        print *, 'grossism, tau, dzoom pour Y et repasser ! '
112    
113        print *, ' Longitudes '
114        print 3, dxmin, dxmax
115        print *, 'Si cette derniere est trop lache, modifiez les parametres'
116        print *, 'grossism, tau, dzoom pour Y et repasser ! '
117    
118    3   Format(1x, ' Au centre du zoom, la longueur de la maille est', &
119             ' d environ ', f0.2, ' degres ', /, &
120             ' alors que la maille en dehors de la zone du zoom est ', &
121             "d'environ", f0.2, ' degres ')
122    
123      END SUBROUTINE fxyhyper
124    
125    end module fxyhyper_m
Legend:
Removed from v.3  
changed lines
  Added in v.118
  ViewVC Help
Powered by ViewVC 1.1.21