C
C *** OUTPUT OF AMPLITUDE SPETRUM TO PLOTTER ***
C
      SUBROUTINE SPCPLT(FOM,DOM,NOM,MOM,SPCA)
C
C ** FOM     : FIRST CIRCULAR FREQUENCY : OMEGA OF SPCA(1)
C ** DOM     : INCREMENT OF CIRCULAR FREQUENCY (DELTA OMEGA)
C ** NOM     : TOTAL NUMBER OF CIRCULAR FREQUENCY
C ** MOM     : NOM IN MAIN PROGRAM DIMENSION
C            : IF MOM > 2**13(=8192), CAN NOT USE !!!
C ** SPCA(I) : FOURIER SPECTRUM AMPLITUDE
C    (FOURIER SPECTRUM = FOURIER COEFFICIENTS * DURATION/2.0)
C
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION SPCA(MOM)
      CHARACTER YUNIT*10
C
      PAI2=8.D0*DATAN(1.D0)
C
C *** SEARCH OF MAXIMUM AMPLITUDE AND FINAL OMEGA ***
C
      AMX=0.0D0
      DO 100 IOM=1,NOM
        APC=SPCA(IOM)
        IF(APC.GE.AMX)THEN
        AMX=APC
        IOMMX=IOM
        END IF
  100 CONTINUE
C
      EOM=FOM+DOM*DFLOAT(NOM-1)
      OMMX=FOM+DOM*DFLOAT(IOMMX-1)
      FPR=PAI2/EOM
      IF(FOM.EQ.0)THEN
        EPR=9999.D0
      ELSE
        EPR=PAI2/FOM
      ENDIF
      PRMAX=PAI2/OMMX
C
C *** OUTPUT OF DATA INFORMATION ***
C
      WRITE(*,*)
      WRITE(*,1000)
   10 WRITE(*,1010)
      WRITE(*,1020)DOM,NOM
      WRITE(*,1030)FPR,EPR
      WRITE(*,1040)AMX,PRMAX
 1000 FORMAT(' FROM SUBROUTINE SCCPLT : AMPLITUDE SPETRUM PLOT')
 1010 FORMAT(/' DATA INFORMATION :')
 1020 FORMAT(' DELTA OMEGA   = ',F8.4,'  ,OMEGA NUMBER  = ',I5)
 1030 FORMAT(' FIRST PERIOD  = ',F8.4,'  ,FINAL PERIOD  = ',F8.4)
 1040 FORMAT(' MAXIMUM AMPLITUDE = ',F10.5,' AT PERIOD  = ',F8.4/)
C
C *** AXIS DATA INPUT ***
C
      WRITE(*,1200)
 1200 FORMAT(' AXIS OFF ? ( YES = 0 ENTER ) :',\)
      READ(*,*)NAXY
C
      IF(NAXY.EQ.0)THEN
C
        OPEN(5,FILE='AXP.DAT')
        READ(5,1210)XOR,YOR,XFAC,YFAC,OLDFOM,XVAL
        CLOSE(5)
 1210   FORMAT(6D15.7,I5)
C
      ELSE
C
        WRITE(*,1300)
        WRITE(*,1310)
C     * X-AXIS *
        READ(*,*)XMIN
        WRITE(*,1320)
        READ(*,*)XVAL
        WRITE(*,1330)
        READ(*,*)XLEN
        XLEN=XLEN*100.0D0
        WRITE(*,1340)
        READ(*,*)NUX
        XFAC=XLEN/(XVAL-XMIN)
        WRITE(*,1345)
        READ(*,*)NXINT
C     * Y-AXIS *
        WRITE(*,1350)
        READ(*,*)YVAL
        WRITE(*,1360)
        READ(*,*)YLEN
        YLEN=YLEN*100.0D0
        WRITE(*,1370)
        READ(*,*)NUY
        YFAC=YLEN/YVAL
        WRITE(*,1375)
        READ(*,*)NYINT
 1300   FORMAT(' AXIS DATA INPUT :')
 1310   FORMAT(/' ENTER X-AXIS MIN (MIN PERIOD)                 :',\)
 1320   FORMAT( ' ENTER X-AXIS MAX (MAX PERIOD)                 :',\)
 1330   FORMAT( ' ENTER X-AXIS LENGTH (cm)                      :',\)
 1340   FORMAT( ' ENTER X-AXIS DIVISION NUMBER                  :',\)
 1345   FORMAT( ' ENTER DIVISION INTERVAL FOR X-AXIS SCALE      :',\)
 1350   FORMAT(/' ENTER Y-AXIS MAX VALUE (Y-AXIS AMP > MAX AMP) :',\)
 1360   FORMAT( ' ENTER Y-AXIS LENGTH (cm )                     :',\)
 1370   FORMAT( ' ENTER Y-AXIS DIVISION NUMBER                  :',\)
 1375   FORMAT( ' ENTER DIVISION INTERVAL FOR Y-AXIS SCALE      :',\)
