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	module fxyhyper_m
2
3	IMPLICIT NONE
4
5	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