1*-----------------------------------------------------------------------
2*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
3*-----------------------------------------------------------------------
4      SUBROUTINE UVBRAZ(N,UPX,UPY1,UPY2,ITPAT1,ITPAT2,RSIZE)
5
6      REAL      UPX(*),UPY1(*),UPY2(*)
7
8      LOGICAL   LMISS, LXUNI, LYC1, LYC2
9      CHARACTER COBJ*80
10
11      COMMON    /SZBTN2/ IRMODE, IRMODR
12      COMMON    /SZBTN3/ LCLIP
13      LOGICAL   LCLIP
14
15
16      IF (N.LT.1) THEN
17        CALL MSGDMP('E','UVBRAZ','NUMBER OF POINTS IS LESS THAN 1.')
18      END IF
19      IF (ITPAT1.EQ.0 .OR. ITPAT2.EQ.0) THEN
20        CALL MSGDMP('M','UVBRAZ','TONE PAT. INDEX IS 0 / DO NOTHING.')
21        RETURN
22      END IF
23      IF (ITPAT1.LT.0 .OR. ITPAT2.LT.0) THEN
24        CALL MSGDMP('E','UVBRAZ','TONE PAT. INDEX IS LESS THAN 0.')
25      END IF
26      IF (RSIZE.EQ.0) THEN
27        CALL MSGDMP('M','UVBRAZ','BAR SIZE IS 0 / DO NOTHING.')
28        RETURN
29      END IF
30      IF (RSIZE.LT.0) THEN
31        CALL MSGDMP('E','UVBRAZ','BAR SIZE IS LESS THAN ZERO.')
32      END IF
33
34      CALL SGLGET('LCLIP' , LCLIP)
35      CALL GLRGET('RUNDEF', RUNDEF)
36      CALL GLRGET('RMISS' , RMISS)
37      CALL GLLGET('LMISS' , LMISS)
38
39      CALL STFPR2(0., 0., RX0, RY0)
40      CALL STFPR2(0., 1., RX1, RY1)
41      CALL STFPR2(1., 0., RX2, RY2)
42
43      ROT = (RX2-RX0)*(RY1-RY0) - (RY2-RY0)*(RX1-RX0)
44
45      IRMODE = 0
46      IF (ROT.GT.0) THEN
47        IRMODR = IRMODE
48      ELSE
49        IRMODR = MOD(IRMODE+1, 2)
50      END IF
51
52      WRITE(COBJ,'(2I8,F8.5)') ITPAT1, ITPAT2, RSIZE
53      CALL CDBLK(COBJ)
54      CALL SWOOPN('UVBRAZ',COBJ)
55
56      LXUNI = UPX(1).EQ.RUNDEF
57      LYC1  = UPY1(1).EQ.RUNDEF
58      LYC2  = UPY2(1).EQ.RUNDEF
59
60      IF (LXUNI) THEN
61        CALL UUQIDV(UXMIN, UXMAX)
62        IF (UXMIN.EQ.RUNDEF) CALL SGRGET('UXMIN', UXMIN)
63        IF (UXMAX.EQ.RUNDEF) CALL SGRGET('UXMAX', UXMAX)
64        DX = (UXMAX-UXMIN)/(N-1)
65      END IF
66
67      IF (LYC1 .OR. LYC2) THEN
68        CALL UURGET('UREF', UREF)
69      END IF
70
71      DO 20 I=1,N
72        IF (LXUNI) THEN
73          UXX = UXMIN + DX*(I-1)
74        ELSE
75          UXX = UPX(I)
76        END IF
77
78        IF (LYC1) THEN
79          UYY1 = UREF
80        ELSE
81          UYY1 = UPY1(I)
82        END IF
83
84        IF (LYC2) THEN
85          UYY2 = UREF
86        ELSE
87          UYY2 = UPY2(I)
88        END IF
89
90        IF (.NOT.
91     #    ((UXX.EQ.RMISS .OR. UYY1.EQ.RMISS .OR. UYY2.EQ.RMISS)
92     #     .AND. LMISS)) THEN
93
94          CALL STFTRF(UXX, UYY1, VXX, VY1)
95          CALL STFTRF(UXX, UYY2, VXX, VY2)
96
97          IF (UYY2 .GT. UYY1) THEN
98            CALL SZSTNI(ITPAT1)
99          ELSE
100            CALL SZSTNI(ITPAT2)
101          END IF
102
103          IF (VY1 .GT. VY2) THEN
104            VYY = VY1
105            VY1 = VY2
106            VY2 = VYY
107          END IF
108
109          CALL SZOPTV
110          CALL SZSTTV(VXX-RSIZE/2., VY1)
111          CALL SZSTTV(VXX+RSIZE/2., VY1)
112          CALL SZSTTV(VXX+RSIZE/2., VY2)
113          CALL SZSTTV(VXX-RSIZE/2., VY2)
114          CALL SZSTTV(VXX-RSIZE/2., VY1)
115          CALL SZCLTV
116        END IF
117   20 CONTINUE
118
119      CALL SWOCLS('UVBRAZ')
120
121      END
122