1 SUBROUTINE SDDVC(X, ABETA, SWEPTE, SWEPR, TAPR, TAPER, DHB, ICASE) 2C 3C*** FIND DOWNWARD DISPLACEMENT OF VORTEX CORE 4C*** FIGURE 4.4.1-74 5C 6 DIMENSION X(2), DHB(2), TAPER(4), DDVC(4) 7 DIMENSION ROUTID(2), QA(3), QB(3), QC(3), QD(3) 8 DIMENSION LGH(2), VAR(2), CC(6) 9 DIMENSION XA(7), YA(10), XB(12), YB1(32), YB2(32) 10 DIMENSION XC(8), YC1(15), YC2(15), XD(9), YD(20) 11 LOGICAL FLAG 12C 13 DATA ROUTID / 4HSDDV, 4HC / 14 DATA QA / 4H4.4., 4H1-74, 4HA / 15 DATA QB / 4H4.4., 4H1-74, 4HB / 16 DATA QC / 4H4.4., 4H1-74, 4HC / 17 DATA QD / 4H4.4., 4H1-74, 4HD / 18C 19C*** FIGURE 4.4.1-74A 20C 21 DATA XA / 22 1 .5, 1.5, 3.0, 5.0, 6.0, 23 2 8., 12. / 24 DATA YA / 25 1 .5, .81, 1.50, 2.47, 2.93, 26 2 .3, .61, 1.21, 2.00, 2.38 / 27C 28C*** FIGURE 4.4.1-74B 29C 30 DATA XB / 31 1 .5, .75, 1.50, 2.00, 2.50, 3.00, 3.50, 6.00, 32 2 2., 4., 8., 12. / 33 DATA YB1 / 34 1 1.25, 1.60, 1.60, 2.07, 2.96, 3.81, 4.67, 9.03, 35 2 .700, .750, 1.12, 1.49, 1.94, 2.51, 2.51, 2.51, 36 3 .410, .460, .700, .900, 1.11, 1.32, 1.52, 2.58, 37 4 .310, .330, .500, .630, .800, .960, 1.11, 1.89 / 38 DATA YB2 / 39 1 1.10, 1.50, 1.50, 1.96, 2.75, 3.56, 4.38, 8.33, 40 2 .600, .670, 1.00, 1.30, 1.63, 2.08, 2.52, 2.52, 41 3 .310, .340, .540, .700, .860, 1.02, 1.18, 1.94, 42 4 .220, .221, .320, .450, .580, .700, .810, 1.40 / 43C 44C*** FIGURE 4.4.1-74C 45C 46 DATA XC / 47 1 .5, 1.0, 2.0, 3.5, 6.0, 48 2 3.2, 6.4, 12.8 / 49 DATA YC1 / 50 1 .910, 1.03, 1.46, 2.41, 4.16, 51 2 .500, .600, .940, 1.58, 2.66, 52 3 .250, .320, .620, 1.08, 1.81 / 53 DATA YC2 / 54 1 .910, 1.03, 1.40, 2.31, 3.99, 55 2 .500, .560, .880, 1.46, 2.41, 56 3 .250, .320, .570, .960, 1.59 / 57C 58C*** FIGURE 4.4.1-74D 59C 60 DATA XD / 61 1 1.0, 1.5, 2.0, 3.75, 6.0, 62 2 2., 4., 8., 12. / 63 DATA YD / 64 1 1.00, 1.41, 1.88, 4.00, 6.77, 65 2 .510, .600, .710, 1.37, 2.20, 66 3 .290, .300, .370, .660, 1.02, 67 4 .130, .120, .200, .400, .690 / 68C 69 DO 1020 I=1,2 70C 71C*** FIGURE 4.4.1-74A -- TAPER = 0.0 72C 73 VAR(1) = X(I) 74 VAR(2) = ABETA 75 LGH(1) = 5 76 LGH(2) = 2 77 CALL INTERX(2, XA, VAR, LGH, YA, DDVC(1), 5, 10, 78 1 1, 1, 0, 0, 1, 1, 0, 0, QA, 3, ROUTID) 79C 80C*** FIGURE 4.4.1-74B -- TAPER = 0.25, 0.50 -- SWEEP(C/2) = 0.0 81C 82 FLAG = (ICASE .EQ. 2) .OR. (ICASE .EQ. 3) 83 IF(.NOT. FLAG) GO TO 1000 84 LGH(1) = 8 85 LGH(2) = 4 86 CALL INTERX(2, XB, VAR, LGH, YB1, DDVC(2), 8, 32, 87 1 2, 2, 0, 0, 2, 2, 0, 0, QB, 3, ROUTID) 88 CALL INTERX(2, XB, VAR, LGH, YB2, DDVC(3), 8, 32, 89 1 2, 2, 0, 0, 2, 2, 0, 0, QB, 3, ROUTID) 90 IF(ICASE .EQ. 3) DDVC2 = DDVC(2) 91 IF(ICASE .EQ. 3) DDVC3 = DDVC(3) 92 1000 CONTINUE 93C 94C*** FIGURE 4.4.1-74C -- TAPER = 0.25, 0.50 -- SWEEP(TE) = 0.0 95C 96 FLAG = ICASE .EQ. 2 97 IF(FLAG) GO TO 1010 98 LGH(1) = 5 99 LGH(2) = 3 100 CALL INTERX(2, XC, VAR, LGH, YC1, DDVC(2), 5, 15, 101 1 2, 2, 0, 0, 1, 2, 0, 0, QC, 3, ROUTID) 102 CALL INTERX(2, XC, VAR, LGH, YC2, DDVC(3), 5, 15, 103 1 2, 2, 0, 0, 1, 2, 0, 0, QC, 3, ROUTID) 104 IF(ICASE .EQ. 3) DDVC(2) = DDVC2+SWEPTE*(DDVC(2)-DDVC2)/SWEPR 105 IF(ICASE .EQ. 3) DDVC(3) = DDVC3+SWEPTE*(DDVC(3)-DDVC3)/SWEPR 106 1010 CONTINUE 107C 108C*** FIGURE 4.4.1-74D -- TAPER = 1.0 109C 110 LGH(1) = 5 111 LGH(2) = 4 112 CALL INTERX(2, XD, VAR, LGH, YD, DDVC(4), 5, 20, 113 1 2, 2, 0, 0, 1, 2, 0, 0, QD, 3, ROUTID) 114C 115C*** CALCULATE DHB 116C 117 IN = 0 118 CALL TBFUNX(TAPR, DHB(I), DYDX, 4, TAPER, DDVC, CC, 119 1 IN, MI, NG, 0, 0, 4HDHB , 1, ROUTID) 120 1020 CONTINUE 121 RETURN 122 END 123