|
|
Fundamental TechnologiesUlysses HISCALE Pages |
Appendix 9 Geometric Factor Study for the Deflected and Unscattered Electrons of HISCALE (Buckley MS Thesis continued)
* PROGRAM I.10 *
******************************************************************************* * PLOTR4MYY1 * * SLIGHT MODIFICATION FROM THE ORIGINAL MR. WU'S ROUTINE * * THIS ROUTINE IS SUPPLIED WITH THE MINIMUM AND MAXIMUM VALUES * * OF X AND Y. * * PRIMARILY, TO PLOT THE EXPT. VALUES AND THE CALCULATED VALUES * * OF THE B FILED * *******************************************************************************
SUBROUTINE PLOTR4(NC,X,Y,NPT,NLN,TITLE,FIG,XLAB,YLAB,LNPT,LNK)
PARAMETER (NB=50,NN=1000)
CHARACTER*72 TITLE,XLAB,YLAB,FIG
INTEGER NPT(NB),MTY(NB)
REAL X(NB,NN),Y(NB,NN),X1(NN),Y1(NN),SP(4,4),ST(4)
DATA (SP(1,J),J=1,4)/0.1,0.48,0.55,0.93/
DATA (SP(2,J),J=1,4)/0.6,0.98,0.55,0.93/
DATA (SP(3,J),J=1,4)/0.1,0.48,0.08,0.46/
DATA (SP(4,J),J=1,4)/0.6,0.98,0.08,0.46/
DATA (MTY(I),I=1,8)/1,2,3,4,5,6,7,8/
LPOWX=0
LPOWY=0
IF (LNPT.GT.10.AND.LNPT.LT.15) THEN
LTYP=LNPT-10
ELSE
LTYP=LNPT
END IF
C CALL CMAXMIN(X,NPT,NLN,XMIN,XMAX)
C CALL CMAXMIN(Y,NPT,NLN,YMIN,YMAX)
IF ((NC .EQ. 1) .OR. (NC .EQ. 2)) THEN
XMIN=-1.3
XMAX=0.4
ELSE
XMIN = -0.5
XMAX = 0.5
END IF
YMIN = 0.0
YMAX = 2000.0
WRITE(6,*) ' NC = ',NC
WRITE(6,6) XMIN,XMAX,YMIN,YMAX
6 FORMAT(' XMIN=',E11.4,' XMAX=',E11.4,' YMIN=',E11.4,
X ' YMAX=',E11.4)
IF (LTYP.EQ.1) THEN
CALL NEAR(2,XMAX,XMIN,UMAX,UMIN,MJTKX,MNTKX,LPOWX)
CALL NEAR(2,YMAX,YMIN,VMAX,VMIN,MJTKY,MNTKY,LPOWY)
ELSE
IF (LTYP.EQ.2) THEN
CALL NEAR(2,XMAX,XMIN,UMAX,UMIN,MJTKX,MNTKX,LPOWX)
CALL NEARLOG(YMAX,YMIN,VMAX,VMIN,MJTKY,MNTKY)
ELSE
IF (LTYP.EQ.3) THEN
CALL NEARLOG(XMAX,XMIN,UMAX,UMIN,MJTKX,MNTKX)
CALL NEAR(2,YMAX,YMIN,VMAX,VMIN,MJTKY,MNTKY,LPOWY)
ELSE
CALL NEARLOG(YMAX,YMIN,VMAX,VMIN,MJTKY,MNTKY)
CALL NEARLOG(XMAX,XMIN,UMAX,UMIN,MJTKX,MNTKX)
END IF
END IF
END IF
WRITE(6,6) XMIN,XMAX,YMIN,YMAX
WRITE(6,6) UMIN,UMAX,VMIN,VMAX
CALL HEADER4(TITLE,FIG)
CALL SET(SP(NC,1),SP(NC,2),SP(NC,3),SP(NC,4),XMIN,XMAX,
XYMIN,YMAX,LTYP)
CALL OPTN('SSIZE',2)
CALL OPTN('COLOR','WHITE')
IF (LNPT.LT.10) THEN
CALL PERIM(MJTKX,MNTKX,MJTKY,MNTKY)
ELSE
CALL GRID(MJTKX,MNTKX,MJTKY,MNTKY)
END IF
IF (NC.EQ.1) CALL OPTN('COLOR','YELLOW')
IF (NC.EQ.2) CALL OPTN('COLOR','RED')
IF (NC.EQ.3) CALL OPTN('COLOR','GREEN')
IF (NC.EQ.4) CALL OPTN('COLOR','PINK')
DO I=1,NLN
IF (LNK.NE.11) THEN
NTY=LNK
ELSE
NTY=MTY(I)
END IF
WRITE(6,*) NLN
DO J=1,NPT(I)
X1(J)=X(I,J)
Y1(J)=Y(I,J)
IF (NTY.EQ.0) CALL PWRITX(X1(J),Y1(J),'"140"',5,18,0,0)
IF (NTY.EQ.1) CALL PWRITX(X1(J),Y1(J),'"632"',5,15,0,0)
IF (NTY.EQ.2) CALL PWRITX(X1(J),Y1(J),'"1246"',6,14,0,0)
IF (NTY.EQ.3) CALL PWRITX(X1(J),Y1(J),'"531"',5,15,0,0)
IF (NTY.EQ.4) CALL PWRITX(X1(J),Y1(J),'"1245"',6,15,0,0)
IF (NTY.EQ.5) CALL PWRITX(X1(J),Y1(J),'"532"',5,15,0,0)
IF (NTY.EQ.6) CALL PWRITX(X1(J),Y1(J),'"1253"',6,15,0,0)
IF (NTY.EQ.7) CALL PWRITX(X1(J),Y1(J),'"47"',4,15,0,0)
IF (NTY.EQ.8) CALL PWRITX(X1(J),Y1(J),'"1307"',6,15,0,0)
END DO
IF (NTY.EQ.-1.OR.LNK.EQ.11) CALL CURVE(X1,Y1,NPT(I))
END DO
CALL OPTN('COLOR','WHITE')
ST(1)=SP(NC,1)
ST(2)=SP(NC,2)
ST(3)=SP(NC,3)
ST(4)=SP(NC,4)
CALL LABEL(4,ST,UMIN,UMAX,VMIN,VMAX,MJTKX,MJTKY,13,
XLTYP,LPOWX,LPOWY)
CALL XLABEL4(XLAB,NC,LPOWX)
CALL YLABEL4(YLAB,NC,LPOWY)
RETURN
END
C *********************************************************
SUBROUTINE HEADER4(TITLE)
CHARACTER TITLE*72
NT=LENCHAR(TITLE,FIG)
CALL SET(0.1,0.9,0.955,0.99,0.0,60.0,0.0,2.0,1)
CALL PWRITX(30.0,0.5,%REF(TITLE),NT,18,0,0)
C CALL SET(0.4,0.6,0.01,0.045,0.0,60.0,0.0,2.0,1)
C CALL PWRITX(30.0,0.5,%REF(FIG),NT,18,0,0)
RETURN
END
C *********************************************************
SUBROUTINE XLABEL4(XLAB,NC,LPOWX)
CHARACTER XLAB*72,POW*25
REAL XL(4,4)
DATA (XL(1,J),J=1,4)/0.1,0.5,0.48,0.50/
DATA (XL(2,J),J=1,4)/0.6,1.0,0.48,0.50/
DATA (XL(3,J),J=1,4)/0.1,0.5,0.02,0.04/
DATA (XL(4,J),J=1,4)/0.6,1.0,0.02,0.04/
NXC=LENCHAR(XLAB)
CALL SET(XL(NC,1),XL(NC,2),XL(NC,3),XL(NC,4),0.0,60.0,0.0,2.0,1)
CALL PWRITX(30.0,0.5,%REF(XLAB),NXC,14,0,0)
IF (LPOWX.NE.0) THEN
ENCODE(19,12,POW) LPOWX
CALL PWRITX(55.0,0.5,%REF(POW),19,14,0,0)
END IF
12 FORMAT(' "137"10"S3"',I3,'"N"')
RETURN
END
C **********************************************************
SUBROUTINE YLABEL4(YLAB,NC,LPOWY)
CHARACTER YLAB*72,POW*25
REAL YL(4,4) DATA (YL(1,J),J=1,4)/0.00,0.04,0.58,0.93/ DATA (YL(2,J),J=1,4)/0.50,0.54,0.58,0.93/ DATA (YL(3,J),J=1,4)/0.00,0.04,0.10,0.46/ DATA (YL(4,J),J=1,4)/0.50,0.54,0.10,0.46/
NYC=LENCHAR(YLAB)
CALL SET(YL(NC,1),YL(NC,2),YL(NC,3),YL(NC,4),0.0,2.0,0.0,60.0,1)
CALL PWRITX(0.5,30.0,%REF(YLAB),NYC,14,90,0)
IF (LPOWY.NE.0) THEN
ENCODE(19,12,POW) LPOWY
CALL PWRITX(0.5,50.0,%REF(POW),19,14,90,0)
END IF
12 FORMAT(' "137"10"S3"',I3,'"N"')
RETURN
END