PROGRAM PLOT CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C PLOT IS A PLOTTING ROUTINE DESIGNED TO PLOT ECIS, GENOA OR MACRO OUTPUTS. C C VARIABLES USED C CLOLOR(I) -THE NUMBER OF THE PEN FOR THE I'TH PLOT IN THE HPP MODE C DYEXP(I,J) -THE ERROR IN THE EXPERIMENTAL DATA POINT OF THE I'TH PLOT C AND J'TH DATA POINT. C HORZ -THE HORIZONTAL MARGIN SIZE USED FOR PLOTTING. C IBASE -A NUMBER WHICH KEEPS TRACK OF HOW MANY PLOTS ARE MISSING IN C THE ECIS MODE. C IDTY -THE DATA TYPE. C ILOWER -THE NUMBER OF THE PLOT WHICH IS PLOTTED FIRST. C INDEX -THE NUMBER OF THE DISTRIBUTION IN THE ECIS MODE. C IPLOT(I) -THE NUMBER OF THE PLOT WHICH IS TO BE PLOTTED I'TH. C ISST(I) -THE STATES TO SUM OVER FROM I=1 TO NSUM IN THE ECIS MODE. C ISTA(I) -THE STATE NUMBER OF THE I'TH PLOT IN THE ECIS MODE. C ITYP(I) -THE DATA TYPE OF THE I'TH PLOT. C IUNIT -THE FORTRAN UNIT NUMBER. C MARK(I) -THE NUMBER OF THE SYMBOL FOR THE I'TH PLOT. C NANG -THE MAXIMUM NUMBER OF POINTS EXPECTED IN A PLOT. C NCAL(I) -THE NUMBER OF CALCULATED DATA POINTS IN THE I'TH PLOT. C NDAT -THE TOTAL NUMBER OF PLOTS. C NDIS -THE NUMBER OF ECIS DISTRIBUTIONS. C NDTO -A NUMBER WHICH IS EQUAL TO NDAT MINUS THE CURRENT NUMBER OF C PLOTS IN THIS ECIS DATASET. C NEXP(I) -THE NUMBER OF EXPERIMENTAL DATA POINTS IN THE I'TH PLOT. C NPLOT -THE NUMBER OF PLOTS TO STACK ON THIS GRAPH. C NSTA -THE NUMBER OF STATES IN THE ECIS DATASET. C NSUM -THE NUMBER OF STATES TO SUM OVER. C NTYP -THE ALLOWED NUMBER OF DIFFERENT DATA TYPES. C NUCS -THE NUCLEAR STATE NUMBER IN THE ECIS MODE. C NXLAB -THE NUMBER OF LABELS ON THE X-AXIS. C NXTIC -THE NUMBER OF TIC MARKS ON THE X-AXIS. C NYLAB -THE NUMBER OF LABELS ON THE Y-AXIS. C NYTIC -THE NUMBER OF TIC MARKS ON THE Y-AXIS. C OFFSET -THE OFFSET OF THIS PARTICULAR PLOT. C OFFST(I) -THE OFFSET OF THE I'TH STACKED PLOT. C SZMRK -THE SIZE OF THE SYMBOL. C VERT -THE VERTICAL MARGIN SIZE. C XCAL(I,J) -THE THEORETICAL X OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE CALCULATED ANGLE. C XEXP(I,J) -THE EXPERIMENTAL X OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE EXPERIMENTAL ANGLE. C XMAX -THE MAXIUMUM VALUE ON THE X-AXIS FOR PLOTTING. C XMIN -THE MINIMUM VALUE ON THE X-AXIS FOR PLOTTING. C XTEMP -TEMPORAY STORAGE OF A XCAL(I,J) POINT FROM AN ECIS PLOT. C YCAL(I,J) -THE THEORETICAL Y OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE CALCULATED VALUE. C YEXP(I,J) -THE EXPERIMENTAL Y OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE EXPERIMENTAL VALUE. C YHI(I) -THE LARGEST VALUE IN THE I'TH PLOT. C YLO(I) -THE SMALLEST VALUE IN I'TH PLOT. C YMAX -THE MAXIUMUM VALUE ON THE Y-AXIS FOR PLOTTING. C YMIN -THE MINIMUM VALUE ON THE Y-AXIS FOR PLOTTING. C YTEMP -TEMPORAY STORAGE OF A YCAL(I,J) POINT FROM AN ECIS PLOT. C C FLAGS C IANS -FLAG USED WHEN QUESTIONS ARE ASKED OF THE USER (=0 NO, 1=YES). C ICOL -FLAG FOR THE COLOR OF THE PLOTS (=0 FOR COMPUTER GENERATED C COLORS, =1 FOR USER DEFINED COLORS, =2 FOR ALL BLACK). C IDS -FLAG TO INDICATE IF ANY STATES WERE SUMMED FOR THAT C PARTICULAR FORTRAN UNIT. C ILOG -FLAG FOR LOG OR LINEAR PLOTS (=-1 FOR LOG, =1 FOR LINEAR). C ILP -FLAG FOR SCREEN OR LINE PRINTER OUTPUT (=0 FOR SCREEN, C =1 FOR LINE PRINTER, =2 FOR HPP PLOTS). C IOFFST -FLAG FOR USER DEFINED OFFSETS (0=NO, 1=YES). C IPRO -FLAG TO IDENTIFY WHICH PLOTTING MODE (0=ECIS, 1=GENOA, C 2=MACRO). C IPTY -FLAG TO IDENTIFY WHICH PLOT TYPE (1=CROSS SECTION, C 2=ANALYZING POWERS). C IROT -FLAG FOR ROTAING PLOTS BY 90 DEGREES (0=NO, 1=YES). C ISCAL -FLAG FOR SELF SCALING (=0 FOR SELF SCALING, =1 FOR SET SCALE) C ISPEC -FLAG FOR PLOTTING SPECIFIC PLOTS (=0 NO, 1=YES). C ISUM(I) -FLAG TO IDENTIY IF THE I'TH PLOT NEEDS TO BE SUMMED (0=NO, C 1=YES). C C SUBROUTINES USED C ROTATE -A SUBROUTINE TO ROTATE POINTS CLOCKWISE BY 90 DEGREES. C IDENT -A SUBROUTINE TO IDENTIFY ECIS PLOTS. C SUM -A SUBROUTINE TO SUM STATES OF ECIS DATASETS. C C UNIT ASSIGNMENTS C FORTRAN UNIT 5 SHOULD BE ASSIGNED TO TT. C FORTRAN UNITS 11 THROUGH A MAXIMUM OF UNIT 30 SHOULD BE ASSIGNED AS THE C INPUT DATASETS IN THE ECIS MODE. ONLY FORTRAN UNIT 11 SHOULD BE C ASSIGNED TO THE INPUT DATASET IN EITHER THE GENOA OR MACRO MODE. C FORTRAN UNIT 42 SHOULD BE ASSIGNED TO AN OUTPUT FILE IF A LINE PRINTER C PLOT IS DESIRED. C FORTRAN UNIT 52 SHOULD BE ASSIGNED TO AN OUTPUT FILE IF A HEWLETT PACKARD C PLOT IS DESIRED. C C WRITTEN BY -MARK ROBERTS C C LAST REVISED -MARCH 5, 1986 C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DIMENSION XEXP(200,200),YEXP(200,200),DYEXP(200,200),NEXP(200) DIMENSION XCAL(200,200),YCAL(200,200),NCAL(200) DIMENSION YLO(200),YHI(200),X(200),Y(200) DIMENSION ISTA(200),ITYP(200),ISUM(200),ISST(20) DIMENSION COLOR(200),IPLOT(200),MARK(200),OFFST(200) DATA YLO /200 * 1000./ COMMON /DATA/ NEXP,XEXP,YEXP,DYEXP,NCAL,XCAL,YCAL COMMON /ECIS/ NDAT,NDTO,ISTA,NSTA,NTYP ILOWER=1 IUNIT=10 NANG=199 NDAT=0 NTYP=4 C C OPEN THE DATA FILE C 100 IDS=0 IF(IUNIT.GT.30)GOTO 148 IUNIT=IUNIT+1 OPEN(UNIT=IUNIT,READONLY,STATUS='OLD',ERR=100) READ(IUNIT,1100,ERR=102)IPRO,IDTY,NDAT 1100 FORMAT(3I3) IF(IPRO.EQ.1)GOTO 120 IF(IPRO.EQ.2)GOTO 134 102 READ(IUNIT,1105,ERR=112)NSTA,NDIS 1105 FORMAT(4I5) C C READ EXPERIMENTAL ECIS POINTS C DO 108 K=1,NDIS READ(IUNIT,1105)INDEX,NANG,NUCS,IDTY IF(IDTY.EQ.3)IDTY=8 IF(IDTY.EQ.7)IDTY=3 I=NDAT+(IDTY*NSTA)+NUCS NEXP(I)=NANG IF(NANG.EQ.0)THEN ISUM(I)=1 ELSE READ(IUNIT,*) DO 106 J=1,NANG READ(IUNIT,1110)XEXP(I,J),YEXP(I,J),DYEXP(I,J) 1110 FORMAT(3F10.5) IF(IDTY.EQ.0)THEN DYEXP(I,J)=DYEXP(I,J)*YEXP(I,J)*.01 ENDIF 106 CONTINUE ENDIF 108 CONTINUE C C READ THEORETICAL ECIS POINTS C DO 112 K=1,NSTA READ(IUNIT,*)NUCS J=0 110 READ(IUNIT,1115)IDTY,XTEMP,YTEMP 1115 FORMAT(2X,I1,2F12.9) IF(IDTY.EQ.3)IDTY=8 IF(IDTY.EQ.7)IDTY=3 IF(IDTY.GT.3)GOTO 110 IF(XTEMP.EQ.-1.)GOTO 112 IF(IDTY.EQ.0)J=J+1 I=NDAT+(IDTY*NSTA)+K XCAL(I,J)=XTEMP YCAL(I,J)=YTEMP ISTA(I)=K ITYP(I)=IDTY NCAL(I)=J GO TO 110 112 CONTINUE C C CLOSE FILES C CLOSE(UNIT=IUNIT) NDTO=NDAT NDAT=NDAT+(NTYP*NSTA) C C INFORM USER OF WHICH PLOT IS WHICH PLOT NUMBER C DO 114 I=NDTO+1,NDAT IF(NCAL(I).NE.0)THEN CALL IDENT(I,ITYP(I),IUNIT,ISTA(I),0,0) ENDIF 114 CONTINUE C C SUM PLOTS IF NECCESSARY C NSUM=0 DO 116 I=NDTO+1,NDAT IF(ISUM(I).EQ.1)THEN ISUM(I)=0 NSUM=NSUM+1 ISST(NSUM)=ISTA(I) IF(ISUM(I+1).EQ.0)THEN ISST(NSUM+1)=ISTA(I+1) CALL SUM(ITYP(I),NSUM+1,ISST) ITYP(NDAT)=ITYP(I) CALL IDENT(NDAT,ITYP(NDAT),IUNIT,0,NSUM+1,ISST) NSUM=0 IDS=1 ENDIF ENDIF 116 CONTINUE IF(IDS.EQ.1)THEN WRITE(5,500) 500 FORMAT(' Do you wish to sum any more states? (0=No,1=Yes) ',$) ELSE IDS=1 WRITE(5,505) 505 FORMAT(' Do you wish to sum any states? (0=No,1=Yes) ',$) ENDIF READ(5,510)IANS 510 FORMAT(I1) IF(IANS.NE.1)GOTO 100 118 WRITE(5,515) 515 FORMAT(' Which data type do you wish to sum?', * ' (Type 9 for help) ',$) READ(5,510)IDTY IF(IDTY.EQ.3)IDTY=8 IF(IDTY.EQ.7)IDTY=3 IF(IDTY.EQ.9)THEN WRITE(5,520) 520 FORMAT(' 0 = Cross Sections' * /,' 1 = Ratio-to-Rutherford cross sections' * /,' 2 = Vector Analyzing Powers' * /,' 7 = Spin Flip') GOTO 118 ENDIF WRITE(5,525) 525 FORMAT(' How many states do you wish to sum over? ',$) READ(5,510)NSUM WRITE(5,530) 530 FORMAT(' Which states do you wish to sum? ',$) READ(5,*)(ISST(J),J=1,NSUM) CALL SUM(IDTY,NSUM,ISST) ITYP(NDAT)=IDTY CALL IDENT(NDAT,ITYP(NDAT),IUNIT,0,NSUM,ISST) GOTO 116 C C READ EXPERIMENTAL GENOA DATA SETS C 120 READ(IUNIT,1120,END=148)I 1120 FORMAT(I3) IF(I.EQ.-99)GOTO 126 DO 122 J=1,NANG READ(IUNIT,1110,END=148)XEXP(I,J),YEXP(I,J),DYEXP(I,J) IF(XEXP(I,J).EQ.-100.)GOTO 124 122 CONTINUE 124 NEXP(I)=J-1 GO TO 120 C C READ THEORETICAL GENOA DATA SETS C 126 DO 132 I=1,NDAT ITYP(I)=IDTY DO 128 J=1,NANG READ(IUNIT,1112,END=148)XCAL(I,J),YCAL(I,J) 1112 FORMAT(2E12.5) IF(XCAL(I,J).EQ.-100.)GOTO 130 128 CONTINUE 130 NCAL(I)=J-1 132 CONTINUE C C CLOSE DATA FILE C CLOSE(UNIT=IUNIT) GOTO 148 C C READ EXPERIMENTAL MACRO DATA SETS C 134 NDAT=NDAT+1 ITYP(NDAT)=IDTY 136 DO 138 J=1,NANG READ(IUNIT,1110,END=146)XEXP(NDAT,J),YEXP(NDAT,J),DYEXP(NDAT,J) IF(IDTY.EQ.0)THEN DYEXP(NDAT,J)=DYEXP(NDAT,J)*YEXP(NDAT,J)*.01 ENDIF IF(XEXP(NDAT,J).EQ.-100.)GOTO 140 138 CONTINUE 140 NEXP(NDAT)=J-1 C C READ THEORETICAL MACRO DATA SETS C DO 142 J=1,NANG READ(IUNIT,1112,END=146)XCAL(NDAT,J),YCAL(NDAT,J) IF(XCAL(NDAT,J).EQ.-100.)GOTO 144 142 CONTINUE 144 NCAL(NDAT)=J-1 GOTO 134 146 NDAT=NDAT-1 C C CLOSE DATA FILE C CLOSE(UNIT=IUNIT) 148 CONTINUE C C CONVERT ERRORS TO AN ABSOLUTE VALUE, FIND UPPER AND LOWER VALUES OF A C THE DATA SET AND CHECK FOR A NEGATIVE CROSS SECTTION C IF(NDAT.LE.0)THEN WRITE(5,532) 532 FORMAT(' There is no data. Check your input file.') STOP ENDIF DO 154 I=1,NDAT DO 150 J=1,NEXP(I) IF(YLO(I).GT.(YEXP(I,J)-DYEXP(I,J)))THEN YLO(I)=YEXP(I,J)-DYEXP(I,J) ENDIF IF(YHI(I).LT.(YEXP(I,J)+DYEXP(I,J)))THEN YHI(I)=YEXP(I,J)+DYEXP(I,J) ENDIF 150 CONTINUE DO 152 J=1,NCAL(I) IF(ITYP(I).EQ.0.AND.YCAL(I,J).LE.0.)THEN ITYP(I)=9 WRITE(5,535)I 535 FORMAT(' There is a negative calculated cross section', * ' in data set ',I2) ENDIF IF(ITYP(I).EQ.1.AND.YCAL(I,J).LE.0.)THEN ITYP(I)=9 WRITE(5,540)I 540 FORMAT(' There is a negative calculated ratio-to-', * 'Rutherford cross section in data set ',I2) ENDIF IF(YLO(I).GT.YCAL(I,J))YLO(I)=YCAL(I,J) IF(YHI(I).LT.YCAL(I,J))YHI(I)=YCAL(I,J) 152 CONTINUE 154 CONTINUE C C PROMPT FOR NUMBER OF PLOTS TO STACK C IF((IPRO.EQ.1.OR.IPRO.EQ.2).AND.NDAT.GT.1)THEN WRITE(5,545)NDAT 545 FORMAT(' There are ',I2,' plots.') ENDIF IF(NDAT.GT.1)THEN 200 WRITE(5,550) 550 FORMAT(' Number of plots to stack? ',$) READ(5,555)NPLOT 555 FORMAT(I3) IF(NPLOT.EQ.0)STOP ELSE NPLOT=1 ENDIF IF(ILOWER+NPLOT-1.GT.NDAT)NPLOT=NDAT-ILOWER+1 C C SET ALL NECCESARY PLOTTING PARAMETERS TO ZERO C ILP=0 IROT=0 ILOG=0 IOFFST=0 IPTY=0 XMIN=0. XMAX=0. YMIN=0. YMAX=0. NXLAB=0 NXTIC=0 NYLAB=0 NYTIC=0 HORZ=0. VERT=0. SZMRK=0. DO 205 I=1,NPLOT COLOR(I)=0. IPLOT(I)=0 MARK(I)=0 OFFST(I)=0. 205 CONTINUE C C PROMPT FOR SCALE MODE C WRITE(5,560) 560 FORMAT(' Do you want the program to self-scale?', * ' (0=Yes, 1=No) ',$) READ(5,510)ISCAL IF(ISCAL.EQ.0)GOTO 300 C C LINE PRINTER OUTPUT C WRITE(5,565) 565 FORMAT(' Screen, line printer, or Hewlett Packard output?' * ' (0=Screen, 1=LP, 2=HP) ',$) READ(5,510)ILP C C PLOT SPECIFIC PLOTS C WRITE(5,570) 570 FORMAT(' Do you wish to plot specific plots? (0=No, 1=Yes) ',$) READ(5,510)ISPEC IF(ISPEC.EQ.1)THEN DO 210 I=1,NPLOT WRITE(5,575)I 575 FORMAT(' Which plot should be number ',I2,' ? ',$) READ(5,555)IPLOT(I) 210 CONTINUE ENDIF C C ROTATE PLOT BY 90 DEGREES C IF(ILP.NE.2)THEN WRITE(5,580) 580 FORMAT(' Rotate the plot by 90 degrees? (0=No, 1=Yes) ',$) READ(5,510)IROT ENDIF C C LOG OR LINEAR PLOT C DO 215 I=1,NPLOT IF(ITYP(IPLOT(I)).GE.2)THEN ILOG=1 GOTO 220 ENDIF 215 CONTINUE WRITE(5,585) 585 FORMAT(' Log or linear plot? (-1=Log, 1=Linear) ',$) READ(5,510)ILOG C C MAXIMUM AND MINIMUM VALUES ON THE AXIS C 220 WRITE(5,590) 590 FORMAT(' Do you wish to specify values of either axis?' * ' (0=No, 1=Yes) ',$) READ(5,510)IANS IF(IANS.EQ.1)THEN C C UPPER AND LOWER LIMITS OF THE X-AXIS C WRITE(5,595) 595 FORMAT(' Minimum value on the x axis? (Default=0.) ',$) READ(5,600)XMIN 600 FORMAT(F12.6) WRITE(5,605) 605 FORMAT(' Maximum value on the x axis? (Default=180.) ',$) READ(5,600)XMAX C C UPPER AND LOWER LIMITS OF THE Y-AXIS C WRITE(5,610) 610 FORMAT(' Minimum value on the y axis? ',$) READ(5,600)YMIN WRITE(5,615) 615 FORMAT(' Maximum value on the y axis? ',$) READ(5,600)YMAX ENDIF C C OFFSETS FOR THE PLOTS C WRITE(5,620) 620 FORMAT(' Do you wish to specify the offsets for the' * ' plots? (0=No, 1=Yes) ',$) READ(5,510)IOFFST IF(IOFFST.EQ.1)THEN C C OFFSETS FOR THE PLOTS C DO 225 I=1,NPLOT WRITE(5,625)I 625 FORMAT(' By how much should plot number ',I2 * ' be offset? ',$) READ(5,600)OFFST(I) 225 CONTINUE ENDIF C C MARGIN SIZE, LABELS, TICK MARKS, SYMBOLS AND SYMBOL SIZE C WRITE(5,630) 630 FORMAT(' Do you wish to specify the margins,tic marks', * ' or symbols? (0=No, 1=Yes) ',$) READ(5,510)IANS IF(IANS.EQ.1)THEN C C SET MARGIN SIZES C WRITE(5,645) 645 FORMAT(' What is the horizontal margin size? (Default=4.) ',$) READ(5,600)HORZ WRITE(5,650) 650 FORMAT(' What is the vertical margin size? (Default=4.) ',$) READ(5,600)VERT C C NUMBER OF LABELS ON THE X-AXIS C WRITE(5,655) 655 FORMAT(' How many labels on the x-axis? (Default=6) ',$) READ(5,555)NXLAB C C NUMBER OF TIC MARKS ON THE X-AXIS C WRITE(5,660) 660 FORMAT(' How many tic marks on the x-axis? (Default=18) ',$) READ(5,555)NXTIC C C NUMBER OF LABELS ON THE Y-AXIS C WRITE(5,665) 665 FORMAT(' How many labels on the y-axis? ',$) READ(5,555)NYLAB C C NUMBER OF TIC MARKS ON THE Y-AXIS C WRITE(5,670) 670 FORMAT(' How many tic marks on the y-axis? ',$) READ(5,555)NYTIC C C GET SYMBOL SIZE AND SYMBOL C WRITE(5,675) 675 FORMAT(' What symbol size? (Default=.04) ',$) READ(5,600)SZMRK 230 DO 235 I=1,NPLOT IF(I.EQ.1)THEN WRITE(5,680)I 680 FORMAT(' Symbol for plot number ',I2 * ' ? (For help type 99) ',$) ELSE WRITE(5,685)I 685 FORMAT(' Symbol for plot number ',I2,' ? ',$) ENDIF READ(5,555)MARK(I) IF(MARK(I).EQ.99)THEN WRITE(5,690) 690 FORMAT(' 1 = Circle' * /,' 2 = Triangle' * /,' 3 = +' * /,' 4 = X' * /,' 5 = Diamond' * /,' 6 = Upside down triangle' * /,' 7 = X over square' * /,' 8 = X over +' * /,' 9 = + over diamond' * /,' 10 = + over octagon' * /,' 11 = XX' * /,' 12 = + over square' * /,' 13 = X over octagon' * /,' 14 = Triangle over square' * /,' 15 = Vertical bar') GOTO 230 ENDIF 235 CONTINUE ENDIF C C IF PLOTTED ON A HEWLETT PACKARD FIND OUT PEN COLORS AND PAGE SIZE C IF(ILP.EQ.2)THEN WRITE(5,695) 695 FORMAT(' Do you wish to specify pen colors? (0=No, ', * ' 1=Yes, 2=All Black) ',$) READ(5,510)ICOL IF(ICOL.EQ.1)THEN DO 240 I=1,NPLOT WRITE(5,700)I 700 FORMAT(' Pen for plot ',I2,' ? ',$) READ(5,510)IANS COLOR(I)=FLOAT(IANS) 240 CONTINUE ENDIF ENDIF 300 CONTINUE C C SET DEFAULT VALUES FOR WHICH PLOTS TO PLOT C IBASE=0 DO 310 I=1,NPLOT IF(IPLOT(I).EQ.0)THEN IPLOT(I)=I+ILOWER-1+IBASE 305 IF(NEXP(IPLOT(I)).EQ.0.AND.NCAL(IPLOT(I)).EQ.0)THEN IBASE=IBASE+1 IPLOT(I)=IPLOT(I)+1 GOTO 305 ENDIF ENDIF 310 CONTINUE C C SET DEFAULT VALUE FOR LOG OR LINEAR PLOT C IF(ILOG.EQ.-1)THEN IPTY=1 GOTO 325 ENDIF IF(ILOG.EQ.1)THEN DO 315 I=1,NPLOT IF(ITYP(IPLOT(I)).GE.2)THEN IPTY=2 GOTO 325 ENDIF 315 CONTINUE IPTY=1 GOTO 325 ENDIF DO 320 I=1,NPLOT IF(ITYP(IPLOT(I)).GE.2)THEN ILOG=1 IPTY=2 GOTO 325 ENDIF 320 CONTINUE IPTY=1 ILOG=-1 325 CONTINUE C C SET DEFAULT VALUE FOR XMAX C IF(XMAX.EQ.0)XMAX=180. C C SET DEFAULT VALUES FOR THE OFFSETS C IF(IPTY.EQ.1)THEN IF(OFFST(1).EQ.0..AND.ILOG.EQ.-1)OFFST(1)=1. DO 330 I=2,NPLOT IF(OFFST(I).EQ.0..AND.ILOG.EQ.-1)OFFST(I)=10. IF(OFFST(I).EQ.0..AND.ILOG.EQ.1)OFFST(I)=100. 330 CONTINUE ENDIF IF(IPTY.EQ.2.AND.IOFFST.EQ.0)THEN OFFST(1)=0. DO 335 I=2,NPLOT OFFST(I)=2. 335 CONTINUE ENDIF C C SET DEFAULT VALUE FOR YMIN C IF(YMIN.EQ.0.)THEN IF(ILOG.EQ.-1)THEN IF(YLO(IPLOT(1)).GE.1.)THEN YMIN=10.**(IFIX(ALOG10(YLO(IPLOT(1))))) ELSE YMIN=10.**(IFIX(ALOG10(YLO(IPLOT(1))))-1) ENDIF ENDIF IF(ILOG.EQ.1)THEN IF(IPTY.EQ.1)THEN YMIN=IFIX(YLO(IPLOT(1))) ELSE YMIN=-1. ENDIF ENDIF ENDIF C C SET DEFAULT VALUE FOR YMAX C IF(YMAX.EQ.0.)THEN YMAX=YHI(IPLOT(NPLOT)) IF(ILOG.EQ.-1)THEN DO 340 I=1,NPLOT YMAX=YMAX*OFFST(I) 340 CONTINUE YMAX=10.**(IFIX(ALOG10(YMAX))+1) ENDIF IF(ILOG.EQ.1)THEN IF(IPTY.EQ.1)THEN DO 345 I=1,NPLOT YMAX=YMAX+OFFST(I) 345 CONTINUE YMAX=(IFIX(YMAX*.01)+1)*100. ENDIF IF(IPTY.EQ.2)THEN YMAX=(2.*NPLOT)-1. ENDIF ENDIF ENDIF C C SET DEFAULT VALUES FOR THE MARGINS, NUMBER OF LABELS NUMBER OF C TICK MARKS, SYMBOL SIZE AND SYMBOL TYPE C IF(HORZ.EQ.0.)HORZ=4. IF(VERT.EQ.0.)VERT=4. IF(NXLAB.EQ.0)NXLAB=6 IF(NXTIC.EQ.0)NXTIC=6 IF(NYTIC.EQ.0)THEN IF(IPTY.EQ.1)THEN IF(ILOG.EQ.-1)THEN NYLAB=2*(IFIX(ALOG10(YMAX/YMIN))) NYTIC=5*NYLAB ENDIF IF(ILOG.EQ.1)THEN NYLAB=10 NYTIC=10 ENDIF ENDIF IF(IPTY.EQ.2)THEN NYLAB=(YMAX-YMIN)/.5 NYTIC=5*NYLAB ENDIF ENDIF IF(NYLAB.LE.1)NYLAB=2 IF(NYTIC.LE.1)NYTIC=2 IF(SZMRK.EQ.0.)SZMRK=.04 DO 350 I=1,NPLOT IF(MARK(I).EQ.0)MARK(I)=I 350 CONTINUE C C SET DEFAULT VALUES FOR PEN COLOR C DO 355 I=1,NPLOT IF((ILP.EQ.0).OR.(ILP.EQ.1).OR.(ICOL.EQ.2))THEN COLOR(I)=1. ELSE IF(COLOR(I).EQ.0.)COLOR(I)=FLOAT(I+2-(4*((I-1)/4))) ENDIF 355 CONTINUE C C SETUP PLOTTING ROUTINE C IF(ILP.EQ.0)CALL BEGINZ('TEK') IF(ILP.EQ.1)CALL BEGINZ('DOT') IF(ILP.EQ.2)CALL BEGINZ('HPP') CALL DEFLTZ CALL SPERRZ(-1) CALL SPLASZ(1) CALL SPMKHZ(SZMRK) C C IF PLOTTED ON HEWLETT PACKARD C IF(IROT.EQ.1)GOTO 405 C C NO ROTATION OF PLOT C CALL SPMARZ(VERT,HORZ,VERT,HORZ) CALL STDAXZ(1,'D',XMIN,XMAX,NXLAB,3) CALL STDAXZ(1,'D',XMIN,XMAX,NXTIC,2) CALL SAXISZ(1,.TRUE.,.FALSE.) CALL SAXISZ(3,.TRUE.,.FALSE.) IF(ILOG.EQ.1)THEN CALL STDAXZ(2,'D',YMIN,YMAX,NYLAB,3) CALL STDAXZ(2,'D',YMIN,YMAX,NYTIC,2) CALL SAXISZ(2,.TRUE.,.FALSE.) CALL SAXISZ(4,.TRUE.,.FALSE.) ENDIF IF(ILOG.EQ.-1)THEN CALL LOGAXZ(2,'D',YMIN,YMAX,NYLAB,3) CALL LOGAXZ(2,'D',YMIN,YMAX,NYTIC,2) CALL LAXISZ(2,.TRUE.,.FALSE.) CALL LAXISZ(4,.TRUE.,.FALSE.) ENDIF IF(IPTY.EQ.2)THEN X(1)=XMIN Y(1)=0. X(2)=XMAX Y(2)=0. DO 400 I=1,NPLOT Y(1)=Y(1)+OFFST(I) Y(2)=Y(2)+OFFST(I) CALL LINESZ(X,Y,2) 400 CONTINUE ENDIF CALL BOXZ GOTO 415 C C PLOT ROTATED BY 90 DEGREES C 405 CALL SPCRTZ(90.) CALL SPMARZ(HORZ,VERT,HORZ,VERT) CALL STDAXZ(2,'D',-XMAX,-XMIN,NXLAB,3) CALL STDAXZ(2,'D',-XMAX,-XMIN,NXTIC,2) CALL SAXISZ(2,.TRUE.,.FALSE.) CALL SAXISZ(4,.TRUE.,.FALSE.) IF(ILOG.EQ.1)THEN CALL STDAXZ(3,'D',YMIN,YMAX,NYLAB,3) CALL STDAXZ(3,'D',YMIN,YMAX,NYTIC,2) CALL SAXISZ(3,.TRUE.,.FALSE.) CALL SAXISZ(1,.TRUE.,.FALSE.) ENDIF IF(ILOG.EQ.-1)THEN CALL LOGAXZ(3,'D',YMIN,YMAX,NYLAB,3) CALL LOGAXZ(3,'D',YMIN,YMAX,NYTIC,2) CALL LAXISZ(3,.TRUE.,.FALSE.) CALL LAXISZ(1,.TRUE.,.FALSE.) ENDIF IF(IPTY.EQ.2)THEN X(1)=0. Y(1)=-XMIN X(2)=0. Y(2)=-XMAX DO 410 I=1,NPLOT X(1)=X(1)+OFFST(I) X(2)=X(2)+OFFST(I) CALL LINESZ(X,Y,2) 410 CONTINUE ENDIF CALL BOXZ 415 CONTINUE C C CALCULATE THE OFFSETS C IF(ILOG.EQ.-1)OFFSET=1. IF(ILOG.EQ.1)OFFSET=0. DO 435 I=1,NPLOT CALL SPCOLZ(COLOR(I)) IF(ILOG.EQ.-1)OFFSET=OFFSET*OFFST(I) IF(ILOG.EQ.1)OFFSET=OFFSET+OFFST(I) C C PLOT DATA POINTS C IF(NEXP(IPLOT(I)).EQ.0)GOTO 425 DO 420 J=1,NEXP(IPLOT(I)) X(J)=XEXP(IPLOT(I),J) IF(ILOG.EQ.-1)Y(J)=ALOG10(YEXP(IPLOT(I),J)*OFFSET) IF(ILOG.EQ.1) Y(J)=YEXP(IPLOT(I),J)+OFFSET 420 CONTINUE IF(IROT.EQ.1)CALL ROTATE(X,Y,NEXP(IPLOT(I))) CALL SPCRTZ(90.) CALL DMARKZ(X,Y,NEXP(IPLOT(I)),MARK(I)) C C PLOT ERROR BARS FOR POINTS C IF(NEXP(IPLOT(I)).EQ.0)GOTO 425 DO 425 J=1,NEXP(IPLOT(I)) X(1)=XEXP(IPLOT(I),J) X(2)=XEXP(IPLOT(I),J) IF(ILOG.EQ.-1)THEN Y(1)=ALOG10((YEXP(IPLOT(I),J)-DYEXP(IPLOT(I),J))*OFFSET) Y(2)=ALOG10((YEXP(IPLOT(I),J)+DYEXP(IPLOT(I),J))*OFFSET) IF(Y(1).LT.ALOG10(YMIN))Y(1)=ALOG10(YMIN) IF(Y(2).GT.ALOG10(YMAX))Y(2)=ALOG10(YMAX) ENDIF IF(ILOG.EQ.1)THEN Y(1)=YEXP(IPLOT(I),J)+OFFSET-DYEXP(IPLOT(I),J) Y(2)=YEXP(IPLOT(I),J)+OFFSET+DYEXP(IPLOT(I),J) IF(Y(1).LT.YMIN)Y(1)=YMIN IF(Y(2).GT.YMAX)Y(2)=YMAX ENDIF IF(IROT.EQ.1)CALL ROTATE(X,Y,2) CALL LINESZ(X,Y,2) 425 CONTINUE C C PLOT CURVE C IF(NCAL(IPLOT(I)).EQ.0)GOTO 435 DO 430 J=1,NCAL(IPLOT(I)) X(J)=XCAL(IPLOT(I),J) IF(ILOG.EQ.-1)Y(J)=ALOG10(YCAL(IPLOT(I),J)*OFFSET) IF(ILOG.EQ.1) Y(J)=YCAL(IPLOT(I),J)+OFFSET 430 CONTINUE IF(IROT.EQ.1)CALL ROTATE(X,Y,NCAL(IPLOT(I))) CALL LINESZ(X,Y,NCAL(IPLOT(I))) 435 CONTINUE C C FINISH PLOT C CALL FINISZ IF(ILOWER+NPLOT+IBASE-1.EQ.NDAT)STOP ILOWER=ILOWER+NPLOT+IBASE GOTO 200 END SUBROUTINE ROTATE(X,Y,NP) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C THIS SUBROUTINE ROTATES POINTS CLOCKWISE BY 90 DEGREES C C VARIABLES USED C NP -THE NUMBER OF POINTS TO BE ROTATED. C SAVE -TEMPORARILY STORES THE X-COORDINATE C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DIMENSION X(200),Y(200) DO 100 I=1,NP SAVE=X(I) X(I)=Y(I) Y(I)=-SAVE 100 CONTINUE RETURN END SUBROUTINE SUM(IDTY,NSUM,ISST) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C THIS SUBROUTINE SUMS ECIS STATES. C C VARIABLES USED C ASI -THE SUMMED PRODUCT OF THE ANALYZIGN POWER AND CROSS SECTION. C DYEXP(I,J) -THE ERROR IN THE EXPERIMENTAL DATA POINT OF THE I'TH PLOT C AND J'TH DATA POINT. C IDTY -THE DATA TYPE. C ISST(I) -THE STATES TO SUM OVER FROM I=1 TO NSUM IN THE ECIS MODE. C ISTA(I) -THE STATE NUMBER OF THE I'TH PLOT IN THE ECIS MODE. C NCAL(I) -THE NUMBER OF CALCULATED DATA POINTS IN THE I'TH PLOT. C NDAT -THE TOTAL NUMBER OF PLOTS. C NDTO -A NUMBER WHICH IS EQUAL TO NDAT MINUS THE CURRENT NUMBER OF C NEXP(I) -THE NUMBER OF EXPERIMENTAL DATA POINTS IN THE I'TH PLOT. C NSTA -THE NUMBER OF STATES IN THE ECIS DATASET. C NSUM -THE NUMBER OF STATES TO SUM OVER. C NTYP -THE ALLOWED NUMBER OF DIFFERENT DATA TYPES. C SIG -THE SUMMED CROSS SECTION. C XCAL(I,J) -THE THEORETICAL X OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE CALCULATED ANGLE. C XEXP(I,J) -THE EXPERIMENTAL X OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE EXPERIMENTAL ANGLE. C YCAL(I,J) -THE THEORETICAL Y OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE CALCULATED VALUE. C YEXP(I,J) -THE EXPERIMENTAL Y OF THE I'TH PLOT AND J'TH DATA POINT. C THIS IS USUALLY THE EXPERIMENTAL VALUE. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DIMENSION XEXP(200,200),YEXP(200,200),DYEXP(200,200),NEXP(200) DIMENSION XCAL(200,200),YCAL(200,200),NCAL(200) DIMENSION ISTA(200),ISST(20) COMMON /DATA/ NEXP,XEXP,YEXP,DYEXP,NCAL,XCAL,YCAL COMMON /ECIS/ NDAT,NDTO,ISTA,NSTA,NTYP NDAT=NDAT+1 ISTA(NDAT)=99 NEXP(NDAT)=NEXP(NDTO+NSTA*IDTY+ISST(1)) NCAL(NDAT)=NCAL(NDTO+NSTA*IDTY+ISST(1)) DO 100 I=2,NSUM IF(NEXP(NDAT).LT.NEXP(NDTO+NSTA*IDTY+ISST(I)))THEN NEXP(NDAT)=NEXP(NDTO+NSTA*IDTY+ISST(I)) ENDIF IF(NCAL(NDAT).LT.NCAL(NDTO+NSTA*IDTY+ISST(I)))THEN NCAL(NDAT)=NCAL(NDTO+NSTA*IDTY+ISST(I)) ENDIF 100 CONTINUE DO 106 I=1,NEXP(NDAT) DO 104 J=1,NSUM K=NDTO+NSTA*IDTY+ISST(J) IF(XEXP(NDAT,I).EQ.0..OR.XEXP(K,I).EQ.0.)GOTO 102 IF(IDTY.GE.2)THEN WRITE(5,500)NDAT 500 FORMAT(' This program can not properly add the ', * 'experimental vector analyzing powers in UNIT',I3) NEXP(NDAT)=0 GOTO 108 ENDIF IF(XEXP(NDAT,I).EQ.XEXP(K,I))GOTO 102 WRITE(5,505)NDAT 505 FORMAT(' There is an error in the experimental summation', * ' for plot',I3) NEXP(NDAT)=0 GOTO 108 102 XEXP(NDAT,I)=MAX(XEXP(NDAT,I),XEXP(K,I)) YEXP(NDAT,I)=YEXP(NDAT,I)+YEXP(K,I) DYEXP(NDAT,I)=DYEXP(NDAT,I)+DYEXP(K,I) 104 CONTINUE 106 CONTINUE 108 DO 114 I=1,NCAL(NDAT) IF(IDTY.GE.2)THEN ASI=0 SIG=0 DO 110 J=1,NSUM K=NDTO+NSTA*IDTY+ISST(J) IF(XCAL(NDAT,I).NE.0..AND.XCAL(K,I).NE.0.)THEN IF(XCAL(NDAT,I).NE.XCAL(K,I))THEN NCAL(NDAT)=0 WRITE(5,510)NDAT 510 FORMAT(' There is an error in the calculated', * ' summation for plot',I3) RETURN ENDIF ENDIF XCAL(NDAT,I)=XCAL(K,I) ASI=ASI+(YCAL(K,I)*YCAL(K-NSTA*2,I)) SIG=SIG+YCAL(K-NSTA*2,I) 110 CONTINUE IF(SIG.NE.0.)THEN YCAL(NDAT,I)=ASI/SIG ELSE YCAL(NDAT,I)=0 WRITE(5,515)NDAT 515 FORMAT(' Can''t sum vector analyzing powers', * 'in UNIT',I3,' due to zero cross section.') NCAL(NDAT)=0 RETURN ENDIF ELSE DO 112 J=1,NSUM K=NDTO+NSTA*IDTY+ISST(J) IF(XCAL(NDAT,I).NE.0..AND.XCAL(K,I).NE.0.)THEN IF(XCAL(NDAT,I).NE.XCAL(K,I))THEN NCAL(NDAT)=0 WRITE(5,510)NDAT RETURN ENDIF ENDIF XCAL(NDAT,I)=XCAL(K,I) YCAL(NDAT,I)=YCAL(NDAT,I)+YCAL(K,I) 112 CONTINUE ENDIF 114 CONTINUE RETURN END SUBROUTINE IDENT(NDAT,ITYP,IUNIT,ISTA,NSUM,ISST) CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C THIS SUBROUTINE IDENTIFIES ECIS PLOTS. C C VARIABLES USED C DL(I) -THE NUMBER OF CHARACTERS IN THE NAME OF THE I'TH DATA TYPE. C ISST(I) -THE STATES TO SUM OVER FROM I=1 TO NSUM IN THE ECIS MODE. C ISTA -THE STATE NUMBER OF THE PLOT. C ITYP -THE DATA TYPE OF THE PLOT. C IUNIT -THE NUMBER OF THE FORTRAN UNIT FORM WHICH THE PLOT CAME. C NDAT -THE NUMER OF THE PLOT. C NSUM -THE NUMBER OF STATES THAT WERE SUMMED OVER. C TYPE(I) -THE CHARACTER NAME OF THE I'TH DATA TYPE. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CHARACTER TYPE(4)*30 DIMENSION DL(4),ISST(20) DATA DL /14,19,23,9/ DATA TYPE /'cross sections','ratio-to-Rutherford', * 'vector analyzing powers','spin flip'/ IF(ISTA.EQ.0)THEN WRITE(5,500)NDAT,TYPE(ITYP+1),IUNIT,(ISST(I),I=1,NSUM) 500 FORMAT(' Plot ',I3,' is ',A,' from FORTRAN', * ' UNIT ',I2,' states',(I2,','),' and',I2) ELSE WRITE(5,505)NDAT,TYPE(ITYP+1),IUNIT,ISTA 505 FORMAT(' Plot ',I3,' is ',A,' from FORTRAN', * ' UNIT ',I2,' state',I2) ENDIF RETURN END