viewsol3.f

C
C        PROGRAM VIEWSOL3.F
C
C     THIS ROUTINE PLOTS THE SOLUTION VECTOR FROM PROGRAM
C     RUNSPARS1.F WHICH IS COMPOSED OF SOURCE AND SITE SPECTRA.
C     IT ALSO READS IN AND PLOTS RESULTS FROM ONE OR MORE SOURCES
C     IF AVAILABLE ON THE SAME SET OF AXES.
C
      DIMENSION X(20000),SP(1000),FREQ(1000)
      DIMENSION H(100),XMAG(100),STALAT(100),STALON(100),
     +IASF(13),WINDOW(4)
      DIMENSION SORLAT(100),SORLON(100),CHANALT(3,100),
     +CHANAZI(3,100)
      COMMON/OTHER/IAMP,ICONF,ICOMP,NUMFR(25,5),FROTH(100,25,5),
     +AMPOTH(200,100,5),NOTH(5),NSOUR,STAOTH(25,5)
      CHARACTER*5 BLANK
      CHARACTER*7 BLANK2
      CHARACTER*40 STRING,STALOC,AFLOC
      CHARACTER*14 AFILE(100),NAME1
      CHARACTER*27 AMPTITLE
      CHARACTER*40 TITLE,NAME,NFNAM(5)
      CHARACTER*5 STA(100),NAME2,STAOTH(25,5),STACONF
      COMMON/PLTSC/ITRACK,NSOR
      DATA IASF /13*1/
      CALL SETUSV('MU',8)
      CALL OPNGKS
      WRITE(6,608)
 608  FORMAT(1X,'WHAT LINE WEIGHT THICKNESS DO YOU WANT',/,
     +1X,'THE DEFAULT VALUE IS 1.')
      READ(5,*) WTLINE
      CALL GSLWSC(WTLINE)
      CALL GSASF(IASF)
      CALL GSCR(1,0,0.,0.,1.)
      CALL GSCR(1,1,1.,1.,1.)
      CALL FRAME
      CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
      ICOUNT=1
      OPEN(UNIT=7,FILE='SOLUTIONSP1.DAT',STATUS='OLD',
     +ACCESS='SEQUENTIAL',FORM='UNFORMATTED')
      READ(7) NCA
      READ(7) (X(I),I=1,NCA)
      CLOSE(7)
C
C     TAKE INVERSE LOGARITHM
C
      DO 12 I=1,NCA
  12  X(I)=10.**X(I)
C
      WRITE(6,599)
 599  FORMAT(1X,'IN ADDITION TO PLOTTING THE ENTIRE SPECTRUM',/,
     +1X,'DO YOU WANT TO WRITE OUT A FILE OF AVERAGE AMPLIFICATION',/,
     +1X,'VALUES FOR EACH STATION FOR A GIVEN FREQUENCY BAND',/,
     +1X,'1=YES 0=NO')
      READ(5,*) IBAND
      IF(IBAND .EQ. 1) THEN
      WRITE(6,598)
 598  FORMAT(1X,'WHAT FREQUENCY BAND DO YOU WANT')
      READ(5,*) F1,F2
      END IF
      WRITE(6,600)
 600  FORMAT(1X,'DO YOU WANT TO INTEGRATE THE SPECTRA, THAT IS,',/,
     +1X,'GO FROM VELOCITIES TO DISPLACEMENT, 1=YES  0=NO')
      READ(5,*) INTEG
      WRITE(6,621)
 621  FORMAT(1X,'SPECIFY BACKGROUND TYPE FOR PLOTS:',/,
     +1X,'1 = PERIMETER BACKGROUND',/,
     +1X,'2 = GRID BACKGROUND',/,
     +1X,'3 = JUST AXES',/,
     +1X,'4 = NO BACKGROUND')
      READ(5,*) IBAK
