source: LMDZ.3.3/trunk/libf/dyn3d/fxyhyper.F @ 99

       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