trunk/dyn3d/fxyhyper.f

module fxyhyper_m

  IMPLICIT NONE

contains

  SUBROUTINE fxyhyper(yzoom, grossy, dzoomy, tauy, xzoom, grossx, dzoomx, &
       taux, rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, yprimu2, &
       rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, xprimp025)

    ! From dyn3d/fxyhyper.F, version 1.1.1.1 2004/05/19 12:53:06

    USE dimens_m, ONLY: jjm
    USE paramet_m, ONLY: iip1, jjp1

    ! Auteur : P. Le Van d'après formulations de R. Sadourny

    ! Cette procédure calcule les latitudes (routine fyhyp) et
    ! longitudes (fxhyp) par des fonctions à tangente hyperbolique.

    ! Il y a 3 paramètres, en plus des coordonnées 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)
    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'
    print *, 'grossism, tau, dzoom pour Y et repasser ! '

    print *, ' Longitudes '
    print 3, dxmin, dxmax
    print *, 'Si cette derniere est trop lache, modifiez les parametres'
    print *, '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 ')

  END SUBROUTINE fxyhyper

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