      subroutine curray (nprofs_c, nxeqd_c, nzeqd_c, psistep_c, 
     &   pkexpnt_c, 
     1   igraph_c, iprint_c, nspec_c, epserr_c, epser1_c, idcur_c, 
     2   nprim_c, nimp_c, nminor_c, atm_c, azi_c, aconc_c, denc_c, 
     3   tempec_c, tite_c, denedg_c, frcne_c, gamene_c,
     4   alpene_c, gamene1_c, alpene1_c, temedg_c, frcte_c, gamte_c, 
     5   alpte_c, gamte1_c, alpte1_c, atmf_c, azf_c, ebkev_c, kboot_c, 
     6   nalfa_c, kalfa_c, ioread_c, isimm_c, nspect_c, 
     7   nraypts_c, psi0_c, thgril_c, nthin_c, maxref_c, islofa_c, 
     8   ptot0_c, freqcy_c, heigth_c, indvar_c, powers_c, nnkpar_c,
     9   anzinf_c, anzsup_c, nnkpol_c, anpsup_c, anpinf_c, idrive_c, 
     &   ichois_c, modcd_c, igrill_c, bmax_c, idmpsw_c, irayio_c, inc_c, 
     1   icurdr_c, nrho_c, xrho_c, ne_c, te_c, ni_c, ti_c, elp_c,
     &   xdimeqd_c, zdimeqd_c, reqd_c, redeqd_c, zmideqd_c, 
     2   xma_c, zma_c, psimag_c, psilim_c, beqd_c, toteqd_c, psimx1_c, 
     3   psimx2_c, xax1_c, xax2_c, zax1_c, zax2_c, psisep_c,
     4   xsep_c, zsep_c, feqd_c, presseqd_c, ffpeqd_c, ppeqd_c, qeqd_c,
     5   peqd_c, iounit_c, ppsi_c, pwe_c, pwit_c, pwct_c)
c
C...Translated by Pacific-Sierra Research VAST-90 2.06G2  09:55:32   6/14/01
C...Switches: -p4 -yb
C
C   Calling subroutine for CURRAY, version 8/1/02
C   Converted from main program 'aamaincur'
C
C
C       -----------------------------
C        Multiple ray case
C        -----------------------------
C
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      use Vparam
      use Vsizes
      use Vceqdsk, ONLY: ntitle, dat, ipestg, nxeqd, nzeqd, xdimeqd,
     1   zdimeqd, reqd, redeqd, zmideqd, xma, zma, psimag, psilim,
     2   beqd, toteqd, psimx1, psimx2, xax1, xax2, zax1, zax2, psisep,
     3   xsep, zsep, feqd, presseqd, ffpeqd, ppeqd, peqd, qeqd, xeqd,
     4   zeqd, psiadj, dpolflx, psieqd, tpsieqd, tpsifeqd, iounit1,
     5   inoperm1, nptsdm1, nptsd, torflux, tpsisav, ra, psifra,
     6   dpsifra, fra, fra1, cspln, pds, wnoperm, xcontr, zcontr,
     7   bpcontr, btcontr, dstarp, b_fld, jacob, pprime, vprime,
     8   chipsi, ncontr, dang, bperr, arcl, thet, anglex, csplnx,
     9   csplnz, pdsx, pdsz, nlim, rlim, zlim, nlimiter, rlimiter,
     .   zlimiter, lrz, nprim, nimp, nion, nti, zi, zeffz, r, raeqd,
     1   psifeqd, te, ti, ti1, ene, enp, bmod, rmd, btmd, bpmd, btpmd,
     2   roa, ieqdsk
      use Vcfdamp, ONLY: ifbilin, us, thets, coss, sinn, f, fxx, fyy,
     1   fxxyy, ftemp, ibd, wk, sint, tempx, tempy, dus, dthets,
     2   dudthets, usp, thetsp, bes0, bes1, dbes, ifirstb, nbes, cnstb,
     3   besdel, inf, bmax
      use Vchpcsd, ONLY: irec, rec0, rec1, rec2, rec3, rec4, rec5,
     1   rec6, rec7, rec8, rec9, rec10, rec11, rec12, rec13, rec14,
     2   rec15
      use Vcmnew
      use Vcraylh
      use Vcgraphs, ONLY: seikon, spsi, sxu, szu, skp, skpar, spower,
     1   sdpwri, sphi, stheta, spol, sdkpar, scepx, scepy, scepz,
     2   sztpol, sbtot, sene, salphac, salphal, sjslofa, serrors,
     3   spkpsi, sakpsi, sakth, swkve, jjslofa, sne, ste, sqr, spw,
     4   sxh, sqte, sni, sti, sdeqs, spwer, spwmax, srtor, srplas,
     5   sdenc, stec, sqc, sqa, sbaxis, scurr, sfreq, satm, sazi,
     6   sconc, stic, sxpage, sypage, slenx, sleny, sdelx, sfirtx,
     7   sdely, sfirty, symax, symin, skth, skphi, skpsi, sxx, jslofas,
     8   nurefls, keiks, jpes, jpis, istarts, iprmt5, jhlfs, isimpl,
     9   isimpl0, ngr, nps, nspie, kgraph, kprof, newgra, jksym,
     .   lintyp, nxvarb, nyvarb, kwfr, initlh, nraypts
      use Viogrl
      use Viorlh
      use Vctransp
      use kind_spec

      implicit none
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   P a r a m e t e r s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      integer :: numrf, nin, nin1, nrf, ijk, kion
      real(kind=dp) :: tinit, tfinl, trun, file, status
      integer :: nspec_c,mainsp_c,nprofs_c,ioread_c,idcur_c,
     1   iprint_c,igraph_c,nprim_c,nimp_c,nminor_c,kboot_c,
     2   nalfa_c,kalfa_c
      integer, dimension(30) :: iounit_c
      real(kind=dp) :: psistep_c,pkexpnt_c
      real(kind=dp):: denc_c,tempec_c,gamene_c,alpene_c,gamte_c,alpte_c,
     1   gamti_c,alpti_c,denedg_c,temedg_c,alpene1_c,alpte1_c,frcte_c,
     2   frcne_c,frcti_c,gamte1_c,gamene1_c
      real(kind=dp) :: epserr_c,epser1_c
      real(kind=dp),dimension(nions) :: atm_c,azi_c,tite_c,aconc_c
      real(kind=dp),dimension(nfion) :: atmf_c,azf_c,ebkev_c
