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