SUBROUTINE fxyhyper ( yzoom, grossy, dzoomy,tauy,deltay , , xzoom, grossx, dzoomx,taux, , rlatu,yprimu,rlatv,yprimv,rlatu1, yprimu1, rlatu2, yprimu2 , , rlonu,xprimu,rlonv,xprimv,rlonm025,xprimm025,rlonp025,xprimp025) IMPLICIT NONE c c Auteur : P. Le Van . c c d'apres formulations de R. Sadourny . c c c Ce spg calcule les latitudes( routine fyhyp ) et longitudes( fxhyp ) c par des fonctions a tangente hyperbolique . c c Il y a 3 parametres ,en plus des coordonnees du centre du zoom (xzoom c et yzoom ) : c c a) le grossissement du zoom : grossy ( en y ) et grossx ( en x ) c b) l' extension du zoom : dzoomy ( en y ) et dzoomx ( en x ) c c) la raideur du zoom : tau , ici = 1. c c N.B : le produit ( grossissement * extension ) doit etre < 1. c ******* c En plus , il y a un autre parametre , moins important mais quand c meme utile , c'est deltay , deplacement de la zone du zoom en c latitude : Si on deplace de 10. degres vers le nord ( deltay c = 10. dans inigeom ) . c c #include "dimensions.h" #include "paramet.h" c ..... Arguments ... c REAL xzoom,yzoom,grossx,grossy,dzoomx,dzoomy,taux,tauy REAL rlatu(jjp1), yprimu(jjp1),rlatv(jjm), yprimv(jjm), , rlatu1(jjm), yprimu1(jjm), rlatu2(jjm), yprimu2(jjm) REAL rlonu(iip1),xprimu(iip1),rlonv(iip1),xprimv(iip1), , rlonm025(iip1),xprimm025(iip1), rlonp025(iip1),xprimp025(iip1) REAL deltay c .... var. locales ..... c INTEGER i,j c CALL fyhyp ( yzoom, grossy, dzoomy,tauy, deltay , , rlatu, yprimu,rlatv,yprimv,rlatu2,yprimu2,rlatu1,yprimu1 ) CALL fxhyp(xzoom,grossx,dzoomx,taux,rlonm025,xprimm025,rlonv, , xprimv,rlonu,xprimu,rlonp025,xprimp025 ) DO i = 1, iim IF(rlonp025(i).LT.rlonv(i)) THEN PRINT *,' Attention ! rlonp025 < rlonv',i STOP ENDIF IF(rlonv(i).LT.rlonm025(i)) THEN PRINT *,' Attention ! rlonm025 > rlonv',i STOP ENDIF IF(rlonp025(i).GT.rlonu(i)) THEN PRINT *,' Attention ! rlonp025 > rlonu',i STOP ENDIF ENDDO PRINT *,' *** TEST DE COHERENCE OK POUR FX **** ' c DO j = 1, jjm c IF(rlatu1(j).LE.rlatu2(j)) THEN PRINT *,' Attention ! rlatu1 < rlatu2 ',rlatu1(j), rlatu2(j),j STOP 13 ENDIF c IF(rlatu2(j).LE.rlatu(j+1)) THEN PRINT *,' Attention ! rlatu2 < rlatup1 ',rlatu2(j),rlatu(j+1),j STOP 14 ENDIF c IF(rlatu(j).LE.rlatu1(j)) THEN PRINT *,' Attention ! rlatu < rlatu1 ',rlatu(j),rlatu1(j),j STOP 15 ENDIF c IF(rlatv(j).LE.rlatu2(j)) THEN PRINT *,' Attention ! rlatv < rlatu2 ',rlatv(j),rlatu2(j),j STOP 16 ENDIF c IF(rlatv(j).ge.rlatu1(j)) THEN PRINT *,' Attention ! rlatv > rlatu1 ',rlatv(j),rlatu1(j),j STOP 17 ENDIF c IF(rlatv(j).ge.rlatu(j)) THEN PRINT *,'Attention ! rlatv > rlatu ',rlatv(j),rlatu(j),j STOP 18 ENDIF c ENDDO c PRINT *,' *** TEST DE COHERENCE OK POUR FY **** ' c RETURN END