*"表題 地図投影 : 座標の設定 GTOOL3(GGAXES)
*
*"履歴 90/08/16 沼口  敦
*"     95/05/26 竹広真一 for dcl-5.z.7
*"     95/05/31 竹広真一 極座標 tickmark をつける. 
*"     95/06/05 竹広真一 for dcl-5.z.13
*"     95/11/01 竹広真一 地図境界 clipping 
*"     96/01/10 竹広真一 minor 修正
*"     97/12/01 竹広真一 SET -> STX
*
*********************************************************************
*"         << 軸のセット 地図投影 >>
*********************************************************************
      SUBROUTINE GGAXES
     I         ( HHEAD )
*
      CHARACTER  HHEAD ( * )*(*)         !" ヘッダー
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
      INCLUDE    (GZIWRK)                !" NW: 軸ワークの大きさ
#else
#include         "gzsize.F"              !" NCC, NDC
#include         "gziwrk.F"              !" NW: 軸ワークの大きさ
#endif
      CHARACTER  HHEADX( NDC )*(NCC)     !" X 軸ファイルのヘッダー
      CHARACTER  HHEADY( NDC )*(NCC)     !" Y 軸ファイルのヘッダー
      REAL       AXISX ( NW )            !" X 座標値
      REAL       AXISY ( NW )            !" Y 座標値
      LOGICAL    OSUBCK
*
      REAL       XMIN, XMAX, YMIN, YMAX    !" 描画用変数
      REAL       RADI                      !" NC 上の地球半径
*
      INTEGER    IPRJ                      !" 投影法
      REAL       ALAT, ALON                !" 投影中心緯度傾度
      REAL       ROTA                      !" 回転
      REAL       SIMFAC                    !" 投影拡大率
      CHARACTER  HPOS*30, HLAT*8, HLON*8
*
*"         < 1. 軸ファイルの読み込み >
*
      CALL GTPGET ( 'SUBCHK', OSUBCK )
      CALL GTSIZE ( HHEADX  ,  NW     )
      CALL GTSIZE ( HHEADY  ,  NW     )
      CALL GUQAXV
     I            ( HHEAD , 1     , 'LOC' ,
     O              HHEADX, AXISX , IEOD   )
      CALL GUQAXV
     I            ( HHEAD , 2     , 'LOC' ,
     O              HHEADY, AXISY , IEOD   )
      CALL GTPSET ( 'SUBCHK', OSUBCK )
*
*"         < 2. 範囲 >
*
      CALL GHPGET ( HHEAD , 'ASTR1', IXSTR )
      CALL GHPGET ( HHEAD , 'AEND1', IXEND )
      CALL GHPGET ( HHEAD , 'ASTR2', IYSTR )
      CALL GHPGET ( HHEAD , 'AEND2', IYEND )
*
*"         < 3. 座標の設定 >
*
      CALL GGPGET( 'MAPPRJ', IPRJ )
*
      IF( IPRJ .EQ. 0 )THEN                     !" 地図投影しない <<X-Y>>
         CALL GGAXSZ
     I     ( HHEADX, AXISX , 'X'   )
         CALL GGAXSZ
     I     ( HHEADY, AXISY , 'Y'   )
      ENDIF
*
      CALL UWSGXA ( AXISX, IXEND-IXSTR+1 )
      CALL UWSGYA ( AXISY, IYEND-IYSTR+1 )
*
      IF( IPRJ .EQ. 0 ) RETURN                  !" 地図投影しない <<X-Y>>
*
*
*"         < 4. 地図描画設定 >
*
      CALL GGPGET( 'MAPLON', ALON )
      CALL GGPGET( 'MAPLAT', ALAT )
      CALL GGPGET( 'MAPROT', ROTA )
      CALL GGPGET( 'MAPFAC', SIMFAC )
*
      CALL GGPGET( 'VXMIN', XMIN )
      CALL GGPGET( 'VXMAX', XMAX )
      CALL GGPGET( 'VYMIN', YMIN )
      CALL GGPGET( 'VYMAX', YMAX )
