*%表題   2次元データの折れ線グラフを描く
*%
*%履歴   91/04/15  佐藤正樹     C:\FORT\OORT\MCURV.FOR
*%       91/04/27  佐藤正樹     C:\FORT\PLOT\MCURV2.FOR
*%       91/05/20  佐藤正樹     C:\FORT\PLOT\MCURV2.FOR
*%       91/05/21  佐藤正樹     C:\FORT\OORT\GYZCURV.FOR
*%
*%
*-----------------------------------------------------------------------
      PROGRAM    GYZCURV
*
      INTEGER  NXMAX         ! 座標配列の次元の上限
      PARAMETER(  NXMAX   = 100 )
      REAL  XXX(1:NXMAX)      ! 第1次元配列
      REAL  YYY(1:NXMAX)      ! 第2次元配列

      INTEGER  NZMAX          ! 2次元配列の次元の上限
      PARAMETER(  NZMAX   = 1000 )
      REAL  GDATA(1:NZMAX)    ! 2次元配列

      REAL  ZZZ(1:NXMAX, 1:NXMAX) ! 描画用のデータ



      INTEGER  IDIM           ! データ次元数
      INTEGER  JDIM
      INTEGER  KDIM
      INTEGER  IJKDIM

      INTEGER  IXDIM          ! X 軸次元数
      INTEGER  JXDIM
      INTEGER  KXDIM
      INTEGER  IJKXDIM

      INTEGER  IYDIM          ! Y 軸次元数
      INTEGER  JYDIM
      INTEGER  KYDIM
      INTEGER  IJKYDIM

      INTEGER  IX             ! DOループ
      INTEGER  IY             ! DOループ
      INTEGER  IWWW           ! 描画する次元



      INTEGER  NCC
      INTEGER  NDC
      PARAMETER  ( NCC=16, NDC=64 )
      CHARACTER  HHEAD( NDC )*(NCC)
      CHARACTER  HHEADX( NDC )*(NCC)
      CHARACTER  HHEADY( NDC )*(NCC)


*     < 入出力パラメーター >

      INTEGER   IPR  / 10 /          ! 入力ユニット番号
      CHARACTER HIPFL*13 / 'GYZCURV.PAR' / 
     &                               ! 入力パラメーターファイル名
      LOGICAL   LIPEX                ! 入力パラメーターファイルの存在

      INTEGER   IFILE   / 20 /       ! 入力ユニット番号
      CHARACTER HIFLX*16             ! X 軸情報ファイル名
      CHARACTER HIFLY*16             ! Y 軸情報ファイル名
      CHARACTER HFILE*16             ! 入力ファイル名



*     < 描画パラメーター >

      INTEGER  IWS                  ! ワークステーション番号

      CHARACTER  CXTTL*16, CXUNIT*16 ! X 軸のパラメーター
      REAL  XMIN, XMAX, DXS, DXL
      REAL  XFAC         / 1. /
      INTEGER  STYPX
      LOGICAL  LXINV

      CHARACTER  CYTTL*16, CYUNIT*16 ! Y 軸のパラメーター
      REAL  YMIN, YMAX, DYS, DYL
      REAL  YFAC         / 1. /
      INTEGER  STYPY
      LOGICAL  LYINV

      CHARACTER  CZTTL*32, CZUNIT*16 ! データに関するパラメーター
      REAL  ZMIN,     ZMAX,     DZS,     DZL
      REAL  ZFAC         / 1. /
      INTEGER  STYPZ
      LOGICAL  LZINV

      REAL  RMISS

      CHARACTER  XYIDX*2     ! 座標軸の取り方
*                              XYIDX = 'XZ'
*                              XYIDX = 'ZY'


      REAL  VXMIN / 0.175 /   ! ビューポート X座標
      REAL  VXMAX / 0.825 /   ! ビューポート X座標
      REAL  VYMIN / 0.1875 /  ! ビューポート Y座標
      REAL  VYMAX / 0.5125 /  ! ビューポート Y座標
      LOGICAL  LFULL



*     < NAMELIST >

      NAMELIST / XPARA /   CXTTL,    CXUNIT,
     &                     XMIN,     XMAX,     DXS,      DXL,
     &                     STYPX,
     &                     XFAC
      NAMELIST / YPARA /   CYTTL,    CYUNIT,
     &                     YMIN,     YMAX,     DYS,      DYL,
     &                     STYPY,
     &                     YFAC
      NAMELIST / ZPARA /   CZTTL, 
     &                     ZMIN,     ZMAX,     DZS,     DZL,
     &                     STYPZ,
     &                     ZFAC
      NAMELIST / VPARA /   VXMIN,    VXMAX,    VYMIN,    VYMAX,
     &                     LFULL

*-----------------------------------------------------------------------
*     < アンダーフローのスイッチの設定 >

      CALL UNDER0(.TRUE.)

