trunk/dyn3d/fxyhyper.f

module fxyhyper_m

  IMPLICIT NONE

contains

  SUBROUTINE fxyhyper(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 fxhyp_m, only: fxhyp
    use fyhyp_m, only: fyhyp
    USE paramet_m, ONLY: iip1
    use serre, only: clat, grossismy, dzoomy, tauy, clon, grossismx, dzoomx, &
         taux

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

    ! f(x, y) à dérivée tangente hyperbolique

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

    ! Il y a trois paramètres, en plus des coordonnées du centre du
    ! zoom (clon et clat) :

    ! a) le grossissement du zoom : grossismy (en y) et grossismx (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 

    ! Nota bene : il vaut mieux avoir : grossismx * dzoomx < pi (radians)
    ! et grossismy * dzoomy < pi/2 (radians)

    REAL rlatu(:), yprimu(:) ! (jjm + 1)
    real rlatv(:), yprimv(:) ! (jjm)
    real rlatu1(:), yprimu1(:), rlatu2(:), yprimu2(:) ! (jjm)
    REAL rlonu(:), xprimu(:), rlonv(:), xprimv(:) ! (iim + 1)
    REAL rlonm025(:), xprimm025(:), rlonp025(:), xprimp025(:) ! (iim + 1)

    ! Local:

    double precision dxmin, dxmax, dymin, dymax
    INTEGER i, j

    !----------------------------------------------------------

    CALL fyhyp(clat, grossismy, dzoomy, tauy, rlatu, yprimu, rlatv, yprimv, &
         rlatu2, yprimu2, rlatu1, yprimu1, dymin, dymax)
    CALL fxhyp(clon, grossismx, 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	112	SUBROUTINE fxyhyper(rlatu, yprimu, rlatv, yprimv, rlatu1, yprimu1, rlatu2, &
8			yprimu2, rlonu, xprimu, rlonv, xprimv, rlonm025, xprimm025, rlonp025, &
9			xprimp025)
10	guez	3
11	guez	97	! 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	guez	78	use fxhyp_m, only: fxhyp
15	guez	97	use fyhyp_m, only: fyhyp
16			USE paramet_m, ONLY: iip1
17	guez	112	use serre, only: clat, grossismy, dzoomy, tauy, clon, grossismx, dzoomx, &
18			taux
19	guez	3
20	guez	97	! Auteur : P. Le Van d'après les formulations de R. Sadourny
21	guez	3
22	guez	112	! f(x, y) à dérivée tangente hyperbolique
23
24	guez	70	! Cette procédure calcule les latitudes (routine fyhyp) et
25			! longitudes (fxhyp) par des fonctions à tangente hyperbolique.
26	guez	3
27	guez	78	! Il y a trois paramètres, en plus des coordonnées du centre du
28	guez	112	! zoom (clon et clat) :
29	guez	3
30	guez	112	! a) le grossissement du zoom : grossismy (en y) et grossismx (en x)
31	guez	70	! 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	guez	3
34	guez	112	! Nota bene : il vaut mieux avoir : grossismx * dzoomx < pi (radians)
35			! et grossismy * dzoomy < pi/2 (radians)
36	guez	38
37	guez	97	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	guez	38
43	guez	97	! Local:
44	guez	38
45	guez	78	double precision dxmin, dxmax, dymin, dymax
46	guez	70	INTEGER i, j
47	guez	38
48	guez	70	!----------------------------------------------------------
49	guez	38
50	guez	112	CALL fyhyp(clat, grossismy, dzoomy, tauy, rlatu, yprimu, rlatv, yprimv, &
51	guez	70	rlatu2, yprimu2, rlatu1, yprimu1, dymin, dymax)
52	guez	112	CALL fxhyp(clon, grossismx, dzoomx, taux, rlonm025, xprimm025, rlonv, &
53	guez	70	xprimv, rlonu, xprimu, rlonp025, xprimp025, dxmin, dxmax)
54	guez	3
55	guez	70	DO i = 1, iip1
56			IF(rlonp025(i).LT.rlonv(i)) THEN
57			print *, ' Attention ! rlonp025 < rlonv', i
58			STOP 1
59			ENDIF
60	guez	3
61	guez	70	IF(rlonv(i).LT.rlonm025(i)) THEN
62			print *, ' Attention ! rlonm025 > rlonv', i
63			STOP 1
64			ENDIF
65	guez	3
66	guez	70	IF(rlonp025(i).GT.rlonu(i)) THEN
67			print *, ' Attention ! rlonp025 > rlonu', i
68			STOP 1
69			ENDIF
70			ENDDO
71	guez	3
72	guez	70	print *, 'Test de coherence ok pour fx'
73	guez	38
74	guez	70	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	guez	38
80	guez	70	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	guez	38
85	guez	70	IF(rlatu(j).LE.rlatu1(j)) THEN
86			print *, ' Attention ! rlatu < rlatu1 ', rlatu(j), rlatu1(j), j
87			STOP 15
88			ENDIF
89	guez	38
90	guez	70	IF(rlatv(j).LE.rlatu2(j)) THEN
91			print *, ' Attention ! rlatv < rlatu2 ', rlatv(j), rlatu2(j), j
92			STOP 16
93			ENDIF
94	guez	38
95	guez	70	IF(rlatv(j).ge.rlatu1(j)) THEN
96			print *, ' Attention ! rlatv > rlatu1 ', rlatv(j), rlatu1(j), j
97			STOP 17
98			ENDIF
99	guez	38
100	guez	70	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	guez	38
106	guez	70	print *, 'Test de coherence ok pour fy'
107	guez	3
108	guez	70	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	guez	38
113	guez	70	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	guez	3
118	guez	70	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