*
      IF( ( 5 .LE. IPRJ ) .AND. ( IPRJ .LE. 6 ) )THEN
         CALL GHPGET ( HHEADX , 'DMAX' , RADW )          !" 動径最大値
         RADI = MIN( XMAX-XMIN, YMAX-YMIN ) / 2. * SIMFAC / RADW
      ENDIF
*
      CALL SGPSTX('LDEG',  .TRUE.)    !" 角度単位
      CALL SGPSTX('LLNINT',.TRUE.)
      CALL SGPSTX('LGCINT',.TRUE.)
      CALL SGPSTX('STLAT1', 45.0 )
      CALL SGPSTX('STLAT2', 30.0 )
*
      CALL SGSVPT( XMIN, XMAX, YMIN, YMAX )
*
      IF( ( 5 .LE. IPRJ ) .AND. ( IPRJ .LE. 6 ) )THEN
         CALL SGSSIM( RADI, 0., 0. )
         CALL SGSTRN(IPRJ)
         CALL SGSTRF
      ELSE IF( ( 10 .LE. IPRJ ) .AND. ( IPRJ .LE. 15 ) )THEN
         CALL GRSTRN(IPRJ)
         CALL UMSCNT( ALON, ALAT, ROT )
         CALL UMLSTX('LGLOBE', .TRUE. )
         CALL UMPFIT
         CALL GRSTRF
      ELSE IF( ( 20 .LE. IPRJ ) .AND. ( IPRJ .LE. 23 ) )THEN
         CALL GRSTRN(IPRJ)
         CALL UMSCNT( ALON, ALAT, ROT )
         CALL UMLSTX('LGLOBE', .TRUE. )
         CALL UMPFIT
         CALL GRSTRF
      ELSE IF( ( 30 .LE. IPRJ ) .AND. ( IPRJ .LE. 33 ) )THEN
         CALL GRSTRN(IPRJ)
         CALL UMSCNT( ALON, ALAT, ROT )
         CALL UMLSTX('LGLOBE', .TRUE. )
         CALL UMPFIT
         CALL GRSTRF
      ENDIF
*
*"         < 5. 投影中心位置の表示 > 
*
      CALL GGPGET( 'SEDIT' , SEDIT )
*
      CALL CHVAL( '(F6.1)', ALON, HLON )
      IHLON = LENC( HLON )
      CALL CHVAL( '(F5.1)', ALAT, HLAT )
      IHLAT = LENC( HLAT )
      HPOS = '(lon,lat)=(' // HLON(1:IHLON) // ', '
     &                              // HLAT(1:IHLAT) // ')'
      IHPOS = LENC(HPOS)
*
      XP = ( XMIN + XMAX ) / 2
      YP = YMIN - SEDIT * 1.2
      CALL SGTXZV( XP , YP , HPOS(1:IHPOS), SEDIT, 0, 0, 3 )
*
*"         < 6. 描画境界線 > 
*
      IF( ( 5 .LE. IPRJ ) .AND. ( IPRJ .LE. 6 ) )THEN
         CALL PORAXZ
     I          ( HHEADX , AXISX ,
     I            HHEADY , AXISY   )
      ELSE IF( ( 10 .LE. IPRJ ) .AND. ( IPRJ .LE. 33 ) )THEN
         CALL SGPSTX( 'LCLIP', .TRUE. )
         CALL UMPLIM
         CALL SGPSTX( 'LCLIP', .FALSE. )
      ENDIF
*
      RETURN
      END
**********************************************************************
      SUBROUTINE PORAXZ                  !" 外枠囲み(極座標)
     I             ( HHEADX , AXISX ,
     I               HHEADY , AXISY   )
*
#ifdef SYS_IBMS
      INCLUDE    (GZSIZE)                !" NCC, NDC
#else
#include         "gzsize.F"              !" NCC, NDC
#endif
*
      CHARACTER  HHEADX( NDC )*(NCC)     !" 動径軸ヘッダーファイル
      CHARACTER  HHEADY( NDC )*(NCC)     !" 方位角軸ヘッダーファイル
      CHARACTER  HDSETY*(NCC)
