C SUBROUTINE GOPKS(LUERR,ISIZE) INTEGER LUERR,ISIZE C Dummy subroutine. C C C ENTRY GPL(N,PX,PY) C INTEGER N C REAL PX(N),PY(N) C C ENTRY GPM(N,PX,PY) C INTEGER N C REAL PX(N),PY(N) C C ENTRY GTX(PX1,PY1,CHARS) C REAL PX1,PY1 C CHARACTER*(*) CHARS C C ENTRY GSCHH(CHH) C REAL CHH C C ENTRY GSCHXP(CHXP) C REAL CHXP C C ENTRY GSCHSP(CHSP) C REAL CHSP C C ENTRY GSCHUP(CHUX,CHUY) C REAL CHUX,CHUY C C ENTRY GSLN(LTYPE) C INTEGER LTYPE C C ENTRY GSLWSC(WIDTH) C REAL WIDTH C C ENTRY GSMKSC(PMSZSF) C REAL PMSZSF C C ENTRY GSMK(MTYPE) C INTEGER MTYPE C C ENTRY GSPLCI(KOLI) C INTEGER KOLI C C ENTRY GSPMCI(KOLI) C INTEGER KOLI C C ENTRY GSTXCI(KOLI) C INTEGER KOLI C C ENTRY GSTXAL(ITXALH,ITXALV) C INTEGER ITXALH,ITXALV C C ENTRY GSTXFP(IFONT,IPREC) C INTEGER IFONT,IPREC C C ENTRY GSTXP(ITXP) C INTEGER ITXP C C INTEGER N REAL PX(N),PY(N),PX1,PY1 CHARACTER*(*) CHARS REAL CHH,CHXP,CHSP,CHUX,CHUY INTEGER LTYPE REAL WIDTH,PMSZSF INTEGER MTYPE,KOLI,ITXALH,ITXALV,IFONT,IPREC,ITXP C C C Version: 5.60 C Date: 2002, May 18 C Coded by Ludek Klimes C C----------------------------------------------------------------------- C C Common block /PLOTC/: INCLUDE 'calcops.inc' C calcops.inc C C----------------------------------------------------------------------- C C Intrinsic functions: INTRINSIC LEN INTEGER LEN C C Temporary storage location: INTEGER I REAL X,Y C C GKS setting: INTEGER LSYMB,MSYMB PARAMETER (LSYMB=-1,MSYMB=20) INTEGER KOLPL,KOLPM,KOLTX,LNTYPE,KPM,KSYMB(LSYMB:MSYMB) SAVE KOLPL,KOLPM,KOLTX,LNTYPE,KPM,KSYMB REAL SIZEPL,SIZEPM,SIZE0,SIZETX,ANGLE SAVE SIZEPL,SIZEPM,SIZE0,SIZETX,ANGLE INTEGER JTXALH,JTXALV SAVE JTXALH,JTXALV C Default GKS types DATA KOLPL/1/,KOLPM/1/,KOLTX/1/,LNTYPE/1/,KPM/1/ C Translation table of GKS marker types to CALCOMP centered symbols DATA KSYMB/5,1,1,3,11,0,4,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14/ C Default GKS dimensions DATA SIZEPL/1.0/,SIZEPM/1.0/,SIZETX/1.0/,ANGLE/0.0/ C Default text alignment DATA JTXALH/0/,JTXALV/0/ SIZE0=2.54/7.2 C Unit polymarker size in CALCOMP is SIZE0. C C....................................................................... C RETURN C ENTRY GPL(N,PX,PY) CALL NEWPEN(KOLPL) CALL PLOT(PX(1),PY(1),3) DO 10 I=2,N CALL PLOT(PX(I),PY(I),2) 10 CONTINUE RETURN C ENTRY GPM(N,PX,PY) CALL NEWPEN(KOLPM) DO 20 I=1,N CALL SYMBOL(PX(I),PY(I),SIZE0*SIZEPM,CHAR(KSYMB(KPM)),0.,-1) 20 CONTINUE RETURN C ENTRY GTX(PX1,PY1,CHARS) CALL NEWPEN(KOLTX) I=LEN(CHARS) IF (JTXALH.EQ.0) THEN X=PX1 ELSE X=PX1-FLOAT((JTXALH-1)*I)*SIZETX*0.5 ENDIF IF (JTXALV.EQ.0) THEN Y=PY1 ELSE Y=PY1-1.2*SIZETX+FLOAT(JTXALV-1)*1.4*SIZETX*0.25 ENDIF CALL SYMBOL(X,Y,SIZETX,CHARS,ANGLE,I) RETURN C ENTRY GSCHH(CHH) SIZETX=CHH*2.54/7.2 RETURN C ENTRY GSCHXP(CHXP) C Not applied. Might be coded using 'stringwidth' and 'ashow'. RETURN C ENTRY GSCHSP(CHSP) C Not applied. Might be coded using 'ashow'. RETURN C ENTRY GSCHUP(CHUX,CHUY) ANGLE=ATAN2(-CHUX,CHUY)*180./3.141593 RETURN C ENTRY GSLN(LTYPE) IF(LTYPE.NE.LNTYPE) THEN LNTYPE=LTYPE IF(LNTYPE.EQ.-1) THEN WRITE(LUCFG,'(A)') 'S [3 3 1 3 1 3] 0 setdash' ELSE IF(LNTYPE.EQ.0) THEN WRITE(LUCFG,'(A)') 'S [] 0 setdash' ELSE IF(LNTYPE.EQ.1) THEN WRITE(LUCFG,'(A)') 'S [] 0 setdash' ELSE IF(LNTYPE.EQ.2) THEN WRITE(LUCFG,'(A)') 'S [3 3] 0 setdash' ELSE IF(LNTYPE.EQ.3) THEN WRITE(LUCFG,'(A)') 'S [1 3] 0 setdash' ELSE IF(LNTYPE.EQ.4) THEN WRITE(LUCFG,'(A)') 'S [3 3 1 3] 0 setdash' ELSE C GKSPS-01 CALL ERROR('GKSPS-01: Subroutine GSLN: Wrong line type LTYPE') END IF END IF RETURN C ENTRY GSLWSC(WIDTH) IF(WIDTH.NE.SIZEPL) THEN SIZEPL=WIDTH WRITE(LUCFG,'(A,F6.2,A)') 'S ',SIZEPL,' setlinewidth' END IF RETURN C ENTRY GSMKSC(PMSZSF) SIZEPM=PMSZSF RETURN C ENTRY GSMK(MTYPE) C Centred symbols: IF(MTYPE.LT.LSYMB.OR.MTYPE.GT.MSYMB) THEN C GKSPS-02 CALL ERROR('GKSPS-02: Subroutine GSMK: Wrong marker type MTYPE') END IF KPM=MTYPE RETURN C ENTRY GSPLCI(KOLI) KOLPL=KOLI RETURN C ENTRY GSPMCI(KOLI) KOLPM=KOLI RETURN C ENTRY GSTXCI(KOLI) KOLTX=KOLI RETURN C ENTRY GSTXAL(ITXALH,ITXALV) IF((ITXALH.LT.0.OR.ITXALH.GT.3).OR. * ((ITXALV.NE.0).AND.(ITXALV.NE.1).AND.(ITXALV.NE.3).AND. * (ITXALV.NE.5))) THEN C GKSPS-04 CALL ERROR('GKSPS-04: Subroutine GSTXAL: Wrong text alignment') END IF JTXALH=ITXALH JTXALV=ITXALV RETURN C ENTRY GSTXFP(IFONT,IPREC) C Not applied. RETURN C ENTRY GSTXP(ITXP) C Not applied. * IF(ITXP.NE.0) THEN C GKSPS-03 * CALL ERROR('GKSPS-03: Subroutine GSTXP: Wrong text type ITXP') * END IF RETURN C END C C======================================================================= C