subroutine frantic_edits
  !
  !-------------------------------
  !
  !  TBT Jun, 1991  Added NINLDX as the pointer to the lightest gas in
  !                 BACKZ for this source.
  !-----------------------------
  
  !  Mod TBT July 25, 1991 - Corrected index to RMASS in RMASS/APLAS.
  !  Mod TBT May,1991 - Added INDX so that ALPHAX would not divide by 0
  !
  !  MOD DMC AUG 1986 - TRANSP VSN UPGRADE TO SUPPORT ROTATION BALANCE
  !    EVALUATE CROSS SURFACE FLUX OF MOMENTUM
  !
  !  MOD DMC JUL 1989 -- UPGRADE TO SUPPORT HELIUM + HYDROGEN MIX
  !    CROSS SURFACE PTCL FLUXES ARE NOW IN UNITS OF NO. OF ELECTRONS
  !    CARRIED.  CHARGE EXCHANGE CAN NOW GIVE AN ELECTRON SOURCE
  !    E.G. HE0 + H+ --> HE+ + H0 --> HE++ + E- + H0 IS ASSUMED
  !    (CONVERSELY, H0 + HE++ --> H+ + HE+ --> H+ + HE++ + E- IS TREATED
  !    AS AN IONIZATION, CF CROSS SECTION ROUTINES ...)
  !
  !    ALSO, MULTISPECIES, MULTIPLE CHARGE STATE BEAMS MAY BE PRESENT.
  !    IN A KLUGE, THE NO. OF ELECTRONS GOING TO FORM BEAM NEUTRALS IS
  !    SUMMED AND STORED IN TSTOR1 AT THE VERY end; THE CALLER MAY USE
  !    THIS TO COMPLETE AN ELECTRON WEIGHTED NEUTRAL PARTICLE BALANCE
  !    AS A CHECK ON THE CODE
  !
  !
  !  THIS ROUTINE WAS WRITTEN BY HARRY H. TOWNER OF THE PRINCETON
  !  PLASMA PHYSICS LAB.  THIS ROUTINE WILL CALCULATE THE NET SOURCES
  !  FOR:
  !  ELECTRONS
  !  HYDROGEN OR HELIUM ISOTOPE IONS
  !  HYDROGEN OR HELIUM NEUTRALS
  !  POWER FLOW DUE TO CHARGE EXCHANGE  (IONS TO NEUTRALS)
  !  POWER FLOW DUE TO IONIZATION  (NEUTRALS TO IONS)
  !
  use iso_c_binding, only: fp => c_double
  use physconst_mod, only: zero, half, one
  use frantic_module
  implicit none
  real(fp), parameter :: C3OV2 = 1.5_fp
  real(fp), parameter :: FOUR = 4.0_fp
  real(fp), parameter :: CEPS7 = 1.0e-7_fp
  !
  integer :: i,ik,ikc,inl,inlc,j,isb,idir,jz,jm1
  real(fp) :: zflmin,zelsmg,zvipcx,zvipii,zviprc
  real(fp) :: zvivs,zvipvs,zflxmg,zelosw,zfluxt,zeflux,zfluxw,ztwalk
  real(fp) :: zwarea,zmassf,zjperg,ztka,zvwall,zflxw,zvphik
  real(fp) :: zmassk,zusum1,zpcxmg,zpcxsfmg,ztqcxmg,zpiimg,zpiisfmg
  real(fp) :: ztqiimg,zpcxw,zpcxsfw,ztqcxw,zpiiw,zpiisfw,ztqiiw
  real(fp) :: ztsum3,zts1,zsum,zsum2,zsum2tq,zsum3,zsum3tq,ztsum1
  real(fp) :: ztempi,zvphii,zmassi,ztempj,zvphij,zmassj,zsmg
  real(fp) :: zts8,zts2,zts5,zbsum,zts6,zvoli,zts3,zflb,zfub
  real(fp) :: zpflb,zpfub,ztflb,ztfub,znrm2,zfl,zsum2tqw
  real(fp) :: zvphi0,zmass0
  real(fp) :: zscxw,zscxmg
  real(fp) :: ZSTOR(MJ)  ! TEMP STORAGE -- ELECTRONS TO BEAM NEUTRALS
  !
  !------------------------------------------------------
  !
  real(fp), parameter :: zcon1 = 1.6021892e-16_fp
  real(fp), parameter :: zcon2 = 2.8945365e15_fp
  real(fp), parameter :: ztwopi = 6.2831853071795862_fp
  !
  !  CON1 = JOULES/KEV
  !  CON2 = 3*C*C/(KEV/AMU)
  !-----------------

  !
  !  MINIMUM FLUX TO CONSIDER (AVOID UNDERFLOWS ON VAX):
  !
  ZFLMIN=EPSLON/ZCON1
  !
  ZELSMG=ZERO
  ZVIPCX=ZERO
  ZVIPII=ZERO
  ZVIPRC=ZERO
  ZVIVS=ZERO
  ZVIPVS=ZERO
  ZFLXMG=ZERO
  PLOSS1=ZERO
  ZELOSW=ZERO
  ZFLUXT=ZERO
  ZEFLUX=ZERO
  ZFLUXW=ZERO
  ZTWALK=ZERO
  ZWAREA=ZTWOPI*AMINOR
  !
  do I=1,NZONEC
    ZSTOR(I)=ZERO
  end do
  !  MASS (GRAMS) / AMU  ... FACTOR FOR ROTATION POWER TERMS
  !
  !CC	ZMASSF=RMASS(1)/APLAS(NSPEC(1))
  !CC	ZMASSF=RMASS(NINLDX)/APLAS(NSPEC(NINLDX))            ! TBT 5/91
  ZMASSF=RMASS(NSPEC(NINLDX)-2)/APLAS(NSPEC(NINLDX))   ! TBT 7/91
  ZJPERG=CEPS7 ! JOULES/ERG
  !
  do IK=1,NNEUT
    IKC=NSPEC(IK)
    ZMASSK=APLAS(IKC)*ZMASSF
    !=============
    !  ESCAPE COEFFICIENTS AND AVG ENERGY SUMS FOR TRANSP
    OUTFLX(IK)=ZERO
    EESCAV(IK)=ZERO
    !=============
    if(.NOT.ESFLAG) GO TO 10
    ZTWALK=TWALL(IK)
    ZFLUXT=ZFLUXT+FLUXI0(IK)
    ZEFLUX=ZEFLUX+FLUXI0(IK)*ZTWALK
    WWALL(IK)=FOUR*WWALL(IK)*FLUXI0(IK)/ZWAREA
    ZFLUXW=ZFLUXW+WWALL(IK)
    ZELOSW=ZELOSW+WWALL(IK)*ZTWALK
    !=============
    OUTFLX(IK)=OUTFLX(IK)+WWALL(IK)
    EESCAV(IK)=EESCAV(IK)+ZTWALK*WWALL(IK)*C3OV2*ZCON1 + &
         wwall(ik)*zjperg*half*zmassk*vphi_wall(ik)**2
    !=============