c
      integer :: isimm_c,nspect_c,nraypts_c,nthin_c,maxref_c,igrill_c,
     1   islofa_c,irayio_c,indvar_c,idrive_c,ichois_c,modcd_c,
     2   idmpsw_c,inc_c,icurdr_c,bmax_c
      integer,dimension(nspect1) :: nnkpar_c
      integer,dimension(nspectm) :: nnkpol_c
      real(kind=dp) :: freqcy_c,psi0_c,heigth_c,ptot0_c
      real(kind=dp),dimension(nspect1) :: anzsup_c,anzinf_c
      real(kind=dp),dimension(nspectm) :: anpsup_c,anpinf_c
      real(kind=dp),dimension(nspect1) :: powers_c
      real(kind=dp),dimension(nspectm) :: thgril_c
c
      integer :: nrho_c
      real(kind=dp),dimension(nprofm) :: xrho_c, ne_c, te_c, elp_c
      real(kind=dp),dimension(nprofm,nions) :: ni_c, ti_c
c
      integer :: ipestg_c, nxeqd_c, nzeqd_c
      real(kind=dp) :: xdimeqd_c, zdimeqd_c, reqd_c, redeqd_c, 
     &   zmideqd_c, 
     1   xma_c, zma_c, psimag_c,psilim_c, beqd_c, toteqd_c, psimx1_c, 
     2   psimx2_c, xax1_c, xax2_c, zax1_c, zax2_c,psisep_c, xsep_c, 
     3   zsep_c
      real(kind=dp), dimension(nxa) :: feqd_c, presseqd_c, 
     1   ffpeqd_c, ppeqd_c, qeqd_c
      real(kind=dp), dimension(nxa,nza) :: peqd_c
c
      real(kind=dp),dimension(nprofm) :: ppsi_c, pwe_c, pwct_c,
     &   pwit_c
c     real(kind=dp),dimension(nprofm,nions) :: pwi_c
c
C-----------------------------------------------
C   E x t e r n a l   F u n c t i o n s
C-----------------------------------------------
      real(kind=dp),EXTERNAL::furmaj,furrho,futria,fuelon
      real(kind=dp),EXTERNAL::prone,prote,proti