C      WRITE(6,622)
C 622  FORMAT(1X,'SPECIFY LINEAR (=0) OR LOGARITHMIC (=1) X, HORIZ.',/,
C     +1X,'SCALE')
C      READ(5,*) IXTYPE
C      WRITE(6,623)
C 623  FORMAT(1X,'SPECIFY LINEAR (=0) OR LOGARITHMIC (=1) Y, VERT.',/,
C     +1X,'SCALE')
C      READ(5,*) IYTYPE
C
C     FIRST FIND OUT HOW MANY DIFFERENT SOURCES THERE ARE.
C
      WRITE(6,707)
 707  FORMAT(1X,'ENTER THE NAME OF THE FILE IN MASTER.DAT FORMAT',/,
     +1X,'WITH SOURCE LOCATIONS')
      READ(5,601) AFLOC
      OPEN(UNIT=7,FILE=AFLOC,STATUS='OLD')
      IC=1
  4   READ(7,602,END=5) XLAT,XLONG,H(IC),XMAG(IC),AFILE(IC) 
 602  FORMAT(F7.4,1X,F9.4,2F5.2,1X,A)
      SORLAT(IC)=XLAT
      SORLON(IC)=XLONG
      IC=IC+1
      GO TO 4
  5   IC=IC-1
      CLOSE(7)
      NSOR=IC
      WRITE(6,666) (SORLAT(I),SORLON(I),I=1,NSOR)
 666  FORMAT(1X,2F12.3)     
C
C     NOW READ IN SITE INFORMATION.
C
      WRITE(6,702)
 702  FORMAT('ENTER THE NAME OF THE FILE WITH STATION LOCATIONS')
      READ(5,601) STALOC
      OPEN(UNIT=7,FILE=STALOC,STATUS='OLD')
      I=1
  61  READ(7,601,END=60) STRING
      IF(STRING(1:5) .EQ. 'STNID') THEN 
      STA(I)=STRING(7:11)
      READ(7,*) BLANK,STALAT(I),STALON(I),HH
      DO 37 IPC=1,3
      READ(7,*,END=60) BLANK2,ICOM,CHANALT(ICOM,I)
      READ(7,*,END=60) BLANK2,ICOM,CHANAZI(ICOM,I)
  37  CONTINUE
      I=I+1
      END IF
      GO TO 61
  60  CLOSE(7)
 601  FORMAT(A)
      NSIT=I-1
C
C
      OPEN(UNIT=10,FILE='D.DAT',STATUS='OLD',ACCESS='SEQUENTIAL',
     +FORM='UNFORMATTED')
      READ(10) ILOOP,JLOOP,IFN,FMIN,FSTEP
      CLOSE(10)