10  continue
    !  KC GIVES THE ION NUMBER OF THE KTH NEUTRAL.
    ZTKA=APLAS(IKC)
    !  I NOW FIND THE WALL VELOCITY FOR THIS NEUTRAL SPECIES.
    ZVWALL=SQRT(ZCON2*ZTWALK/ZTKA)
    !  I NOW LOOP OVER ALL DEATH ZONES.
    do I=1,NZONEC
      ZFLXW=WALL(I,IK)*TSTOR1(I,IK)/ZWAREA
      ZFLXMG=ZFLXMG+ZFLXW
      ZELSMG=ZELSMG+ZFLXW*TEMP(I,IKC)
      !AUG86
      ZVPHIK=VPHIZ(I,IKC)
      !
      !==================
      !  CALCULATE TRANSP ESCAPE COEFFICIENT, SPECIES-RESOLVED,
      !  FOR RENORMALIZATION OF SOURCE
      !  THE TRANSP NEUTRAL SOURCE NUMBER NSRC WILL HAVE BEEN SET
      OUTFLX(IK)=OUTFLX(IK)+ZFLXW
      EESCAV(IK)=EESCAV(IK)+ZFLXW*TEMP(I,IKC)*C3OV2*ZCON1 &
           +ZFLXW*ZJPERG*ZVPHIK**2*HALF*ZMASSK
      !======================================
      ZUSUM1=ZERO
      !  USUM1 WILL CONTAIN THE SOURCE OF ELECTRONS RESULTING FROM
      !  THE INTERACTION OF THE K NEUTRAL SPECIES.
      ZPCXMG=ZERO
      !  PCXMG WILL CONTAIN THE CHARGE EXCHANGE POWER FLOW IN ZONE I
      !  DUE TO MG NEUTRAL PARTICAL K INTERACTING WITH ALL CHARGED
      !  PARTICLES. - THERMAL CONTRIBUTION ONLY

      !dmc06 ..useful to compute net cx reaction rate as well..

      zscxmg=ZERO

      !AUG86
      ZPCXSFMG=ZERO
      !  PCX CONTRIBUTION DUE TO DifFERENCE IN ROT. VELOCITY BTW
      !  BIRTH AND DEATH ZONES (FRICTIONAL TERM)
      ZTQCXMG=ZERO
      !  TORQUE DUE TO CX
      !AUG86_end
      !
      ZPIIMG=ZERO
      !  PIIMG WILL CONTAIN THE IONIZATION POWER FLOW IN ZONE I DUE
      !  TO MG NEUTRAL PARTICLES BEING IONIZED.
      !AUG86
      ZPIISFMG=ZERO
      !  PIONIZ. CONTRIBUTION DUE TO DifFERENCE IN ROT. VELOCITY BTW
      !  BIRTH AND DEATH ZONES (FRICTIONAL TERM)
      ZTQIIMG=ZERO
      !  TORQUE DUE TO IONIZ.
      !AUG86_end
      ZPCXW=ZERO
      !  PCXW WILL CONTAIN THE CHARGE EXCHANGE POWER FLOW IN ZONE I
      !  DUE TO WALL NEUTRAL PARTICAL K INTERACTING WITH ALL CHARGED
      !  PARTICLES.

      !dmc06 ..useful to compute net cx reaction rate as well..

      zscxw=ZERO
      !AUG86
      ZPCXSFW=ZERO
      !  PCX CONTRIBUTION DUE TO DifFERENCE IN ROT. VELOCITY BTW
      !  WALL AND DEATH ZONES (FRICTIONAL TERM)
      ZTQCXW=ZERO
      !  TORQUE DUE TO CX
      !AUG86_end
      ZPIIW=ZERO
      !  PIIW WILL CONTAIN THE IONIZATION POWER FLOW IN ZONE I DUE TO
      !  WALL NEUTRALS.
      !AUG86
      ZPIISFW=ZERO
      !  PII CONTRIBUTION DUE TO DifFERENCE IN ROT. VELOCITY BTW
      !  WALL AND DEATH ZONES (FRICTIONAL TERM)
      ZTQIIW=ZERO
      !  TORQUE DUE TO IONIZ. WALL SCE
      !AUG86_end
      ZTSUM3=ZERO
      !  TSUM3 WILL CONTAIN THE TOTAL MG REACTION RATE/CM**3 FOR THE
      !  K NEUTRAL INTERACTING IN ZONE I.
      ZTS1=DCOLD(I,IK)*ZVWALL
      ZSUM=ZERO
      !  SUM CONTAINS THE WALL SOURCE OF NEUTRALS PRODUCED BY THE K NEUTRAL
      !  INTERACTING WITH ALL CHARGED PARTICLES.
      !
      ZSUM2=ZERO
      !AUG86
      ZSUM2TQ=ZERO
      zsum2tqw=ZERO
      !  SUM2 CONTAINS THE POWER OF THE K MG NEUTRAL SPECIES IN ZONE I
      !  SUMMED OVER ALL BIRTH ZONES AND OVER ALL CHARGED PARTICLES.
      !  AUG86 - RELATED SUM FOR TORQUES ADDED
      !
      ZSUM3=ZERO
      !AUG86
      ZSUM3TQ=ZERO
      !  SUM3 CONTAINS THE POWER OF THE K WALL NEUTRAL SPECIES IN ZONE I
      !  SUMMED OVER ALL CHARGED PARTICLES.
      !  AUG86 - RELATED SUM FOR TORQUES ADDED
      !
      do INL=1,NNEUT
        !
        !  NL REPRESENTS THE CHARGED HYDROGENIC SPECIES
        INLC=NSPEC(INL)
        ZTSUM1=ZERO
        !  TSUM1 WILL CONTAIN THE SOURCE OF ALL CX MG NEUTRALS IN ZONE I
        !  SUMMED OVER ALL BIRTH ZONES FOR THE K NEUTRAL AND THE NLC PLASMA
        !  SPECIE.
        !  SAME AS ABOVE BUT FOR CROSS SPECIES.
        ZTEMPI=TEMP(I,INLC)
        !AUG86
        ZVPHII=VPHIZ(I,INLC)
        ZMASSI=APLAS(INLC)*ZMASSF
        !
        !  TEMPI IS THE TEMPERATURE OF THE NLC PLASMA SPECIES IN ZONE I.
        !  I NOW LOOP OVER THE BIRTH ZONES OF THE MULTI-GENERATION NEUTRALS.
        do J=1,NZONEC
          ZTEMPJ=TEMP(J,IKC)
          !AUG86
          ZVPHIJ=VPHIZ(J,IKC)
          ZMASSJ=ZMASSK
          !
          !  TEMPJ IS THE TEMPERATURE OF THE K NEUTRAL SPECIE BORN IN J.
          !  I NOW FIND THE VELOCITY AT WHICH THE NEUTRAL WAS BORN.
          !WHY?	        ZVNEUT=SQRT(ZCON2*ZTEMPJ/ZTKA)
          !  I NOW FIND THE SOURCE OF NEUTRALS
          ZSMG=-GFUN(I,J,INL,IK)
          if(J.EQ.I.AND.INL.EQ.IK) ZSMG=ZSMG+ONE
          ZSMG=ZSMG*TSTOR1(J,IK)
          !  SMG IS NOW THE SOURCE RATE OF MULTI-GENERATION NEUTRALS OF SPECIES
          !  NL IN ZONE I DUE TO NEUTRALS OF TYPE K BORN IN ZONE J CHARGE
          !  EXCHANGING ON CHARGED PARTICLE L.
          ZTSUM1=ZTSUM1+ZSMG
          !  DMC JUL 1989 - if NEWBORN NEUTRALS HAVE LOWER Z THAN OLD NEUTRALS
          !  K, THEN THERE IS AN ELECTRON SOURCE
          ZUSUM1=ZUSUM1+ZSMG*(XZPLAS(IKC)-XZPLAS(INLC))
          ZPCXMG=ZPCXMG+(ZTEMPI-ZTEMPJ)*ZSMG
          ZSCXMG=ZSCXMG+ZSMG
          ZSUM2=ZSUM2+ZTEMPJ*ZSMG
          !AUG86
          ZPCXSFMG=ZPCXSFMG+ZSMG*ZMASSJ*HALF*(ZVPHIJ-ZVPHIK)**2
          !
          ZTQCXMG=ZTQCXMG+ZSMG* &
               (ZVPHII*ZMASSI-ZVPHIJ*ZMASSJ)
          ZSUM2TQ=ZSUM2TQ+ZSMG*ZVPHIJ*ZMASSJ
          !AUG86_end
          !
          !CC	        if(INL.GT.1) GO TO 20
          if(INL.NE.NINLDX) GO TO 20       ! TBT 5/91
          !  INCLUDE TOTAL MG REACTIONS.
          !CC		  ZTS8=ALPHAT(I,J,IK)*ZSMG/ALPHAX(I,J,1,IK)
          ZTS8=ALPHAT(I,J,IK)*ZSMG/ALPHAX(I,J,NINLDX,IK)  ! TBT 91
          ZTSUM3=ZTSUM3+ZTS8
          !!SOURCE DUE TO MG IONIZATION
          ZUSUM1=ZUSUM1+ZTS8*XZPLAS(IKC)
          ZPIIMG=ZPIIMG+ZTS8*ZTEMPJ
          ZPIISFMG=ZPIISFMG+ZTS8*ZMASSJ*HALF*(ZVPHIJ-ZVPHIK)**2
          ZTQIIMG=ZTQIIMG+ZTS8*ZVPHIJ*ZMASSJ
          ! NOTE THAT THE NEUTRAL POWER (SUM2) WILL BE SUBTRACTED LATER.
