1*----------------------------------------------------------------------- 2* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. 3*----------------------------------------------------------------------- 4 SUBROUTINE UVERBZ(N,UPX,UPY1,UPY2,ITYPE,INDEX,RSIZE) 5 6 REAL UPX(*),UPY1(*),UPY2(*) 7 8 LOGICAL LMISS, LXUNI 9 CHARACTER COBJ*80 10 11 COMMON /SZBLS2/ LCLIP 12 COMMON /SZBTX3/ LCLIPT 13 LOGICAL LCLIP, LCLIPT 14 15 16 IF (N.LT.1) THEN 17 CALL MSGDMP('E','UVERBZ','NUMBER OF POINTS IS LESS THAN 1.') 18 END IF 19 IF (ITYPE.EQ.0) THEN 20 CALL MSGDMP('M','UVERBZ','LINE TYPE IS 0 / DO NOTHING.') 21 RETURN 22 END IF 23 IF (INDEX.EQ.0) THEN 24 CALL MSGDMP('M','UVERBZ','LINE INDEX IS 0 / DO NOTHING.') 25 RETURN 26 END IF 27 IF (INDEX.LT.0) THEN 28 CALL MSGDMP('E','UVERBZ','LINE INDEX IS LESS THAN 0.') 29 END IF 30 IF (RSIZE.EQ.0) THEN 31 CALL MSGDMP('M','UVERBZ','MARKER SIZE IS 0 / DO NOTHING.') 32 RETURN 33 END IF 34 IF (RSIZE.LT.0) THEN 35 CALL MSGDMP('E','UVERBZ','MARKER SIZE IS LESS THAN ZERO.') 36 END IF 37 38 CALL SGLGET('LCLIP' , LCLIP ) 39 LCLIPT = LCLIP 40 CALL GLRGET('RUNDEF', RUNDEF) 41 CALL GLRGET('RMISS' , RMISS) 42 CALL GLLGET('LMISS' , LMISS) 43 44 IF (UPY1(1).EQ.RUNDEF .OR. UPY2(1).EQ.RUNDEF) THEN 45 CALL MSGDMP('E', 'UVERBZ', 46 # 'RUNDEF CAN NOT BE UESED FOR UPY1 OR UPY2') 47 END IF 48 49 WRITE(COBJ,'(2I8,F8.5)') ITYPE, INDEX, RSIZE 50 CALL CDBLK(COBJ) 51 CALL SWOOPN('UVERBZ',COBJ) 52 53 CALL SZSIDX(INDEX) 54 CALL SZSTYP(ITYPE) 55 56 LXUNI = UPX(1).EQ.RUNDEF 57 58 IF (LXUNI) THEN 59 CALL UUQIDV(UXMIN, UXMAX) 60 IF (UXMIN.EQ.RUNDEF) CALL SGRGET('UXMIN', UXMIN) 61 IF (UXMAX.EQ.RUNDEF) CALL SGRGET('UXMAX', UXMAX) 62 DX = (UXMAX-UXMIN)/(N-1) 63 END IF 64 65 DO 20 I=1,N 66 IF (LXUNI) THEN 67 UXX = UXMIN + DX*(I-1) 68 ELSE 69 UXX = UPX(I) 70 END IF 71 72 IF (.NOT. 73 # ((UXX.EQ.RMISS .OR. UPY1(I).EQ.RMISS .OR. UPY2(I).EQ.RMISS) 74 # .AND. LMISS)) THEN 75 76 CALL STFTRF(UXX, UPY1(I), VXX, VY1) 77 CALL STFTRF(UXX, UPY2(I), VXX, VY2) 78 79 CALL SZOPLV 80 CALL SZMVLV(VXX, VY1) 81 CALL SZPLLV(VXX, VY2) 82 CALL SZCLLV 83 84 CALL SZOPSV 85 CALL SZMVSV(VXX-RSIZE/2., VY2) 86 CALL SZPLSV(VXX+RSIZE/2., VY2) 87 CALL SZMVSV(VXX-RSIZE/2., VY1) 88 CALL SZPLSV(VXX+RSIZE/2., VY1) 89 CALL SZCLSV 90 END IF 91 20 CONTINUE 92 93 CALL SWOCLS('UVERBZ') 94 95 END 96