C
C
      IFNMAX=IFN
      WRITE(6,703)
 703  FORMAT(1X,'DO YOU WANT TO PUT AN UPPER LIMIT ON THE',/,
     +1X,'FREQUENCY TO BE PLOTTED, 1=YES 0=NO')
      READ(5,*) ILIM
      IF(ILIM .EQ. 1) THEN
      WRITE(6,704)
 704  FORMAT(1X,'INPUT UPPER FREQUENCY LIMIT TO PLOT')
      READ(5,*) FUPER
      DO 705 I=1,IFN
      F=FMIN+FLOAT(I-1)*FSTEP
      IF(F .GE. FUPER) GO TO 706
 705  CONTINUE
 706  IFNMAX=I-1
      END IF
      WRITE(6,603)
 603  FORMAT(1X,'DO YOU WANT TO PLOT A SOLUTION FROM ANOTHER',/,
     +1X,'SOURCE FOR COMPARISON, 1=YES 0=NO')
      READ(5,*) ICOMP
      IF(ICOMP .EQ. 1) THEN
      WRITE(6,609)
 609  FORMAT(1X,'HOW MANY OTHER SOURCES')
      READ(5,*) NSOUR
      DO 31 IS=1,NSOUR
      WRITE(6,604)
 604  FORMAT(1X,'ENTER FILE NAME OF OTHER SOLUTION')
      READ(5,605) NFNAM(IS)
 605  FORMAT(A)
      OPEN(UNIT=10,FILE=NFNAM(IS),STATUS='OLD')
      WRITE(6,610)
 610  FORMAT(1X,'IS THIS A CONFID95 FILE, 1=YES 0=NO')
      READ(5,*) ICONF
      WRITE(6,613)
 613  FORMAT(1X,'IS THIS AN AMP.DAT FILE, 1=YES 0=NO')
      READ(5,*) IAMP
      IF(ICONF .EQ. 1) THEN
      DO 32 I=1,NSIT
      READ(10,605) STACONF
      IF(STACONF(1:3) .NE. STA(I)(1:3)) THEN
      WRITE(6,611) STACONF,STA(I)
 611  FORMAT(1X,'STATION ',A,' DOES NOT MATCH STATION ',A)
      STOP
      END IF
      READ(10,612) (AMPOTH(K,I,IS),K=1,IFN)
  32  CONTINUE
      GO TO 33
      END IF
      IF(IAMP .EQ. 1) THEN
      DO 36 I=1,NSIT
      READ(10,605) AMPTITLE
      IF(AMPTITLE(25:27) .NE. STA(I)(1:3)) THEN
      WRITE(6,611) AMPTITLE(25:27),STA(I)
      STOP
      END IF
      READ(10,661) (AMPOTH(K,I,IS),K=1,IFN)
      READ(10,605) AMPTITLE
      READ(10,605) AMPTITLE
  36  CONTINUE
      GO TO 33
      END IF
      READ(10,606) NOTH(IS)
      DO 30 I=1,NOTH(IS)
      READ(10,605) STAOTH(I,IS)
      READ(10,606) NUMFR(I,IS)
      READ(10,607) (FROTH(K,I,IS),AMPOTH(K,I,IS),K=1,NUMFR(I,IS))
 606  FORMAT(I5)
 607  FORMAT(2F10.0)
 612  FORMAT(1X,8F12.5)
 661  FORMAT(6F12.4)
  30  CONTINUE
  33  CONTINUE
      CLOSE(10)
  31  CONTINUE
      END IF
C
C
      MMS=NSOR+NSIT
      IF(INTEG .EQ. 1) THEN
      DO 15 I=1,NSOR
      K1=IFN*(I-1)+1
      K2=IFN*I
      K=K1
      DO 14 J=1,IFN
      F=FMIN+FLOAT(J-1)*FSTEP
      X(K)=X(K)/(6.2831853*F)
  14  K=K+1
  15  CONTINUE
      END IF
C
C
      ITRACK=0
      DO 100 IK=1,NSOR
      ITRACK=ITRACK+1
      IXTYPE=1
      IYTYPE=1
      K1=IFN*(IK-1)+1
      K2=IFN*IK
      NAME1=AFILE(IK)
      NAME(1:37)='SOURCE SPECTRUM EVENT: '//NAME1(1:14)
      IF(IK .EQ. 1) THEN
      DO 20 I=1,IFN
  20  FREQ(I)=FMIN+FLOAT(I-1)*FSTEP
      OPEN(UNIT=21,FILE='SOURCE.DAT',STATUS='NEW')
      END IF
      KQ=K1
      DO 10 I=1,IFN
      SP(I)=X(KQ) 
  10  KQ=KQ+1
      WRITE(21,698) NAME(1:37)
      WRITE(21,701) (SP(I),I=1,IFN)
      WRITE(21,700)
      CALL BOX4(FREQ,SP,IFNMAX,WINDOW,IBAK,IXTYPE,IYTYPE,NAME,
     +ICOUNT)
 100  CONTINUE
      DO 200 IK=1,NSIT
      ITRACK=ITRACK+1
      IXTYPE=0
      IYTYPE=0
      K1=IFN*(NSOR+IK-1)+1
      K2=IFN*(NSOR+IK)
      NAME2=STA(IK)
      TITLE(1:29)='SITE SPECTRUM LOCATION: '//NAME2(1:5)
      KQ=K1
      DO 25 I=1,IFN
      SP(I)=X(KQ)
  25  KQ=KQ+1
