subroutine frantic_kernel
  !  THIS subroutine WAS WRITTEN BY HARRY. H. TOWNER OF THE PRINCETON
  !  PLASMA PHYSICS LAB.  THIS ROUTINE WILL FINISH CONSTRUCTING
  !  THE S0COLD AND GFUN ARRAYS.  IT WILL ALSO CONSTRUCT THE KERNEL
  !  FROM GFUN.
  !
  ! UPDATES:
  !
  !  TBT Jun, 1991  Added NINLDX as the pointer to the lightest gas in
  !                 BACKZ for this source.
  !	6/04/91 TBT Switched loop 10 and 20 to fix do 20 INL=NNEUT,1,-1
  !                   bug when we had BACKZ=2,1 which overwrote good value.
  !	5/20/91 TBT Added INDX to handle H and He plasmas.
  !
  use iso_c_binding, only: fp => c_double
  use physconst_mod, only: one
  use frantic_module
  implicit none
  real(fp), parameter :: FOUR = 4.0_fp
  !-----------------
  integer :: ik,i,idir,j,inl
  real(fp) :: zts1,zts3,zts2,zts4,zga,zts0
  !-----------------
  !
  ! I NOW LOOP OVER ALL NEUTRAL SPECIES.
  do IK=1,NNEUT
    ZTS1=FOUR*FLUXI0(IK)
    ! I NOW LOOP OVER ALL BIRTH ZONES.
    do I=1,NZONEC
      if(.NOT.MCFLAG) GO TO 50
      ZTS3=ONE/ALPHAT(I,I,IK)
      WALL(I,IK)=WALL(I,IK)*ZTS3
      
      do IDIR=1,2
        do J=1,NZONEC
          PRFLUX(I,J,IK,IDIR)=PRFLUX(I,J,IK,IDIR)*ZTS3
        end do
      end do

50    if(ESFLAG) then             ! TBT 6/91
        ZTS2=BETAT(I,IK)*VOL(I)
        !CC ZTS4=S0COLD(I,1,IK)
        ZTS4=S0COLD(I,NINLDX,IK)      ! TBT 5/91

        !              I NOW LOOP OVER ALL ALLOWED CHARGED PARTICLES.
        do INL=1,NNEUT
          S0COLD(I,INL,IK)=ZTS4*ZTS1*BETAX(I,INL,IK)/ZTS2
        end do
      end if  ! ESFLAG

      if(MCFLAG) then
        do J=1,NZONEC
          !CC ZGA=GFUN(J,I,1,IK)*ZTS3
          ZGA=GFUN(J,I,NINLDX,IK)*ZTS3      ! TBT 5/91

          ! .I NOW LOOP OVER ALL ZONES.
          do INL=1,NNEUT               ! TBT 6/91
            ZTS0=-ALPHAX(J,I,INL,IK)/(ALPHAT(J,I,IK)*VOL(J))
            GFUN(J,I,INL,IK)=ZGA*ZTS0
            if(J.EQ.I.AND.INL.EQ.IK) then
              GFUN(J,I,INL,IK) = GFUN(J,I,INL,IK)+ONE
            end if  ! J=I
          end do
        end do
      end if  ! MCFLAG

    end do
  end do

  return
end subroutine frantic_kernel
