/[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 38 by guez, Thu Jan 6 17:52:19 2011 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, xzoom, grossx, dzoomx, taux, &  module fxyhyper_m
      rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, yprimu2, &  
      rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, xprimp025)  
   
   ! From dyn3d/fxyhyper.F, v 1.1.1.1 2004/05/19 12:53:06  
   
   use dimens_m  
   use paramet_m  
2    
3    IMPLICIT NONE    IMPLICIT NONE
4    
5    ! Auteur : P. Le Van.  contains
   ! d'apres formulations de R. Sadourny.  
   
   ! Cette procédure calcule les latitudes (routine fyhyp) et  
   ! longitudes (fxhyp) par des fonctions a tangente hyperbolique.  
6    
7    ! Il y a 3 parametres, en plus des coordonnees du centre du zoom (xzoom    SUBROUTINE fxyhyper(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
8    ! et yzoom) :         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    ! a) le grossissement du zoom : grossy (en y) et grossx (en x)    END SUBROUTINE fxyhyper
   ! 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)  
   real rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm)  
   REAL rlonu(iip1), xprimu(iip1), rlonv(iip1), xprimv(iip1)  
   REAL rlonm025(iip1), xprimm025(iip1), rlonp025(iip1), xprimp025(iip1)  
   double precision dxmin, dxmax, dymin, dymax  
   
   ! variables 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 1  
      ENDIF  
   
      IF(rlonv(i).LT.rlonm025(i)) THEN  
         print *, ' Attention ! rlonm025 > rlonv', i  
         STOP 1  
      ENDIF  
   
      IF(rlonp025(i).GT.rlonu(i)) THEN  
         print *, ' Attention ! rlonp025 > rlonu', i  
         STOP 1  
      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 *, ' Latitudes '  
   print 3, dymin, dymax  
   print *, ' Si cette derniere est trop lache, modifiez les parametres grossism, tau, dzoom pour Y et repasser ! '  
   
   print *, ' Longitudes '  
   print 3, dxmin, dxmax  
   print *, ' Si cette derniere est trop lache, modifiez les parametres grossism, tau, dzoom pour Y et repasser ! '  
   
 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 ')  
124    
125  END SUBROUTINE fxyhyper  end module fxyhyper_m
Legend:
Removed from v.38  
changed lines
  Added in v.118
  ViewVC Help
Powered by ViewVC 1.1.21