1 | c |
---|
2 | c $Header$ |
---|
3 | c |
---|
4 | SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy , |
---|
5 | , xzoom, grossx, dzoomx,taux , |
---|
6 | , rlatu,yprimu,rlatv,yprimv,rlatu1, yprimu1, rlatu2, yprimu2 , |
---|
7 | , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025) |
---|
8 | |
---|
9 | IMPLICIT NONE |
---|
10 | c |
---|
11 | c Auteur : P. Le Van . |
---|
12 | c |
---|
13 | c d'apres formulations de R. Sadourny . |
---|
14 | c |
---|
15 | c |
---|
16 | c Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp ) |
---|
17 | c par des fonctions a tangente hyperbolique . |
---|
18 | c |
---|
19 | c Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom |
---|
20 | c et yzoom ) : |
---|
21 | c |
---|
22 | c a) le grossissement du zoom : grossy ( en y ) et grossx ( en x ) |
---|
23 | c b) l' extension du zoom : dzoomy ( en y ) et dzoomx ( en x ) |
---|
24 | c c) la raideur de la transition du zoom : taux et tauy |
---|
25 | c |
---|
26 | c N.B : Il vaut mieux avoir : grossx * dzoomx < pi ( radians ) |
---|
27 | c ****** |
---|
28 | c et grossy * dzoomy < pi/2 ( radians ) |
---|
29 | c |
---|
30 | #include "dimensions.h" |
---|
31 | #include "paramet.h" |
---|
32 | |
---|
33 | |
---|
34 | c ..... Arguments ... |
---|
35 | c |
---|
36 | REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy |
---|
37 | REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm), |
---|
38 | , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm) |
---|
39 | REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1), |
---|
40 | , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1) |
---|
41 | REAL*8 dxmin, dxmax , dymin, dymax |
---|
42 | |
---|
43 | c .... var. locales ..... |
---|
44 | c |
---|
45 | INTEGER i,j |
---|
46 | c |
---|
47 | |
---|
48 | CALL fyhyp ( yzoom, grossy, dzoomy,tauy , |
---|
49 | , rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 , |
---|
50 | , dymin,dymax ) |
---|
51 | |
---|
52 | CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv, |
---|
53 | , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax ) |
---|
54 | |
---|
55 | |
---|
56 | DO i = 1, iip1 |
---|
57 | IF(rlonp025(i).LT.rlonv(i)) THEN |
---|
58 | WRITE(6,*) ' Attention ! rlonp025 < rlonv',i |
---|
59 | STOP |
---|
60 | ENDIF |
---|
61 | |
---|
62 | IF(rlonv(i).LT.rlonm025(i)) THEN |
---|
63 | WRITE(6,*) ' Attention ! rlonm025 > rlonv',i |
---|
64 | STOP |
---|
65 | ENDIF |
---|
66 | |
---|
67 | IF(rlonp025(i).GT.rlonu(i)) THEN |
---|
68 | WRITE(6,*) ' Attention ! rlonp025 > rlonu',i |
---|
69 | STOP |
---|
70 | ENDIF |
---|
71 | ENDDO |
---|
72 | |
---|
73 | WRITE(6,*) ' *** TEST DE COHERENCE OK POUR FX **** ' |
---|
74 | |
---|
75 | c |
---|
76 | DO j = 1, jjm |
---|
77 | c |
---|
78 | IF(rlatu1(j).LE.rlatu2(j)) THEN |
---|
79 | WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j |
---|
80 | STOP 13 |
---|
81 | ENDIF |
---|
82 | c |
---|
83 | IF(rlatu2(j).LE.rlatu(j+1)) THEN |
---|
84 | WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j |
---|
85 | STOP 14 |
---|
86 | ENDIF |
---|
87 | c |
---|
88 | IF(rlatu(j).LE.rlatu1(j)) THEN |
---|
89 | WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j |
---|
90 | STOP 15 |
---|
91 | ENDIF |
---|
92 | c |
---|
93 | IF(rlatv(j).LE.rlatu2(j)) THEN |
---|
94 | WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j |
---|
95 | STOP 16 |
---|
96 | ENDIF |
---|
97 | c |
---|
98 | IF(rlatv(j).ge.rlatu1(j)) THEN |
---|
99 | WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j |
---|
100 | STOP 17 |
---|
101 | ENDIF |
---|
102 | c |
---|
103 | IF(rlatv(j).ge.rlatu(j)) THEN |
---|
104 | WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j |
---|
105 | STOP 18 |
---|
106 | ENDIF |
---|
107 | c |
---|
108 | ENDDO |
---|
109 | c |
---|
110 | WRITE(6,*) ' *** TEST DE COHERENCE OK POUR FY **** ' |
---|
111 | c |
---|
112 | WRITE(6,18) |
---|
113 | WRITE(6,*) ' Latitudes ' |
---|
114 | WRITE(6,*) ' *********** ' |
---|
115 | WRITE(6,18) |
---|
116 | WRITE(6,3) dymin, dymax |
---|
117 | WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par |
---|
118 | ,ametres grossism , tau , dzoom pour Y et repasser ! ' |
---|
119 | c |
---|
120 | WRITE(6,18) |
---|
121 | WRITE(6,*) ' Longitudes ' |
---|
122 | WRITE(6,*) ' ************ ' |
---|
123 | WRITE(6,18) |
---|
124 | WRITE(6,3) dxmin, dxmax |
---|
125 | WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par |
---|
126 | ,ametres grossism , tau , dzoom pour Y et repasser ! ' |
---|
127 | WRITE(6,18) |
---|
128 | c |
---|
129 | 3 Format(1x, ' Au centre du zoom , la longueur de la maille est', |
---|
130 | , ' d environ ',f8.2 ,' degres ', |
---|
131 | , ' alors que la maille en dehors de la zone du zoom est d environ |
---|
132 | , ', f8.2,' degres ' ) |
---|
133 | 18 FORMAT(/) |
---|
134 | |
---|
135 | RETURN |
---|
136 | END |
---|
137 | |
---|