Porting DISSPLA Programs to DISLIN
C------------------------------------------------------------------------- C This file contains some notes and interface routines for porting DISSPLA C programs to DISLIN. C C One big difference between DISLIN and DISSPLA are the plot coordinates: C DISLIN uses normally integer coordinates with 100 points per cm where the C point (0, 0) is located in the upper left corner. DISSPLA uses by default C inch with the origin in the lower left corner. C Additional, many routines in DISLIN have different names and parameters. C C The following routines have the same names in DISLIN and DISSPLA, but a C different parameter list or meaning. These routines must be renamed in the C DISSPLA code. A trailing '_DP' is used in the interface. The routines C are: C C PAGE, UNITS, MESSAG, ANGLE, GRAF, CURVE, FRAME, GRACE, HEIGHT, RESET, C STRTPT, CONNPT, VECTOR, RLVEC, GRAF3D, RLMESS, LEGEND, SPLINE, BARS C VBARS, HBARS, POLAR, THKCRV, GRID, GETMAT, SURMAT C C The interface contains wrapper routines for the following routines and C functions. C C PAGE, UNITS, MESSAG, GRAF, CURVE, FRAME, GRACE, HEIGHT, ENDGR, ANGLE, C PSPLOT, PHYSOR, AREA2D, HWROT, NEWCLR, SETCLR, THKFRM, REALNO, INTNO, C ENDPL, DONEPL, XTICKS, YTICKS, ZTICKS, INTAXS, XINTAX, YINTAX, ZINTAX, C XREVTK, YREVTK, ZREVTK, XAXEND, YAXEND, ZAXEND, XNONUM, YNONUM, ZNONUM, C XAXCTR, YAXCTR, ZAXCTR, RLREAL, RLINT, RLMESS, XLABGR, YLABGR, XYLAB C XNAME, YNAME, SWISSL, SWISSM, SCLPIC, XAXANG, YAXANG, ZAXANG, XLOG, YLOG, C LOGLOG, NOBRDR, OREL, STRTPT, CONNPT, VECTOR, RLVEC, THKVEC, RESET, XMESS C GRAF3D, X3NAME, Y3NAME, Z3NAME, VOLM3D, AXES3D, VUABS, VUANGL, VIEW, C LEGEND, LINES, LEGNAM, LINEAR, STEP, BARS, BARWID, SHDCHA, VBARS, HBARS, C POLAR, SETEND, THKCRV, BLSYM, SWISSB, CHRPAT, HWSHD, XLGAXS, YLGAXS C XLEGND, YLEGND, BLREC, BLKEY, BLOFF, XGRAXS, YGRAXS, GETMAT, SURMAT, C BGNMAT, ENDMAT, RELPT3, XREAL C C The following routines have the same meaning and parameter list and don't C need to be ported. C C CROSS, MARKER, C COMPLX, SIMPLX, DUPLX, SERIF, TRIPLX C CHNDSH, CHNDOT, DASH, DOT, LINESP C BOX3D C C Notes: C - Dislin is initialized in PAGE. If PAGE is not called, it is initialized C in AREA2D. C - PSPLOT is an example for an initialization routine of DISSPLA and C creates by default a DISLIN PostScript file. You can also plot directly C to the screen if you change the keyword 'PS' to 'CONS' in METAFL. C PSPLOT defines also some global variables for scaling etc. C - The final target should be to replace the DISSPLA routines directly by C DISLIN routines in the source code. The interface routines may help to C understand the differences better between DISSPLA nad DISLIN. C C Date : 16.11.2007 C Version: 2.0 C Author : H. Michels C------------------------------------------------------------------------- SUBROUTINE PSPLOT(CFIL,XPAGE,YPAGE,PENWD) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CFIL CALL SETFIL (CFIL) CALL METAFL ('PS') NX=XPAGE*100+0.5 NY=YPAGE*100+0.5 CALL PAGE(NX,NY) CALL COMMON_INI C PSPLOT defines cm as default plot unit XCM=1.0 END SUBROUTINE PAGE_DP(XPAGE,YPAGE) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS NX=XPAGE*XCM*100+0.5 NY=YPAGE*XCM*100+0.5 CALL PAGE (NX, NY) CALL DISLIN_INI END SUBROUTINE AREA2D (X, Y) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS NX=X*XCM*100+0.5 NY=Y*XCM*100+0.5 CALL GETLEV(NLEV) IF(NLEV.EQ.0) CALL DISLIN_INI CALL AXSLEN(NX,NY) C If PHYSOR is not called before center AREA2D IF(IPHYS.EQ.0) THEN CALL GETPAG(NXP,NYP) CALL AXSPOS((NXP-NX)/2+70,NY+(NYP-NY)/2+70) IPHYS=1 END IF CALL GETPOS(NXA,NYA) IF(IBOR.EQ.1) CALL PAGERA END SUBROUTINE UNITS_DP(CSTR) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CSTR,COPT*2 COPT=CSTR CALL UPSTR(COPT) IF((COPT.EQ.'CM').OR.(COPT.EQ.'CE')) THEN XCM=1.0 ELSE IF(COPT.EQ.'IN') THEN XCM=2.54 ELSE IF((COPT.EQ.'MI').OR.(COPT.EQ.'MM')) THEN XCM=10. END IF END SUBROUTINE RESET_DP(CSTR) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CSTR,COPT*4 C RESET may have different values for DISSPLA and DISLIN CALL GETLEV(NLEV) IF(NLEV.EQ.0) RETURN COPT=CSTR CALL UPSTR(COPT) C For example IF(COPT.EQ.'XTIC') THEN CALL TICKS(2,'X') ELSE IF(COPT.EQ.'YTIC') THEN CALL TICKS(2,'Y') ELSE IF(COPT.EQ.'ZTIC') THEN CALL TICKS(2,'Z') ELSE IF(COPT.EQ.'DASH') THEN CALL SOLID ELSE IF(COPT.EQ.'DOT') THEN CALL SOLID ELSE IF(COPT.EQ.'HWSH') THEN RETURN ELSE IF(COPT.EQ.'BLNK') THEN CALL RESET('SHIELD') ELSE CALL RESET(CSTR) END IF END SUBROUTINE FRAME_DP COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS N=XFRM+0.5 CALL FRAME(N) CALL BOX2D CALL FRAME(0) END SUBROUTINE THKFRM(X) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS IF((X.GT.-1.0).AND.(X.LE.1.0)) THEN XFRM=X*XCM*100 ELSE XFRM=X END IF END SUBROUTINE THKVEC(X) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS IF(X.LT.1.0) THEN XVEC=X*XCM*100 ELSE CALL GETLIN(N) XVEC=X*N END IF END SUBROUTINE PHYSOR(X,Y) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS NX=X*XCM*100+0.5 NY=Y*XCM*100+0.5 CALL GETPAG(NXP,NYP) CALL AXSPOS(NX,NYP-NY) IPHYS=1 END SUBROUTINE OREL(X,Y) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CALL GETPOS(NXA,NYA) NX=X*XCM*100+0.5 NY=Y*XCM*100+0.5 CALL AXSPOS(NX+NXA,NYA-NY) END SUBROUTINE HWROT(CSTR) CHARACTER*(*) CSTR,COPT*4 COPT=CSTR CALL UPSTR(COPT) IF((COPT.EQ.'AUTO').OR.(COPT.EQ.'COMI')) THEN CALL PAGMOD('LAND') ELSE CALL PAGMOD('PORT') END IF END SUBROUTINE NEWCLR(COL) CHARACTER*(*) COL CALL COLOR(COL) END SUBROUTINE SETCLR_DP(COL) CHARACTER*(*) COL CALL COLOR(COL) END SUBROUTINE SHDCHR(ARAY,NANG,GAPRAY,NGAPS) c Dislin supports only shaded or not shaded characters IF(NGAPS.EQ.0) THEN CALL RESET('SHDCHA') ELSE CALL SHDCHA END IF END SUBROUTINE ANGLE_DP(X) N=NINT(X) CALL ANGLE(N) END SUBROUTINE SETEND(CSTR,N) COMMON /CDISSPL6/ CEND,NEND CHARACTER*(*) CSTR,CEND*40 CEND=CSTR NEND=N END SUBROUTINE MESSAG_DP(CMSG,N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CMSG,CSTR*256 C Delete self-counting string (not necessary in DISLIN) CSTR=CMSG CALL CLEARSTR(CSTR) IF((ICSTRING(XPOS,'ABUT').EQ.1).AND. * (ICSTRING(YPOS,'ABUT').EQ.1)) THEN NX=999 NY=999 ELSE NX=XPOS+0.5 NY=YPOS+0.5 IF((NX.NE.999).OR.(NY.NE.999)) THEN CALL GETPAG(NXP,NYP) CALL GETPOS(NXA,NYA) CALL GETHGT(NH) NX=NXA+XPOS*XCM*100+0.5 NY=NYA-YPOS*XCM*100-NH+0.5 END IF END IF CALL MESSAG(CSTR,NX,NY) END SUBROUTINE RLMESS_DP(CSTR,N,XPOS,YPOS) CHARACTER*(*) CSTR CALL RLMESS(CSTR,XPOS,YPOS) END SUBROUTINE REALNO(X,N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*40 CSTR IF((ICSTRING(XPOS,'ABUT').EQ.1).AND. * (ICSTRING(YPOS,'ABUT').EQ.1)) THEN NX=999 NY=999 ELSE NX=XPOS+0.5 NY=YPOS+0.5 IF((NX.NE.999).OR.(NY.NE.999)) THEN CALL GETPAG(NXP,NYP) CALL GETPOS(NXA,NYA) CALL GETHGT(NH) NX=NXA+XPOS*XCM*100+0.5 NY=NYA-YPOS*XCM*100-NH+0.5 END IF END IF IF(N.GE.100) THEN NN=N-100 IF(NN.EQ.0) RETURN CALL FCHA(X,NN,NL,CSTR) CSTR(NN+1:)=' ' CALL MESSAG(CSTR,NX,NY) ELSE IF(N.GE.0) THEN CALL NUMBER(X,N,NX,NY) ELSE CALL NUMFMT('FEXP') CALL NUMBER(X,-N,NX,NY) CALL NUMFMT('FLOAT') END IF END SUBROUTINE RLREAL(X,N,XPOS,YPOS) CHARACTER*40 CSTR IF(N.GE.100) THEN NN=N-100 IF(NN.EQ.0) RETURN CALL FCHA(X,NN,NL,CSTR) CSTR(NN+1:)=' ' CALL RLMESS(CSTR,XPOS,YPOS) ELSE IF(N.GE.0) THEN CALL RLNUMB(X,N,XPOS,YPOS) ELSE CALL NUMFMT('FEXP') CALL RLNUMB(X,-N,XPOS,YPOS) CALL NUMFMT('FLOAT') END IF END SUBROUTINE INTNO(N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS IF((ICSTRING(XPOS,'ABUT').EQ.1).AND. * (ICSTRING(YPOS,'ABUT').EQ.1)) THEN NX=999 NY=999 ELSE NX=XPOS+0.5 NY=YPOS+0.5 IF((NX.NE.999).OR.(NY.NE.999)) THEN CALL GETPAG(NXP,NYP) CALL GETPOS(NXA,NYA) CALL GETHGT(NH) NX=NXA+XPOS*XCM*100+0.5 NY=NYA-YPOS*XCM*100-NH+0.5 END IF END IF X=N CALL NUMBER(X,-1,NX,NY) END SUBROUTINE RLINT(N,XPOS,YPOS) X=N CALL RLNUMB(X,-1,XPOS,YPOS) END FUNCTION XMESS(CSTR,N) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CSTR NL=NLMESS(CSTR) XMESS=NL/(100*XCM) END FUNCTION XREAL(X,N) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*40 CSTR IF(N.GE.100) THEN NN=N-100 CALL FCHA(X,NN,NL,CSTR) CSTR(NN+1:)=' ' NL=NLMESS(CSTR) XREAL=NL/(100*XCM) ELSE IF(N.GE.0) THEN NL=NLNUMB(X,N) XREAL=NL/(100*XCM) ELSE CALL NUMFMT('FEXP') NL=NLNUMB(X,-N) XREAL=NL/(100*XCM) CALL NUMFMT('FLOAT') END IF END SUBROUTINE CONNPT_DP(XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CALL GETPOS(NXA,NYA) X=NXA+XPOS*XCM*100 Y=NYA-YPOS*XCM*100 CALL CONNPT(X,Y) END SUBROUTINE STRTPT_DP(XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CALL GETPOS(NXA,NYA) X=NXA+XPOS*XCM*100 Y=NYA-YPOS*XCM*100 CALL STRTPT(X,Y) END SUBROUTINE VECTOR_DP(X1,Y1,X2,Y2,IVEC) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CALL GETLIN(NW) CALL PENWID(XVEC) CALL GETPOS(NXA,NYA) NX1=NXA+X1*XCM*100 NY1=NYA-Y1*XCM*100 NX2=NXA+X2*XCM*100 NY2=NYA-Y2*XCM*100 CALL VECTOR(NX1,NY1,NX2,NY2,IVEC) CALL LINWID(NW) END SUBROUTINE RLVEC_DP(X1,Y1,X2,Y2,IVEC) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CALL GETLIN(NW) CALL PENWID(XVEC) CALL RLVEC(X1,Y1,X2,Y2,IVEC) CALL LINWID(NW) END SUBROUTINE ENDPL(IPLOT) END SUBROUTINE ENDGR(IOPT) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL5/IPOLAR,THETA IHDR=0 DO I=1,4 CALL TITLIN(' ',I) END DO IXGRF=0 IYGRF=0 IPOLAR=0 CALL ENDGRF END SUBROUTINE DONEPL CALL DISFIN END SUBROUTINE GRAF_DP (XORIG,XSTP,XMAX,YORIG,YSTP,YMAX) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL5/IPOLAR,THETA REAL XRAY(2),YRAY(2) C If XSTP = 'SCALE' or YSTP = 'SCALE', the automatic scaling in C Dislin is used. For automatic scaling, the calculated scaling c parameters are returned in GRAF. Therefore, the paramters in GRAF_DP c must be copied to local variables, or GRAF will crash if constants c are passed to GRAF_DP XA=XORIG XOR=XA XE=XMAX XS=XSTP YA=YORIG YOR=YA YE=YMAX YS=YSTP IXSCL=0 IF(ICSTRING(XSTP,'SCAL').EQ.1) THEN XRAY(1)=XA XRAY(2)=XE CALL SETSCL(XRAY,2,'X') YS=1. IXSCL=1 END IF IYSCL=0 IF(ICSTRING(YSTP,'SCAL').EQ.1) THEN YRAY(1)=YA YRAY(2)=YE CALL SETSCL(YRAY,2,'Y') YS=1 IYSCL=1 END IF IF((IXGRF.EQ.0).AND.(IYGRF.EQ.0)) THEN CALL SETGRF('NONE','NONE','NONE','NONE') ELSE IF(IYGRF.EQ.0) THEN CALL SETGRF('NAME','NONE','TICKS','NONE') ELSE IF(IXGRF.EQ.0) THEN CALL SETGRF('NONE','NAME','NONE','TICKS') ELSE CALL SETGRF('NAME','NAME','TICKS','TICKS') END IF CALL GETLEN(NXL,NYL,NZL) CALL GETPOS(NXA,NYA) CALL AXSSCL('LIN','XY') CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL TITLE IF(IXSCL.EQ.1) CALL SETSCL(XRAY,2,'XRESET') IF(IYSCL.EQ.1) CALL SETSCL(YRAY,2,'YRESET') CALL RESET('SETGRF') END SUBROUTINE XGRAXS(XORIG,XSTP,XMAX,XAXIS,CSTR,N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CSTR REAL XRAY(2) CALL GETGRF(YA,YE,YOR,YS,'Y') CALL ENDGRF C X axis length may be changed CALL GETLEN(NXL,NYL,NZL) NXL=XAXIS*XCM*100+0.5 CALL AXSLEN(NXL,NYL) XA=XORIG XOR=XA XE=XMAX XS=XSTP IXSCL=0 IF(ICSTRING(XSTP,'SCAL').EQ.1) THEN XRAY(1)=XA XRAY(2)=XE CALL SETSCL(XRAY,2,'X') YS=1. IXSCL=1 END IF C Position is realized via ORIGIN so that position of AREA2D is not C changed NX0=XPOS*XCM*100+0.5 NY0=YPOS*XCM*100+0.5 CALL ORIGIN(NX0,-NY0) CALL NAME(CSTR,'X') CALL AXSSCL('LIN','XY') IF(N.EQ.0) THEN CALL SETGRF('NONE','NONE','NONE','NONE') ELSE IF(N.LT.0) THEN CALL ORIGIN(NX0,-NY0+NYL) CALL SETGRF('NONE','NONE','NAME','NONE') ELSE CALL SETGRF('NAME','NONE','NONE','NONE') END IF CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) IF(IXSCL.EQ.1) CALL SETSCL(XRAY,2,'XRESET') CALL RESET('SETGRF') CALL RESET('ORIGIN') END SUBROUTINE YGRAXS(YORIG,YSTP,YMAX,YAXIS,CSTR,N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CSTR REAL YRAY(2) CALL GETGRF(XA,XE,XOR,XS,'X') CALL ENDGRF C Y axis length may be changed CALL GETLEN(NXL,NYL,NZL) NYL=YAXIS*XCM*100+0.5 CALL AXSLEN(NXL,NYL) YA=YORIG YOR=YA YE=YMAX YS=YSTP IYSCL=0 IF(ICSTRING(YSTP,'SCAL').EQ.1) THEN YRAY(1)=YA YRAY(2)=YE CALL SETSCL(YRAY,2,'Y') YS=1 IYSCL=1 END IF C Position is realized via ORIGIN so that position of AREA2D is not C changed NX0=XPOS*XCM*100+0.5 NY0=YPOS*XCM*100+0.5 CALL ORIGIN(NX0,-NY0) CALL NAME(CSTR,'Y') CALL AXSSCL('LIN','XY') IF(N.EQ.0) THEN CALL SETGRF('NONE','NONE','NONE','NONE') ELSE IF(N.LT.0) THEN CALL ORIGIN(NX0-NXL,-NY0) CALL SETGRF('NONE','NONE','NONE','NAME') ELSE CALL SETGRF('NONE','NAME','NONE','NONE') END IF CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) IF(IYSCL.EQ.1) CALL SETSCL(YRAY,2,'YRESET') CALL RESET('SETGRF') CALL RESET('ORIGIN') END SUBROUTINE XLGAXS(XORIG,XCYCLE,XAXIS,CSTR,N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CSTR CALL GETGRF(YA,YE,YOR,YS,'Y') CALL ENDGRF C X axis length may be changed CALL GETLEN(NXL,NYL,NZL) NXL=XAXIS*XCM*100+0.5 CALL AXSLEN(NXL,NYL) C Position is realized via ORIGIN so that position of AREA2D is not C changed NX0=XPOS*XCM*100+0.5 NY0=YPOS*XCM*100+0.5 CALL ORIGIN(NX0,-NY0) XA=ALOG10(XORIG) XE=XA+XAXIS/XCYCLE XS=1. IOR=XA IF(IOR.LT.(XA-0.01)) IOR=IOR+1 XOR=IOR CALL NAME(CSTR,'X') CALL AXSSCL('LIN','Y') CALL AXSSCL('LOG','X') CALL LABELS('LOG','X') CALL LABDIG(-1,'X') IF(N.EQ.0) THEN CALL SETGRF('NONE','NONE','NONE','NONE') ELSE IF(N.LT.0) THEN CALL ORIGIN(NX0,-NY0+NYL) CALL SETGRF('NONE','NONE','NAME','NONE') ELSE CALL SETGRF('NAME','NONE','NONE','NONE') END IF CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL LABELS('FLOAT','X') CALL LABDIG(1,'X') CALL RESET('SETGRF') CALL RESET('ORIGIN') END SUBROUTINE YLGAXS(YORIG,YCYCLE,YAXIS,CSTR,N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CSTR CALL GETGRF(XA,XE,XOR,XS,'X') CALL ENDGRF C Y axis length may be changed CALL GETLEN(NXL,NYL,NZL) NYL=YAXIS*XCM*100+0.5 CALL AXSLEN(NXL,NYL) C Position is realized via ORIGIN so that position of AREA2D is not C changed NX0=XPOS*XCM*100+0.5 NY0=YPOS*XCM*100+0.5 CALL ORIGIN(NX0,-NY0) YA=ALOG10(YORIG) YE=YA+YAXIS/YCYCLE YS=1. IOR=YA IF(IOR.LT.(YA-0.01)) IOR=IOR+1 YOR=IOR CALL NAME(CSTR,'Y') CALL AXSSCL('LIN','X') CALL AXSSCL('LOG','Y') CALL LABELS('LOG','Y') CALL LABDIG(-1,'Y') IF(N.EQ.0) THEN CALL SETGRF('NONE','NONE','NONE','NONE') ELSE IF(N.LT.0) THEN CALL ORIGIN(NX0-NXL,-NY0) CALL SETGRF('NONE','NONE','NONE','NAME') ELSE CALL SETGRF('NONE','NAME','NONE','NONE') END IF CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL LABELS('FLOAT','Y') CALL LABDIG(1,'Y') CALL RESET('SETGRF') CALL RESET('ORIGIN') END SUBROUTINE GRID_DP(I,J) COMMON /CDISSPL5/IPOLAR,THETA IF(IPOLAR.EQ.1) THEN CALL GRID(J,I) ELSE IF((I.EQ.0).AND.(J.EQ.0)) THEN CALL FRAME(1) CALL BOX2D CALL FRAME(0) ELSE CALL GRID(I,J) END IF END IF END SUBROUTINE POLAR_DP (THEFAC,RSTEP,XDIST,YDIST) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL4/CXAX,CYAX COMMON /CDISSPL5/IPOLAR,THETA CHARACTER*132 CXAX,CYAX IPOLAR=1 THETA=THEFAC CALL GETPOS(NXA,NYA) CALL GETLEN(NXL,NYL,NZL) NX=XDIST*XCM*100+0.5 NY=YDIST*XCM*100+0.5 CALL AXSPOS(NXA-NXL/2+NX,NYA+NYL/2-NY) CALL AXSTYP('CROSS') X=NXL/(100*XCM) XE=X*RSTEP/2 XOR=RSTEP XSTP=RSTEP YOR=0. YSTP=30. IF(IXGRF.EQ.0) THEN CALL SETGRF('TICKS','NONE','TICKS','NONE') ELSE CALL SETGRF('NAME','NONE','TICKS','NONE') END IF CALL LABELS('none','y'); CALL TICKS(0,'y') CALL NOLINE('y') CALL NAME(' ','Y') CALL POLAR(XE,XOR,XSTP,YOR,YSTP) C Special handling for Y-axis title IF(IYGRF.EQ.1) THEN CALL ENDGRF CALL SETGRF('NONE','NONE','NAME','NONE') CALL NAME(CYAX,'X') CALL POLAR(XE,XOR,XSTP,YOR,YSTP) IF(IXGRF.EQ.1) THEN CALL NAME(CXAX,'X') ELSE CALL NAME(' ','X') END IF CALL NAME(CYAX,'Y') END IF CALL TITLE CALL RESET('SETGRF') CALL TICKS(1,'y') CALL RESET('NOLINE') END SUBROUTINE XLOG (XORIG,XCYCLE,YORIG,YSTEP) CALL GETLEN(NXL,NYL,NZL) XL=NXL/(100*2.54) XA=ALOG10(XORIG) XE=XA+XL/XCYCLE XS=1. IOR=XA IF(IOR.LT.(XA-0.01)) IOR=IOR+1 XOR=IOR YL=NYL/(100*2.54) YA=YORIG YE=YA+YL*YSTEP YOR=YA YS=YSTEP CALL AXSSCL('LOG','X') CALL AXSSCL('LIN','Y') CALL LABELS('LOG','X') CALL LABDIG(-1,'X') CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL TITLE CALL LABELS('FLOAT','X') CALL LABDIG(1,'X') END SUBROUTINE YLOG (XORIG,XSTEP,YORIG,YCYCLE) CALL GETLEN(NXL,NYL,NZL) XL=NXL/(100*2.54) XA=XORIG XE=XA+XL*XSTEP XOR=XA XS=XSTEP YL=NYL/(100*2.54) YA=ALOG10(YORIG) YE=YA+YL/YCYCLE YS=1. IOR=YA IF(IOR.LT.(YA-0.01)) IOR=IOR+1 YOR=IOR CALL AXSSCL('LIN','X') CALL AXSSCL('LOG','Y') CALL LABELS('LOG','Y') CALL LABDIG(-1,'Y') CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL TITLE CALL LABELS('FLOAT','Y') CALL LABDIG(1,'Y') END SUBROUTINE LOGLOG (XORIG,XCYCLE,YORIG,YCYCLE) CALL GETLEN(NXL,NYL,NZL) XL=NXL/(100*2.54) XA=ALOG10(XORIG) XE=XA+XL/XCYCLE XS=1. IOR=XA IF(IOR.LT.(XA-0.01)) IOR=IOR+1 XOR=IOR YL=NYL/(100*2.54) YA=ALOG10(YORIG) YE=YA+YL/YCYCLE YS=1. IOR=YA IF(IOR.LT.(YA-0.01)) IOR=IOR+1 YOR=IOR CALL AXSSCL('LOG','XY') CALL LABELS('LOG','XY') CALL LABDIG(-1,'XY') CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL TITLE CALL LABELS('FLOAT','XY') CALL LABDIG(1,'XY') END SUBROUTINE XLABGR (CRAY,IC,N,YORIG,YSTP,YMAX) CHARACTER*(*) CRAY(N) REAL YRAY(2) XA=0. XOR=0. XE=N XS=1. YA=YORIG YOR=YA YE=YMAX YS=YSTP IYSCL=0 IF(ICSTRING(YSTP,'SCAL').EQ.1) THEN YRAY(1)=YA YRAY(2)=YE CALL SETSCL(YRAY,2,'Y') YS=1 IYSCL=1 END IF CALL LABELS('MYLAB','X') DO I=1,N CALL MYLAB(CRAY(I),I,'X') END DO CALL AXSSCL('LIN','XY') CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL TITLE IF(IYSCL.EQ.1) CALL SETSCL(YRAY,2,'YRESET') CALL LABELS('FLOAT','X') END SUBROUTINE YLABGR (XORIG,XSTP,XMAX,CRAY,IC,N) CHARACTER*(*) CRAY(N) REAL XRAY(2) YA=0. YOR=0. YE=N YS=1. XA=XORIG XOR=XA XE=XMAX XS=XSTP IXSCL=0 IF(ICSTRING(XSTP,'SCAL').EQ.1) THEN XRAY(1)=XA XRAY(2)=XE CALL SETSCL(XRAY,2,'X') XS=1 IXSCL=1 END IF CALL LABELS('MYLAB','Y') DO I=1,N CALL MYLAB(CRAY(I),I,'Y') END DO CALL AXSSCL('LIN','XY') CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL TITLE IF(IXSCL.EQ.1) CALL SETSCL(XRAY,2,'XRESET') CALL LABELS('FLOAT','Y') END SUBROUTINE XYLAB (CXRAY,ICX,NX,CYRAY,ICY,NY) CHARACTER*(*) CXRAY(NX),CYRAY(NY) XA=0. XOR=0. XE=NX XS=1. YA=0. YOR=0. YE=NY YS=1. CALL LABELS('MYLAB','XY') DO I=1,NX CALL MYLAB(CXRAY(I),I,'X') END DO DO I=1,NY CALL MYLAB(CYRAY(I),I,'Y') END DO CALL GRAF(XA,XE,XOR,XS,YA,YE,YOR,YS) CALL TITLE CALL LABELS('FLOAT','XY') END SUBROUTINE GRAF3D_DP (XORIG,XSTP,XMAX,YORIG,YSTP,YMAX, * ZORIG,ZSTP,ZMAX) REAL XRAY(2),YRAY(2),ZRAY(2) XA=XORIG XOR=XA XE=XMAX XS=XSTP YA=YORIG YOR=YA YE=YMAX YS=YSTP ZA=ZORIG ZOR=ZA ZE=ZMAX ZS=ZSTP IXSCL=0 IF(ICSTRING(XSTP,'SCAL').EQ.1) THEN XRAY(1)=XA XRAY(2)=XE CALL SETSCL(XRAY,2,'X') YS=1. IXSCL=1 END IF IYSCL=0 IF(ICSTRING(YSTP,'SCAL').EQ.1) THEN YRAY(1)=YA YRAY(2)=YE CALL SETSCL(YRAY,2,'Y') YS=1 IYSCL=1 END IF IZSCL=0 IF(ICSTRING(ZSTP,'SCAL').EQ.1) THEN ZRAY(1)=ZA ZRAY(2)=ZE CALL SETSCL(ZRAY,2,'Z') ZS=1 IZSCL=1 END IF CALL GRAF3D(XA,XE,XOR,XS,YA,YE,YOR,YS,ZA,ZE,ZOR,ZS) CALL TITLE IF(IXSCL.EQ.1) CALL SETSCL(XRAY,2,'XRESET') IF(IYSCL.EQ.1) CALL SETSCL(YRAY,2,'YRESET') IF(IZSCL.EQ.1) CALL SETSCL(ZRAY,2,'ZRESET') END SUBROUTINE VOLM3D(X,Y,Z) CALL AXIS3D(X,Y,Z) END SUBROUTINE AXES3D(CX,NX,CY,NY,CZ,NZ,X,Y,Z) CHARACTER*(*) CX,CY,CZ CALL NAME(CX,'X') CALL NAME(CY,'Y') CALL NAME(CZ,'Z') CALL AXIS3D(X,Y,Z) END SUBROUTINE VUABS(X,Y,Z) CALL VIEW3D(X,Y,Z,'ABS') END SUBROUTINE VIEW(X,Y,Z) CALL VIEW3D(X,Y,Z,'USER') END SUBROUTINE VUANGL(X,Y,Z) CALL VIEW3D(X,Y,Z,'ANGLE') END SUBROUTINE THKCRV_DP (X) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS IF((X.GT.-1.0).AND.(X.LE.1.0)) THEN N=X*XCM*100+0.5 ELSE CALL GETLIN(NWID) N=X*NWID+0.5 END IF IF(N.LT.0) N=-N CALL THKCRV(N) END SUBROUTINE BLSYM CALL SHIELD('SYMBOL','ON') END SUBROUTINE CURVE_DP (XRAY,YRAY,N,IMRK) COMMON /CDISSPL5/IPOLAR,THETA REAL XRAY(N),YRAY(N) CALL INCMRK(IMRK) IF(IPOLAR.EQ.1) THEN DO I=1,N XRAY(I)=XRAY(I)*THETA END DO CALL CURVE(YRAY,XRAY,N) DO I=1,N XRAY(I)=XRAY(I)/THETA END DO ELSE CALL CURVE(XRAY,YRAY,N) END IF END SUBROUTINE STEP CALL POLCRV('STEP') END SUBROUTINE LINEAR CALL POLCRV('LINEAR') END SUBROUTINE SPLINE_DP CALL POLCRV('SPLINE') END SUBROUTINE BARS_DP(X) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS V=X*XCM*100+0.5 C Negative values of X are not supported IF(V.LT.0) V=-V CALL BARWTH(-V) CALL POLCRV('BARS') END SUBROUTINE VBARS_DP (XRAY,Y1RAY,Y2RAY,N) REAL XRAY(N),Y1RAY(N),Y2RAY(N) CALL BARTYP('VERT') CALL BARS(XRAY,Y1RAY,Y2RAY,N) END SUBROUTINE HBARS_DP (X1RAY,X2RAY,YRAY,N) REAL X1RAY(N),X2RAY(N),YRAY(N) CALL BARTYP('HORI') CALL BARS(X1RAY,X2RAY,YRAY,N) END SUBROUTINE BARWID(X) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS IF(X.GT.0.) THEN V=X*XCM*100+0.5 CALL BARWTH(-V) ELSE CALL BARWTH(-X) END IF END SUBROUTINE BARPAT(N) CALL SHDPAT(N) END SUBROUTINE SCLPIC(F) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS NH=F*XCM*100+0.5 CALL HSYMBL(NH) END SUBROUTINE GRACE_DP(X) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS N=X*XCM*100+0.5 CALL GRACE(N) END SUBROUTINE HEIGHT_DP(X) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS N=X*XCM*100+0.5 CALL HEIGHT(N) END SUBROUTINE HEADIN (CHDR, N, XF, NLINE) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CHARACTER*(*) CHDR,CSTR*132 C The heading is plottet with TITLE after GRAF CSTR=CHDR CALL CLEARSTR(CSTR) CALL GETHGT(NH) NH=XF*NH+0.5 CALL HTITLE(NH) IF(IHDR.GT.4) RETURN IHDR=IHDR+1 I=4-NLINE+IHDR CALL TITLIN(CSTR,I) END SUBROUTINE XTICKS (N) CALL TICKS (N, 'X') END SUBROUTINE YTICKS (N) CALL TICKS (N, 'Y') END SUBROUTINE ZTICKS (N) CALL TICKS (N, 'Z') END SUBROUTINE INTAXS CALL LABDIG (-1, 'XY') END SUBROUTINE XINTAX CALL LABDIG (-1, 'X') END SUBROUTINE YINTAX CALL LABDIG (-1, 'Y') END SUBROUTINE ZINTAX CALL LABDIG (-1, 'Z') END SUBROUTINE XREVTK CALL TICPOS('REVERS','X') END SUBROUTINE YREVTK CALL TICPOS('REVERS','Y') END SUBROUTINE ZREVTK CALL TICPOS('REVERS','Z') END SUBROUTINE XAXCTR CALL LABPOS('CENTER','X') END SUBROUTINE YAXCTR CALL LABPOS('CENTER','Y') END SUBROUTINE ZAXCTR CALL LABPOS('CENTER','Z') END SUBROUTINE XAXEND(COPT) CHARACTER*(*) COPT CALL AXENDS(COPT,'X') END SUBROUTINE YAXEND(COPT) CHARACTER*(*) COPT CALL AXENDS(COPT,'Y') END SUBROUTINE ZAXEND(COPT) CHARACTER*(*) COPT CALL AXENDS(COPT,'Z') END SUBROUTINE XNONUM CALL LABELS('NONE','X') END SUBROUTINE YNONUM CALL LABELS('NONE','Y') END SUBROUTINE ZNONUM CALL LABELS('NONE','Z') END SUBROUTINE XNAME (CNAME, N) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL4/CXAX,CYAX CHARACTER*(*) CNAME,CSTR*132,CXAX*132,CYAX*132 CSTR=CNAME CALL CLEARSTR(CSTR) IF(N.EQ.0) RETURN CALL NAME (CSTR, 'X') IXGRF=1 C Special handling for polar axis systems CXAX=CSTR END SUBROUTINE YNAME (CNAME, N) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL4/CXAX,CYAX CHARACTER*(*) CNAME,CSTR*132,CXAX*132,CYAX*132 CSTR=CNAME CALL CLEARSTR(CSTR) IF(N.EQ.0) RETURN CALL NAME (CSTR, 'Y') IYGRF=1 C Special handling for polar axis systems CYAX=CSTR END SUBROUTINE X3NAME (CNAME, N) CHARACTER*(*) CNAME,CSTR*132 CSTR=CNAME CALL CLEARSTR(CSTR) IF(N.EQ.0) RETURN CALL NAME (CSTR, 'X') END SUBROUTINE Y3NAME (CSTR, N) CHARACTER*(*) CSTR IF(N.EQ.0) RETURN CALL NAME (CSTR, 'Y') END SUBROUTINE Z3NAME (CSTR, N) CHARACTER*(*) CSTR IF(N.EQ.0) RETURN CALL NAME (CSTR, 'Z') END SUBROUTINE SWISSL CALL HELVES END SUBROUTINE SWISSM CALL HELVE END SUBROUTINE SWISSB C Not supported by Dislin CALL HELVE END SUBROUTINE SCMPLX C Not supported by Dislin CALL COMPLX END SUBROUTINE HWSHD C Not supported by Dislin END SUBROUTINE CHRPAT(N) C Only N=16 is supported IF(N.EQ.16) THEN CALL SHDCHA ELSE CALL RESET('SHDCHA') END IF END SUBROUTINE XAXANG(A) IF(A.EQ.90.) THEN CALL LABTYP('VERT','X') ELSE CALL LABTYP('HORI','X') END IF RETURN END SUBROUTINE YAXANG(A) IF(A.EQ.90.) THEN CALL LABTYP('VERT','Y') ELSE CALL LABTYP('HORI','Y') END IF RETURN END SUBROUTINE ZAXANG(A) IF(A.EQ.90.) THEN CALL LABTYP('VERT','Z') ELSE CALL LABTYP('HORI','Z') END IF RETURN END SUBROUTINE NOBRDR COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS IBOR=0 END SUBROUTINE LINES(CSTR,IRAY,N) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL2/CLEG,CLGTIT DIMENSION IRAY(1) CHARACTER*(*) CSTR CHARACTER*60 CLEG(100),CLGTIT*80 IF(NLEG.EQ.0) THEN DO I=1,100 CLEG(I)=' ' END DO END IF IF((N.GE.1).AND.(N.LE.100)) THEN CLEG(N)=CSTR IF(N.GT.NLEG) NLEG=N ELSE WRITE(6,*) 'Not allowed sequence number in LINES!' END IF END SUBROUTINE LEGNAM(CSTR,N) COMMON /CDISSPL2/CLEG,CLGTIT CHARACTER*(*) CSTR CHARACTER*60 CLEG(100),CLGTIT*80 CLGTIT=CSTR END SUBROUTINE LEGEND_DP(IRAY,N,XPOS,YPOS) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL2/CLEG,CLGTIT DIMENSION IRAY(1) CHARACTER*60 CLEG(100),CLGTIT*80,CBUF*6000 CALL LEGINI(CBUF,NLEG,60) CALL LEGTIT(CLGTIT) DO I=1,NLEG CALL LEGLIN(CBUF,CLEG(I),I) END DO NLX=NXLEGN(CBUF) NLY=NYLEGN(CBUF) CALL GETPOS(NXA,NYA) NX=NXA+XPOS*XCM*100+0.5 NY=NYA-YPOS*XCM*100+0.5-NLY CALL LEGPOS(NX,NY) CALL RECFLL(NX,NY,NLX,NLY,0) CALL LEGEND(CBUF,1) END FUNCTION XLEGND(IRAY,N) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL2/CLEG,CLGTIT DIMENSION IRAY(1) CHARACTER*60 CLEG(100),CLGTIT*80,CBUF*6000 CALL LEGINI(CBUF,N,60) CALL LEGTIT(CLGTIT) DO I=1,N CALL LEGLIN(CBUF,CLEG(I),I) END DO XLEGND=NXLEGN(CBUF) XLEGND=XLEGND/(100*XCM) END FUNCTION YLEGND(IRAY,N) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL2/CLEG,CLGTIT DIMENSION IRAY(1) CHARACTER*60 CLEG(100),CLGTIT*80,CBUF*6000 CALL LEGINI(CBUF,N,60) CALL LEGTIT(CLGTIT) DO I=1,N CALL LEGLIN(CBUF,CLEG(I),I) END DO YLEGND=NYLEGN(CBUF) YLEGND=YLEGND/(100*XCM) END SUBROUTINE BLREC(XORG,YORG,WIDE,HIGH,FRM) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CALL GETPOS(NXA,NYA) NX=NXA+XORG*XCM*100+0.5 NY=NYA-YORG*XCM*100+0.5 NW=WIDE*XCM*100+0.5 NH=HIGH*XCM*100+0.5 NY=NY-NH IF((FRM.GT.-1.0).AND.(FRM.LE.1.0)) THEN NFRM=FRM*XCM*100 ELSE NFRM=FRM+0.5 END IF CALL FRAME(NFRM) CALL SHLREC(NX,NY,NW,NH) CALL FRAME(0) END SUBROUTINE BLKEY(ID) CALL SHLIND(ID) END SUBROUTINE BLOFF(ID) CALL SHLRES(ID) END SUBROUTINE BGNMAT(N,M) PARAMETER (N1=100000) COMMON /CDISSPL7/ NXDIM,NYDIM,NNRAY,XXRAY,YYRAY,ZZRAY DIMENSION XXRAY(N1),YYRAY(N1),ZZRAY(N1) NXDIM=N NYDIM=M NNRAY=0 END SUBROUTINE GETMAT_DP(XRAY,YRAY,ZRAY,N,IOPT) PARAMETER (N1=100000) COMMON /CDISSPL7/ NXDIM,NYDIM,NNRAY,XXRAY,YYRAY,ZZRAY DIMENSION XXRAY(N1),YYRAY(N1),ZZRAY(N1), * XRAY(N),YRAY(N),ZRAY(N) C GETMAT may be called multiple times IF((N+NNRAY).GT.N1) THEN WRITE(6,*) 'Not enough memory in GETMAT_DP' WRITE(6,*) 'Please increase N1 in BGNMAT, GETMAT and ENDMAT' ELSE DO I=1,N XXRAY(I+NNRAY)=XRAY(I) YYRAY(I+NNRAY)=YRAY(I) ZZRAY(I+NNRAY)=ZRAY(I) END DO NNRAY=NNRAY+N END IF END SUBROUTINE ENDMAT(ZMAT,IOPT) PARAMETER (N1=100000,N2=200000) COMMON /CDISSPL7/ NXDIM,NYDIM,NNRAY,XXRAY,YYRAY,ZZRAY DIMENSION XXRAY(N1),YYRAY(N1),ZZRAY(N1), * ZMAT(1),IMAT(N2),WMAT(N2) IF((NXDIM*NYDIM).GT.N2) THEN WRITE(6,*) 'Not enough memory in ENDMAT' WRITE(6,*) 'Please increase N2 in ENDMAT' ELSE CALL GETGRF(ZA,ZE,ZOR,ZSTP,'Z') CALL GETMAT(XXRAY,YYRAY,ZZRAY,NNRAY,ZMAT,NXDIM,NYDIM,ZA, * IMAT,WMAT) END IF END SUBROUTINE SURMAT_DP(ZMAT,IXPTS,IXDIM,IYPTS,IYDIM,IOPT) DIMENSION ZMAT(IXDIM,IYDIM) CALL SURMAT(ZMAT,IXDIM,IYDIM,IXPTS,IYPTS) END SUBROUTINE RELPT3(A,B,C,X2INCH,Y2INCH) COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS CALL GETPOS(NXA,NYA) CALL REL3PT(A,B,C,XP,YP) X2INCH=(XP-NXA)/(100*XCM) Y2INCH=(NYA-YP)/(100*XCM) END C === Utilities SUBROUTINE COMMON_INI COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL5/IPOLAR,THETA COMMON /CDISSPL6/ CEND,NEND CHARACTER*40 CEND XCM=2.54 XFRM=0.03*XCM*100 IBOR=1 IHDR=0 IPHYS=0 IPOLAR=0 CEND='$' NEND=1 END SUBROUTINE CLEARSTR(CSTR) COMMON /CDISSPL6/ CEND,NEND CHARACTER*(*) CSTR,CEND*40 IF(NEND.LE.0) RETURN I=INDEX(CSTR,CEND(1:NEND)) IF(I.NE.0) CSTR(I:)=' ' END FUNCTION ICSTRING(X,CSTR) CHARACTER*(*) CSTR,COP1*4,COP2*4,C1(4)*1 EQUIVALENCE (C1,V) V=X DO I=1,4 COP1(I:I)=C1(I) END DO COP2=CSTR CALL UPSTR(COP1) CALL UPSTR(COP2) IF (COP1.EQ.COP2) THEN ICSTRING=1 ELSE ICSTRING=0 END IF END SUBROUTINE DISLIN_INI COMMON /CDISSPL1/XCM,XFRM,XVEC,IBOR,IHDR,NLEG,IXGRF,IYGRF,IPHYS COMMON /CDISSPL2/CLEG,CLGTIT CHARACTER*60 CLEG(100),CLGTIT*80 CALL GETLEV(NLEV) IF(NLEV.NE.0) RETURN CALL DISINI CALL COMPLX CALL HEIGHT(30) C Don't plot '$' in strings CALL MIXALF CALL LABTYP('VERT','Y') CALL GETPAG(NXP,NYP) CALL TICKS(1,'XYZ') CALL HSYMBL(20) CALL FRAME(0) NLEG=0 CLGTIT='Legend' XVEC=1. IXGRF=0 IYGRF=0 END
News
Upgrade 11.5.2
8. April 2024
Support for Python 3.11 and Windows
28. July 2023
Bug fix for the X11 distributions
22. July 2023
Upgrade 11.5.1
25. April 2023
Support for Linux 64-bit on IBM z series
30. October 2022
Support for MingW 64-bit UCRT runtime environment
28. September 2022
Release 11.5
15. March 2022
Release 11.4
15. March 2021
Support for Free Pascal 64-bit on Windows
22. July 2020
Upgrade 11.3.3
28. June 2020
DISLIN Book Version 11 is available
8. March 2017
8. April 2024
Support for Python 3.11 and Windows
28. July 2023
Bug fix for the X11 distributions
22. July 2023
Upgrade 11.5.1
25. April 2023
Support for Linux 64-bit on IBM z series
30. October 2022
Support for MingW 64-bit UCRT runtime environment
28. September 2022
Release 11.5
15. March 2022
Release 11.4
15. March 2021
Support for Free Pascal 64-bit on Windows
22. July 2020
Upgrade 11.3.3
28. June 2020
DISLIN Book Version 11 is available
8. March 2017