20        continue
        end do
        !  NEXT 3 LINES GIVE CONTRIBUTION DUE TO MG NEUTRALS.
        SORI(I,INL)=SORI(I,INL)-ZTSUM1   !SINK DUE TO MG CX
        SORN(I,INL)=SORN(I,INL)+ZTSUM1   !SOURCE DUE TO MG CX
        ZUSUM1=ZUSUM1-ZTSUM1*XZPLAS(IKC) !CORRECTION FOR MG CX
        !
        if(.NOT.ESFLAG) GO TO 40
        ZTS2=S0COLD(I,INL,IK)
        SORI(I,INL)=SORI(I,INL)-ZTS2    !SINK DUE TO WALL CX
        SORN(I,INL)=SORN(I,INL)+ZTS2    !SOURCE DUE TO WALL CX
        !  DMC JUL 1989 - if NEWBORN NEUTRALS HAVE LOWER Z THAN OLD NEUTRALS
        !  K, THEN THERE IS AN ELECTRON SOURCE
        SORE(I)=SORE(I)+ZTS2*(XZPLAS(IKC)-XZPLAS(INLC))
        ZPCXW=ZPCXW+(ZTEMPI-ZTWALK)*ZTS2
        ZSCXW=ZSCXW+ZTS2
        ZSUM3=ZSUM3+ZTS2*ZTWALK
        ZSUM=ZSUM+ZTS2
        ZPCXSFW=ZPCXSFW+ZTS2*HALF*(ZVPHIK-vphi_wall(ik))**2*ZMASSK
        ZTQCXW=ZTQCXW+ZTS2*(ZVPHII*ZMASSI-vphi_wall(iK)*ZMASSK)
        zsum2tqw=zsum2tqw+ zts2*vphi_wall(iK)*ZMASSK
        !  EVALUATE ZSUM3TQ HERE if THE WALLS SPIN
