1*----------------------------------------------------------------------- 2* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. 3*----------------------------------------------------------------------- 4 SUBROUTINE UHBRFZ(N,UPX1,UPX2,UPY,ITYPE,INDEX,RSIZE) 5 6 REAL UPX1(*),UPX2(*),UPY(*) 7 8 LOGICAL LMISS, LYUNI, LXC1, LXC2 9 CHARACTER COBJ*80 10 11 COMMON /SZBLS2/ LCLIP 12 LOGICAL LCLIP 13 14 15 IF (N.LT.1) THEN 16 CALL MSGDMP('E','UHBRFZ','NUMBER OF POINTS IS LESS THAN 1.') 17 END IF 18 IF (ITYPE.EQ.0) THEN 19 CALL MSGDMP('M','UHBRFZ','LINE TYPE IS 0 / DO NOTHING.') 20 RETURN 21 END IF 22 IF (INDEX.EQ.0) THEN 23 CALL MSGDMP('M','UHBRFZ','LINE INDEX IS 0 / DO NOTHING.') 24 RETURN 25 END IF 26 IF (INDEX.LT.0) THEN 27 CALL MSGDMP('E','UHBRFZ','LINE INDEX IS LESS THAN 0.') 28 END IF 29 IF (RSIZE.EQ.0) THEN 30 CALL MSGDMP('M','UHBRFZ','MARKER SIZE IS 0 / DO NOTHING.') 31 RETURN 32 END IF 33 IF (RSIZE.LT.0) THEN 34 CALL MSGDMP('E','UHBRFZ','ERROR MARKER SIZE IS LESS THAN ZERO.') 35 END IF 36 37 CALL SGLGET('LCLIP' , LCLIP ) 38 CALL GLRGET('RUNDEF', RUNDEF) 39 CALL GLRGET('RMISS' , RMISS) 40 CALL GLLGET('LMISS' , LMISS) 41 42 WRITE(COBJ,'(2I8,F8.5)') ITYPE, INDEX, RSIZE 43 CALL CDBLK(COBJ) 44 CALL SWOOPN('UHBRFZ',COBJ) 45 46 CALL SZSIDX(INDEX) 47 CALL SZSTYP(ITYPE) 48 49 LYUNI = UPY(1).EQ.RUNDEF 50 LXC1 = UPX1(1).EQ.RUNDEF 51 LXC2 = UPX2(1).EQ.RUNDEF 52 53 IF (LYUNI) THEN 54 CALL UUQIDV(UYMIN, UYMAX) 55 IF (UYMIN.EQ.RUNDEF) CALL SGRGET('UYMIN', UYMIN) 56 IF (UYMAX.EQ.RUNDEF) CALL SGRGET('UYMAX', UYMAX) 57 DY = (UYMAX-UYMIN)/(N-1) 58 END IF 59 60 IF (LXC1 .OR. LXC2) THEN 61 CALL UURGET('UREF', UREF) 62 END IF 63 64 DO 20 I=1,N 65 IF (LYUNI) THEN 66 UYY = UYMIN + DY*(I-1) 67 ELSE 68 UYY = UPY(I) 69 END IF 70 71 IF (LXC1) THEN 72 UXX1 = UREF 73 ELSE 74 UXX1 = UPX1(I) 75 END IF 76 77 IF (LXC2) THEN 78 UXX2 = UREF 79 ELSE 80 UXX2 = UPX2(I) 81 END IF 82 83 IF (.NOT. 84 # ((UYY.EQ.RMISS .OR. UXX1.EQ.RMISS .OR. UXX2.EQ.RMISS) 85 # .AND. LMISS)) THEN 86 87 CALL STFTRF(UXX1, UYY, VX1, VYY) 88 CALL STFTRF(UXX2, UYY, VX2, VYY) 89 90 CALL SZOPLV 91 CALL SZMVLV(VX2, VYY-RSIZE/2.) 92 CALL SZPLLV(VX2, VYY+RSIZE/2.) 93 CALL SZPLLV(VX1, VYY+RSIZE/2.) 94 CALL SZPLLV(VX1, VYY-RSIZE/2.) 95 CALL SZPLLV(VX2, VYY-RSIZE/2.) 96 CALL SZCLLV 97 END IF 98 20 CONTINUE 99 100 CALL SWOCLS('UHBRFZ') 101 102 END 103