SUBROUTINE XTPNUP(X,Y) 21,2 C position pen at point (x,y) defined in maths space COMMON /XPEN11/ XPEN,YPEN,FLEN,BLEN,NPD,XMPEN,YMPEN CALL PPENUP( X,Y) XPEN= X YPEN= Y RETURN END SUBROUTINE XTPNDN (X,Y) 22,2 C Join point (x,y) defined in maths space with current line thickness COMMON /XPEN11/ XPEN,YPEN,FLEN,BLEN,NPD,XMPEN,YMPEN COMMON /XLPN13/ HF1,HB1,HF2,HB2,LFULL,lfull0,LTHICK,DTHICK XP1=XPEN YP1=YPEN XP2=X YP2=Y c IF( LTHICK.EQ.1) THEN CALL PPENDN( XP2, YP2) c ELSE c DX=XP2-XP1 c DY=YP2-YP1 c IF( ABS(DX).LT.1.0E-6) THEN c DPX=DTHICK c DPY=0.0 c ELSE c AK=DY/DX c A=SQRT(1.0+AK*AK) c DPX=DTHICK*AK/A c DPY=DTHICK/A c ENDIF c CALL PPENDN( XP2,YP2) c CALL PPENUP( XP2+DPX, YP2-DPY) c CALL PPENDN( XP1+DPX, YP1-DPY) c CALL PPENUP( XP1-DPX, YP1+DPY) c CALL PPENDN( XP2-DPX, YP2+DPY) c CALL PPENUP( XP2,YP2) c ENDIF XPEN=XP2 YPEN=YP2 RETURN END SUBROUTINE XBROKN(IF1,IB1,IF2,IB2) 23,10 C Set line atribute as broken line segments. C IF1 IF2 set length of line segments plotted in unit of 0.001 C that of the total vertical ND-space range. C IB1 IB2 set length of blanks between line segments in unit of 0.001 C that of the total vertical ND-space range. COMMON /XLPN13/ HF1,HB1,HF2,HB2,LFULL,lfull0,LTHICK,DTHICK H=0.001 HF1=H*IF1 HB1=H*IB1 HF2=H*IF2 HB2=H*IB2 lfull=0 ! Is the current line setting 'full'? lfull0=0 ! To use own dash line plotting algorithm? Used in XPENDN. ! Set it to lfull if want to use own dash line plotting algorithm ! and remove call to gsln c call gsln(2) RETURN ENTRY XBROKN0 RETURN ENTRY XDASH C Set line atribute as dash line. H=0.001 HF1=H*10 HB1=H*5 HF2=H*10 HB2=H*5 LFULL=0 LFULL0=0 c call gsln(2) RETURN ENTRY XDOT C Set line atribute as dash line. H=0.001 HF1=0.0 HB1=H*6 HF2=0.0 HB2=H*6 LFULL=0 LFULL0=0 c call gsln(3) RETURN ENTRY XQBRKN(KF1,KB1,KF2,KB2) H=0.001 KF1=HF1/H KB1=HB1/H KF2=HF2/H KB2=HB2/H RETURN ENTRY XFULL C Set line atribute as solid (full) line. LFULL =1 LFULL0=1 c call gsln(1) RETURN ENTRY XQFULL(KFULL) KFULL=LFULL RETURN END SUBROUTINE XTHICK(ITHICK) 45,2 COMMON /XLPN13/ HF1,HB1,HF2,HB2,LFULL,lfull0,LTHICK, DTHICK integer alnmag,blnmag C Set thickness of lines. ITHICK=1 or 2. c LTHICK=min(ITHICK,2) LTHICK=ITHICK call plotif(0.0, 0.0, 2) call gslwsc(1.0+0.5*(ithick-1)) RETURN entry xlnmag(alnmag) c c Magnify the line thickness by a factor of nlnmag. c return entry xqlnmag(blnmag) return entry xqthik(kthick) C Enquiry routine for line thickness. kthick=lthick return END SUBROUTINE XCHARL(XO,YO,STRING) 45,4 CHARACTER*(*) STRING call xqthik(lthick) call plotif(0.0, 0.0, 2) call gslwsc(1.0) call gqln(ierr,lstyle) call gsln(1) CALL XLETER(XO,YO,STRING, -1) call plotif(0.0, 0.0, 2) call gslwsc(1.0+0.5*(lthick-1)) if (ierr.eq.0) call gsln(lstyle) RETURN END SUBROUTINE XCHARR(XO,YO,STRING) 31,4 CHARACTER*(*) STRING call xqthik(lthick) call plotif(0.0, 0.0, 2) call gslwsc(1.0) call gqln(ierr,lstyle) call gsln(1) CALL XLETER(XO,YO,STRING, 1) call plotif(0.0, 0.0, 2) call gslwsc(1.0+0.5*(lthick-1)) if (ierr.eq.0) call gsln(lstyle) RETURN END SUBROUTINE XCHARC(XO,YO,STRING) 119,4 CHARACTER*(*) STRING call xqthik(lthick) call plotif(0.0, 0.0, 2) call gslwsc(1.0) call gqln(ierr,lstyle) call gsln(1) CALL XLETER(XO,YO,STRING, 0) call plotif(0.0, 0.0, 2) call gslwsc(1.0+0.5*(lthick-1)) if (ierr.eq.0) call gsln(lstyle) RETURN END SUBROUTINE XCHMAG(H) 40 COMMON /XCHA20/ HCTR,SCTR,CRATIO, KFONT,NUNDLN COMMON /XFTR06/ XFACTR,YFACTR HCTR=ABS(H) SCTR=HCTR/YFACTR RETURN ENTRY XQCHMG(HH ) HH=HCTR RETURN ENTRY XCHSIZ( HC ) SCTR= abs(HC) HCTR= SCTR*YFACTR RETURN ENTRY XQCHSZ( CS1 ) CS1= HCTR/YFACTR RETURN END SUBROUTINE XCFONT( IFONT ) 11,5 COMMON /XCHA20/ HCTR,SCTR,CRATIO, KFONT,NUNDLN COMMON /XCHR31/ CHDATA COMMON /XCHR32/ ICDATA CHARACTER CHDATA(127)*300 common /xoutch/ nch INTEGER ICDATA (0:150 , 32:127) KF=KFONT KFONT=IFONT IF ((KFONT .LT. 1) .OR. (KFONT .GT. 4)) THEN WRITE(NCH,'(1x,a,i2,a,/1x,a)')'Font number ',ifont, : ' not available with the NCAR graphics version of ZXPLOT. ', : 'Default font number 2 will be used.' kfont = 2 ENDIF IF( KF.EQ. KFONT) RETURN GOTO ( 501, 502, 503, 504 ) KFONT 501 CALL XCSETB(CHDATA) GOTO 505 502 CALL XCSETC(CHDATA) GOTO 505 503 CALL XCSETA(CHDATA) GOTO 505 504 CALL XCSETD(CHDATA) 505 CONTINUE RETURN ENTRY XQCFNT ( NFONT ) NFONT=KFONT RETURN END SUBROUTINE XARROW(U,V,X0,Y0, XLENG,UUNIT) 3,16 C Plot vector (U,V) at (X0,Y0). Unit X-component UUNIT is plotted with C length XLENG in mapped maths coordinate. Length of vector in C Y-direction is scaled according to the mapping. c PARAMETER(PI=3.14159,ANGLE1=(15./180+1)*PI,ANGLE2=(-15./180+1)*PI) c PARAMETER(SINA1=-.25882,COSA1=-.96593,SINA2=-SINA1,COSA2=COSA1) parameter(pi=3.14159,angle1=(20./180+1)*pi,angle2=(-20./180+1)*pi) PARAMETER(SINA1=-.342,COSA1=-.93969,SINA2=-SINA1,COSA2=COSA1) COMMON /XART36/ KARTYP,KVMODE,VSC C IF( ABS(U)+ABS(V).EQ.0.0) RETURN ALPHA= XLENG/UUNIT *0.5 XC0=0.0 YC0=0.0 XPLENG =XPNTSD( XC0,YC0,XC0+XLENG,YC0 ) DX=U*ALPHA DY=V*ALPHA C TO PLOT ARROW IN ABSOLUTE SPACE (FOR CONFORMALITY) PX0=X0 PY0=Y0 PX1=X0+DX PY1=Y0+DY CALL XTRANS(PX0,PY0) CALL XTRANS(PX1,PY1) DPX=PX1-PX0 DPY=PY1-PY0 DPXY=SQRT( DPX*DPX+DPY*DPY) IF(DPXY.GT.1.0E-30) THEN SINTA=DPY/DPXY COSTA=DPX/DPXY ARROW=0.40* MIN(XPLENG,2*DPXY) IF( KARTYP.EQ.2 ) ARROW=0.40* DPXY*2 DX1=ARROW*(COSTA*COSA1-SINTA*SINA1) DY1=ARROW*(SINTA*COSA1+COSTA*SINA1) DX2=ARROW*(COSTA*COSA2-SINTA*SINA2) DY2=ARROW*(SINTA*COSA2+COSTA*SINA2) CALL XPENUP(X0-DX, Y0-DY) CALL XPENDN(X0+DX, Y0+DY) CALL XTPNUP(PX1 , PY1 ) CALL XTPNDN(PX1+DX1, PY1+DY1) CALL XTPNUP(PX1 , PY1 ) CALL XTPNDN(PX1+DX2, PY1+DY2) ENDIF RETURN ENTRY XARTYP(KTYPE) KARTYP=KTYPE RETURN END SUBROUTINE XVECTK_old(X0,Y0, XLENG, UUNIT, KEY ),36 C Plot unit vectors starting at (X0,Y0) C KEY=-1, 0, 1, 2, for none,in both X and Y-direction,X only, Y only PARAMETER(PI=3.14159,ANGLE1=(10./180+1)*PI,ANGLE2=(-10./180+1)*PI) PARAMETER(SINA1=-.17365,COSA1=-.98481,SINA2=-SINA1,COSA2=COSA1) CHARACTER CH*20 CALL XQRANG(XRG,YRG) CALL XQMAP(XL,XR,YB,YT) XSCALE=XR-XL YSCALE=YT-YB YF=0.4+( MIN(XRG,YRG)-0.4)*0.5 CTRSIZ=3.0*YF*0.01 CALL XCHMAG(CTRSIZ) VUNIT=UUNIT DX=XLENG DY=XLENG PXO=X0 PYO=Y0 PX1=X0+DX PY1=Y0 PX2=X0 PY2=Y0+DY CALL XTRANS(PXO,PYO) CALL XTRANS(PX1,PY1) CALL XTRANS(PX2,PY2) DPH=SQRT( (PX1-PXO)**2+(PY1-PYO)**2 ) DPV=SQRT( (PX2-PXO)**2+(PY2-PYO)**2 ) 5 IF( DPV.GT.1.5*DPH ) THEN DPV=DPV*0.5 DY=DY*0.5 VUNIT=VUNIT*0.5 GOTO 5 ENDIF 6 IF( DPV.LT.0.75*DPH ) THEN DPV=DPV*2 DY=DY*2 VUNIT=VUNIT*2 GOTO 6 ENDIF PX2=X0 PY2=Y0+DY CALL XTRANS(PX2,PY2) IF( KEY.EQ.0.OR.KEY.EQ.1) THEN ARROW=0.30*DPH COSTA=(PX1-PXO)/DPH SINTA=(PY1-PYO)/DPH DX1=ARROW*(COSTA*COSA1-SINTA*SINA1) DY1=ARROW*(SINTA*COSA1+COSTA*SINA1) DX2=ARROW*(COSTA*COSA2-SINTA*SINA2) DY2=ARROW*(SINTA*COSA2+COSTA*SINA2) CALL XTPNUP(PXO,PYO) CALL XTPNDN(PX1 , PY1) C CALL XTPNUP(PX1 , PY1 ) CALL XTPNDN(PX1+DX1, PY1+DY1) CALL XTPNUP(PX1 , PY1 ) CALL XTPNDN(PX1+DX2, PY1+DY2) WRITE(CH,'(F6.1,'' m/s'')') UUNIT LCH=10 CALL XCHLJ (CH,LCH) CALL XCHARL(X0+DX +0.01*XSCALE,Y0,CH(1:LCH) ) ENDIF IF(KEY.EQ.0.OR.KEY.EQ.2) THEN ARROW=0.20*DPH COSTA=(PX2-PXO)/DPV SINTA=(PY2-PYO)/DPV DX1=ARROW*(COSTA*COSA1-SINTA*SINA1) DY1=ARROW*(SINTA*COSA1+COSTA*SINA1) DX2=ARROW*(COSTA*COSA2-SINTA*SINA2) DY2=ARROW*(SINTA*COSA2+COSTA*SINA2) CALL XTPNUP(PXO,PYO) CALL XTPNDN(PX2 , PY2) C CALL XTPNUP(PX2 , PY2 ) CALL XTPNDN(PX2+DX1, PY2+DY1) CALL XTPNUP(PX2 , PY2 ) CALL XTPNDN(PX2+DX2, PY2+DY2) CALL XQOBAG( XANG, YANG ) CALL XQCHOR( ASYM ) CALL XCHORI(90.0+ YANG- XANG) WRITE(CH,'(F6.1,'' m/s'')') VUNIT LCH=10 CALL XCHLJ (CH,LCH) CALL XCHARL(X0-.02*XSCALE ,Y0 ,CH(1:LCH) ) CALL XCHORI( ASYM ) ENDIF RETURN END