40      continue
      end do
      !  NEXT 5 LINES GIVE CONTRIBUTION DUE TO MG NEUTRALS.
      ZPIIMG=ZPIIMG-ZSUM2
      ZPIISFMG=ZPIISFMG-ZPCXSFMG
      ZTQIIMG=ZTQIIMG-ZSUM2TQ
      SORI(I,IK)=SORI(I,IK)+ZTSUM3  !SOURCE DUE TO MG ION.
      SORN(I,IK)=SORN(I,IK)-ZTSUM3  !SINK DUE TO MG ION.
      !
      if(.NOT.ESFLAG) GO TO 50
      ZTS5=BETAT(I,IK)*ZTS1
      SORI(I,IK)=SORI(I,IK)+ZTS5  !SOURCE DUE TO WALL ION.
      SORN(I,IK)=SORN(I,IK)-ZTS5  !SINK DUE TO WALL ION.
      ZUSUM1=ZUSUM1+ &
           (ZTS5-ZSUM)*XZPLAS(IKC)  !SOURCE DUE TO WALL IONIZATION
      ZPIIW=ZPIIW+ZTS5*ZTWALK-ZSUM3
      ztqiiw=ztqiiw+zts5*vphi_wall(iK)*ZMASSK-zsum2tqw
      ZPIISFW=ZPIISFW+ZTS5*HALF*(ZVPHIK-vphi_wall(ik))**2*ZMASSK - &
           ZPCXSFW