*-----------------------------------------------------------------------

      WRITE ( 6,* )     ' FILE NAME ? '              ! ファイル名
      READ  ( 5,'(A)' ) HFILE
      WRITE ( 6,* )     ' データは X 軸か Y 軸か( ''XZ'' or ''ZY'' )?'
      READ  ( 5,* )     XYIDX                        ! データの軸
      WRITE ( 6,* )     ' WORK STATION NO ?'         ! ワークステー
      READ  ( 5,* )     IWS                          !   ション番号

*-----------------------------------------------------------------------
*     < データ入力 >

      CALL  RDGTDT
     I           ( IFILE,    HFILE,
     O             HHEAD,    GDATA,
     D             IDIM,     JDIM,     KDIM,     IJKDIM  )



*     < 軸情報の入力 >

      CALL  GHCGET( HHEAD, 'AITM2', HIFLX )
      CALL  GHCGET( HHEAD, 'AITM3', HIFLY )

      CALL  RDGTDT
     I           ( IFILE,    HIFLX,
     O             HHEADX,   XXX,
     D             IXDIM,    JXDIM,    KXDIM,     IJKXDIM  )

      CALL  RDGTDT
     I           ( IFILE,    HIFLY,
     O             HHEADY,   YYY,
     D             IYDIM,    JYDIM,    KYDIM,     IJKYDIM  )

*-----------------------------------------------------------------------
*     < 描画用のデータの設定 >

      IF( XYIDX .EQ. 'XZ' ) THEN

        DO 100 IX = 1, IJKXDIM
          DO 110 IY = 1, IJKYDIM
            ZZZ(IX, IY) = GDATA( IX + (IY-1) * IJKXDIM )
 110      CONTINUE
 100    CONTINUE

*       矩形
        VXMIN=0.175
        VXMAX=0.825
        VYMIN=0.1875
        VYMAX=0.5125
        LFULL=.TRUE.


      ELSE IF( XYIDX .EQ. 'ZY' ) THEN

        DO 200 IX = 1, IJKXDIM
          DO 210 IY = 1, IJKYDIM
            ZZZ(IY, IX) = GDATA( IX + (IY-1) * IJKXDIM )
 210      CONTINUE
 200    CONTINUE

*       正方形
        VXMIN=0.175
        VXMAX=0.825
        VYMIN=0.175
        VYMAX=0.825
        LFULL=.FALSE.

      ELSE

        WRITE(6,*) 'XYIDX の指定が不適切です'
        STOP

      END IF

*-----------------------------------------------------------------------
*     < 描画パラメーターの設定 >

      CALL  GHCGTS( HHEAD, 'TITL',  CZTTL )
      CALL  GHCGET( HHEAD, 'UNIT',  CZUNIT )
      CALL  GHPGET( HHEAD, 'DMIN',  ZMIN )
      CALL  GHPGET( HHEAD, 'DMAX',  ZMAX )
      CALL  GHPGET( HHEAD, 'DIVS',  DZS )
      CALL  GHPGET( HHEAD, 'DIVL',  DZL )
      CALL  GHPGET( HHEAD, 'STYP',  STYPZ )

      CALL  GHCGET( HHEADX, 'UNIT',  CXUNIT )
      CALL  GHPGET( HHEADX, 'DMIN',  XMIN )
      CALL  GHPGET( HHEADX, 'DMAX',  XMAX )
      CALL  GHPGET( HHEADX, 'DIVS',  DXS )
      CALL  GHPGET( HHEADX, 'DIVL',  DXL )
      CALL  GHPGET( HHEADX, 'STYP',  STYPX )
      IF( STYPX .EQ. 1 ) THEN
        LXINV = .FALSE.
      ELSE IF( STYPX .EQ. -1 ) THEN
        LXINV = .TRUE.
      ENDIF

      CALL  GHCGET( HHEADY, 'UNIT',  CYUNIT )
      CALL  GHPGET( HHEADY, 'DMIN',  YMIN )
      CALL  GHPGET( HHEADY, 'DMAX',  YMAX )
      CALL  GHPGET( HHEADY, 'DIVS',  DYS )
      CALL  GHPGET( HHEADY, 'DIVL',  DYL )
      CALL  GHPGET( HHEADY, 'STYP',  STYPY )
      IF( STYPY .EQ. 1 ) THEN
        LYINV = .FALSE.
      ELSE IF( STYPY .EQ. -1 ) THEN
        LYINV = .TRUE.
      ENDIF

*-----------------------------------------------------------------------
*     < 欠損値処理 >

      CALL  GHPGET( HHEAD, 'MISS',  RMISS )
      CALL  GLPSET( 'RMISS', RMISS )
      CALL  GLPSET( 'LMISS', .TRUE. )

*-----------------------------------------------------------------------
*     < パラメーターの入力 >

      INQUIRE(FILE=HIPFL, EXIST=LIPEX)
      IF( .NOT. LIPEX ) THEN
        WRITE(6,*) '入力パラメーターファイルが存在しません'
        WRITE(6,*) ' ファイル名: ', HIPFL
        GOTO 5000
      END IF


      OPEN(IPR,FILE=HIPFL)
        READ(IPR,XPARA)
        READ(IPR,YPARA)
        READ(IPR,ZPARA)
        READ(IPR,VPARA)
      CLOSE(IPR)

 5000 CONTINUE

