linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial revision

Browse Source
This commit is contained in:
cvs
2000-02-07 10:38:55 +00:00
commit fdc6b051c9
846 changed files with 230218 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

144
difrac/pltprf.f Normal file
View File

@@ -0,0 +1,144 @@
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