!      real,EXTERNAL::secnds
C-----------------------------------------------
c
c  parameters
c  Nspect-->nspectm, Nion-->nions,  Nua-->nuam,  Nta-->ntam, Lrz-->lrza,
c  Nthp11-->nthp11a,  Npnt-->npnta,   Mpnt-->mpnta
c
c  Storage related to EQDSK:
c  Units used in the EQDSK are entirely MKSA.
c  Comeqdsk-->ceqdsk.i

c
c  Comfdamp
c
c
c
c   Comhpcsd
c
c********************************************
c  6/26/91,  Latest update: 06/02/00
c     Comnew
cNew common added for FWCD
c  Storage related to FWCD:
cSubroutines displh inital use Comnew1


c******      TKM   03/97, 09/99, 04/00, 06/00
c********************

c---------------------------
c   common block for Comraylh
c-------------------------
c
c
c$$$$$$$$     TKM    11/98
c*********    TKM   2/97, 6/99, 9/99
c*********    TKM   2/97
c*******   TK Mau   8/98
c*************************
c  SCC  3/7/95

c----------------------------
c   common blocks of Cmgraphs
c

c    2   ,sqti(nprofm)
c------------ --------------
c   common blocks of Comiogrl
c---------------------------
c----------------------------
c       common block Comiorlh(1-8)
c
c  ipropt         integer   #option for n-T profile calculation: 1 if
c                        # calculated from prontp; else =0.


c--------SCC  5/23/95
c*******  TKM  06/97, 2/00
c*************************
c********    TKM    11/98
c*******************************
c  #   SCC 3/27/92   SCC 4/13/95
c     character*16 specfl(1),outfl(1),rayfl(1)
c     dimension hedin1(10), hedin2(10)
c
c      call seconds(tinit)
c
      smallest = tiny(bperr)*1.0e+10
      largest = huge(bperr)*1.0e-10
c     print *,' Smallest real(kind=dp) number = ', smallest
c     print *,' Largest real(kind=dp) number  = ', largest
c
c
      call setdflt
      call op_file(0)
c      open(iout0, file='zf1r.ou', status='old')
c      call zfinit
      iedge = 0
      numrf = 1
c     open(nin, file='curray.in', status='old')
c**********************************
c   Preliminary initialization of variables
c   Identify mode of activation by 'ioread'
c   set number of RF sources by 'numrf'
c   (for now, set numrf = 1 ) (numrf gt.1 is not working yet;
c  for onetwo with more than one FW source, call xcurrayf more
c  than once)
c   Identify names of spectral inputfiles by specfl(1:numrf)
c   Identify names of summary outputfiles by outfl(1:numrf)
c   (currayout files)
c   Identify names of ray_data files by rayfl(1:numrf)
c     (rayop files)
c************************************
      call bram
c     read (nin,1001) (hedin1(i),i=1,10),(hedin2(i),i=1,10)
 1001 format(10a8)