C
C
      IF(IK .EQ. 1) THEN
      OPEN(UNIT=22,FILE='AMP.DAT',STATUS='NEW')
      END IF
      WRITE(22,698) TITLE(1:29)
      WRITE(22,699) (SP(I),I=1,IFN)
      WRITE(22,700)
 698  FORMAT(A)
 699  FORMAT(6F12.4)
 701  FORMAT(6E12.4)
 700  FORMAT(/)
C
C
      IF(IK .EQ. 1 .AND. IBAND .EQ. 1) THEN
      IF(F1 .LT. FMIN) F1=FMIN
      IF(F2 .GT. FREQ(IFN)) F2=FREQ(IFN)
      N1=(F1-FMIN)/FSTEP + 1.5
      N2=(F2-FMIN)/FSTEP + 1.5
      NPOINT=N2-N1+1
      OPEN(UNIT=7,FILE='SITE',STATUS='NEW')
      END IF
      IF(IBAND .EQ. 1) THEN
      AVG=0.
      DO 45 N=N1,N2
  45  AVG=AVG+ALOG10(SP(N))
      AVG=AVG/FLOAT(NPOINT)
      AVG=10.**AVG
      WRITE(7,77) STALON(IK),STALAT(IK),AVG
  77  FORMAT(3F12.4)
      END IF
C
C
      CALL BOX4(FREQ,SP,IFNMAX,WINDOW,IBAK,IXTYPE,IYTYPE,TITLE,
     +ICOUNT)
 200  CONTINUE
      CALL CLSGKS
      CLOSE(22)
      CLOSE(21)
      IF(IBAND .EQ. 1) CLOSE(7)
      STOP
      END
C
C
      SUBROUTINE BOX4(X,Y,NT,WINDOW,IBAK,IXTYPE,IYTYPE,NAME,
     +ICOUNT)
      DIMENSION X(1),Y(1),WINDOW(4)
      CHARACTER*40 NAME
      IF(ICOUNT .GT. 4) THEN
      CALL FRAME
      ICOUNT=1
      END IF
      IF(ICOUNT .EQ. 1) THEN
      WINDOW(1)=0.
      WINDOW(2)=0.5
      WINDOW(3)=0.5
      WINDOW(4)=1.0
      END IF
      IF(ICOUNT .EQ. 2) THEN
      WINDOW(1)=0.5
      WINDOW(2)=1.0
      WINDOW(3)=0.5
      WINDOW(4)=1.0
      END IF
      IF(ICOUNT .EQ. 3) THEN
      WINDOW(1)=0.
      WINDOW(2)=0.5
      WINDOW(3)=0.
      WINDOW(4)=0.5
      END IF
      IF(ICOUNT .EQ. 4) THEN
      WINDOW(1)=0.5
      WINDOW(2)=1.0
      WINDOW(3)=0.
      WINDOW(4)=0.5
      END IF
      CALL DRAW3(X,Y,NT,WINDOW,IBAK,IXTYPE,IYTYPE,NAME)
      ICOUNT=ICOUNT+1
      RETURN
      END
      SUBROUTINE DRAW3(X,Y,NT,WINDOW,IBAK,IXTYPE,IYTYPE,NAME)