*-----------------------------------------------------------------------
*     < 描画 >

*     << 開始 >>

      CALL SGPSET('LFULL', LFULL)     ! 画面をいっぱいにとるかどうか
      CALL GROPN(IWS)



      CALL GRFRM

      CALL USSVPT(VXMIN, VXMAX, VYMIN, VYMAX) ! ビューポート
      CALL GLPSET('LMISS', .TRUE. )    ! 欠損値処理


*     << 表題 >>

      CALL SGSTXC( 0 )                 ! 中央に書く
      CALL SGSTXS( 0.02 )              ! 文字の高さ
      CALL SGSTXI( 5 )                 ! 文字の線のインデックス
      CALL SGTXV( 0.5, VYMAX+0.05,  CZTTL)



*     << 描画 >>

      CALL USCSET('CBLKT' , ' ')       ! サブラベルに括弧をつけない
      CALL UZPSET('INNER', -1)         ! 外側に向かって目盛を打つ


*     ------------------------------------------------------------------
      IF( XYIDX .EQ. 'XZ' ) THEN



      CALL USCSET('CXTTL' , CXTTL)
      CALL USCSET('CXUNIT', CXUNIT)
      CALL USPSET('XMIN', XMIN)
      CALL USPSET('XMAX', XMAX)
      CALL USPSET('DXT', DXS)
      CALL USPSET('DXL', DXL)
      CALL USPSET('LXINV', LXINV)
      CALL USPSET('XFAC', XFAC)

      CALL USCSET('CYTTL' , CZTTL)
      CALL USCSET('CYUNIT', CZUNIT)
      CALL USPSET('YMIN', ZMIN)
      CALL USPSET('YMAX', ZMAX)
      CALL USPSET('DYT', DZS)
      CALL USPSET('DYL', DZL)
      CALL USPSET('LYINV', LZINV)
      CALL USPSET('YFAC', ZFAC)


      CALL USAXIS


 1000 CONTINUE

        WRITE(6,*) '描画する座標を指定してください'
        WRITE(6,*) '  範囲: 1 <', CYTTL, '<', IJKYDIM
        WRITE(6,*) '描画を終了するときは 999'
        WRITE(6,*) CYTTL
        READ(5,*) IWWW
        IF(IWWW .EQ. 999) THEN
                                                           GOTO 1100
        ENDIF
        IF( (IWWW .GT. IJKYDIM) .OR. (IWWW .LT. 1) ) THEN
          WRITE(6,*) '範囲が不適切です'
                                                           GOTO 1000
        ENDIF
        WRITE(6,*) CYTTL, YYY(IWWW)

        CALL SGPLZU(IJKXDIM, XXX, ZZZ(1,IWWW), 1, 3)

                                                           GOTO 1000
 1100 CONTINUE



*     ------------------------------------------------------------------
      ELSE IF( XYIDX .EQ. 'ZY' ) THEN



      CALL USCSET('CXTTL' , CZTTL)
      CALL USCSET('CXUNIT', CZUNIT)
      CALL USPSET('XMIN', ZMIN)
      CALL USPSET('XMAX', ZMAX)
      CALL USPSET('DXT', DZS)
      CALL USPSET('DXL', DZL)
      CALL USPSET('LXINV', LZINV)
      CALL USPSET('XFAC', ZFAC)

      CALL USCSET('CYTTL' , CYTTL)
      CALL USCSET('CYUNIT', CYUNIT)
      CALL USPSET('YMIN', YMIN)
      CALL USPSET('YMAX', YMAX)
      CALL USPSET('DYT', DYS)
      CALL USPSET('DYL', DYL)
      CALL USPSET('LYINV', LYINV)
      CALL USPSET('YFAC', YFAC)


      CALL USAXIS


 2000 CONTINUE

        WRITE(6,*) '描画する座標を指定してください'
        WRITE(6,*) '  範囲: 1 <', CXTTL, '<', IJKXDIM
        WRITE(6,*) '描画を終了するときは 999'
        WRITE(6,*) CXTTL
        READ(5,*) IWWW
        IF(IWWW .EQ. 999) THEN
                                                           GOTO 2100
        ENDIF
        IF( (IWWW .GT. IJKXDIM) .OR. (IWWW .LT. 1) ) THEN
          WRITE(6,*) '範囲が不適切です'
                                                           GOTO 2000
        ENDIF
        WRITE(6,*) CXTTL, XXX(IWWW)

        CALL SGPLZU(IJKYDIM, ZZZ(1,IWWW), YYY, 1, 3)

                                                           GOTO 2000
 2100 CONTINUE



*     ------------------------------------------------------------------
      END IF



*     << 画面のメッセージを消去 >>

C      CALL SYSTEM('CLS')



*     << 終了 >>

      CALL GRCLS

*-----------------------------------------------------------------------
      STOP
      END