50    continue
      !  THE ELECTRON SOURCE IS NOW CORRECTED FOR BEAM CX.
      if(LBFLAG) then
        ZBSUM=ZERO
        do ISB=1,NSBEAM
          ZBSUM=ZBSUM+BCXS(I,IK,ISB)*XZBEAMS(ISB)* &
               (DCOLD(I,IK)+DNEUT(I,IK))
        end do
        ZUSUM1=ZUSUM1-ZBSUM
        ZSTOR(I)=ZSTOR(I)+ZBSUM
      end if
      SCX(I)=SCX(I)+ZSCXMG+ZSCXW
      PCX(I)=PCX(I)+ZPCXMG+ZPCXW
      PII(I)=PII(I)+ZPIIMG+ZPIIW
      SORE(I)=SORE(I)+ZUSUM1
      PCXSF(I)=PCXSF(I)+ZPCXSFMG+ZPCXSFW
      PIISF(I)=PIISF(I)+ZPIISFMG+ZPIISFW
      !
      TQCX(I)=TQCX(I)+ZTQCXMG+ZTQCXW
      TQII(I)=TQII(I)+ZTQIIMG+ZTQIIW
      if(.NOT.RCFLAG) GO TO 60
      ZTS6=SVRC(I)*DEN(I,IKC)
      SORI(I,IK)=SORI(I,IK)-ZTS6
      SORE(I)=SORE(I)-ZTS6*XZPLAS(IKC)
      SORN(I,IK)=SORN(I,IK)+ZTS6
      PRC(I)=PRC(I)+ZTS6*TEMP(I,IKC)