C
C     X......ARRAY OF X (HORIZONTAL) COORDINATE VALUES
C     Y......ARRAY OF Y (VERTICAL) COORDINATE VALUES
C     NT.....NUMBER OF POINTS IN X AND Y
C     WINDOW.FOUR ELEMENT ARRAY SPECIFYING THE GRAPH WINDOW
C            AS FRACTIONS OF THE SCREEN DIMENSIONS.
C            WINDOW(1)= LEFT LIMIT
C            WINDOW(2)= RIGHT LIMIT
C            WINDOW(3)= BOTTOM LIMIT
C            WINDOW(4)= TOP LIMIT.
C     IBAK...BACKGROUND PARAMETER.
C            IBAK= 1, PERIMETER BACKGROUND
C            IBAK= 2, GRID BACKGROUND
C            IBAK= 3, JUST AXES
C            IBAK= 4, NO BACKGROUND
C     IXTYPE.SPECIFIES LINEAR (=0) OR LOGARITHMIC (=1) X SCALE.
C     IYTYPE.SPECIFIES LINEAR (=0) OR LOGARITHMIC (=1) Y SCALE.
C     NAME...TITLE FOR PLOT.
C
      DIMENSION X(1),Y(1),WINDOW(4),X2(1000,5),Y2(1000,5),
     +IPKI(5),IPKIS(5)
      COMMON/OTHER/IAMP,ICONF,ICOMP,NUMFR(25,5),FROTH(100,25,5),
     +AMPOTH(200,100,5),NOTH(5),NSOUR,STAOTH(25,5)
      CHARACTER*5 STAOTH(25,5)
      CHARACTER*15 LNLG(2)
      CHARACTER*40 NAME
      COMMON/PLTSC/ITRACK,NSOR
      DATA N1 /B'1111111111111111'/,N2 /B'1100110011001100'/,
     +N3 /B'1111100011111000'/
      IF(IXTYPE .EQ. 0) LNLG(1)='LINEAR$'
      IF(IXTYPE .EQ. 1) LNLG(1)='LOGARITHMIC$'
      IF(IYTYPE .EQ. 0) LNLG(2)='LINEAR$'
      IF(IYTYPE .EQ. 1) LNLG(2)='LOGARITHMIC$'
C
      LNLG(1)='FREQUENCY (HZ)$'
      LNLG(2)='AMPLITUDE$'
C
      CALL AGSETI('FRAME.',2)
      CALL AGSETP('GRAPH WINDOW.',WINDOW(1),4)
      CALL AGSETI('BACKGROUND TYPE.',IBAK)
      CALL AGSETI('X/LOGARITHMIC.',IXTYPE)
      CALL AGSETI('Y/LOGARITHMIC.',IYTYPE)
      CALL AGSETC('LABEL/NAME.','B')
      CALL AGSETI('LINE/NUMBER.',-100)
      CALL AGSETF('LINE/CHARACTER.',.02)
      CALL AGSETC('LINE/TEXT.',LNLG(1))
      CALL AGSETC('LABEL/NAME.','L')
      CALL AGSETI('LINE/NUMBER.',100)
      CALL AGSETF('LINE/CHARACTER.',.02)
      CALL AGSETC('LINE/TEXT.',LNLG(2))
      CALL AGSETC('LABEL/NAME.','T')
      CALL AGSETI('LINE/NUMBER.',100)
      CALL AGSETF('LINE/CHARACTER.',.02)
C
      CALL AGSETF('AXIS/LEFT/NUMERIC/WIDTH/MANTISSA.',.03)
      CALL AGSETF('AXIS/LEFT/NUMERIC/WIDTH/EXPONENT.',.02)
      CALL AGSETF('AXIS/BOTTOM/NUMERIC/WIDTH/MANTISSA.',.03)
      CALL AGSETF('AXIS/BOTTOM/NUMERIC/WIDTH/EXPONENT.',.02)
      IF(ITRACK .GT. NSOR) THEN
      CALL AGSETF('Y/MINIMUM.',0.)
      CALL AGSETF('Y/MAXIMUM.',7.)
      CALL AGSETF('Y/SMALLEST.',0.)
      CALL AGSETF('Y/LARGEST.',7.)
      END IF
C
      IF(ICOMP .EQ. 0) GO TO 30
      IF(ITRACK .LE. NSOR) GO TO 30
      IF(ICONF .EQ. 1) THEN
      CALL AGSETI('ROW.',2)
      CALL AGSETI('DASH/SELECTOR.',3)
      CALL AGSETI('DASH/PATTERNS/1.',N1)
      CALL AGSETI('DASH/PATTERNS/2.',N2)
      CALL AGSETI('DASH/PATTERNS/3.',N2)
      MANY=2
      GO TO 50
      END IF
      IF(IAMP .EQ. 1) THEN
      MANY=NSOUR
      IF(MANY .EQ. 2) THEN
      CALL AGSETI('DASH/SELECTOR.',3)
      CALL AGSETI('DASH/PATTERNS/1.',N1)
      CALL AGSETI('DASH/PATTERNS/2.',N2)
      CALL AGSETI('DASH/PATTERNS/3.',N3)
      END IF
      IF(MANY .EQ. 1) THEN
      CALL AGSETI('DASH/SELECTOR.',2)
      CALL AGSETI('DASH/PATTERN/1.',N1)
      CALL AGSETI('DASH/PATTERN/2.',N2)
      END IF
      GO TO 50
      END IF
      MANY=0
      DO 10 IS=1,NSOUR
      DO 10 I=1,NOTH(IS)
      IF(STAOTH(I,IS)(1:3) .EQ. NAME(25:27)) GO TO 20
      GO TO 10
  20  MANY=MANY+1
      IPKI(MANY)=I
      IPKIS(MANY)=IS
  10  CONTINUE
      IF(MANY .EQ. 0) GO TO 30