C
        WRITE(*,1500)
        READ(*,*)XOR
        XOR=(2.0D0+XOR)*100.0D0
        WRITE(*,1510)
        READ(*,*)YOR
        YOR=(2.0D0+YOR)*100.0D0
        WRITE(*,1520)
        READ(*,*)IYES
        IF(IYES.NE.0)GOTO 10
 1500   FORMAT(/' ENTER X ORIGIN POSITION (cm):',\)
 1510   FORMAT( ' ENTER Y ORIGIN POSITION (cm):',\)
 1520   FORMAT(/' ALL INPUT DATA OK ? ( YES = 0 ) :',\)
C
      END IF
C
C *** OUTPUT PLOTTER DATA ***
C 
      OPEN(6,FILE='PS.DAT')
C
      IF(NAXY.EQ.0)GOTO 20
C
C   * PEN, TERM, AXIS AND CHARACTER *
C
      WRITE(6,2000)
      WRITE(6,2010)
C   * X-AXIS *
      WRITE(6,2020)XOR,YOR
      WRITE(6,2030)XLEN,NUX
      XINT=XLEN/DFLOAT(NUX)
      XINTV=(XVAL-XMIN)/DFLOAT(NUX)
      DO 150 INT=0,NUX,NXINT
        WRITE(6,2020)XOR+XINT*DFLOAT(INT)-100.0D0,YOR-60.0D0
        WRITE(6,2040)XMIN+XINTV*DFLOAT(INT)
  150 CONTINUE
      WRITE(6,2020)XOR+XLEN-270.0D0,YOR-120.0D0
      WRITE(6,2050)
C   * Y-AXIS *
      WRITE(6,2020)XOR,YOR
      WRITE(6,2060)YLEN,NUY
      YINT=YLEN/DFLOAT(NUY)
      YINTV=YVAL/DFLOAT(NUY)
      DO 160 INT=0,NUY,NYINT
        WRITE(6,2020)XOR-40.0D0,YOR+YINT*DFLOAT(INT)-70.D0
        WRITE(6,2070)YINTV*DFLOAT(INT)
  160 CONTINUE
      WRITE(6,2020)XOR-100.0D0,YOR+YLEN-480.0D0
      WRITE(6,2080)
C
 2000 FORMAT(2HJ1)
 2010 FORMAT(3H=<<)
 2020 FORMAT(1HM,F6.1,1H,F6.1,1H,)
 2030 FORMAT(3HX3,,F6.1,1H,I2,2H<<)
 2040 FORMAT(7HR0,S30,,1HP,F5.1,2H<<)
 2050 FORMAT(7HR0,S30,,14HPPERIOD(SEC)<<)
 2060 FORMAT(3HX2,,F6.1,1H,I2,2H<<)
 2070 FORMAT(9HR900,S30,,1HP,F4.1,2H<<)
 2080 FORMAT(9HR900,S25,,4HQ25,,23HPAMPLIFICATION FACTOR<<,3HQ30)
C
C   * DATA PLOT *
C
   20 DO 195 IOM=NOM,1,-1
        PER=PAI2/(FOM+DOM*DFLOAT(IOM-1))
        IF(PER.GE.XMIN)GOTO 25
  195 CONTINUE
   25 FPER=PER
      IFOM=IOM
C
      WRITE(*,2090)
      READ(*,*)NLIN
      WRITE(6,2094)
      IF(NLIN.EQ.1)WRITE(6,2095)
 2090 FORMAT(/' Line Type : Solid (0) or Dot (1) ? : ',\)
 2094 FORMAT(2HL0)
 2095 FORMAT(3HL3,,3HB20)
C
      WRITE(6,2100)XOR+(FPER-XMIN)*XFAC,YOR+SPCA(IFOM)*YFAC
      DO 200 IOM=IFOM,1,-1
        PER=PAI2/(FOM+DOM*DFLOAT(IOM-1))
        IF(PER.GE.XVAL)GO TO 30
        WRITE(6,2110)XOR+(PER-XMIN)*XFAC,YOR+SPCA(IOM)*YFAC
  200 CONTINUE
   30 WRITE(6,2100)XOR+XVAL*XFAC+500.0D0,YOR
 2100 FORMAT(1HM,F6.1,1H,F6.1,1H,)
 2110 FORMAT(1HD,F6.1,1H,F6.1,1H,)
C
      CLOSE(6)
C
C *** AXIS DATA OUTPUT TO FILE ***
C
      IF(NAXY.NE.0)THEN
        OPEN(5,FILE='AXP.DAT')
        WRITE(5,2200)XOR,YOR,XFAC,YFAC,FOM,XVAL
        CLOSE(5)
 2200   FORMAT(6D15.7,I5)
      END IF
C
      WRITE(*,3000)
 3000 FORMAT(/' USE FOR PLOTTER : A> COPY PS.DAT PRN')
      WRITE(*,*)
C
      RETURN
      END
