|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: S T
Length: 4295 (0x10c7)
Types: TextFile
Names: »S00012.f«
└─⟦db229ac7e⟧ Bits:30007240 EUUGD20: SSBA 1.2 / AFW Benchmarks
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21E/doduc/S00012.f«
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21F/doduc/S00012.f«
SUBROUTINE S00012
IMPLICITDOUBLEPRECISION(A-H,O-Z)
COMMON/AAA44/SC(21),SCAPA(22),SHTC(22),VC(22),XL(22)
1,VFIX,ZCOT(21),I6FT,J6FT,I8FT,J8FT,NC,NC1,NC2,IBCH,IHCH
COMMON/AAA66/TS,HFS,HGS,HFGS,DHFPS,DHGPS,VVFS,VVGS,DVVFPS,DVVGPS
1 ,DHFGS,VV1,VV2,DVV1P,DVV2P,T1,T2
COMMON/AAA77/QINIT,TPUI(20),QPUI(20),RPUI,PLMOY,
1 XHTC(22,12),PL(22,12),QREPA(22,12),
2 XMCGA(22,12),XMCUO(22,12),QCED(22,12),QCON(22,12)
3 ,QUGA(22,12),QFOU(22,12),QCEI(2),QCONI(2),QUGII(2)
4 ,TMI(2),DTMI(2),QTOTAL,QTUG,QTGF,TERC(2)
4 ,TGAI(22,12),TGAII(22,12),T876(22,12),TUMAX(22,12)
5 ,TUMIN(22,12),DTGAI(22,12),DT876(22,12)
6 ,TERCO(22,12),TMU(2),DTMU(2),NPUI,NASL(22),NSL(22)
COMMON/AAA10/V(22,2),VV(22,2),H(22,2),HF(22,2),HG(22,2),
1 DNUHP(22,2),U(22,2),XM(22,2),XT(22,2),ALFA(22,2),
2 T(22,2),DVVH(22,2),DELH(22,2),DVVP(22,2),DELP(22,2)
3 ,AA(22,2),BB(22,2),DTDH(22,2),DTDP(22,2),DTSAT,
4 DNUPP(22,2),A(22),B(22),C(22),TVID(22,12),M(22,2),IST(22,2)
COMMON/AAA13/TEM,P,DT,HNIV(22),VITESS
1 ,ZNIV,RI(2),ISS,NITERA,NIV,ISLNI,IBTR,IHTR,ITYP(22)
COMMON/AAA55/KPRESS,KDEB,KCON,KTGAI,KT876,ICAT(3),KIMP,KGLISS
COMMON/AAA26/DEB(21),DEBV(21),DEBL(21),ALFAD(21),ALFB(21),
2ALFT(21),HA(21),HB(21),HE(21,2),HEM(21),VE(21,2),
3 XA(21),XB(21),XD(21),XEM(21),SDSC
4 ,TJONC(21),HJONB(21,2),HJONT(21,2),DEBAV(21)
5 ,GLINF(21),GLSUP(21),PP1,PP2,ALNIV
6 ,VGJO(21),GLINFP(21),V55198(21),ICAS(21),ICZW(21)
DOUBLEPRECISION M,AX(5),AY(5)
TVID(1,1)=ALFA(1,1)
TVID(NC2,1)=ALFA(NC2,1)
ALFB(1)=TVID(1,1)
ALFT(NC1)=TVID(NC2,1)
ALEC=.01
ALIN=ALEC
ALSU=1.-ALEC
DO 1600 I=2,NC1
NI=NASL(I)
XL2=XL(I)/2.
IF(ITYP(I).EQ.3)XL2=HNIV(I)/2.
AX(2)=ZCOT(I-1)+XL2
AY(2)=ALFA(I,1)
IF(ITYP(I).EQ.2)AY(2)=V(I,2)/VC(I)
XLM=XL2
ALM=AY(2)
FM=0.
HM=1.
GM=0.
IF(ALM.GE.ALIN)GOTO 1005
HM=ALM/ALEC
FM=1.-HM
GOTO 1010
1005 IF(ALM.LE.ALSU)GOTO 1010
GM=(ALM-ALSU)/ALEC
HM=1.-GM
1010 CONTINUE
J=I-1
AX(1)=ZCOT(I-1)
XLB=-XL(J)/2.
IF(J.EQ.1)XLB=-XL(I)/2.
ALB=ALFA(J,1)
IF(ITYP(J).EQ.2)ALB=V(J,2)/VC(J)
IF(ITYP(J).NE.3)GOTO 1015
ALB=ALFA(J,2)
XLB=(HNIV(J)-XL(J))/2.
1015 CONTINUE
ALJO=(ALB*XLM-ALM*XLB)/(XLM-XLB)
FB=0.
GB=0.
HBB=1.
IF(ALB.GE.ALIN)GOTO 1020
HBB=ALB/ALEC
FB=1.-HBB
GOTO 1025
1020 IF(ALB.LE.ALSU)GOTO 1025
GB=(ALB-ALSU)/ALEC
HBB=1.-GB
1025 TCC=HM*(HBB+FM*FB+GM*GB)
AY(1)=ALM+(ALJO-ALM)*TCC
ALJB=AY(1)
P1=(AY(2)-AY(1))/(AX(2)-AX(1))
Q1=AY(1)-AX(1)*P1
J=I+1
IF(ITYP(I).LE.2)GOTO 1029
AX(2)=ZCOT(I-1)+(XL(I)+HNIV(I))/2.
AY(2)=ALFA(I,2)
ALM=AY(2)
XLM=(HNIV(I)-XL(I))/2.
FM=0.
HM=0.
GM=0.
IF(ALM.GE.ALIN)GOTO 1026
HM=ALM/ALEC
FM=1.-HM
GOTO 1027
1026 IF(ALM.LE.ALSU)GOTO 1027
GM=(ALM-ALSU)/ALEC
HM=1.-GM
1027 CONTINUE
1029 CONTINUE
AX(3)=ZCOT(I-1)+XL(I)
XLM=AX(2)-AX(3)
XLH=XL(J)/2.
IF(ITYP(J).EQ.3)XLH=HNIV(J)/2.
IF(J.EQ.NC2)XLH=XL(I)/2.
ALH=ALFA(J,1)
IF(ITYP(J).EQ.2)ALH=V(J,2)/VC(J)
ALJO=(ALH*XLM-ALM*XLH)/(XLM-XLH)
FH=0.
GH=0.
HH=1.
IF(ALH.GE.ALIN)GOTO 1030
HH=ALH/ALEC
FH=1.-HH
GOTO 1035
1030 IF(ALH.LE.ALSU)GOTO 1035
GH=(ALH-ALSU)/ALEC
HH=1.-GH
1035 TCC=HM*(HH+FM*FH+GM*GH)
AY(3)=ALM+(ALJO-ALM)*TCC
ALJT=AY(3)
P2=(AY(3)-AY(2))/(AX(3)-AX(2))
Q2=AY(2)-AX(2)*P2
IF(ICAT(2).GE.3)GOTO 1300
ALFB(I)=ALM
ALFT(I-1)=ALM
DO 1200 J=1,NI
XP=ZCOT(I-1)+(J-.5)*XL(I)/NI
IF(XP.GE.AX(2))GOTO 1100
TVID(I,J)=P1*XP+Q1
GOTO 1200
1100 TVID(I,J)=P2*XP+Q2
1200 CONTINUE
GOTO 1600
1300 ALFB(I)=ALJT
ALFT(I-1)=ALJB
IF(ITYP(I).GE.3)GOTO 1400
DO 1350 J=1,NI
1350 TVID(I,J)=ALM
GOTO 1600
1400 TVID(I,1)=ALFA(I,1)
TVID(I,2)=ALFA(I,2)
1600 CONTINUE
RETURN
END