|
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: 4265 (0x10a9)
Types: TextFile
Names: »S00004.f«
└─⟦db229ac7e⟧ Bits:30007240 EUUGD20: SSBA 1.2 / AFW Benchmarks
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21E/doduc/S00004.f«
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21F/doduc/S00004.f«
SUBROUTINE S00004(ICA,NIVO,IORG)
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/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/AAA33/VCO,XL0055,D876,DINT,DEXT,VOL002,VOL005,LCO,NCRAY
COMMON/AAA99/HLCF,HVCFO,HVAP,HCON,HVIN,HLIN,R876,RGAI
1 ,XM876,XMGAI,XL876,XLGAI,CP876,CPGAI,XMC876,XMCGAI
2 ,DIAHY,HGAPP(22),HCG(22),HTC(22,12),HVCFF(22)
DOUBLEPRECISION M,HNIVO(22)
ISLNIO=ISLNI
IBTRO=IBTR
IHTRO=IHTR
DO 1400 I=2,NC1
1400 HNIVO(I)=HNIV(I)
IF(ICAT(2).LE.2)GOTO 1600
HNIV(NIV)=V(NIV,1)/SCAPA(NIV)
GOTO 1600
1600 CONTINUE
CALL S66832
IF(IBTR.GE.IBTRO)GOTO 2000
CALL S33055(IBTR)
CALL S00055(IHTRO)
2000 IF(IHTR.LE.IHTRO)GOTO 3000
CALL S33055(IHTR)
CALL S00055(IBTRO)
3000 IF(ICAT(2).LE.2)RETURN
ZNIV=0.
I=1
3100 I=I+1
IF(ITYP(I).GE.3)GOTO 3200
ZNIV=ZNIV+XL(I)
HNIV(I)=0.
GOTO 3100
3200 CONTINUE
HNIV(I)= V(I,1)/SCAPA(I)
ZNIV=ZNIV+HNIV(I)
ISLNI=HNIV(I)/XL(I)*NASL(I)+1
IF(I.GE.NC1)GOTO 3700
INDICE=I+1
DO 3600 I=INDICE,NC1
3600 HNIV(I)=0.
3700 CONTINUE
LL=12
INDIO=LL*NIVO+ISLNIO
INDI=LL*NIV+ISLNI
IF(INDI.EQ.INDIO)RETURN
I1=NIVO
J1=ISLNIO
I2=NIV
J2=ISLNI
H1=XL(I1)/NASL(I1)
Z3=XL(I2)/NASL(I2)
DT3=DTGAI(I2,J2)
T3=TGAI(I2,J2)
DTU3=DT876(I2,J2)
TU3=T876(I2,J2)
IF(ISS.EQ.2)GOTO 4100
Z2=-HNIVO(I1)+J1*XL(I1)/NASL(I1)
IND1=1
IND2=2
VITE=-VITESS/SCAPA(I1)
H2=HNIV(I2)-(J2-1.)*XL(I2)/NASL(I2)
H3=-HNIV(I2)+J2*XL(I2)/NASL(I2)
I4=I2
J4=J2+1
IF(J4.LE.NASL(I2))GOTO 4200
I4=I2+1
J4=1
GOTO 4200
4100 Z2=HNIVO(I1)-(J1-1.)*XL(I1)/NASL(I1)
IND1=2
IND2=1
VITE=VITESS/SCAPA(I1)
H2=-HNIV(I2)+J2*XL(I2)/NASL(I2)
H3=HNIV(I2)-(J2-1.)*XL(I2)/NASL(I2)
I4=I2
J4=J2-1
IF(J4.GE.1)GOTO 4200
I4=I2-1
J4=NASL(I4)
4200 IF(I4.LT.IBCH.OR.I4.GT.IHCH)GOTO 4250
H4=XL(I4)/NASL(I4)
T4=TGAI(I4,J4)
TU4=T876(I4,J4)
4250 T1=TMI(IND1)
TU1=TMU(IND1)
IF(IORG.EQ.1)GOTO 4320
DT2=DTMI(IND2)
T2=TMI(IND2)-DT2*DT
T3=T3-DT3*DT
DTU2=DTMU(IND2)
TU2=TMU(IND2)-DTU2*DT
TU3=TU3-DTU3*DT
U2=(Z2*TU2+Z3*TU3)/(Z2+Z3)
DTU2=(VITE*(TU2-U2)+Z2*DTU2+Z3*DTU3)/(Z2+Z3)
TU3=U2+DTU2*DT
U2=(Z2*T2+Z3*T3)/(Z2+Z3)
DTU2=(VITE*(T2-U2)+Z2*DT2+Z3*DT3)/(Z2+Z3)
T3=U2+DTU2*DT
4320 CONTINUE
IF(I4.GE.IBCH.AND.I4.LE.IHCH)GOTO 4350
T2=(T1+T3)/2.
TU2=(TU1+TU3)/2.
GOTO 4400
4350 CONTINUE
T2=(T1*H3+(H1+H2)/(H3+H4)*((H2+H3+H4)*T3-H2*T4))/(H1+H2+H3)
T2MIN=DMIN1(T1,T3)
T2MAX=DMAX1(T1,T3)
IF(T2.LT.T2MIN)T2=T2MIN
IF(T2.GT.T2MAX)T2=T2MAX
TU2=(TU1*H3+(H1+H2)/(H3+H4)*((H2+H3+H4)*TU3-H2*TU4))/
1 (H1+H2+H3)
T2MIN=DMIN1(TU1,TU3)
T2MAX=DMAX1(TU1,TU3)
TU2=DMIN1(TU2,T2MAX)
TU2=DMAX1(TU2,T2MIN)
4400 TGAI(I1,J1)=T1
TMI(IND1)=T2
TMI(IND2)=T3
T876(I1,J1)=TU1
TMU(IND1)=TU2
TMU(IND2)=TU3
RETURN
END