60    continue
    end do
  end do
  !  I NOW CONVERT POWER TERMS TO WATTS
  !   AUG86 - AND THE TORQUE DENSITIES TO JLES/CM3
  do I=1,NZONEC
    PCX(I)=PCX(I)*ZCON1*C3OV2
    PII(I)=PII(I)*ZCON1*C3OV2
    !AUG86
    PCXSF(I)=PCXSF(I)*ZJPERG
    PIISF(I)=PIISF(I)*ZJPERG
    TQCX(I)=TQCX(I)*ZJPERG
    TQII(I)=TQII(I)*ZJPERG
    !AUG86_end
    ZVOLI=VOL(I)
    ZVIPII=ZVIPII+PII(I)*ZVOLI
    ZVIPCX=ZVIPCX+PCX(I)*ZVOLI
    if(.NOT.RCFLAG) GO TO 80
    PRC(I)=PRC(I)*ZCON1*C3OV2
    ZVIPRC=ZVIPRC+PRC(I)*ZVOLI
    !
80  continue
    vsor_zw(i)=0
    vsor_en(i)=0
    vsor_mo(i)=0
    do IK=1,NNEUT
      IKC=NSPEC(IK)
      PLOSS1=PLOSS1+SORN(I,IK)*ZVOLI
      if(.NOT.VSFLAG) GO TO 90
      ZTS3=VOLSOR(I,IK)*ZVOLI
      ZVIVS=ZVIVS+ZTS3
      ZVIPVS=ZVIPVS+ZTS3*TEMP(I,IKC)

      ZVPHI0=VPHIZ(I,IKC)
      ZMASS0=APLAS(IKC)*ZMASSF
      vsor_zw(i)=vsor_zw(i) + volsor(i,ik)*xZplas(ikc)
      vsor_en(i)=vsor_en(i) + volsor(i,ik)* &
           (TEMP(I,IKC)*C3OV2*ZCON1)
      vsor_mo(i)=vsor_mo(i) + volsor(i,ik)* &
           ZJPERG*ZVPHI0*ZMASS0
