SUBROUTINE DATA1 common /b_1/ 1 TEMPD(5,5),A(5,5),AX(5,5),B(5,5),BX(5,5), 1 C(5,5),CX(5,5),D(5,5),DX(5,5),ND,NTHE(6),FRAC(10,5) cfm COMMON /b_5/TOTVOL(10),ARCON(10),PROVEL(6,5),ALPHA(10) COMMON /b_5/TOTVOL(10),ARCON(10),PROVEL(5,6),ALPHA(10) COMMON /b_6/A1(6),B1(6),C1(6),D1(6),A2(6),B2(6),C2(6),D2(6) COMMON /b_7/A3(6),B3(6),C3(6),D3(6),A4(6),B4(6),C4(6),D4(6) COMMON /b_8/A5(6),B5(6),C5(6),D5(6),A6(6),B6(6),C6(6),D6(6) COMMON /b_9/PROV1(6),PROV2(6),PROV3(6),PROV4(6),PROV5(6),PROV6(6) COMMON /b_10/FIELD1(6),FIELD2(10),BETA(10) c common /bcu/rrr(10),b_t(10) DIMENSION CC(6),RR(6) DIMENSION CARD(20) C C C SUBROUTINE READS AND STORES MATERIALS DATA C C READ(8,*)ND C ADD DATA OUTPUT SUPRESSION READ(8,*)NND ND=IABS(NND) C DO 2 K=1,ND READ(8,*)NTHE(K) NTH=NTHE(K) DO 1 L=1,NTH READ(8,*)TEMPD(K,L),A(K,L),AX(K,L),B(K,L), *BX(K,L),C(K,L),CX(K,L),D(K,L),DX(K,L) 1 CONTINUE 2 CONTINUE C C CALCULATE AND PRINT OUT MATERIALS DATA AT 20 DEGREE INTERVALS C 1. SPECIFIC HEAT * DENSITY C IF(NND.LT.0)WRITE(6,101) DO 5 J=1,20 PTEMP=20.0*J DO 4 K=1,ND NTH=NTHE(K) DO 3 L=1,NTH IF(PTEMP.GE.TEMPD(K,L)) 1 CC(K)=C(K,L)*(PTEMP**CX(K,L))+D(K,L)*(PTEMP**DX(K,L)) 3 CONTINUE 4 CONTINUE IF(NND.LT.0)WRITE(6,102)PTEMP,(CC(K),K=1,ND) 5 CONTINUE C C CALCULATE AND PRINT OUT MATERIALS DATA AT 20 DEGREE INTERVALS C 2. ELECTRICAL RESISTIVITY C IF(NND.LT.0)WRITE(6,103) DO 8 J=1,20 PTEMP=20.0*J DO 7 K=1,ND NTH=NTHE(K) DO 6 L=1,NTH IF(PTEMP.GE.TEMPD(K,L)) 1 RR(K)=A(K,L)*(PTEMP**AX(K,L))+B(K,L)*(PTEMP**BX(K,L)) c if(k.eq.2)rr(k)=rcu(rrr(1),ptemp,b_t(1)) 6 CONTINUE 7 CONTINUE IF(NND.LT.0)WRITE(6,102)PTEMP,(RR(K),K=1,ND) 8 CONTINUE C C READ DATA FOR VELOCITY OF PROPOGATION OF NORMALITY IN C 25/40 WIRE AS A FUNCTION OF FIELD AND CURRENT DO 110 I=1,5 READ(8,*)PROVEL(I,1),PROVEL(I,2),PROVEL(I,3), *PROVEL(I,4),PROVEL(I,5),PROVEL(I,6) 110 CONTINUE C PRINT PROPOGATION DATA IF(NND.LT.0)WRITE(6,105) IF(NND.LT.0)WRITE(6,106) IF(NND.LT.0)WRITE(6,107) DO 9 I=1,5 CURRT=10.0*I+20.0 9 IF(NND.LT.0)WRITE(6,108)CURRT,(PROVEL(I,J),J=1,6) C INTERPOLATE PROPOGATION VELOCITY USING SPLIT FOR THE C VALUES OF CURRENT GIVEN THE DATA DO 111 I=1,6 PROV1(I)=PROVEL(1,I) PROV2(I)=PROVEL(2,I) PROV3(I)=PROVEL(3,I) PROV4(I)=PROVEL(4,I) PROV5(I)=PROVEL(5,I) FIELD1(I)=I*10.0-10.0 111 CONTINUE CALL SPLIT(6,FIELD1,PROV1,XX,A1,B1,C1,D1,YY,0) CALL SPLIT(6,FIELD1,PROV2,XX,A2,B2,C2,D2,YY,0) CALL SPLIT(6,FIELD1,PROV3,XX,A3,B3,C3,D3,YY,0) CALL SPLIT(6,FIELD1,PROV4,XX,A4,B4,C4,D4,YY,0) CALL SPLIT(6,FIELD1,PROV5,XX,A5,B5,C5,D5,YY,0) RETURN C C C 100 FORMAT (20A4) 101 FORMAT (1H ,/,30X, 1 43HMATERIALS DATA 1. SPECIFIC HEAT * DENSITY, // 2 //,9X,11HTEMPERATURE,9X,6HSUPER-,9X,6HCOPPER, 3 5X,10HINSULATION,6X,9HSTAINLESS,/,26X,9HCONDUCTOR,40X, 4 5HSTEEL,//) 105 FORMAT(//30X,37HNORMALITY PROPOGATION VELOCITY CM/SEC) 106 FORMAT(/7X,9HFIELD(KG),6X,2H00,6X,2H10,6X,2H20,6X,2H30, 16X,2H40,6X,2H50) 107 FORMAT(3X,13HCURRENT(AMPS)) 108 FORMAT(6X,F5.1,7X,6(F7.2,1X)) 102 FORMAT (15X,F5.1,1P5E15.2) 103 FORMAT (1H ,/,30X, 1 43HMATERIALS DATA 2. ELECTRICAL RESISTIVITY ,// 2 //,9X,11HTEMPERATURE,9X,6HSUPER-,9X,6HCOPPER, 3 5X,10HINSULATION,6X,9HSTAINLESS,/,26X,9HCONDUCTOR,40X, 4 5HSTEEL,//) C C C C C ND = NUMBER OF COMPONENT MATERIALS IN WINDING C ( MAXIMUM 5 ) C NTHE = NUMBER OF DATA CARDS FOR EACH MATERIAL C ( MAXIMUM 5 ) C TEMPD,A,AX,B,BX,C,CX,D,DX C = DATA SPECIFYING SPECIFIC HEAT AND RESISTIVITY OF C MATERIALS, AS DEFINED IN SUBROUTINES CP AND RHO C C 999 FORMAT(20F) END SUBROUTINE DATA2 C common /b_2/ 1 AMPSSP(10),AMPSCR(10),OHM(10),RT(10), 1 FK(10,10),RK(10,10) common /b_4/ 1 NC,NT,AREA(10),AREARS(10),TSP(10),TQ(10),IQ(10), 1 TEMPZP,TEMP(10,800) C DIMENSION AA(10,10) DIMENSION CARD(20) C C C SUBROUTINE READS AND STORES INDUCTANCE MATRIX DATA C WRITE(6,101) C DO 6 I=1,NC NREAD1 =1 c NREAD2 =6 NREAD2 =10 NREAD3 =NC 1 IF(NREAD3-10) 2,2,3 2 CONTINUE READ(5,*)FK(I,1),FK(I,2),FK(I,3), *FK(I,4),FK(I,5),FK(I,6),FK(I,7),FK(I,8),FK(I,9),FK(I,10) GO TO 4 3 CONTINUE READ(5,*)FK(I,NREAD1),FK(I,NREAD1+1), *FK(I,NREAD1+2),FK(I,NREAD1+3), *FK(I,NREAD1+4),FK(I,NREAD1+5), *FK(I,NREAD1+6),FK(I,NREAD1+7), *FK(I,NREAD1+8),FK(I,NREAD1+9) IF(NREAD2.GE.NC) GO TO 4 NREAD1=NREAD1+10 NREAD2=NREAD2+10 NREAD3=NREAD3-10 GO TO 3 4011 CONTINUE 4 DO 5 J=1,NC AA(I,J)=FK(I,J) 5 CONTINUE WRITE(6,102)(FK(I,J),J=1,NC) 6 CONTINUE C C WRITE(6,103) C IF(NC.EQ.1) GO TO 9 C MAKE SURE MATRIX IS SYMMETRIC. DO 21 I=1,NC,1 DO 21 J=1,NC,1 FK(I,J)=FK(J,I) 21 AA(I,J)=AA(J,I) C CALL MFLIP(AA,NC,10) C THIS SUBROUTINE INVERTS THE INDUCTANCE MATRIX DO 8 I=1,NC DO 7 J=1,NC RK(I,J)=AA(I,J) 7 CONTINUE WRITE(6,102)(RK(I,J),J=1,NC) 8 CONTINUE C IF(NC.GT.1) GO TO 10 9 RK(1,1)=1.0/AA(1,1) WRITE(6,104)RK(1,1) C 10 RETURN C C C 100 FORMAT (20A4) 101 FORMAT (1H ,20X,21HINDUCTANCE MATRIX FK) 102 FORMAT ( (20X,1P8E12.3)) 103 FORMAT ( 20X,18HINVERSE MATRIX RK) 104 FORMAT (20X,1PE12.3) C C C C C FK = INDUCTANCE MATRIX FOR NC COUPLED COILS ( IN HENRIES C RK = INVERSE MATRIX C C 999 FORMAT(20F) END SUBROUTINE DATA3 COMMON /b_1/TEMPD(5,5),A(5,5),AX(5,5),B(5,5),BX(5,5) 1, C(5,5),CX(5,5),D(5,5),DX(5,5),ND,NTHE(6),FRAC(10,5) COMMON /b_2/AMPSSP(10),AMPSCR(10),OHM(10),RT(10) 1,FK(10,10),RK(10,10) COMMON /b_3/AMPS(10),VELZ(10),P1(10),P2(10),P3(10),P4(10) 1,X(10),VOL(10,800),IND(10),DT COMMON /b_4/NC,NT,AREA(10),AREARS(10),TSP(10),TQ(10),IQ(10) 1,TEMPZ,TEMP(10,800) COMMON /b_5/TOTVOL(10),ARCON(10),PROVEL(6,5),ALPHA(10) COMMON /b_6/A1(6),B1(6),C1(6),D1(6),A2(6),B2(6),C2(6),D2(6) COMMON /b_7/A3(6),B3(6),C3(6),D3(6),A4(6),B4(6),C4(6),D4(6) COMMON /b_8/A5(6),B5(6),C5(6),D5(6),A6(6),B6(6),C6(6),D6(6) COMMON /b_9/PROV1(6),PROV2(6),PROV3(6),PROV4(6),PROV5(6),PROV6(6) COMMON /b_10/FIELD1(6),FIELD2(10),BETA(10) COMMON/PP/ A7(6),B7(6),C7(6),D7(6),VELP(6),CURR1(6) COMMON/ERR/EB1,EB2 COMMON/CONN/ITHER(10),TEMPDF(10),DUMMY1(10,800),DUMMY2(10) common/bcu/r_rr(10),b_t(10) DIMENSION RATIO(10),DIAM(10,3),TURNS(10),LENGTH(10,6) REAL LENGTH COMMON/TMSCAL/DTOLD,TMPMRK,DTNU,ASTOP DIMENSION CARD(20) C C C SUBROUTINE READS AND STORES COIL AND CONDUCTOR DATA C C ALL DIMENSIONS IN CM. C CURRENTS IN AMPS C C PI=3.14159 DO 800 KC=1,NC READ(5,*)ALPHA(KC),BETA(KC),FIELD2(KC), *P2(KC),P3(KC),P4(KC),TSP(KC),TQ(KC),VELZ(KC) b_t(kc)=field2(kc)/10. 800 CONTINUE WRITE(6,101) DO 1 KC=1,NC C READ IN WIRE DATA-RATIO IS RATIO OF COPPER TO SUPERCONDUCTER C TAKING S/C AS 1.0 READ(5,*)CONTYP IF(CONTYP.LT.0)GO TO 87 C CIRCULAR WIRE SECTION READ(5,*)RATIO(KC),TURNS(KC),DIAM(KC,1), *DIAM(KC,2),DIAM(KC,3),r_rr(kc) if(r_rr(kc).le.0.)r_rr(kc)=100. WRITE(6,109)RATIO(KC),TURNS(KC),(DIAM(KC,I),I=1,3) AREA(KC)=P3(KC)*P4(KC)/TURNS(KC) ARCON(KC)=PI*(DIAM(KC,1)/2.0)**2.0 ARSUP=ARCON(KC)/(RATIO(KC)+1.0) IF(RATIO(KC).GT.1000.0) ARSUP=0.0 ARCU=ARCON(KC)-ARSUP ARSS=PI*(DIAM(KC,3)+DIAM(KC,2))**2.0/16.0 GO TO 88 87 CONTINUE C RECTANGULAR WIRE SECTION. READ(5,*)RATIO(KC),TURNS(KC),LENGTH(KC,1), *LENGTH(KC,2),LENGTH(KC,3),LENGTH(KC,4),LENGTH(KC,5), *LENGTH(KC,6),r_rr(kc) if(r_rr(kc).le.0.)r_rr(kc)=100. WRITE(6,109)RATIO(KC),TURNS(KC),(LENGTH(KC,I),I=1,6) AREA(KC)=P3(KC)*P4(KC)/TURNS(KC) ARCON(KC)=LENGTH(KC,1)*LENGTH(KC,2) ARSUP=ARCON(KC)/(RATIO(KC)+1.0) IF(RATIO(KC).GT.1000.0) ARSUP=0.0 ARCU=ARCON(KC)-ARSUP ARSS=LENGTH(KC,6)*LENGTH(KC,5)-LENGTH(KC,4)*LENGTH(KC,3) 88 FRAC(KC,1)=ARSUP/AREA(KC) FRAC(KC,2)=ARCU/AREA(KC) FRAC(KC,3)=(AREA(KC)-(ARCON(KC)+ARSS))/AREA(KC) FRAC(KC,4)=ARSS/AREA(KC) 1 CONTINUE C PRINT CALCULATED CROSS SECTION FRACTIONS. WRITE(6,108) DO 10 KC=1,NC WRITE(6,102)AREA(KC),(FRAC(KC,K),K=1,ND) 10 CONTINUE WRITE(6,103) DO 2 KC=1,NC ITHER(KC)=0 TEMPDF(KC)=0.0 READ(5,*)AMPS SP(KC),AMPS CR(KC),OHM(KC), 1ITHER(KC),TEMPDF(KC) WRITE(6,104)AMPS SP(KC),AMPS CR(KC),OHM(KC),ITHER(KC),TEMPDF(KC) IF(ITHER(KC).GT.10) ITHER(KC)=0 IF(AMPSSP(KC).EQ.0.0) AMPSSP(KC)=1.0E-6 IF(AMPSCR(KC).EQ.0.0) AMPSCR(KC)=1.0E-5 2 CONTINUE DO 3 KC=1,NC C IF VELZ IS READ IN, DO NOT CALCULATE IT. IF(VELZ(KC).GT.0.) GO TO 3 DO 89 I=1,5 89 CURR1(I)=I*10.0+20.0 C USING DATA PREVIOUSLY INTERPOLATED BY SPLIT OBTAIN C PROPOGATION VEL AS A FUNCTION OF CURRENT AT THE INITIAL VALUE OF F CALL SPLIT(6,FIELD1,PROV1,FIELD2(KC),A1,B1,C1,D1,YY,1) VELP(1)=YY CALL SPLIT(6,FIELD1,PROV2,FIELD2(KC),A2,B2,C2,D2,YY,1) VELP(2)=YY CALL SPLIT(6,FIELD1,PROV3,FIELD2(KC),A3,B3,C3,D3,YY,1) VELP(3)=YY CALL SPLIT(6,FIELD1,PROV4,FIELD2(KC),A4,B4,C4,D4,YY,1) VELP(4)=YY CALL SPLIT(6,FIELD1,PROV5,FIELD2(KC),A5,B5,C5,D5,YY,1) VELP(5)=YY C INTERPOLATE PROPOGATION VEL AS A FUNCTION OF CURRENT FIELD CONSTAN AMPS1=ABS(AMPSSP(KC))*0.0012566/ARCON(KC) CALL SPLIT(5,CURR1,VELP,AMPS1,A7,B7,C7,D7,VEL,0) C LOOK UP VALUE OF PROP VEL AT PRESENT VALUE OF CURRENT CALL SPLIT(5,CURR1,VELP,AMPS1,A7,B7,C7,D7,VEL,1) VELZ(KC)=VEL/ABS(AMPSSP(KC)) IF(VEL.LT.0.0)VELZ(KC)=0.0 3 CONTINUE WRITE(6,105) WRITE(6,106)(VELZ(KC),ALPHA(KC),BETA(KC),FIELD2(KC),P2(KC), 1P3(KC),P4(KC),TSP(KC),TQ(KC),KC=1,NC) C READ(5,*)DTOLD,TMPMRK,DTNU,NT,EB1,EB2,ASTOP IF(NT.GT.800) NT=800 WRITE(6,107)DTOLD,TMPMRK,DTNU,NT,EB1,EB2,ASTOP RETURN C C C 100 FORMAT (20A4) 101 FORMAT (30X, 1 45HDETAILS OF SIZE AND COMPOSITION OF CONDUCTORS) 108 FORMAT('0'10X,4HAREA,7X,8HFRAC(ND)) 102 FORMAT (5X,1PE15.4,0P5F15.4) 103 FORMAT ( 30X,40HDETAILS OF CURRENTS AND EXT. RESISTANCES, 1 /, 12X,7HAMPS SP,8X,7HAMPS CR,12X,3HOHM, 25X,' THERMAL CONNECTION TO COIL',6X,' QUENCH IF DT>BELOW') 104 FORMAT(5X,2F15.1,F15.7,10X,I6,15X,F10.4) 105 FORMAT( 30X,35HDETAILS OF PROPOGATION WITHIN COILS,/, 1 3X,4HVELZ,10X,5HALPHA,11X,4HBETA,9X,6HFIELD2,13X,2HP2,13X,2HP3, 2 13X,3HP4,12X,3HTSP,13X,2HTQ) 106 FORMAT (1X,F8.4,F13.4,F15.4,2F15.4,2F15.2,2F15.4) 107 FORMAT(10X,'DT=',F10.4,' TO TEMP='F8.1,'K, THEN DT='F10.4,'.' 1 ' NT='I5,' EB1='F8.6,', EB2='F8.6,' ASTOP= ',F6.4) 109 FORMAT(F12.4,F12.1,6F12.5) 999 FORMAT(20F) C C C C C AREA = AVERAGE AREA PER TURN IN COIL C FRAC = FRACTION OF EACH MATERIAL IN COIL C AMPS SP = SUPPLY CURRENT C AMPS CR = CRITICAL ( OR QUENCHING ) CURRENT OF COIL C OHM = EXTERNAL RESISTANCE IN PARALLEL WITH COIL C VELZ = VELOCITY OF PROPAGATION PER UNIT CURRENT C P1,2,3,4 = PARAMETERS DESCRIBING PROPAGATION OF NORMAL REGION C IN COIL, AS SPECIFIED IN SUBROUTINE NORVOL C TSP = TIME AT WHICH SUPPLY CURRENT DISCONNECTED C TQ = TIME AT WHICH COIL QUENCHES C DT = INTERVAL OF TIME USED IN STEP-WISE CALCULATION C NT = MAXIMUM NUMBER OF STEPS USED C C c r_rr = RRR of Cu in each coil c b_t = field at conducton in Tesla for magnetoresis calcs END