1*----------------------------------------------------------------------- 2* INTERPOLATION ON TC (GREAT CIRCLE INTERPOLATION) 3*----------------------------------------------------------------------- 4* Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved. 5*----------------------------------------------------------------------- 6 SUBROUTINE SZPIPT(TX0, TY0, TX1, TY1, MODE) 7 8 PARAMETER (EPSIL=1.E-5) 9 10 LOGICAL LINTT, LREQA, LXMOD, LSTD, LCONT, LMAP 11 12 COMMON /SZBLS1/ LLNINT,LGCINT,RDXR,RDYR 13 LOGICAL LLNINT,LGCINT 14 15 EXTERNAL RFPI, LREQA 16 17 SAVE 18 19* MODE=0 : FOR LINE 20* 1 : FOR TONE 21* 2 : FOR ARROW 22 23 24 PI = RFPI() 25 26 IF (MODE.EQ.0) THEN 27 LINTT = LGCINT 28 ELSE IF(MODE.EQ.1) THEN 29 LINTT = LGCINT .AND. 30 + .NOT. (LREQA(TY0,TY1,EPSIL) .AND. LREQA(ABS(TY0),PI/2,EPSIL)) 31 ELSE IF(MODE.EQ.2) THEN 32 CALL STQTRF(LMAP) 33 LINTT = LGCINT .AND. LMAP 34 END IF 35 36 XX0 = TX0 37 YY0 = TY0 38 XX1 = TX1 39 YY1 = TY1 40 NN = 1 41 NEND = 1 42 43 IF (.NOT.LINTT) RETURN 44 45 DX1 = SZXMOD (TX1 - TX0) 46 DY1 = TY1-TY0 47 48 ADX = ABS(DX1) 49 ADY = ABS(DY1) 50 51 IF (ADX.LT.RDXR .AND. ADY.LT.RDXR) RETURN 52 53 LSTD = .FALSE. 54 IF ( LREQA(ABS(TY0), PI/2, EPSIL) ) THEN 55 YLA = SIGN(PI/2, TY0) 56 XLA = TX1 57 LXMOD = ADX .GE. ADY 58 ELSE IF ( LREQA(ABS(TY1), PI/2, EPSIL) ) THEN 59 YLA = SIGN(PI/2, TY1) 60 XLA = TX0 61 LXMOD = ADX .GE. ADY 62 ELSE IF ( LREQA(ADX, 0., EPSIL) ) THEN 63 XLA = TX0 64 LXMOD = .FALSE. 65 ELSE IF ( LREQA(ADX, PI, EPSIL) ) THEN 66 YLA = SIGN(PI/2, TY0+TY1) 67 LXMOD = .TRUE. 68 ELSE 69* / THE FOLLOWING PART IS NOT COMPLETE ! / 70 LSTD = .TRUE. 71 LXMOD = ADX .GE. ADY 72 CALL SZSGCL(TX0, TY0, TX1, TY1) 73 END IF 74 75 IF (LXMOD) THEN 76 NEND = ADX/RDXR + 1 77 DXX = DX1/NEND 78 ELSE 79 NEND = ADY/RDYR + 1 80 DYY = DY1/NEND 81 END IF 82 83 RETURN 84*----------------------------------------------------------------------- 85 ENTRY SZGIPT(TX, TY, LCONT) 86 87 LCONT = NN.LT.NEND 88 IF (LCONT) THEN 89 IF (LXMOD) THEN 90 TX = XX0 + NN*DXX 91 IF (LSTD) THEN 92 CALL SZQGCY(TX, TY) 93 ELSE 94 TY = YLA 95 END IF 96 ELSE 97 TY = YY0 + NN*DYY 98 IF (LSTD) THEN 99 CALL SZQGCX(TY, TX) 100 ELSE 101 TX = XLA 102 END IF 103 END IF 104 ELSE 105 TX = XX1 106 TY = YY1 107 END IF 108 NN = NN+1 109 110 RETURN 111 END 112