c     read (nin, input)
      nprofs = nprofs_c
      nxeqd = nxeqd_c
      nzeqd = nzeqd_c
      psistep = psistep_c
      pkexpnt = pkexpnt_c 
      igraph = igraph_c
      iprint = iprint_c
      nspec = nspec_c
      epserr = epserr_c
      epser1 = epser1_c
      idcur = idcur_c 
      nprim = nprim_c
      nimp = nimp_c
      nminor = nminor_c
      atm(:nspec) = atm_c(:nspec)
      azi(:nspec) = azi_c(:nspec)
      aconc(:nspec) = aconc_c(:nspec)
      denc = denc_c 
      tempec = tempec_c
      tite(:nspec) = tite_c(:nspec)
      denedg = denedg_c
      frcne = frcne_c
      gamene = gamene_c
      alpene = alpene_c
      gamene1 = gamene1_c
      alpene1 = alpene1_c
      temedg = temedg_c
      frcte = frcte_c
      gamte = gamte_c 
      alpte = alpte_c
      gamte1 = gamte1_c
      alpte1 = alpte1_c
      atmf(1) = atmf_c(1)
      azf(1) = azf_c(1)
      ebkev(1) = ebkev_c(1)
      kboot = kboot_c 
      nalfa = nalfa_c
      kalfa = kalfa_c
      ioread = ioread_c
      isimm = isimm_c
      nspect = nspect_c
      nraypts = nraypts_c
      psi0 = psi0_c
      thgril(:isimm) = thgril_c(:isimm)
      nthin = nthin_c
      maxref = maxref_c
      islofa = islofa_c 
      ptot0 = ptot0_c
      freqcy = freqcy_c
      heigth = heigth_c
      indvar = indvar_c
      powers(:isimm) = powers_c(:isimm)
      nnkpar(:isimm) = nnkpar_c(:isimm)
      anzinf(:isimm) = anzinf_c(:isimm)
      anzsup(:isimm) = anzsup_c(:isimm)
      nnkpol(:isimm) = nnkpol_c(:isimm)
      anpsup(:isimm) = anpsup_c(:isimm)
      anpinf(:isimm) = anpinf_c(:isimm)
      idrive = idrive_c 
      ichois = ichois_c
      modcd = modcd_c
      igrill = igrill_c
      bmax = bmax_c
      idmpsw = idmpsw_c
      irayio = irayio_c
      inc = inc_c 
      icurdr = icurdr_c
      nrho_tr = nrho_c
      xrho_tr(:nrho_tr) = xrho_c(:nrho_tr)
      ne_tr(:nrho_tr) = ne_c(:nrho_tr)
      te_tr(:nrho_tr) = te_c(:nrho_tr)
      ni_tr(:nrho_tr,:nspec) = ni_c(:nrho_tr,:nspec)
      ti_tr(:nrho_tr,:nspec) = ti_c(:nrho_tr,:nspec)
      elp_tr(:nrho_tr) = elp_c(:nrho_tr)
      xdimeqd = xdimeqd_c
      zdimeqd = zdimeqd_c
      reqd = reqd_c
      redeqd = redeqd_c
      zmideqd = zmideqd_c 
      xma = xma_c
      zma = zma_c
      psimag = psimag_c
      psilim = psilim_c
      beqd = beqd_c 
      toteqd = toteqd_c
      psimx1 = psimx1_c 
      psimx2 = psimx2_c
      xax1 = xax1_c
      xax2 = xax2_c
      zax1 = zax1_c
      zax2 = zax2_c
      psisep = psisep_c
      xsep = xsep_c 
      zsep = zsep_c
      feqd(:nxeqd) = feqd_c(:nxeqd)
      presseqd(:nxeqd) = presseqd_c(:nxeqd)
      ffpeqd(:nxeqd) = ffpeqd_c(:nxeqd)
      ppeqd(:nxeqd) = ppeqd_c(:nxeqd)
      qeqd(:nxeqd) = qeqd_c(:nxeqd)
      peqd(:nxeqd,:nzeqd) = peqd_c(:nxeqd,:nzeqd)
      iounit(:30) = iounit_c(:30)
c
      nprof = nprofs
C
C
      call tmpdata(1)
      nrf = 1
c     open(nin1, file='specfl.in', status='old')
      call op_file(1)
c     open(iout, file='currayout', status='unknown')
c     read (nin1, input1)
c----------------------------------
c  if 'curray' is activated by ONETWO, set ioread=1 in /input/
c
      if (ioread == 1) then
         open(iout1, file='raytrin', status='old')
         call rtinout(1)
         close(iout1)
      endif
c     if (ieqdsk == 0) read (nin, inpeq)
c-------------------------------------
C    Input spectral information:
C*************************************
C powers(i) is power in MW in i-th n-phi bin
C freqcy in Hertz,
C nraypts=maxmum No. of steps in ray-marching
C (Note: nraypts should be large enough so that the actual absorption
C is greater than 50%, and preferrably more than 70%.)
C nnkpar(i) is number of n-phi values to be taken in each n-phi bin
C anzinf(i) is the lower bound value of n-phi for ith bin
C anzsup(i) is the upper bound value of n-phi for ith bin
C nthin=No. of poloidal positions to start a ray,
C total No. of rays is sum(i=1,nspect) of nnkpar(i)*nthin
C maxref= maximum No. of reflections for each ray
C islofa=-1 for fast wave, islofa=1 for slow wave.
C isimm=nspect=no. of n-phi spectrum bins
C Normal input: igrill (defined later)=-3; nnkpar(i)=1
C The following three arrays are only used when igrill=-3 and nnkpar(i)=1:
C nnkpol(i) is number of n-poloidal values to be taken in each n-phi bin
C anpinf(i) is lower bound value of n-pol for the ith-bin
C anpsup(i) is upper bound value of n-pol for the ith-bin
C normally, set nnkpol(i)=1 and anpsup(i)=anpinf(i)
C ptot0 is total rf-power in MW
C********************************
C Note: Run time is roughly proportional to nraypts and total No. of rays.
C*************************
      nspect = isimm
      call tmpdata(4)