90    continue
    end do
!
  end do
  !
  !=============
  !  RENORMALIZE TRANSP ESCAPED NEUTRALS ARRAYS
  !
  do IK=1,NNEUT
    if(OUTFLX(IK).GT.ZERO) then
      EESCAV(IK)=EESCAV(IK)/OUTFLX(IK)
    else
      EESCAV(IK)=1.0_fp
    end if
  end do
  !=============
  PLOSS=ZWAREA*(ZFLXMG+ZFLUXW-ZFLUXT)-ZVIVS
  ELOSS=(ZWAREA*(ZELSMG+ZELOSW-ZEFLUX)-ZVIPVS)*C3OV2*ZCON1
  ELOSS1=ZVIPCX+ZVIPRC-ZVIPII
  !===================
  !  FLUX(R) CALCULATION.
  !  NORMALIZATION IS CORRECT WHEN USED AS TRANSP subroutine WITH
  !  "[TRANSP]SORCE1.FOR" AS DRIVER ***ONLY***
  !  VARIABLES DEFINED ARE TRANSP NEUTRAL FLUX(R) ARRAYS
  !
  !  LOOP OVER IN/OUT FLUX DIRECTION
  do IDIR=1,2
    !  LOOP OVER ZONE WHERE FLUX DIVERGENCES ARE DEFINED
    do J=1,NZONEC
      JZ=J
      JM1=J-1
      !  INITIALIZE SUMS
      if(IDIR.EQ.1) TQFLX0(JZ)=ZERO
      ZFLB=ZERO
      ZFUB=ZERO
      ZPFLB=ZERO
      ZPFUB=ZERO
      ZTFLB=ZERO
      ZTFUB=ZERO
      !  PORTION OF FLUX DUE TO WALL SOURCE
      if(.NOT.ESFLAG) GO TO 130
      do IK=1,NNEUT
        IKC=NSPEC(IK)
        ZNRM2=FLUXI0(IK)
        ZFL=ZNRM2*FOUR*PRWFLX(J,IK,IDIR)
        !  CHECK AGAINST MINIMUM FLUX (UNDERFLOW A POSSIBILITY)
        if(ABS(ZFL).LT.ZFLMIN) ZFL=ZERO
        ZFUB=ZFUB+ZFL*XZPLAS(IKC)
        ZTFUB=ZTFUB+ZFL*APLAS(IKC)*vphi_wall(ik)*ZMASSF
        !AUG86 - ROT - COMPUTE POWER FLUX IN PLASMA FRAME, REL. ZONE J
        ZPFUB=ZPFUB+C3OV2*ZCON1*ZFL*TWALL(IK) &
             +ZFL*ZJPERG*APLAS(IKC)* &
             HALF*(VPHIZ(J,IKC)-vphi_wall(ik))**2*ZMASSF
        if(JM1.EQ.0) GO TO 120
        ZFL=ZNRM2*FOUR*PRWFLX(JM1,IK,IDIR)
        !  CHECK AGAINST MINIMUM FLUX (UNDERFLOW A POSSIBILITY)
        if(ABS(ZFL).LT.ZFLMIN) ZFL=ZERO
        ZFLB=ZFLB+ZFL*XZPLAS(IKC)
        ZTFLB=ZTFLB+ZFL*APLAS(IKC)*vphi_wall(ik)*ZMASSF
        !AUG86 - ROT - COMPUTE POWER FLUX IN PLASMA FRAME
        ZPFLB=ZPFLB+ZFL*C3OV2*ZCON1*TWALL(IK) &
             +ZFL*ZJPERG*APLAS(IKC)* &
             HALF*(VPHIZ(J,IKC)-vphi_wall(ik))**2*ZMASSF
120     continue
      end do
