|
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: 3852 (0xf0c)
Types: TextFile
Names: »S33055.f«
└─⟦db229ac7e⟧ Bits:30007240 EUUGD20: SSBA 1.2 / AFW Benchmarks
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21E/doduc/S33055.f«
└─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21F/doduc/S33055.f«
SUBROUTINE S33055(II)
IMPLICITDOUBLEPRECISION(A-H,O-Z)
COMMON/AAA11/V0011N(20),V0012X(20),V0011,V0012,
1TLIM,ZLIMIN,ZLIMAX,DTVOI,TIMIMP(20),DIFREF(20),DIFMIC(20),
3V00001,V22202,TEMIMP,TEMMIC,DELM,DELV,DELVI,DELVS,
6V22201,V22203,DTPRE,DTPHY,DTTEMP,DTCHAN,DTDIS,DTBEF,DTORG
7,NIMIC,NMULTR,IZONE,N00011(20),ISORT,NECRIT,NSTAR,IPLOT,NZONE
+,IFRE(20),ICO,IIMP,NPAS1(20),NPAS2(20)
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/AAA44/SC(21),SCAPA(22),SHTC(22),VC(22),XL(22)
1,VFIX,ZCOT(21),I6FT,J6FT,I8FT,J8FT,NC,NC1,NC2,IBCH,IHCH
DOUBLEPRECISION STO(12,12),AG(12),BG(12),AU(12),BU(12),X(12)
DOUBLEPRECISION XN(12)
IF(NMULTR.LE.1)RETURN
N1=NSL(II)
DO 1 I=1,N1
STO(I,1)=TGAI(II,I)
STO(I,2)=TGAII(II,I)
STO(I,3)=T876(II,I)
STO(I,4)=TUMAX(II,I)
STO(I,5)=TUMIN(II,I)
STO(I,6)=XMCGA(II,I)
STO(I,7)=XMCUO(II,I)
STO(I,8)=PL(II,I)
STO(I,9)=QREPA(II,I)
STO(I,10)=XHTC(II,I)
1 CONTINUE
NASL(II)=NSL(II)*NMULTR
IF(II.GT.2.AND.II.LT.NC1)GOTO 300
IF(N1.EQ.1)GOTO 200
X(1)=XL(II)/N1/2.
DO 10 I=2,N1
X(I)=X(I-1)+XL(II)/N1
BG(I)=(TGAI(II,I)-TGAI(II,I-1))/(X(I)-X(I-1))
AG(I)=TGAI(II,I)-X(I)*BG(I)
BU(I)=(T876(II,I)-T876(II,I-1))/(X(I)-X(I-1))
AU(I)=T876(II,I)-X(I)*BU(I)
10 CONTINUE
X(1)=0.
X(N1)=XL(II)
XN(1)=XL(II)/N1/2./NMULTR
N2=N1*NMULTR
DO 20 I=2,N2
20 XN(I)=XN(I-1)+XL(II)/N1/NMULTR
I2=0
DO 2 I=1,N1
I1=I2+1
I2=I*NMULTR
DO 2 K=I1,I2
IJ=I
IF(XN(K).GE.X(I))IJ=I+1
TGAI(II,K)=AG(IJ)+BG(IJ)*XN(K)
T876(II,K)=AU(IJ)+BU(IJ)*XN(K)
2 CONTINUE
GOTO 250
200 N2=N1*NMULTR
DO 220 I=2,N2
TGAI(II,I)=TGAI(II,1)
220 T876(II,I)=T876(II,1)
250 CONTINUE
I2=0
DO 260 I=1,N1
I1=I2+1
I2=I*NMULTR
DO 260 K=I1,I2
TGAII(II,K)=STO(I,2)
TUMAX(II,K)=STO(I,4)
TUMIN(II,K)=STO(I,5)
XMCGA(II,K)=STO(I,6)/NMULTR
XMCUO(II,K)=STO(I,7)/NMULTR
PL(II,K)=STO(I,8)
QREPA(II,K)=STO(I,9)/NMULTR
XHTC(II,K)=STO(I,10)/NMULTR
260 CONTINUE
RETURN
300 CONTINUE
X1=-XL(II-1)/NASL(II-1)/2.
X2=XL(II)/2.
X3=XL(II)+XL(II+1)/NASL(II+1)/2.
YG1=TGAI(II-1,NASL(II-1))
YG3=TGAI(II+1,1)
YU1=T876(II-1,NASL(II-1))
YU3=T876(II+1,1)
N1=NASL(II)
TG2=0.
TU2=0.
N2=NSL(II)
DO 350 J=1,N2
TG2=TG2+TGAI(II,J)
TU2=TU2+T876(II,J)
350 CONTINUE
YG2=TG2/N2
YU2=TU2/N2
YX21=(YG2-YG1)/(X2-X1)
YX32=(YG3-YG2)/(X3-X2)
GA=(YX21-YX32)/(X1-X3)
GB=(YG2-YG1-GA*(X2*X2-X1*X1))/(X2-X1)
GC=YG1-GA*X1*X1-GB*X1
YX21=(YU2-YU1)/(X2-X1)
YX32=(YU3-YU2)/(X3-X2)
UA=(YX21-YX32)/(X1-X3)
UB=(YU2-YU1-UA*(X2*X2-X1*X1))/(X2-X1)
UC=YU1-UA*X1*X1-UB*X1
N2=NSL(II)
I2=0
DO 400 I=1,N2
I1=I2+1
I2=I*NMULTR
DO 400 J=I1,I2
Y=XL(II)/N1*(J-0.5)
TGAI(II,J)=GA*Y*Y+GB*Y+GC
T876(II,J)=UA*Y*Y+UB*Y+UC
TGAII(II,J)=STO(I,2)
TUMAX(II,J)=STO(I,4)
TUMIN(II,J)=STO(I,5)
XMCGA(II,J)=STO(I,6)/NMULTR
XMCUO(II,J)=STO(I,7)/NMULTR
PL(II,J)=STO(I,8)
QREPA(II,J)=STO(I,9)/NMULTR
XHTC(II,J)=STO(I,10)/NMULTR
400 CONTINUE
RETURN
END