⟦288c9aacf⟧

TextFile

      SUBROUTINE S00017
      IMPLICITDOUBLEPRECISION(A-H,O-Z)
      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)
      COMMON/AAA22/DH(22,2),DM(22,2),DPDT,DUU(22,2),DV(22,2),DNU(22,2)
      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/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/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/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/AAA33/VCO,XL0055,D876,DINT,DEXT,VOL002,VOL005,LCO,NCRAY
      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/AAA17/DDPDT,DDH(22,2),DDV(22,2),DDM(22,2),DDU(22,2)
      COMMON/AAA18/DDEB(21),DDDEB(21),DXAT(21),DXAG(21),DXBT(21),
     1             DXBG(21),DNUG(21),DNUF(21),DHE(22,2),DDEBO(21)
      COMMON/AAA20/DQP(22,2),DFLUL(22),DFLUV(22),DFLUIL(22),DFLUIV(22)
     1            ,DDEBIL(22),DDEBIV(22),DQCEI(2),DQCED(22,12),
     2             DDTUO(22,12),DDTGA(22,12),DDTMI(2),DDTMU(2)
      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/AAA16/DBENT(20),TENT(20),HENT(20),DEBE,ENTE,
     2        DBSOR(20),TSOR(20),DEBS,DPDTT(20),TDPDT(20)
     3  ,HSOR(20),THSOR(20),ENTS,NDBENT,NDPDT,NDBSOR,NHSOR
      DOUBLEPRECISION M,NUM,DALFA(22,2),DTF(22,2)
      DOUBLEPRECISION R(22),TA(22),W(22),DAL(12),XX(8),S(22)
      DOUBLEPRECISION DML(21),DMV(21)
      DOUBLEPRECISION YA(5),TTA(5),CR(5)
      DOUBLEPRECISION E(22),F(22),AL(12)
      DOUBLEPRECISION DALBB(21),DALTT(21)
      DOUBLEPRECISION DTVID(22,12),DFLUVE(22),DFLUVS(22)
      COEF=144.D+00/778.D+00
      EPS=1.D-6
      DTSAT=DTSAT*DPDT
      TESS=TEM+1.D-4
      CALL S00934(TENT,DBENT,HENT,TESS,X1,X2,20)
      DQINJ=(X1-DEB(1))/1.D-4
      DH(1,1)=(X2-H(1,1))/1.D-4
      CALL S00934(THSOR,HSOR,HSOR,TESS,ENTSS,X,2)
      DH(NC2,1)=(ENTSS-H(NC2,1))/1.D-4
      DHFS=DHFPS*DPDT
      DHGS=DHGPS*DPDT
      DNUFS=DVVFPS*DPDT
      DNUGS=DVVGPS*DPDT
      DO 990 I=1,NC1
      IE=I
      IS=I+1
      DVFB=DNUFS
      DVFT=DNUFS
      DVGB=DNUGS
      DVGT=DNUGS
      DHFB=DHFS
      DHFT=DHFS
      DHGB=DHGS
      DHGT=DHGS
      DDEBO(I)=DDEB(I)
      IDODUC=ITYP(IE)
      GOTO (961,963,964),IDODUC
  961 ICA=IST(IE,1)
      IF(ICA.NE.1)GOTO 962
      DHFB=DH(IE,1)
      DVFB=DNU(IE,1)
      GOTO 970
  962 IF(ICA.NE.3)GOTO 970
      DHGB=DH(IE,1)
      DVGB=DNU(IE,1)
      GOTO 970
  963 DHFB=DH(IE,1)
      DHGB=DH(IE,2)
      DVFB=DNU(IE,1)
      DVGB=DNU(IE,2)
      GOTO 970
  964 ICA=IST(IE,2)
      IF(ICA.NE.1)GOTO 965
      DHFB=DH(IE,2)
      DVFB=DNU(IE,2)
      GOTO 970
  965 IF(ICA.NE.3)GOTO 970
      DHGB=DH(IE,2)
      DVGB=DNU(IE,2)
  970 CONTINUE
      IF(ITYP(IS).EQ.2)GOTO 973
      ICA=IST(IS,1)
      IF(ICA.NE.1)GOTO 972
      DHFT=DH(IS,1)
      DVFT=DNU(IS,1)
      GOTO 980
  972 IF(ICA.NE.3)GOTO 980
      DHGT=DH(IS,1)
      DVGT=DNU(IS,1)
      GOTO 980
  973 DHFT=DH(IS,1)
      DHGT=DH(IS,2)
      DVFT=DNU(IS,1)
      DVGT=DNU(IS,2)
  980 CONTINUE
      DNUG(I)=(DVGB+DVGT)/2.
      DNUF(I)=(DVFB+DVFT)/2.
      DHE(I,1)=DHFB
      DHE(I,2)=DHGB
      DEBLL=DEBAV(I)*(1.-XA(I))-XB(I)
      DEBVV=DEBAV(I)*XA(I)+XB(I)
      IF(DEBLL.LT.0.)DHE(I,1)=DHFT
      IF(DEBVV.LT.0.)DHE(I,2)=DHGT
  990 CONTINUE
      VFDVG=VVFS/VVGS
      DVFDVG=(DVVFPS-VFDVG*DVVGPS)*DPDT
      DALFA(1,1)=0.
      DALFA(NC2,1)=0.
      DO 1000 I=2,NC1
      J1=2-1/ITYP(I)
      DO 1000 J=1,J1
      DTF(I,J)=DTDP(I,J)*DPDT+DTDH(I,J)*DH(I,J)
      DALFA(I,J)=0.
      IF(IST(I,J).NE.2)GOTO 1000
      X=(H(I,J)-HFS)/HFGS
      DXDT=(DH(I,J)-(DHFPS+DHFGS*X)*DPDT)/HFGS
      ALDX=1./(X+(1.-X)*VFDVG)
      ALDX=ALDX*ALDX
      DALFA(I,J)=ALDX*(VFDVG*DXDT-(1.-X)*X*DVFDVG/VVGS)
 1000 CONTINUE
      DALBB(1)=0.
      DALTT(NC1)=0.
      DO 1200 I=2,NC1
      NI=NASL(I)
      DO 1100 J=1,NI
 1100 AL(J)=TVID(I,J)
      CALL S33018(I,DALFA,DAL,DALJB,DALJT)
      DALTT(I-1)=DALJB
      DALBB(I)=DALJT
      DO 2100 J=1,NI
 2100 DTVID(I,J)=DAL(J)
 1200 CONTINUE
      DO 2500 I=1,NC1
      DALB=DALBB(I)
      DALT=DALTT(I)
      SEC=SC(I)
      IK=ICZW(I)
      IF(KGLISS.EQ.4)GOTO 2300
      GOTO 2400
 2300 CONTINUE
      CALL S33022(I,SEC,IK,DALB,DALT,X1,X2,X3,X4)
 2400 CONTINUE
      DXAT(I)=X1
      DXAG(I)=X2
      DXBT(I)=X3
      DXBG(I)=X4
 2500 CONTINUE
      DO 1500 I=2,NC1
      NI=NASL(I)
      DO 1300 J=1,NI
      AL(J)=TVID(I,J)
 1300 DAL(J)=DTVID(I,J)
      CALL S00089(I,AL,DAL,DTF,XX)
      IF(ITYP(I).EQ.2)GOTO 1400
      DQP(I,1)=XX(1)
      DQP(I,2)=XX(2)
      GOTO 1500
 1400 DFLUL(I)=XX(1)
      DFLUV(I)=XX(2)
      DFLUIL(I)=XX(3)
      DFLUIV(I)=XX(4)
      DDEBIL(I)=XX(5)
      DDEBIV(I)=XX(6)
      DFLUVE(I)=XX(7)
      DFLUVS(I)=XX(8)
 1500 CONTINUE
      DO 3000 I=2,NC1
      IE=I-1
      IS=I
      IF(ITYP(I).GE.2)GOTO 2600
      HLVE=HE(IE,2)-HE(IE,1)
      HLVS=HE(IS,2)-HE(IS,1)
      VH=DVVH(I,1)
      DVP=DVVP(I,1)*DPDT
      DVVPP=DNUPP(I,1)*DPDT
      DVVHH=DNUHP(I,1)*DH(I,1)
      DVVHP=DNUHP(I,1)*DPDT
      DADT=VH*(DQP(I,1)+HLVE*DXBT(IE)-HLVS*DXBT(IS)
     1 +(DHE(IE,2)-DHE(IE,1))*XB(IE)-(DHE(IS,2)-DHE(IS,1))*XB(IS))
     2 +DVVHP*(FLUP(I,1)+HB(IE)-HB(IS))
      DADME=VH*HLVE*DXBG(IE)
      DADMS=-VH*HLVS*DXBG(IS)
      DBDT=VH*(HLVE*DXAT(IE)+XA(IE)*DHE(IE,2)+(1.-XA(IE))*DHE(IE,1))
     1 +DVP+(HA(IE)-H(I,1))*DVVHP
      DBDME=VH*HLVE*DXAG(IE)
      DCDT=-VH*(HLVS*DXAT(IS)+XA(IS)*DHE(IS,2)+(1.-XA(IS))*DHE(IS,1))
     1 -DVP-(HA(IS)-H(I,1))*DVVHP
      DCDMS=-VH*HLVS*DXAG(IS)
      W(I)=BB(I,1)
      R(I)=DVP*DM(I,1)+DPDT*(M(I,1)*(DVVPP+DVVHH)+COEF*V(I,1)*DVVHP)
      GOTO 2800
 2600 IF(ITYP(I).GE.3)GOTO 2700
      DFLVME=DFLUVE(I)
      DFLVMS=DFLUVS(I)
      VH1=DVVH(I,1)
      VH2=DVVH(I,2)
      VP1=DVVP(I,1)*DPDT
      VP2=DVVP(I,2)*DPDT
      YNE1=DELH(I,1)+VH1*HE(IE,1)
      YNE2=DELH(I,2)+VH2*HE(IE,2)
      YNS1=DELH(I,1)+VH1*HE(IS,1)
      YNS2=DELH(I,2)+VH2*HE(IS,2)
      DNS=YNS1-YNS2
      DNE=YNE1-YNE2
      YL1=DELH(I,1)+VH1*H(I,1)
      YL2=DELH(I,2)+VH2*H(I,2)
      GA1=DELH(I,1)+VH1*HFS
      GA2=DELH(I,2)+VH2*HGS
      DDNS=VP1-VP2+VH1*DHE(IS,1)-VH2*DHE(IS,2)
      DDNE=VP1-VP2+VH1*DHE(IE,1)-VH2*DHE(IE,2)
      DGA2=VP2+VH2*DHGPS*DPDT-DNU(I,1)
      DGA1=VP1+VH1*DHFPS*DPDT-DNU(I,2)
      DADT=DNS*DXBT(IS)-DNE*DXBT(IE)
     1 +VH1*(DFLUL(I)+DFLUIL(I))+VH2*(DFLUV(I)+DFLUIV(I))
     2 +DDEBIL(I)*(-YL1+GA2)+DDEBIV(I)*(GA1-YL2)
     3  +XB(IS)*DDNS-XB(IE)*DDNE
     4 +DEBIL(I,1)*DGA2+DEBIV(I,2)*DGA1
      DADME=-DNE*DXBG(IE)+VH2*DFLVME
      DADMS=DNS*DXBG(IS)+VH2*DFLVMS
      DBDT=-DNE*DXAT(IE)+XA(IE)*(VP2+VH2*DHE(IE,2))+
     1 (1.-XA(IE))*(VP1+VH1*DHE(IE,1))
      DBDME=-DNE*DXAG(IE)
      DCDT=DNS*DXAT(IS)-XA(IS)*(VP2+VH2*DHE(IS,2))-(1.-XA(IS))*
     1 (VP1+VH1*DHE(IS,1))
      DCDMS=DNS*DXAG(IS)
      W(I)=BB(I,1)+BB(I,2)
      R(I)=DPDT*(DM(I,1)*DVVP(I,1)+DM(I,2)*DVVP(I,2)+COEF*DV(I,1)*
     1(VH1-VH2))
      GOTO 2800
 2700 CONTINUE
      VP1=DVVP(I,1)*DPDT
      VP2=DVVP(I,2)*DPDT
      VH1=DVVH(I,1)
      VH2=DVVH(I,2)
      DVVPP1=DNUPP(I,1)*DPDT
      DVVHH1=DNUHP(I,1)*DH(I,1)
      DVVHP1=DNUHP(I,1)*DPDT
      DVVPP2=DNUPP(I,2)*DPDT
      DVVHH2=DNUHP(I,2)*DH(I,2)
      DVVHP2=DNUHP(I,2)*DPDT
      HLVE=HE(IE,2)-HE(IE,1)
      HLVS=HE(IS,2)-HE(IS,1)
      ALL=ALFA(I,1)
      DDEBI=0.
      DDEBHI=0.
      IF(ALL.LE.1.D-6)GOTO 2710
      DDEBI=DEBI(I)/(ALL*(1.-ALL))*DALFA(I,1)
 2710 DDEBI=DDEBI-DEBI(I)*DVVGPS*DPDT/VVGS
      DDEBHI=DDEBI*HGS+DEBI(I)*DHGPS*DPDT
      DADT=VH1*(DQP(I,1)+HLVE*DXBT(IE)+XB(IE)*(DHE(IE,2)-DHE(IE,1)))
     1 +VH2*(DQP(I,2)-HLVS*DXBT(IS)-XB(IS)*(DHE(IS,2)-DHE(IS,1)))
     2 +DEBI(I)*(VP2-VP1-H(I,2)*DVVHP2+H(I,1)*DVVHP1)
     3 +DDEBI*(DELH(I,2)-DELH(I,1))+DDEBHI*(VH2-VH1)
     4 +DVVHP1*(HB(IE)-DEBHI(I)+FLUP(I,1))+DVVHP2*(DEBHI(I)-HB(IS)
     5 +FLUP(I,2))
      DADME=VH1*HLVE*DXBG(IE)
      DADMS=-VH2*HLVS*DXBG(IS)
      DBDT=VH1*(HLVE*DXAT(IE)+XA(IE)*DHE(IE,2)+(1.-XA(IE))*DHE(IE,1))
     1 +VP1+(HA(IE)-H(I,1))*DVVHP1
      DBDME=VH1*HLVE*DXAG(IE)
      DCDT=-VH2*(HLVS*DXAT(IS)+XA(IS)*DHE(IS,2)+(1.-XA(IS))*DHE(IS,1))
     1 -VP2-(HA(IS)-H(I,2))*DVVHP2
      DCDMS=-VH2*HLVS*DXAG(IS)
      W(I)=BB(I,1)+BB(I,2)
      R(I)=DM(I,1)*VP1+DM(I,2)*VP2+DPDT*(COEF*(DV(I,1)*(VH1-VH2)
     1 +V(I,1)*DVVHP1+V(I,2)*DVVHP2)+M(I,1)*(DVVPP1+DVVHH1)
     2 +M(I,2)*(DVVPP2+DVVHH2))
 2800 CONTINUE
      R(I)=R(I)+DADT+DEB(IE)*DBDT+DEB(IS)*DCDT
      S(I)=DADME+DEB(IE)*DBDME+B(I)
      TA(I)=DADMS+DEB(IS)*DCDMS+C(I)
      E(I)=-R(I)
 3000 CONTINUE
      IF(KDEB.EQ.0)GOTO 3100
      RET=1./15.
      DDEB(1)=DDEB(1)*(1.-RET*(1.+SDSC))+RET*(SDSC*DDEB(NC1)+DQINJ)
      GOTO 3150
 3100 DDEB(1)=DQINJ
 3150 CONTINUE
      IF(KPRESS.EQ.0)GOTO 3300
      DDPDT=0.
      DO 3200 I=2,NC1
 3200 DDEB(I)=(-R(I)-W(I)*DDPDT-S(I)*DDEB(I-1))/TA(I)
      GOTO 4500
 3300 TESS=TEM+1.D-4
      CALL S00934(TSOR,DBSOR,DBSOR,TESS,X1,X2,NDBSOR)
      DDEB(NC1)=(X1-DEB(NC1))/1.D-4
      E(2)=E(2)-S(2)*DDEB(1)
      E(NC1)=E(NC1)-TA(NC1)*DDEB(NC1)
      F(2)=1.
      NUM=0.
      DENOM=0.
      DO 3500 I=2,NC
      NUM=NUM+F(I)*E(I)
      DENOM=DENOM+F(I)*W(I)
      F(I+1)=-F(I)*TA(I)/S(I+1)
 3500 CONTINUE
      NUM=NUM+F(NC1)*E(NC1)
      DENOM=DENOM+F(NC1)*W(NC1)
      DDPDT=NUM/DENOM
      DDEB(2)=(E(2)-W(2)*DDPDT)/TA(2)
      DO 4000 I=3,NC
      DDEB(I)=(E(I)-S(I)*DDEB(I-1)-W(I)*DDPDT)/TA(I)
 4000 CONTINUE
 4500 CONTINUE
      DO 5000 I=1,NC1
      DXMM=DDEB(I)
      XMM=DEB(I)
      XAA=XA(I)
      DXADM=DXAG(I)
      DXADT=DXAT(I)
      DXBDM=DXBG(I)
      DXBDT=DXBT(I)
      DML(I)=DXMM*(1.-XAA-XMM*DXADM-DXBDM)-XMM*DXADT-DXBDT
      DMV(I)=DXMM*(XAA+XMM*DXADM+DXBDM)+XMM*DXADT+DXBDT
      QSEC=(DXMM-DDEBO(I))/DT
      Y=DABS(DXMM)/(20.*DT)
      DODUC=.01
      Y=DMAX1(Y,DODUC)
      YY=DABS(QSEC)
      IF(YY.GE.Y)QSEC=QSEC*Y/YY
      DDDEB(I)=QSEC
 5000 CONTINUE
      DDDEB(1)=0.
      DO 6500 I=2,NC1
      IE=I-1
      IS=I
      IF(ITYP(I).GE.2)GOTO 6200
      DDV(I,2)=0.
      DDH(I,2)=0.
      DDM(I,2)=0.
      DDU(I,2)=0.
      DDM(I,1)=DDEB(IE)-DDEB(IS)
      DDU(I,1)=DML(IE)*HE(IE,1)+DMV(IE)*HE(IE,2)-DML(IS)*HE(IS,1)-
     1 DMV(IS)*HE(IS,2)+DEBV(IE)*DHE(IE,2)+DQP(I,1)
     2 +DEBL(IE)*DHE(IE,1)-DEBV(IS)*DHE(IS,2)-DEBL(IS)*DHE(IS,1)
      GOTO 6400
 6200 IF(ITYP(I).GE.3)GOTO 6300
      DFLUV(I)=DFLUV(I)+DFLUVE(I)*DDEB(IE)+DFLUVS(I)*DDEB(IS)
      DDM(I,1)=DML(IE)-DML(IS)-DDEBIL(I)+DDEBIV(I)
      DDM(I,2)=DMV(IE)-DMV(IS)+DDEBIL(I)-DDEBIV(I)
      DDU(I,1)=DML(IE)*HE(IE,1)-DML(IS)*HE(IS,1)+DFLUL(I)+DFLUIL(I)
     1+DEBL(IE)*DHE(IE,1)-DEBL(IS)*DHE(IS,1)
     2 -DEBIL(I,1)*DH(I,1)+DEBIV(I,2)*DHFPS*DPDT
     3 -H(I,1)*DDEBIL(I)+HFS*DDEBIV(I)
      DDU(I,2)=DMV(IE)*HE(IE,2)-DMV(IS)*HE(IS,2)+DFLUV(I)+DFLUIV(I)+
     1 DEBV(IE)*DHE(IE,2)-DEBV(IS)*DHE(IS,2)
     2 +DEBIL(I,1)*DHGPS*DPDT-DEBIV(I,2)*DH(I,2)
     3 +HGS*DDEBIL(I)-H(I,2)*DDEBIV(I)
      GOTO 6400
 6300 CONTINUE
      DDM(I,1)=DDEB(IE)-DDEBI
      DDM(I,2)=DDEBI-DDEB(IS)
      DDU(I,1)=DML(IE)*HE(IE,1)+DMV(IE)*HE(IE,2)-DDEBHI+DQP(I,1)
     1 +DEBL(IE)*DHE(IE,1)+DEBV(IE)*DHE(IE,2)
      DDU(I,2)=DDEBHI-DML(IS)*HE(IS,1)-DMV(IS)*HE(IS,2)
     1 -DEBL(IS)*DHE(IS,1)-DEBV(IS)*DHE(IS,2)+DQP(I,2)
 6400 J1=2-1/ITYP(I)
      EPSM=DELM*VC(I)/VVFS
      DO 6450 J=1,J1
      DAJ=DVVH(I,J)*(DDU(I,J)-H(I,J)*DDM(I,J))+VV(I,J)*DDM(I,J)
     1 +(DVVP(I,J)*DM(I,J)+DNUHP(I,J)*(DUU(I,J)-H(I,J)*DM(I,J)))*DPDT
      DBJ=DM(I,J)*DVVP(I,J)+M(I,J)*(DNUPP(I,J)*DPDT+DNUHP(I,J)*DH(I,J))
     1 +COEF*(DVVH(I,J)*DV(I,J)+V(I,J)*DNUHP(I,J)*DPDT)
      DDV(I,J)=DAJ+DBJ*DPDT+BB(I,J)*DDPDT
      YM=M(I,J)
      IF(YM.GE.EPSM)GOTO 6420
      YM=EPSM
      DYM=0.
      DDH(I,J)=(COEF *(DV(I,J)*DPDT+V(I,J)*DDPDT)+DDU(I,J)-H(I,J)*
     1 DDM(I,J)-DH(I,J)*(DM(I,J)+DYM))/YM
      GOTO 6430
 6420 CONTINUE
      DDH(I,J)=(COEF*(DV(I,J)*DPDT+V(I,J)*DDPDT)+DDU(I,J)
     1 -H(I,J)*DDM(I,J)-2.*DH(I,J)*DM(I,J))/YM
 6430 CONTINUE
      IF(DABS(DDH(I,J)).LT.1.D-4)DDH(I,J)=0.
      IF(DABS(DDV(I,J)).LT.1.D-4)DDV(I,J)=0.
 6450 CONTINUE
 6500 CONTINUE
      TTEM=TEM+1.D-4
      CALL S00934(TPUI,QPUI,QPUI,TTEM,RPUI,XX,6)
      QQTOT=QINIT*RPUI
      DQTDT=(QQTOT-QTOTAL)/1.D-4
      DO 7000 I=2,NC1
      N1=NASL(I)
      CCC=HCG(I)*NCRAY*XL(I)/N1
      DO 7000 J=1,N1
      DQFOU=QREPA(I,J)*DQTDT
      DQUGA=(DT876(I,J)-DTGAI(I,J))*CCC
      DDTUO(I,J)=(DQFOU-DQUGA)/XMCUO(I,J)
      DDTGA(I,J)=(DQUGA-DQCED(I,J))/XMCGA(I,J)
 7000 CONTINUE
      IF(ICAT(2).LE.2)GOTO 7500
      I=NIV
      J=ISLNI
      N1=NASL(I)
      DQFOU=QREPA(I,J)*DQTDT
      COEFF=XLGAI*SEC*XL(I)/N1
      CCC=HCG(I)*NCRAY*XL(I)/N1
      DRI=N1*DV(I,1)/VC(I)
      IF(I.NE.2.OR.J.NE.1)GOTO 7100
      YA(1)=RI(1)*XL(I)/(2.*N1)
      YA(2)=(1.-RI(2)/2.)*XL(I)/N1
      TTA(1)=DTMI(1)
      TTA(2)=DTMI(2)
      II=I
      JJ=ISLNI+1
      IF(N1.GT.1)GOTO 7020
      II=NIV+1
      JJ=1
 7020 YA(3)=XL(I)/N1+.5*XL(II)/NASL(II)
      TTA(3)=DTGAI(II,JJ)
      DER1=2.*(TTA(2)-TTA(1))/((YA(2)-YA(1))*(YA(2)+YA(1)))
      CALL S00099(3,YA,TTA,CR)
      DER2=2.*CR(1)
      GOTO 7300
 7100 IF(I.NE.NC1.OR.J.NE.N1)GOTO 7200
      YA(1)=RI(2)*XL(I)/(2.*N1)
      YA(2)=(1.-RI(1)/2.)*XL(I)/N1
      TTA(1)=DTMI(2)
      TTA(2)=DTMI(1)
      II=I
      JJ=ISLNI-1
      IF(N1.GT.1)GOTO 7120
      II=I-1
      JJ=NASL(II)
 7120 YA(3)=XL(I)/N1+.5*XL(II)/NASL(II)
      TTA(3)=DTGAI(II,JJ)
      DER2=2.*(TTA(2)-TTA(1))/((YA(2)-YA(1))*(YA(2)+YA(1)))
      CALL S00099(3,YA,TTA,CR)
      DER1=2.*CR(1)
      GOTO 7300
 7200 II=I
      JJ=ISLNI-1
      IF(JJ.GE.1)GOTO 7220
      II=I-1
      JJ=NASL(II)
 7220 YA(1)=-.5*XL(II)/NASL(II)
      TTA(1)=DTGAI(II,JJ)
      YA(2)=.5*RI(1)*XL(I)/N1
      TTA(2)=DTMI(1)
      TTA(3)=DTMI(2)
      YA(3)=(1.-.5*RI(2))*XL(I)/N1
      II=I
      JJ=ISLNI+1
      IF(JJ.LE.N1)GOTO 7240
      II=I+1
      JJ=1
 7240 YA(4)=XL(I)/N1+.5*XL(II)/NASL(II)
      TTA(4)=DTGAI(II,JJ)
      CALL S00099(4,YA,TTA,CR)
      DER1=6.*CR(1)*YA(2)+2*CR(2)
      DER2=6.*CR(1)*YA(3)+2*CR(2)
 7300 CONTINUE
      DQUCE1=HLCF*(TMU(1)-TMI(1))*XHTC(I,J)
      DQUCE2=HVCFF(I)*(TMU(2)-TMI(2))*XHTC(I,J)
      IF(RI(1).LT.EPS)GOTO 7301
      DQUCE1=(DQCEI(1)-QCEI(1)*DRI/RI(1))/RI(1)
 7301 IF(RI(2).LT.EPS)GOTO 7302
      DQUCE2=(DQCEI(2)+QCEI(2)*DRI/RI(2))/RI(2)
 7302 DQUGI1=CCC*(DTMU(1)-DTMI(1))
      DQUGI2=CCC*(DTMU(2)-DTMI(1))
      DQCON1=COEFF*DER1
      DQCON2=COEFF*DER2
      YMCGA=XMCGA(I,J)
      YMCUO=XMCUO(I,J)
      DDTMU(1)=(DQFOU-DQUGI1)/YMCUO
      DDTMU(2)=(DQFOU-DQUGI2)/YMCUO
      DDTMI(1)=(DQUGI1+DQCON1-DQUCE1)/YMCGA
      DDTMI(2)=(DQUGI2+DQCON2-DQUCE2)/YMCGA
      YLIM=.05
      YS=XL(I)/N1
      Y1=RI(1)*YS
      Y2=RI(2)*YS
      DY1=DRI*YS
      DY2=-DRI*YS
      YZ=DV(I,1)*(TMI(1)-TMI(2))/SCAPA(I)
      DYZ=(DDV(I,1)*(TMI(1)-TMI(2))+DV(I,1)*(DTMI(1)-DTMI(2)))/SCAPA(I)
      IF(DV(I,1).LT.0.)GOTO 7400
      IF(Y1.LT.YLIM)GOTO 7310
      DDTMI(1)=DDTMI(1)-(DYZ-YZ*DY1/Y1)/Y1
      GOTO 7500
 7310 DTERC=DYZ/YLIM
      IF(RI(1).LT.1.D-3)GOTO 7320
      DDTMI(1)=DDTMI(1)-DTERC
 7320 I1=I
      J1=ISLNI-1
      IF(J1.GE.1)GOTO 7330
      I1=I-1
      J1=NASL(I1)
 7330 IF(I1.LT.IBCH.OR.I1.GT.IHCH)GOTO 7500
      DTERC=XMCGA(I,J)*(DYZ*(1.-Y1/YLIM)-YZ*DY1/YLIM)/(YS*XMCGA(I1,J1))
      DDTGA(I1,J1)=DDTGA(I1,J1)-DTERC
 7400 CONTINUE
      IF(Y2.LT.YLIM)GOTO 7410
      DDTMI(2)=DDTMI(2)-(DYZ-YZ*DY2/Y2)/Y2
      GOTO 7500
 7410 DTERC=DYZ/YLIM
      IF(RI(2).LT.1.D-3)GOTO 7420
      DDTMI(2)=DDTMI(2)-DTERC
 7420 I1=I
      J1=ISLNI+1
      IF(J1.LE.N1)GOTO 7430
      I1=I+1
      J1=1
 7430 IF(I1.LT.IBCH.OR.I1.GT.IHCH)GOTO 7500
      DTERC=XMCGA(I,J)*(DYZ*(1.-Y2/YLIM)-YZ*DY2/YLIM)/(YS*XMCGA(I1,J1))
      DDTGA(I1,J1)=DDTGA(I1,J1)-DTERC
 7500 CONTINUE
      RETURN
      END
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦288c9aacf⟧ TextFile

Derivation

TextFile