C
C   set workarea to zero and renormalize spectal powers to ptot0

C**************************
C tmpdata sums absorption and current density profiles of all RF sources.
C tmpdata(ientry): ientry=1  zero out working areas
C                        =2  add contribution of RF-source to work-areas
C                        =3  add absorption and current of all previous
C                            RF-source to the current RF-source
C                        =4  renormalize spectral powers to total power
C                            specified by ptot0
C                        =6  output profiles and total absorption etc.
C                            to output file (called only if there are
C                            more than one RF-source)
C
C****************************************************************
C
C  Basic control parameters for xcurray are:
C  initlh  0  calc rays
C          1  read in ray data from rayop and extend as appropriate
C  nraypts    max number of ray elements for which calc performed.
C  ieqdsk  0  use Brambilla flux surface specification.
C          1  from Brambilla representation, generate and write an eqdsk,
C             then use it; (not working)
C          2  from Brambilla representation, generate and write an eqdsk,
C             then exit; (not working)
C          3  read eqdsk to get equilibrium data.
C          4  read extended eqdsk to get equilibrium data and plasma
C             profiles.
C
C ieqdsk set by rtinout(1) to 0 for codeid='onedee', 4 otherwise.
C
C****************************************************************
C
C
C dang : angular increment for contour search
C nptsd : no. of points in theta grid in contour nptsd=360/dang+1
C nxeqd : eqdsk x-array dimension, default is 33
C nzeqd :  "     z-"      "          "         65
C specfac :  used in pwicpl for spectrum weight;default=0.5
C New statements added by TK Mau  8/8/91
C thgril :  in degrees
C delthe :  inradians
C idrive : >0  do current drive calculations
C*******************
C ichois=1: Use high frequency dispersion (for LH)
C       =2: Use ICRF dispersion (for FW)
C***************************
C modcd =0:  Ehst model for j/p
C       =1:  Chiu's model
C wfrac0: wall attenuation factor per reflection
C phase: in degrees (not relevant)
C---------------------
C igrill =-1,Analytic fitted power spectrum
C        =-2, read in power spectrum and starting n-phi
C                  (not working)
C        =-3:  Read in poloidal and toroidal spectrum
C------------------------------
C
C deykpr :  step along ray for saving data, in phase periods.
C psistep :if.ne.0.,  then adjust deykpr at each step so that
C           the step in psi is approx. psistep
C pkexpnt: Further adjust deykpr so that the step in psi is
C        approx psistep/abs(pkpar)**pkexpnt
C igraph:0 suppresses graphical output; 1 for normal graphical output
C iprint =0  output suppressed
C          =1  normal output
C          =2  more detailed output
C          =3  determine output at each call of output1(x)
C bmax: Maximum in the bessel function table
C scatd: Pi/2-k_perp-scattering depth of edge plasma.
C iscat0 : If .eq.0, no scatttering as ray leaves antenna.
C solrfl: Scrapeoff layer position for reflection.
C accur: default 1.e-5

C*****************************************************************
C  Input parameters for bi-Maxwellian description of electron and
C    ion distribution functions
C  This section is relevant only if inf=-1 and/or infi<=0.
C  For explanation, please see file CURRAY.V
C  nspec=3
C  trate=1.;  tratte=1.;  ttle=5.;  concte=0.0
C  trati(1)=1.;  tratti(1)=1.;  ttli(1)=5.;  concti(1)=0.0
C  trati(2)=1.;  tratti(2)=1.;  ttli(2)=5.;  concti(2)=0.0
C  trati(3)=1.;  tratti(3)=1.;  ttli(3)=5.;  concti(3)=0.0
C  vdrfte=0.;  vdrfti(1)=0.;  infi(1)=0; vdrfti(2)=0.; infi(2)=0
C         vdrfti(3)=0.; infi(3)=0
C
C****************************************************************
C  Reset plasma equilibrium quantities if ieqdsk.eq.0:
C  (Else equilibrium data obtained from an existing eqdsk.)

      select case (ieqdsk)
      case (0)

