[203] | 1 | c |
---|
[207] | 2 | c $Header$ |
---|
[203] | 3 | c |
---|
| 4 | SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy , |
---|
| 5 | , xzoom, grossx, dzoomx,taux , |
---|
[2] | 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 ) |
---|
[203] | 24 | c c) la raideur de la transition du zoom : taux et tauy |
---|
[2] | 25 | c |
---|
[203] | 26 | c N.B : Il vaut mieux avoir : grossx * dzoomx < pi ( radians ) |
---|
| 27 | c ****** |
---|
| 28 | c et grossy * dzoomy < pi/2 ( radians ) |
---|
[2] | 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) |
---|
[212] | 41 | REAL*8 dxmin, dxmax , dymin, dymax |
---|
[2] | 42 | |
---|
| 43 | c .... var. locales ..... |
---|
| 44 | c |
---|
| 45 | INTEGER i,j |
---|
| 46 | c |
---|
| 47 | |
---|
[203] | 48 | CALL fyhyp ( yzoom, grossy, dzoomy,tauy , |
---|
[212] | 49 | , rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 , |
---|
| 50 | , dymin,dymax ) |
---|
[2] | 51 | |
---|
| 52 | CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv, |
---|
[212] | 53 | , xprimv,rlonu,xprimu,rlonp025,xprimp025 , dxmin,dxmax ) |
---|
[2] | 54 | |
---|
| 55 | |
---|
[203] | 56 | DO i = 1, iip1 |
---|
[2] | 57 | IF(rlonp025(i).LT.rlonv(i)) THEN |
---|
[203] | 58 | WRITE(6,*) ' Attention ! rlonp025 < rlonv',i |
---|
[2] | 59 | STOP |
---|
| 60 | ENDIF |
---|
| 61 | |
---|
| 62 | IF(rlonv(i).LT.rlonm025(i)) THEN |
---|
[203] | 63 | WRITE(6,*) ' Attention ! rlonm025 > rlonv',i |
---|
[2] | 64 | STOP |
---|
| 65 | ENDIF |
---|
| 66 | |
---|
| 67 | IF(rlonp025(i).GT.rlonu(i)) THEN |
---|
[203] | 68 | WRITE(6,*) ' Attention ! rlonp025 > rlonu',i |
---|
[2] | 69 | STOP |
---|
| 70 | ENDIF |
---|
| 71 | ENDDO |
---|
| 72 | |
---|
[203] | 73 | WRITE(6,*) ' *** TEST DE COHERENCE OK POUR FX **** ' |
---|
[2] | 74 | |
---|
| 75 | c |
---|
| 76 | DO j = 1, jjm |
---|
| 77 | c |
---|
| 78 | IF(rlatu1(j).LE.rlatu2(j)) THEN |
---|
[203] | 79 | WRITE(6,*)'Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j |
---|
[2] | 80 | STOP 13 |
---|
| 81 | ENDIF |
---|
| 82 | c |
---|
| 83 | IF(rlatu2(j).LE.rlatu(j+1)) THEN |
---|
[203] | 84 | WRITE(6,*)'Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j |
---|
[2] | 85 | STOP 14 |
---|
| 86 | ENDIF |
---|
| 87 | c |
---|
| 88 | IF(rlatu(j).LE.rlatu1(j)) THEN |
---|
[203] | 89 | WRITE(6,*)' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j |
---|
[2] | 90 | STOP 15 |
---|
| 91 | ENDIF |
---|
| 92 | c |
---|
| 93 | IF(rlatv(j).LE.rlatu2(j)) THEN |
---|
[203] | 94 | WRITE(6,*)' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j |
---|
[2] | 95 | STOP 16 |
---|
| 96 | ENDIF |
---|
| 97 | c |
---|
| 98 | IF(rlatv(j).ge.rlatu1(j)) THEN |
---|
[203] | 99 | WRITE(6,*)' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j |
---|
[2] | 100 | STOP 17 |
---|
| 101 | ENDIF |
---|
| 102 | c |
---|
| 103 | IF(rlatv(j).ge.rlatu(j)) THEN |
---|
[203] | 104 | WRITE(6,*) ' Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j |
---|
[2] | 105 | STOP 18 |
---|
| 106 | ENDIF |
---|
| 107 | c |
---|
| 108 | ENDDO |
---|
| 109 | c |
---|
[203] | 110 | WRITE(6,*) ' *** TEST DE COHERENCE OK POUR FY **** ' |
---|
[2] | 111 | c |
---|
[212] | 112 | WRITE(6,18) |
---|
| 113 | WRITE(6,*) ' Latitudes ' |
---|
| 114 | WRITE(6,*) ' *********** ' |
---|
| 115 | WRITE(6,18) |
---|
[544] | 116 | cvg>> |
---|
| 117 | WRITE(6,3) dymin |
---|
| 118 | WRITE(6,4) dymax |
---|
| 119 | cvg<< |
---|
| 120 | cvg WRITE(6,3) dymin, dymax |
---|
[212] | 121 | WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par |
---|
| 122 | ,ametres grossism , tau , dzoom pour Y et repasser ! ' |
---|
| 123 | c |
---|
| 124 | WRITE(6,18) |
---|
| 125 | WRITE(6,*) ' Longitudes ' |
---|
| 126 | WRITE(6,*) ' ************ ' |
---|
| 127 | WRITE(6,18) |
---|
[544] | 128 | cvg>> |
---|
| 129 | WRITE(6,3) dxmin |
---|
| 130 | WRITE(6,4) dxmax |
---|
| 131 | cvg<< |
---|
| 132 | cvg WRITE(6,3) dxmin, dxmax |
---|
[212] | 133 | WRITE(6,*) ' Si cette derniere est trop lache , modifiez les par |
---|
| 134 | ,ametres grossism , tau , dzoom pour Y et repasser ! ' |
---|
| 135 | WRITE(6,18) |
---|
| 136 | c |
---|
[544] | 137 | cvg3 Format(1x, ' Au centre du zoom , la longueur de la maille est', |
---|
| 138 | cvg , ' d environ ',f8.2 ,' degres ', |
---|
| 139 | cvg , ' alors que la maille en dehors de la zone du zoom est d environ |
---|
| 140 | cvg , ', f8.2,' degres ' ) |
---|
| 141 | cvg>> |
---|
[212] | 142 | 3 Format(1x, ' Au centre du zoom , la longueur de la maille est', |
---|
[544] | 143 | , ' d environ ',f8.2 ,' degres ') |
---|
| 144 | 4 Format(1x, ' alors que la maille en dehors de la zone du zoom', |
---|
| 145 | , ' est d environ ', f8.2,' degres ' ) |
---|
| 146 | cvg<< |
---|
[212] | 147 | 18 FORMAT(/) |
---|
[2] | 148 | |
---|
| 149 | RETURN |
---|
| 150 | END |
---|
| 151 | |
---|