130   continue
      !  PORTION DUE TO VOLUME/MULTIGENERATION SOURCE
      !  LOOP OVER INDEX TO ZONE OF ORIGIN OF NEUTRAL CONTRIBUTING TO
      !  FLUX AT BDY J/JM1, AND OVER SPECIES
      do IK=1,NNEUT
        IKC=NSPEC(IK)
        do I=1,NZONEC
          ZFL=TSTOR1(I,IK)*PRFLUX(I,J,IK,IDIR)
          !  CHECK AGAINST MINIMUM FLUX (UNDERFLOW A POSSIBILITY)
          if(ABS(ZFL).LT.ZFLMIN) ZFL=ZERO
          ZFUB=ZFUB+ZFL*XZPLAS(IKC)
          !AUG86 - ROT - COMPUTE POWER FLUX IN PLASMA FRAME
          !  ** NOT VALID ** if VPHI REALLY A FCN OF PLASMA SPECIES
          !  ** BECAUSE WHAT THEN IS THE PLASMA FRAME?
          ZPFUB=ZPFUB+C3OV2*ZCON1*TEMP(I,IKC)*ZFL &
               +ZFL*ZJPERG*APLAS(IKC)*HALF &
               *(VPHIZ(I,IKC)-VPHIZ(J,IKC))**2*ZMASSF
          !AUG86 - TORQUE FLUX IN LAB FRAME
          ZTFUB=ZTFUB+ZFL* &
               APLAS(IKC)*VPHIZ(I,IKC)*ZMASSF
          if(JM1.EQ.0) cycle
          ZFL=TSTOR1(I,IK)*PRFLUX(I,JM1,IK,IDIR)
          !  CHECK AGAINST MINIMUM FLUX (UNDERFLOW A POSSIBILITY)
          if(ABS(ZFL).LT.ZFLMIN) ZFL=ZERO
          ZFLB=ZFLB+ZFL*XZPLAS(IKC)
          !AUG86 - ROT - COMPUTE POWER FLUX IN PLASMA FRAME
          !  ** NOT VALID ** if VPHI REALLY A FCN OF PLASMA SPECIES
          ZPFLB=ZPFLB+ZFL*C3OV2*ZCON1*TEMP(I,IKC) &
               +ZFL*ZJPERG*APLAS(IKC)*HALF &
               *(VPHIZ(I,IKC)-VPHIZ(J,IKC))**2*ZMASSF
          !AUG86 - TORQUE FLUX IN LAB FRAME
          ZTFLB=ZTFLB+ZFL* &
               APLAS(IKC)*VPHIZ(I,IKC)*ZMASSF
        end do
      end do
!  DEFINE FLUX DIVERGENCES
      SFLX0M(IDIR,JZ)=(ZFUB-ZFLB)/VOL(J)
      PFLX0M(IDIR,JZ)=(ZPFUB-ZPFLB)/VOL(J)
      TQFLX0M(IDIR,JZ)=ZJPERG*(ZTFUB-ZTFLB)/VOL(J)
      !
    end do
  end do
  !================
  !  FINAL KLUGE
  !   force densities (or equiv.) to torque densities
  do I=1,NZONEC
    TSTOR1(I,1)=ZSTOR(I)
    TQFLX0(I)=-TQFLX0M(1,I)+TQFLX0M(2,I)
    TQFLX0(I)=RMJRMP(I)*TQFLX0(I)
    TQFLX0M(1,I)=RMJRMP(I)*TQFLX0M(1,I)
    TQFLX0M(2,I)=RMJRMP(I)*TQFLX0M(2,I)
    tqflx0(i)=tqflx0m(2,i)-tqflx0m(1,i)
    TQII(I)=RMJRMP(I)*TQII(I)
    TQCX(I)=RMJRMP(I)*TQCX(I)
    VSOR_MO(I)=RMJRMP(I)*VSOR_MO(I)
  end do
  !================
  return
end subroutine frantic_edits