C******************
C  for analytical MHDEQ
C*******************
C           open(iounit1,file='aneqfl',status='old')
C           read(iounit1,inpeq)
C rshift:shift of flux surfaces
C dtrian:triangularity
         dpsimhd = 1./float(nmhd - 1)
         do ijk = 1, nmhd
            psimhd(ijk) = float(ijk - 1)*dpsimhd
            rmaj(ijk) = furmaj(psimhd(ijk))
            rrho(ijk) = furrho(psimhd(ijk))
            triang(ijk) = futria(psimhd(ijk))
            elong(ijk) = fuelon(psimhd(ijk))
         end do
         do ijk = 1, nprofs
            psi = float(ijk - 1)/float(nprofs - 1)
            ppsi(ijk) = psi
            pne(ijk) = prone(psi)
            pte(ijk) = prote(psi)
            pjavg(ijk) = pte(ijk)**1.5
            do kion = 1, nspec
               pti(ijk,nspec) = proti(psi)
            end do
         end do
      case (3)
c
c    ipropt=1   n-T calculated from prontp
c          =0       read in from eqdskex
         ipropt = 1
c        open(iounit1, file='eqdsk.hb', status='old')
      case (4)
         ipropt = 0
!         call link('unit59=terminal//')
         write (6, 901)
  901    format('opening eqdsk')
         open(iounit1, file='eqdskex', status='old')
      case (5)
c
c  Bob Miller's equilibrium disk
c
         ipropt = 1
         open(iounit1, file='dskbal', status='old')
c           open(iounit1,file='eqdskex',status='old')
      end select
C  Set edge treatment flag. (Calc edge region parameters
C  below if ieqdsk.eq.0; else, in fiteqdsk).
C  Number of flux surface pts including plasma edge region.
C****************************************************************
C  Set nequip to nraypts
      nequip = nraypts
C
C for first call of inital use ientry=1
C
C  for more than one call of inital use ientry=2 for later calls.
      if (initlh == 0) call inital
C
C  epserr:first error limit
C  epser1:second error limit: epser1 should be about 4 to 5 times smaller than epser
C
C
C  idmpsw=0  ion damping not calculated
C        =1  ion damping calculated.
C
C
C  rayop-file output option
C  irayio =0   output current and absorption profiles plus ray data
C         =1   no current and absorption profiles in rayop
C              for CQL3D rayop files, use =1 option
C
      if (icurdr == 1) then
         call op_file(3)
         call op_file(4)
         call op_file(5)
         call op_file(6)
c        open(iout3, file='adjinp', status='unknown')
c        open(iout4, file='scrach', status='unknown')
c        open(iout5, file='adjout', status='unknown')
c        open(iout6, file='joptab', status='unknown')
         call master (1)
      endif
      if (icurdr/=1 .and. idcur==3) then
         call op_file(3)
         call op_file(4)
         call op_file(5)
         call op_file(6)
c        open(iout3, file='adjinp', status='old')
c        open(iout4, file='scrach', status='unknown')
c        open(iout5, file='adjout', status='old')
c        open(iout6, file='joptab', status='unknown')
         call master (2)
      endif
c     if (icurdr/=1 .and. idcur/=3) then
c        open(iout3, file='adjinp', status='unknown')
c        open(iout4, file='scrach', status='unknown')
c        call master(4)
c     endif
c
c
      call op_file(2)
c     open(iout2, file='rayop', status='unknown')
      call master(3)
      if (initlh==1 .and. inf>=0) call dodamp
C
C****************************************************************
C   Output the ray data
C files with the following names should be moved or erased
      if (nrf /= numrf) then
         call tmpdata(2)
      else
         call tmpdata(3)
         call tmpdata(6)
      endif
      close(iout1)
!        close(iout)
      close(iounit1)
c100   continue
C****************************************************************
C
C  output heating and current drive data for ONETWO
      if(ioread==1) then 
         open(iout1, file='raytrout', status='unknown')
         call rtinout(2)
         close(iout1)
       endif
!      call secnds(tfinl)
!      trun = tfinl - tinit
!      write (iout, '(/"  Runtime = ",e12.3," seconds")') trun
      close(iout)
c
c---- Write output quantities as arguments of subroutine
c
      ppsi_c(:nprofs) = ppsi(:nprofs)
      pwe_c(:nprofs) = pwe(:nprofs)
      pwit_c(:nprofs) = pwit(:nprofs)
c     pwi_c(:nprofs,:nspec) = pwi(:nprofs,:nspec)
      pwct_c(:nprofs) = pwct(:nprofs)
c
      return
      end subroutine curray
C
C****************************************************************
c

