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