C
      CALL AGSETI('ROW.',2)
      IF(MANY .EQ. 2) THEN
      CALL AGSETI('DASH/SELECTOR.',3)
      CALL AGSETI('DASH/PATTERNS/1.',N1)
      CALL AGSETI('DASH/PATTERNS/2.',N2)
      CALL AGSETI('DASH/PATTERNS/3.',N3)
      END IF
      IF(MANY .EQ. 1) THEN
      CALL AGSETI('DASH/SELECTOR.',2)
      CALL AGSETI('DASH/PATTERN/1.',N1)
      IF(IPKIS(1) .EQ. 1) THEN
      CALL AGSETI('DASH/PATTERN/2.',N2)
      END IF
      IF(IPKIS(1) .EQ. 2) THEN
      CALL AGSETI('DASH/PATTERN/2.',N3)
      END IF
      END IF
C
  50  DO 60 I=1,NT
      DO 60 J=1,5
  60  Y2(I,J)=0.
      ITM=MANY
      MANY=MANY+1
      DO 22 I=1,NT
      X2(I,1)=X(I)
  22  Y2(I,1)=Y(I)
      DO 23 IM=1,ITM
      ISLT=IM+1
      DO 24 I=1,NT
      IF(ICONF .EQ. 1) THEN
      IF(IM .EQ. 1) SIGN=1.0
      IF(IM .EQ. 2) SIGN=-1.0
      X2(I,ISLT)=X(I)
      Y2(I,ISLT)=Y(I)+SIGN*AMPOTH(I,ITRACK-NSOR,1)
      GO TO 24
      END IF
      IF(IAMP .EQ. 1) THEN
      X2(I,ISLT)=X2(I,1)
      Y2(I,ISLT)=AMPOTH(I,ITRACK-NSOR,IM)
      GO TO 24
      END IF
      NUM=NUMFR(IPKI(IM),IPKIS(IM))
      IF(I .GT. NUM) THEN
      X2(I,ISLT)=FROTH(NUM,IPKI(IM),IPKIS(IM))
      Y2(I,ISLT)=AMPOTH(NUM,IPKI(IM),IPKIS(IM))
      GO TO 24
      END IF
      X2(I,ISLT)=FROTH(I,IPKI(IM),IPKIS(IM))
      Y2(I,ISLT)=AMPOTH(I,IPKI(IM),IPKIS(IM))
  24  CONTINUE
  23  CONTINUE
      IF(ITRACK .GT. NSOR) THEN
      DO 61 I=1,NT
      DO 61 J=1,MANY
      IF(Y2(I,J) .LT. 0.) Y2(I,J)=0.
  61  IF(Y2(I,J) .GT. 7.) Y2(I,J)=7.
      END IF
      CALL EZMXY(X2,Y2,1000,MANY,NT,NAME)
      GO TO 40
  30  CONTINUE
      IF(ITRACK .GT. NSOR) THEN
      DO 62 I=1,NT
      IF(Y(I) .LT. 0.) Y(I)=0.
  62  IF(Y(I) .GT. 7.) Y(I)=7.
      END IF
      CALL EZXY(X,Y,NT,NAME)
  40  CALL SET(0.,1.,0.,1.,0.,1.,0.,1.,1)
      RETURN
      END