subroutine frantic_editr
  !
  !  THIS ROUTINE WAS WRITTEN BY HARRY H. TOWNER OF THE PRINCETON
  !  PLASMA PHYSICS LAB.  THIS ROUTINE WILL CONSTRUCT THE OUTPUT
  !  RESULTS OF DNEUT, TNEUT, EDEP, RdoT AND SPECTRUM.
  !
  !  Mod TBT 5/1/91 added NINLDX as index to lowest atomic #.
  !  MOD DMC AUG85 FOR TRANSP ROTATION BAL. CALCULATION
  
  !-------------------------------
  !
  !  TBT Jun, 1991  Added NINLDX as the pointer to the lightest gas in
  !                 BACKZ for this source.
  !
  !-----------------------------
  !
  use iso_c_binding, only: fp => c_double
  use physconst_mod, only: zero, one
  use frantic_module
  implicit none
  real(fp), parameter :: CEPS30 = 1.0e-30_fp
  integer :: ik,innk,i,inl,ilp1,j
  real(fp) :: ztska,zvwall,zsum2,zsum3,zsum4,zvneut,zgf,zts2
  real(fp) :: zts4,ztotln
  real(fp), parameter :: zcon2 = 2.8945365e15_fp
  !
  !  CON2 = 3*C*C/(KEV/AMU)


  ! I NOW LOOP OVER ALL ORGINAL NEUTRAL SPECIES.
  do IK=1,NNEUT
    INNK=NSPEC(IK)
    ZTSKA=APLAS(INNK)
    ! I NOW FIND THE WALL VELOCITY FOR THIS SPECIES.
    ZVWALL=SQRT(ZCON2*TWALL(IK)/ZTSKA)
    ! I NOW LOOP OVER ALL ZONES
    do I=1,NZONEC
      ! I NOW LOOP OVER ALL CHARGED PARTICLES WHICH COULD
      ! RESULT IN AN INTERACTION.
      if(ESFLAG) then
        !CC TBT	 DCOLD(I,IK)=S0COLD(I,1,IK)/(BETAX(I,1,IK)*ZVWALL)
        DCOLD(I,IK)=S0COLD(I,NINLDX,IK)/ &
             (BETAX(I,NINLDX,IK)*ZVWALL)
        if(ABS(DCOLD(I,IK)).LT.EPSLON) DCOLD(I,IK)=ZERO
      end if
      ! INL=1
      INL= NINLDX      ! TBT  5/1/91
      ILP1=NSPEC(INL)
      ZSUM2=ZERO
      ZSUM3=ZERO
      !AUG86
      ZSUM4=ZERO
      !
      !-----------------
      !  I NOW LOOP OVER ALL BIRTH ZONES
      do J=1,NZONEC
        ZVNEUT=SQRT(ZCON2*TEMP(J,INNK)/ZTSKA)
        ! I NOW FIND THE SOURCE RATE
        ZGF=-GFUN(I,J,INL,IK)
        if(J.EQ.I.AND.INL.EQ.IK) ZGF=ZGF+ONE
        !  TS2 CONTAINS THE SOURCE RATE OF NEUTRALS NL IN ZONE I
        !  DUE TO NEUTRALS OF TYPE K BORN IN ZONE J CHARGE EXCHANGING
        !  ON CHARGED PARTICLE L.
        ZTS2=ZGF*TSTOR1(J,IK)
        !  TS4 IS THE NUMBER OF MULTI-GENERATION NEUTRALS IN ZONE I DUE
        !  TO NEUTRAL K BORN IN ZONE J INTERACTING WITH CHARGED PARTICLE
        !  L.
        ZTS4=ZTS2/(ALPHAX(I,J,INL,IK)*ZVNEUT)
        ZSUM2=ZSUM2+ZTS4
        ZSUM3=ZSUM3+ZTS4*TEMP(J,ILP1)
        ZSUM4=ZSUM4+ZTS4*VPHIZ(J,ILP1)
      end do
      !-----------------
      DNEUT(I,IK)=ZSUM2
      TNEUT(I,IK)=ZSUM3
      !AUG86
      VPHI0F(I,IK)=ZSUM4
    end do
    !-----------------
  end do
  !-----------------
  if(.NOT.ESFLAG) GO TO 60
  !
  !-----------------
  do IK=1,NNEUT
    do I=1,NZONEC
      ZTOTLN=DNEUT(I,IK)+DCOLD(I,IK)
      if(ZTOTLN.LT.CEPS30) GO TO 40
      TNEUT(I,IK)=(TNEUT(I,IK)+DCOLD(I,IK)*TWALL(IK))/ZTOTLN
      !AUG86
      VPHI0F(I,IK)=(VPHI0F(I,IK)+DCOLD(I,IK)*vphi_wall(ik))/ZTOTLN
40    continue
    end do
  end do
  GO TO 90
  !
  !-----------------
60 continue
  do IK=1,NNEUT
    do I=1,NZONEC
      TNEUT(I,IK)=TNEUT(I,IK)/DNEUT(I,IK)
      !AUG86
      VPHI0F(I,IK)=VPHI0F(I,IK)/DNEUT(I,IK)
    end do
  end do
  !
  !-----------------
90 return
end subroutine frantic_editr
