DataMuseum.dk

top - metrics - download

    Length: 7076 (0x1ba4)
    Types: TextFile
    Names: »S00020.f«

└─⟦db229ac7e⟧ Bits:30007240 EUUGD20: SSBA 1.2 / AFW Benchmarks
    └─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21E/doduc/S00020.f« 
    └─⟦this⟧ »EUUGD20/AFUU-ssba1.21/ssba1.21F/doduc/S00020.f« 

TextFile

      SUBROUTINE S00020
      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/AAA55/KPRESS,KDEB,KCON,KTGAI,KT876,ICAT(3),KIMP,KGLISS
      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/AAA88/FLUP(22,2),FLUV(22,2),FLUL(22,2),FLUIV(22,2),
     2DEBIL(22,2),FLUIL(22,2),DEBI(22),DEBHI(22),DEBIV(22,2)
      COMMON/AAA13/TEM,P,DT,HNIV(22),VITESS
     1            ,ZNIV,RI(2),ISS,NITERA,NIV,ISLNI,IBTR,IHTR,ITYP(22)
      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)
      COMMON/AAA22/DH(22,2),DM(22,2),DPDT,DUU(22,2),DV(22,2),DNU(22,2)
      COMMON/AAA66/TS,HFS,HGS,HFGS,DHFPS,DHGPS,VVFS,VVGS,DVVFPS,DVVGPS
     1             ,DHFGS,VV1,VV2,DVV1P,DVV2P,T1,T2
      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)
      DOUBLEPRECISION M,X(5),Y(5),XY(5),DER(2)
      DOUBLEPRECISION XG(132),TG(132),XF(132),DTG(132)
      DOUBLEPRECISION XG1(132),XG2(132),TG1(132),TG2(132)
      PI=3.14159
      EPS=1.D-3
      TERC(1)=0.
      TERC(2)=0.
      DTMI(1)=0.
      DTMI(2)=0.
      SEC=PI/4.*(DEXT*DEXT-DINT*DINT)
      SEC=SEC*NCRAY
      CALL S00934(TPUI,QPUI,QPUI,TEM,RPUI,X,6)
      QTOTAL=QINIT*RPUI
      PLMOY=QTOTAL/XL0055/NCRAY
      IF(ICAT(2).LE.2)GOTO 800
      TGAI(NIV,ISLNI)=TMI(1)*RI(1)+TMI(2)*RI(2)
      T876(NIV,ISLNI)=TMU(1)*RI(1)+TMU(2)*RI(2)
  800 CONTINUE
      IF(KCON.EQ.0)GOTO 60
      XF(1)=0.
      K=1
      DO 10 I=2,NC1
      N1=NASL(I)
      DO 10 J=1,N1
      TERCO(I,J)=0.
      K=K+1
      XF(K)=XF(K-1)+XL(I)/N1
      XG(K-1)=XF(K-1)+(XF(K)-XF(K-1))/2.
      TG(K-1)=TGAI(I,J)
       XG1(K-1)=XG(K-1)
       XG2(K-1)=XG(K-1)
      TG1(K-1)=TG(K-1)
      TG2(K-1)=TG(K-1)
      IF(I.NE.NIV.OR.J.NE.ISLNI)GOTO 10
      XG1(K-1)=XF(K-1)+(XF(K)-XF(K-1))/2.*RI(1)
      XG2(K-1)=XF(K)-(XF(K)-XF(K-1))/2.*RI(2)
      TG1(K-1)=TMI(1)
      TG2(K-1)=TMI(2)
      KNIV=K-1
 10   CONTINUE
      KMAX=K
      KMAX1=KMAX-1
      DO 20 K=2,KMAX1
      DTG(K)=(TG1(K)-TG2(K-1))/(XG1(K)-XG2(K-1))
 20   CONTINUE
      DTG(1)=0.
      DTG(KMAX)=0.
      K=0
      DO 50 I=2,NC1
      N1=NASL(I)
      DO 50 J=1,N1
      K=K+1
      IF(K.NE.1)GOTO 42
      X(1)=XG(1)
      X(2)=XG1(2)
      Y(1)=TG(1)
      Y(2)=TG1(2)
      XO=0.
      GOTO 44
   42 IF(K.NE.KMAX1)GOTO 46
      X(1)=XG(KMAX1)
      X(2)=XG2(KMAX1-1)
      Y(1)=TG(KMAX1)
       Y(2)=TG2(KMAX1-1)
      XO=XF(KMAX)
  44  XY(1)=(Y(2)-Y(1))/ (X(2)-X(1)) *(X(1)+X(2)-2*XO)
      GOTO 48
   46 X(1)=XG2(K-1)
      X(2)=XG(K)
      X(3)=XG1(K+1)
      Y(1)=TG2(K-1)
      Y(2)=TG(K)
      Y(3)=TG1(K+1)
      CALL S00099(3,X,Y,XY)
  48  QCON(I,J)=2.*XY(1)*XLGAI*SEC*XL(I)/N1
 50   CONTINUE
      X(3)=XL(2)/(2.*NASL(2))
      X(2)=-X(3)
      X(1)=-3.*X(3)
      Y(3)=TGAI(2,1)
      Y(2)=T(1,1)
       Y(1)=2.*Y(2)-TS+20.
      CALL S00099(3,X,Y,XY)
      QCON(1,1)=2.*XY(1)*XLGAI*SEC*XL(2)/NASL(2)
   60 CONTINUE
      DO 100 I=2,NC1
      N1=NASL(I)
      HCGG=HCG(I)
      DO 100 J=1,N1
      QFOU(I,J)=QREPA(I,J)*QTOTAL
      QUGA(I,J)=(T876(I,J)-TGAI(I,J))*HCGG*XL(I)*NCRAY/N1
      DT876(I,J)=(QFOU(I,J)-QUGA(I,J))/XMCUO(I,J)
      DTGAI(I,J)=(QUGA(I,J)-QCED(I,J)+QCON(I,J))/XMCGA(I,J)
 100  CONTINUE
      IF(ICAT(2).LE.2)GOTO 200
      IF(NIV.LE.IHCH.AND.NIV.GE.IBCH)GOTO 180
      DO 170 IJ=1,3
      QUGII(IJ)=0.
      QCONI(IJ)=0.
  170 CONTINUE
      GOTO 210
  180 CONTINUE
      I=NIV
      J=ISLNI
      N1=NASL(I)
      CCC=XL(I)*NCRAY*HCG(I)/N1
      QUGII(1)=(TMU(1)-TMI(1))*CCC*RI(1)
      QUGII(2)=(TMU(2)-TMI(2))*CCC*RI(2)
      IF(KNIV.NE.1)GOTO 182
      X(1)=XG1(1)
      X(2)=XG2(1)
      X(3)=XG(2)
      Y(1)=TG1(1)
      Y(2)=TG2(1)
      Y(3)=TG(2)
      XO=0.
      IND1=1
      IND2=2
      GOTO 186
  182 IF(KNIV.NE.KMAX1)GOTO 184
      X(1)=XG2(KMAX1)
      X(2)=XG1(KMAX1)
      X(3)=XG(KMAX1-1)
      Y(1)=TG2(KMAX1)
      Y(2)=TG1(KMAX1)
      Y(3)=TG(KMAX1-1)
      XO=XF(KMAX)
      IND1=2
      IND2=1
      GOTO 186
  184 X(1)=XG(KNIV-1)
      X(2)=XG1(KNIV)
      X(3)=XG2(KNIV)
      X(4)=XG(KNIV+1)
      Y(1)=TG(KNIV-1)
      Y(2)=TG1(KNIV)
      Y(3)=TG2(KNIV)
      Y(4)=TG(KNIV+1)
      CALL S00099(4,X,Y,XY)
      DER(1)=6.*XY(1)*X(2)+2.*XY(2)
      DER(2)=6.*XY(1)*X(3)+2.*XY(2)
      GOTO 188
  186 DER(IND1)=2.*(Y(2)-Y(1))/((X(2)-X(1))*(X(2)+X(1)-2.*XO))
      CALL S00099(3,X,Y,XY)
      DER(IND2)=2.*XY(1)
  188 COEF=XLGAI*SEC*XL(I)/N1
      QCONI(1)=COEF*RI(1)*DER(1)
      QCONI(2)=COEF*RI(2)*DER(2)
      DO 190 IJ=1,2
      IF(RI(IJ).LT.EPS)GOTO 190
      DTMI(IJ)=(QUGII(IJ)-QCEI(IJ)+QCONI(IJ))/(XMCGA(I,J)*RI(IJ))
      DTMU(IJ)= (QFOU(I,J)-QUGII(IJ)/RI(IJ))/XMCUO(I,J)
  190 CONTINUE
      ZLIM=.05
      ZS=XL(I)/N1
      Z1=RI(1)*ZS
      Z2=RI(2)*ZS
      ZZ=VITESS*(TMI(1)-TMI(2))/SCAPA(I)
      ZZU=VITESS*(TMU(1)-TMU(2))/SCAPA(I)
      IF(ISS.EQ.2)GOTO 195
      IF(Z1.LT.ZLIM)GOTO 191
      TERC(1)=ZZ/Z1
      DTMI(1)=DTMI(1)-TERC(1)
      TERCU=ZZU/Z1
      DTMU(1)=DTMU(1)-TERCU
      GOTO 210
  191 TERC(1)=ZZ/ZLIM
      TERCU=ZZU/ZLIM
      IF(RI(1).LT.EPS)GOTO 192
      DTMI(1)=DTMI(1)-TERC(1)
      DTMU(1)=DTMU(1)-TERCU
  192 IF(ISLNI.EQ.1)GOTO 193
      I1=I
      J1=ISLNI-1
      GOTO 194
  193 I1=I-1
      J1=NASL(I-1)
  194 IF(I1.LT.IBCH.OR.I1.GT.IHCH)GOTO 210
      TERCO(I1,J1)=ZZ*XMCGA(I,J)*(1.-Z1/ZLIM)/(ZS*XMCGA(I1,J1))
      DTGAI(I1,J1)=DTGAI(I1,J1)-TERCO(I1,J1)
      TERCU=ZZU*XMCUO(I,J)*(1.-Z1/ZLIM)/(ZS*XMCUO(I1,J1))
      DT876(I1,J1)=DT876(I1,J1)-TERCU
      GOTO 210
  195 IF(Z2.LT.ZLIM)GOTO 196
      TERC(1)=ZZ/Z2
      DTMI(2)=DTMI(2)-TERC(1)
      TERCU=ZZU/Z2
      DTMU(2)=DTMU(2)-TERCU
      GOTO 210
  196 TERC(1)=ZZ/ZLIM
      TERCU=ZZU/ZLIM
      IF(RI(2).LT.EPS)GOTO 197
      DTMI(2)=DTMI(2)-TERC(1)
      DTMU(2)=DTMU(2)-TERCU
  197 IF(ISLNI.EQ.N1)GOTO 198
      I1=I
      J1=ISLNI+1
      GOTO 199
  198 I1=I+1
      J1=1
  199 IF(I1.LT.IBCH.OR.I1.GT.IHCH)GOTO 210
      TERCO(I1,J1)=ZZ*XMCGA(I,J)*(1.-Z2/ZLIM)/(ZS*XMCGA(I1,J1))
      DTGAI(I1,J1)=DTGAI(I1,J1)-TERCO(I1,J1)
      TERCU=ZZU*XMCUO(I,J)*(1.-Z2/ZLIM)/(ZS*XMCUO(I1,J1))
      DT876(I1,J1)=DT876(I1,J1)-TERCU
  210 CONTINUE
 200  CONTINUE
      RETURN
      END