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 fxhyp_m, only: fxhyp
    use fyhyp_m, only: fyhyp
    USE paramet_m, ONLY: iip1

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

    ! 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 (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 

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

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