145 lines
4.3 KiB
Fortran
145 lines
4.3 KiB
Fortran
C-----------------------------------------------------------------------
|
|
C Subroutine to plot a line profile on LPT
|
|
C Redirected output to Screen for SICS: MK
|
|
C-----------------------------------------------------------------------
|
|
SUBROUTINE PLTPRF (ACOUNT,NPTS,BEGIN)
|
|
COMMON /IODEVS/ ITP,ITR,LPT,LPTX,NB,NBLOCK,ISD,IID,IBYLEN,
|
|
$ IPR,NPR,IIP
|
|
CHARACTER*132 COUT(20)
|
|
COMMON /IOUASC/ COUT
|
|
CHARACTER BEGIN*2,BL(121)*1,BLANK*1,SPACE*1,AST*1,MARK*1
|
|
CHARACTER ANS*1
|
|
DIMENSION ACOUNT(121),IX(121),IAL(21)
|
|
BLANK = ' '
|
|
SPACE = '+'
|
|
AST = '*'
|
|
MARK = '^'
|
|
IF (BEGIN .NE. 'DE') THEN
|
|
WRITE (COUT,10000)
|
|
CALL YESNO ('Y',ANS)
|
|
IF (ANS .EQ. 'N') RETURN
|
|
ENDIF
|
|
C-----------------------------------------------------------------------
|
|
C Put intensities in descending order
|
|
C-----------------------------------------------------------------------
|
|
DO 100 J = 1,NPTS
|
|
IX(J) = J
|
|
100 CONTINUE
|
|
MPTS = NPTS-1
|
|
DO 120 J = 1,MPTS
|
|
BIG = 0
|
|
DO 110 I = J,NPTS
|
|
IF (ACOUNT(I) .GT. BIG) THEN
|
|
BIG = ACOUNT(I)
|
|
ISAVE = IX(I)
|
|
JBIG = I
|
|
ENDIF
|
|
110 CONTINUE
|
|
IX(JBIG) = IX(J)
|
|
ACOUNT(JBIG) = ACOUNT(J)
|
|
ACOUNT(J) = BIG
|
|
IX(J) = ISAVE
|
|
120 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Scale to 50 max or 10(ACOUNT(1)/10) if ACOUNT(1) < 40
|
|
C-----------------------------------------------------------------------
|
|
SMAX = 50.0
|
|
JLOOP = 6
|
|
SCALE = ACOUNT(1)
|
|
IF (SCALE .LE. 40.0) THEN
|
|
J = 1 + SCALE/10
|
|
SCALE = 10*J
|
|
JLOOP = J + 1
|
|
ENDIF
|
|
DO 130 J = 1,NPTS
|
|
ACOUNT(J) = ACOUNT(J)*SMAX/SCALE
|
|
130 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Fix length of angle axis
|
|
C-----------------------------------------------------------------------
|
|
NINT = 2
|
|
IF (NPTS .GT. 35) NINT = 1
|
|
WRITE (LPT,11000)
|
|
C-----------------------------------------------------------------------
|
|
C Write the tenth lines
|
|
C-----------------------------------------------------------------------
|
|
INOW = 50
|
|
DO 200 JLINE = 1,JLOOP
|
|
DO 150 J = 1,121
|
|
BL(J) = BLANK
|
|
150 CONTINUE
|
|
JK = 1
|
|
DO 160 J = 1,NPTS
|
|
ICOUNT = INT(ACOUNT(J) +0.5)
|
|
IF (INOW .EQ. ICOUNT) THEN
|
|
JT = NINT*(IX(J)-1)+1
|
|
BL(JT) = AST
|
|
IF (JT .GT. JK) JK = JT
|
|
ENDIF
|
|
160 CONTINUE
|
|
WRITE (LPT,12000) INOW,(BL(J),J = 1,JK)
|
|
C----------------------------------------------------------------------
|
|
C Write the intermediate lines
|
|
C-----------------------------------------------------------------------
|
|
IF (JLINE .NE. 6) THEN
|
|
DO 190 JINT = 1,9
|
|
INOW = INOW-1
|
|
DO 170 I = 1,121
|
|
BL(I) = BLANK
|
|
170 CONTINUE
|
|
JK = 1
|
|
DO 180 J = 1,NPTS
|
|
ICOUNT = INT(ACOUNT(J) + 0.5)
|
|
IF (INOW .EQ. ICOUNT) THEN
|
|
JT = NINT*(IX(J)-1)+1
|
|
BL(JT) = AST
|
|
IF (JT .GT. JK) JK = JT
|
|
ENDIF
|
|
180 CONTINUE
|
|
WRITE (COUT,13000) (BL(J),J = 1,JK)
|
|
CALL GWRITE(ITP,' ')
|
|
190 CONTINUE
|
|
INOW = INOW - 1
|
|
ENDIF
|
|
200 CONTINUE
|
|
C-----------------------------------------------------------------------
|
|
C Write the angle axis
|
|
C-----------------------------------------------------------------------
|
|
DO 210 J = 1,121
|
|
BL(J) = BLANK
|
|
210 CONTINUE
|
|
DO 220 J = 1,121,NINT
|
|
BL(J) = SPACE
|
|
220 CONTINUE
|
|
JINT = NINT*5
|
|
DO 230 J = 1,121,JINT
|
|
BL(J) = MARK
|
|
230 CONTINUE
|
|
JK = NPTS*NINT
|
|
WRITE (COUT,14000) (BL(J),J = 1,JK)
|
|
CALL GWRITE(ITP,' ')
|
|
MPTS = 1+(NPTS/5)
|
|
NUM = 0
|
|
DO 240 J = 1,MPTS
|
|
IAL(J) = NUM
|
|
NUM = NUM+5
|
|
240 CONTINUE
|
|
IF (NPTS .LE. 35) THEN
|
|
WRITE (COUT,15000) (IAL(J),J = 1,MPTS)
|
|
CALL GWRITE(ITP,' ')
|
|
ELSE
|
|
WRITE (COUT,16000) (IAL(J),J = 1,MPTS)
|
|
CALL GWRITE(ITP,' ')
|
|
ENDIF
|
|
RETURN
|
|
10000 FORMAT (' Plot Line Profile on LPT (Y) ? ',$)
|
|
11000 FORMAT (/)
|
|
12000 FORMAT (1X,I2,'>',121A1)
|
|
13000 FORMAT (3X,'+',121A1)
|
|
14000 FORMAT (3X,'.',121A1)
|
|
15000 FORMAT (1X,16(I3,7X))
|
|
16000 FORMAT (1X,21(I3,2X))
|
|
END
|
|
|
|
|