DataMuseum.dk

top - metrics - download

    Length: 3552 (0xde0)
    Types: TextFile
    Names: »F88345.f«

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

TextFile

      SUBROUTINE F88345(G,ALFB,ALFT,VG,VF,T,SIG,FLUXG,FLUXF,ALJ,VGJ,
     1   P,Q,ICAS,GL1,GL2,IZW)
      IMPLICITDOUBLEPRECISION(A-H,O-Z)
      Z1(X)=(1.-X)*(ALFT-X)+X*(X-ALFB)
      Z2(X)=X*(ALFT-X)/VG-X*(X-ALFB)/VF
      RF=1./VF
      RG=1./VG
      GRAV=32.174
      GC=32.174
      A1=.67
      A2=.47
      B1=1./A1
      B2=1./A2
      N=0
      NITM=15
      IZW=0
      VFDVG=VF/VG
      SIG=SIGMA(T)
      TCC=SIG*GC*GRAV*(RF-RG)
      TCC=VF*DSQRT(TCC)
      VBCR=1.53*DSQRT(TCC)
      ALO=.925*(VF/VG)**.239D+00
      ALSU=1.-1.D-7
      GL1=1.D+6
      GL2=-1.D+6
      IF(G.GE.0.)GOTO 800
      ICAS=3
      IZW=2
      ALJ=ALFT
      GOTO 900
  800 CONTINUE
      ICAS=1
      IZW=1
      ALJ=ALFB
  900 CONTINUE
      VGJ=S00098(VBCR,ALO,ALJ)
      B=B1
      IF(ALFB.GE.ALO)B=B2
      GL1=((ALFB/ALO)**B)*RG*VBCR
      GL2=-RF*S00098(VBCR,ALO,ALFT)
      IF(ALFB.LT.1.D-7.OR.ALFT.GT.ALSU)GOTO 1010
      IF(G.LT.GL1.AND.G.GT.GL2)GOTO 2000
 1010 RHOB=ALJ*RG+(1.-ALJ)*RF
      VGJ=S00098(VBCR,ALO,ALJ)
      FLUXG=(G+RF*VGJ)*ALJ/RHOB
      FLUXF=(G*(1.-ALJ)-RG*VGJ*ALJ)/RHOB
      P=RG*ALJ/RHOB
      Q=RF*RG*VGJ*ALJ/RHOB
      IF(G.GE.0..AND.FLUXF.LT.0.)GOTO 1100
      IF(G.LT.0..AND.FLUXG.GT.0.)GOTO 1200
      RETURN
 1100 CONTINUE
      IZW=0
      ICAS=1
      IF(G.GE.0.)GOTO 1105
      GL2=-1.D+6
      ICAS=3
 1105 CONTINUE
      ALJ=1.D+00
      FLUXG=G*VG
      FLUXF=0.D+00
      P=1.D+00
      Q=0.D+00
      VGJ=0.D+00
      RETURN
 1200 CONTINUE
      IZW=0
      GL1=1.D+6
      ICAS=1
      IF(G.GE.0.)GOTO 1205
      ICAS=3
 1205 CONTINUE
      ALJ=0.D+00
      FLUXG=0.D+00
      FLUXF=G*VF
      P=0.D+00
      Q=0.D+00
      VGJ=0.D+00
      RETURN
 2000 CONTINUE
      ICAS=2
      IZW=3
      N=1
      ALFST=(RG*ALFT+RF*ALFB)/(RG+RF)
      ALBT=DABS(ALFT-ALFB)
      IF(ALBT.GE.1.D-3)GOTO 2100
      ALJ=(ALFB+ALFT)/2.D+00
      VGJ=S00098(VBCR,ALO,ALJ)
      IZW=4
      GOTO 3000
 2100 AL1=DMIN1(ALFB,ALFT)
      AL2=DMAX1(ALFB,ALFT)
      VG1=S00098(VBCR,ALO,AL1)
      VG2=S00098(VBCR,ALO,AL2)
      VGST=S00098(VBCR,ALO,ALFST)
      X=AL1
      F1=(VG1*Z2(X)-G*Z1(X))/ALBT
      X=AL2
      F2=(VG2*Z2(X)-G*Z1(X))/ALBT
      X=ALFST
      FST=(VGST*Z2(X)-G*Z1(X))/ALBT
      IF(DABS(FST).GT.1.D-04)GOTO 2200
      ALJ=ALFST
      VGJ=VGST
      GOTO 3000
 2200 IF(FST.GT.0.)GOTO 2300
      AL2=ALFST
      F2=FST
      GOTO 2500
 2300 AL1=ALFST
      F1=FST
 2500 CONTINUE
      N=N+1
      X=(AL1*F2-AL2*F1)/(F2-F1)
      VGJ=S00098(VBCR,ALO,X)
      IF((AL2-AL1).GE.1.D-7)GOTO 2510
      ALJ=X
      GOTO 3000
 2510 CONTINUE
      F=(VGJ*Z2(X)-G*Z1(X))/ALBT
      IF(DABS(F).GT.1.D-04)GOTO 2600
      ALJ=X
      IF(DABS(F).LT.1.D-8)GOTO 3000
      IF(F.GT.0.)GOTO 2520
      AL2=X
      F2=F
      GOTO 2550
 2520 AL1=X
      F1=F
 2550 ALJ=(AL1*F2-AL2*F1)/(F2-F1)
      VGJ=S00098(VBCR,ALO,X)
      GOTO 3000
 2600 IF(F.GT.0.)GOTO 2700
      AL2=X
      F2=F
      GOTO 2800
 2700 AL1=X
      F1=F
 2800 IF(N.LT.NITM)GOTO 2500
      ALJ=(AL1*F2-AL2*F1)/(F2-F1)
      VGJ=S00098(VBCR,ALO,X)
 3000 RHOB=ALJ*RG+(1.-ALJ)*RF
      FLUXG=(G+RF*VGJ)*ALJ/RHOB
      FLUXF=(G*(1.-ALJ)-RG*VGJ*ALJ)/RHOB
       X=ALJ
      DZ2=-2.*X*(RG+RF)+ALFT*RG+ALFB*RF
      DZ1=4.*X-1.-ALFB-ALFT
      DJGG=X/RHOB
      A=A1
      IF(X.GE.ALO)A=A2
      EB=1./A-1.D+00
      XVGJA=VBCR*(X/ALO)**EB*(-X+(1.-X)*(1.-A)/A)/ALO
      DJGAL=RF*(XVGJA+(G+RF*VGJ)/RHOB)/RHOB
      Z2VGJA=((ALFT-X)/VG+(ALFB-X)/VF)*XVGJA
      DALG=Z1(X)/(DZ2*VGJ+Z2VGJA-G*DZ1)
      P=RG*(DJGG+DJGAL*DALG)
      Q=RG*FLUXG-P*G
      RETURN
      END