*
      REAL       AXISX(*)                !" X 座標値
      REAL       AXISY(*)                !" Y 座標値
*
      REAL       RSIZE                   !" 座標目盛の長さ(V 座標)
*
      PARAMETER ( N = 5 )
      REAL  X(N) , Y(N)
*
      CALL GHPGET ( HHEADX, 'ASTR1', IXSTR )
      CALL GHPGET ( HHEADX, 'AEND1', IXEND )
      CALL GHPGET ( HHEADY, 'ASTR1', IYSTR )
      CALL GHPGET ( HHEADY, 'AEND1', IYEND )
*
      CALL GHPGET ( HHEADX , 'DMIN' , DMINX )
      CALL GHPGET ( HHEADX , 'DMAX' , DMAXX )
      CALL GHPGET ( HHEADY , 'DMIN' , DMINY )
      CALL GHPGET ( HHEADY , 'DMAX' , DMAXY )
*
      CALL GHCGET ( HHEADY , 'DSET' , HDSETY )
*
      CALL UZRGET('RSIZET1',RSIZE)
      CALL STFTRF( DMINX, DMINY, VX, VY )
      CALL STFTRF( DMINX+1.0, DMINY, VXP, VYP )
      RTICKX = 1.0 * ABS( RSIZE )/ SQRT( (VXP-VX)**2 + (VYP-VY)**2 )
      CALL STFTRF( DMINX, DMINY+1.0, VXP, VYP )
      RTICKY = 1.0 * ABS( RSIZE )/ SQRT( (VXP-VX)**2 + (VYP-VY)**2 )
*
      IF ( HDSETY(1:1) .EQ. 'C' )THEN
         DO 100 I = 1, N
            X(I) = DMINX
            Y(I) = ( DMAXY - DMINY ) / REAL(N-1) * (I-1)
 100     CONTINUE 
         CALL SGPLZU( N, X, Y, 1, 3 )
*     
         DO 110 I = 1, N
            X(I) = DMAXX
            Y(I) = ( DMAXY - DMINY ) / REAL(N-1) * (I-1)
 110     CONTINUE 
         CALL SGPLZU( N, X, Y, 1, 3 )
*
         DO 120 I=1, IYEND-IYSTR+1
            CALL SZLNZU(DMAXX,AXISY(I),DMAXX-RTICKX, AXISY(I) )
            CALL SZLNZU(DMINX,AXISY(I),DMINX+RTICKX, AXISY(I) )
 120     CONTINUE 
*
         DO 130 I=1, IXEND-IXSTR+1
            CALL SZLNZU(AXISX(I),DMINY,AXISX(I),DMINY+RTICKY)
 130     CONTINUE 
      ELSE
         X(1) = DMINX
         Y(1) = DMINY
*
         X(2) = DMINX
         Y(2) = DMAXY
*
         X(3) = DMAXX
         Y(3) = DMAXY
*
         X(4) = DMAXX
         Y(4) = DMINY
*
         X(5) = X(1)
         Y(5) = Y(1)
*
         CALL SGPLZU( N, X, Y, 1, 3 )

         DO 140 I=1, IYEND-IYSTR+1
            CALL SZLNZU(DMAXX,AXISY(I),DMAXX-RTICKX , AXISY(I) )
            CALL SZLNZU(DMINX,AXISY(I),DMINX+RTICKX , AXISY(I) )
 140     CONTINUE 
*
         RTICK = (DMAXY - DMINY) / (IYEND-IYSTR+1)
         DO 150 I=1, IXEND-IXSTR+1
            CALL SZLNZU(AXISX(I),DMAXY,AXISX(I),DMAXY-RTICKY)
            CALL SZLNZU(AXISX(I),DMINY,AXISX(I),DMINY+RTICKY)
 150     CONTINUE 
      ENDIF
*     
      RETURN
      END
