! $Id: teqlib.f90,v 1.2 2007/07/23 16:00:58 meyer Exp $

MODULE teqlib
  USE teqinit
  USE sep_math
  USE ioTeq_mod, only : wreqdskf
  IMPLICIT NONE
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!   Bpol=grad(psi) X grad(phi)
!   psi gauss-cm and is the poloidal flux per radian
!   psibar is the dimentionless poloidal flux and along with theta
!   defines the inverse coordinate system
!
!   Look at teqinit.f90 for more extensive comments
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  TYPE :: global_type
     INTEGER, POINTER :: logunit,ioun7,ioun12,ioun13
     CHARACTER(len=64), POINTER :: logname
     CHARACTER(len=64) :: filename,tokamak,pfcoil
  END TYPE global_type

  TYPE :: eq_type
     REAL(rq), DIMENSION(:),   POINTER :: x,y
     REAL(rq), DIMENSION(:,:), POINTER :: f,fx,fy,fs
     INTEGER, POINTER :: nx,ny
  END TYPE eq_type

  TYPE :: inv_type
     TYPE(eq_type) :: R,Z
     REAL(rq), DIMENSION(:), POINTER :: rbnd,zbnd
     REAL(rq), POINTER :: raxis,zaxis,dpsi0,dpsi00,dphi0,dphi00,plc,fwall,cur
     REAL(rq), POINTER :: epsrk,x
     INTEGER, POINTER :: p,k,eq,nht,mpsi,mth,flag,ls
     LOGICAL, POINTER :: fix_bnd
! (R%x,R%y)     = (theta,psibar)
! (R%f,R%fx,R%fy,R%fs) = (R,R_theta,R_psi,B)
! (Z%x,Z%y)     = (theta,psibar)
! (Z%f,Z%fx,Z%fy,Z%fs) = (Z,Z_theta,Z_psi,Jacobian)
! (raxis,zaxis) = position of axis cm
! (dpsi0,dpsi00)= poloidal flux/radian
! (dphi0,dphi00)= toroidal flux/radian
! x             = position in dimensionless flux beyond which solver adjusts q
!                 indirectly so as to force FF'=0 at the edge. 
! plc           = desired plasma current MA
! cur           = plasma current A
! fwall         = vacuum RBtor gauss-cm
! epsrk         = accuracy for polar1 (defaulted to 1e-6)
! k             = (0 use qs) (1 use fs) (2 use jts) (3 use jpars) as profile.
!               = For a time dependent (predictive mode) Ohm's law requires
!                 that the q-profile be inputed.
! p             = (-1 use dpsi00) (0 use fwall) (1 use plc) as constraint,
! eq            = -2: startup from direct solve, uses internal information,
!               = -1; vanilla flavored startup, uses no internal data, and is
!                     recommended for a "large" boundary change in a sequence
!                     of inverse solves. If this option fails with inv_k=0,
!                     q-profile as input, try a current profile. If it still
!                     fails try eq=0. If it still fails contact ldp@llnl.gov.
!               =  0; from an existing inverse solve, sets the boundary to
!                     (inv%rbnd,inv%zbnd); this is the recommended option if
!                     the boundary is moved.
!               =  1; from an existing inverse solve, but the boundary
!                     relaxes to (inv%rbnd,inv%zbnd); used for time dependent
!                     evolution predictive mode, not snap shots and is needed
!                     for numerical stability.
! nht           = maximum number of iterations
! mpsi          = flux grid size
! mth           = theta gridsize
! ls            = stretching in psi grid: ls=-22  (sin(i*pi/2))**2; i=1,mpsi
!                                           = 22 quadratic axi; polynomial
!                                           = 11  uniform
!                                           = -1=-22;1=11 anachroism
! flag          = 0, uses polar1; 1, uses esc if loaded (libesc.a)

  END TYPE inv_type

  TYPE :: profile_type
     REAL(rq), DIMENSION(:), POINTER :: q,jt,jpar,f,fd,p,pd,bp,rsqi,cu,phi,psi
     REAL(rq), DIMENSION(:), POINTER :: qs,jts,jpars,fs,ps,vpr,w,v,psin,r,a,bsq
! (q,qs)       = q-profile (dynamic,desired)
! (jt,jts)     = <J.B>/(J,grad phi> amps/cm
! (jpar,jpars) = J.B>/<B.B> amps/cm**2/gauss
! (f,fs)       = RBt gauss-cm
! fd           = df/dpsi 1/cm
! (p,ps)       = pressure ergs/cm**3
! pd           = dp/dpsi
! bp           = <Bpol> gauss
! bsq          = <B**2> qauss**2
! rsqi         = <1/R**2> 1/cm**2
! cu           = Mu0*I(psi) gauss-cm
! vpr          = dV/dpsi cm/gauss
! <w,v>        = node values for the two input spline profiles
!                Spline at nodes F**2-F(msrf)**2)/(8*pi*dcpsi0*prsx)
!                Spline at nodes P/(betaj*prsx)
! psin         = dimensionless poloidal flux: input
! (a,r)        = minor, major radius of flux surface at level of magnetic axis
! phi          = dimensionless toroidal flux
! psi          = dimensionless poloidal flux used by teq
! <>           = surface average
  END TYPE profile_type

  TYPE :: dir_type
     TYPE(eq_type) :: psi
     REAL(rq), DIMENSION(:), POINTER :: rxpr,zxpr,alfa,betp,li,betap
     REAL(rq), DIMENSION(:), POINTER :: rxps,zxps,pxps,rsep,zsep
     REAL(rq), POINTER :: rxpt,zxpt,pxpt,paxis,pbnd,rn,rx,ro,zx,prsx
     REAL(rq), POINTER :: betaj,thc,epsj,epsb,aap
     INTEGER,  POINTER :: ipscl,ipf,ipj,ipp,irl,liml,f_wp,nxps,limd,ixpt,msep
     LOGICAL,  POINTER :: fix_bnd
!
! (rsep,zsep)      = separatrix boundary
! (psi%f,psi%fx,psi%fy,psi%fs)=(psi,psi_r,psi_z,bpol)
! rxpr(2) zxpr(2)  = determines box to look for X-point cm
! (alfa(0:1),betp(0:1),aap)= profile factors for analytic forms: see ipp below
! (zxpt,rxpt,pxpt) = Xpoint location and flux/radian cm,cm,gauss-cm**2
! (paxis,pbnd      = poloidal flux at on (axis,boundary)
! (nxps,rxps,zxps,pxps) = number, flux, R and Z of Xpoints found by separatrix
! (rn,rx,zx)       = boundary of computational grid cm (up/down sym. grid)
! limd             = 0 not limited
! ro               = radial mid-point of grid (btor=fwall/ro)
! prsx             = scaling coefficient need for w,v the spline points
! betaj            = scaling factor multiplying the pressure for input forms
! thc              = fraction away from X-point in dimensionless poloidal flux
! ixpt             = 2 use Xpoint; = 1 if limiter is active use limiter
! ipscl            = constrain for dir solve (-1 none 0 plc 1 dpsi00 )
! ipj              = 0, analytic forms for FF' and P
!                    1  jts,ps arrays
!                    2  analytic forms for jt and p
!                    3  jpars and ps arrays for input (inv%p constraint choice)
!                       scaling (see ipscl) not recommended
!                    4  qs and ps arrays; scaling (see ipscl) not recommended
!                    5  qs and ps arrays; no scaling  (inv%p constraint choice)
! (ipf,ipp)        = profile forms for analytic; x dimensionless flux 
!                  = 1; Strickler form exp(-alfa*x)-exp(-alfa) for (FF',P');
!                  = 2; difference of two; 2nd form uses alfa*betp
!                  = 3; (1-x**betp)**alfa for (FF,P)
!                  = 4; 3 form but flat out to aap;with betp*(x-aap)/(1-aap)
!                  = 5; hollow profile: constrained to  2<betp<2.5 and
!                       SENSITIVE near upper limit.
!                  = 999; cubic spline for (FF,P); uses (w,v)
! (epsj,epsb)      = residual accuracy required, (comp boundary, GS rhs)
  END TYPE dir_type

  TYPE :: pf_type
     INTEGER, POINTER :: ngroup,ncircuit,nbd,jcir,nfbd,nc,jax,kax,nlim,irl,ngp
     INTEGER, POINTER :: ircwt,nsym,nsymc,iflxc,limw,lmax,kxp,ncp
     INTEGER,  DIMENSION(:), POINTER :: nrc,nzc,ic,ix,ict
     REAL(rq), DIMENSION(:), POINTER :: cc,rc,zc,drc,dzc,ps0,psi
     REAL(rq), DIMENSION(:), POINTER :: pci,pc0,rlim,zlim,rlimw,zlimw
     REAL(rq), DIMENSION(:), POINTER :: rbd,zbd,rfbd,zfbd,alfbd
     REAL(rq), DIMENSION(:,:), POINTER :: pfim
     REAL(rq), POINTER :: psix,vltf,cejima,rl,rax,zax,skew,dsep,dsip,rxp,zxp
     REAL(rq), POINTER :: rmajor,rminor
          
! nc               = number of coils
! ncp              = number of active coils (shaping coils for DIII-D)
! cc               = coil current, MA
! (rc,drc)         = coil R and width, M
! (zc,dzc)         = coil Z and width, M
! (nrc,nzc)        = number of filamants= nrc*nzc per coil; code generally 
!                    controls
! (psi,ps0)        = flux at coil (calculated, wanted), Wb
! (ic,ix)          = grouping of (coils,circuits); if (ic(1)=n and ic(2)=n
!                    where n=1,2,3,4,... keeps the ratio of current in 
!                    cc(1) and cc(2) fixed;similarly for ix and the coil flux.
!                    note that max(ic) must be greater or equal to max(ix)
!                    depending on whether there are additional constraints.
! iflxc            = 1 forces psi to ps0 for all ix/=0
! ngroup           = number of coil groups, max(ic)
! ncircuit         = number of circuits, max(ix)
! (nbd,rbd,zbd)    = number of boundary points and values in cm's, constraints
! psix             = desired flux at magnetic axis, constraint (units as paxis)
! vltf             = desires external flux linkage (VS), constraint
! cejima           = Ejima coefficient, constraint;vltf=psires +
!                    0.4*pi*cejima*plcm*ro/100, with  psires the average
!                    plasma poloidal flux.
! (rl,irl)         = irl=0,  required separation between active and inactive 
!                    separatrix in dimensionless flux:(pxpu-pxpl)/dpsi0
!                  = (irl=1,upper Xpoint active);(irl=-1, lower Xpoint active);
!                    rl is the required separation between inactive and active
!                    separatrix in cm's (>0 outside. <0 inside)
! (kxp,rxp,zxp)      kxp/=0 X-point forces to (rxp,zxp)
! (kax,rax,zax)      kax/=0 O-point forces to (rax,zax): problematic  since
!                    requires user ingenuity to avoid over-constrainingsing;
!                    can also be another X-point
! jcir             = total number of constraints
! (nfbd,alfbd)     = number of fuzzy boundary points and normalization
! (rfbd,zfbd)      = value of points in cm's not as a minimization
! ircwt            = -1 minimizes (dI/dz)^2;all coils and in sequence.
!                  =  1 minimizes (cc-cc0)!(cc-cc0)
!                  =  2 minimizes cc!cc
!                  =  3 minimizes j**2=(cc/drc/dzc)^2
!                  =  4 minimizes cc!pfim*!cc=I!L!I
!                  =  5 minimizes B!B at the coils
!                  =  6 minimizes (pfpsi-pfps0)^2;change in flux at coils
!                  =  7 minimizes pfpsi!cc
!                  = 11 minimizes (cc*rc)!(cc*rc)
! (rlim(0),zlim(0) = limiter point
! skew             = angle between flux aurface axis and vertical axis
! rminor           = minor radius
! rmajor           = major radius
! dsep             = distance bewtween separatrices at outboard midplane
! dsip             = distance bewtween separatrices at inboard midplane
! (nsym,nsymc;lmax)= (2,2), up/down asymmetric; lmax=mth
!                  = (1,1), up/down symmetrix;  lmax=mth/2+1
! (rlimw,zlimw)    = limiting wall; dimensioned lmax and must be continous.
!                    (rlim(0),zlim(0)) is set to the limiting point if limw=1

  END TYPE pf_type

  CHARACTER(len=48), PRIVATE :: gname
  LOGICAL,PRIVATE :: labeled

CONTAINS

  subroutine find_direq(dir,pf,inv,prof,glb)
    use runTeq_mod, only : runTeq,exeTeq,genTeq
    use teqlib_input, only : mls,map,inv_eq,btor,ro,wvert
    TYPE(dir_type), INTENT(INOUT) :: dir
    TYPE(pf_type), INTENT(INOUT) :: pf
    TYPE(profile_type), INTENT(INOUT) :: prof
    TYPE(inv_type), INTENT(INOUT) :: inv
    TYPE(global_type), INTENT(IN) :: glb
    integer :: inv_eqs

    if(.not.associated(dir%psi%f)) then
       ! first time
       inv_eqs=inv_eq
       inv_eq=0
       call genTeq
       inv_eq=inv_eqs
       wvert=1
       call exeTeq
       call connect_direq(dir,pf,inv,prof)
    elseif(dir%psi%nx/=size(dir%psi%x) .or. dir%psi%ny/=size(dir%psi%y) .or. &
         inv%mth/=size(inv%R%f,1) .or. inv%mpsi/=size(inv%R%f,2))then
       map = mls/2+1
       if(mls/=2*map-1) then
          mls=2*map-1
          inv%mth=mls
          write(*,*) "mls is even, changing mls to ",mls
       end if
       btor=inv%fwall/ro
       wvert=1
       call runteq
       call connect_direq(dir,pf,inv,prof)
    else
       btor=inv%fwall/ro
       wvert=1
       call runTeq
    end if

  end subroutine find_direq

  subroutine find_inveq(inv,prof,glb)

    use runTeq_mod, only : invTeq
    use teqlib_input, only : mls,map,inv_eq,rls,btor,ro,wvert
    type(profile_type), INTENT(INOUT) :: prof
    TYPE(inv_type), INTENT(INOUT) :: inv
    TYPE(global_type), INTENT(IN) :: glb

    if(.not.associated(inv%R%f)) then
       ! first time
       inv_eq=0
       wvert=1
       call invTeq 
       call connect_inveq(inv,prof)
    elseif(inv%eq<0) then
       ! first call from direct equilibrium or recovery or big boundary move
       wvert=1
       btor=inv%fwall/ro
       call start_inveq(inv,prof,glb)
    elseif(inv%mth/=size(inv%R%f,1) .or. inv%mpsi/=size(inv%R%f,2)) then
       ! change in dimension
       map = mls/2+1
       if(mls/=2*map-1) then
          mls=2*map-1
          inv%mth=mls
          write(*,*) "mls is even, changing mls to ",mls
       end if
       btor=inv%fwall/ro
       wvert=1
       call invTeq
       call connect_inveq(inv,prof)
    else
       wvert=1
       btor=inv%fwall/ro
       call invTeq 
    end if

  end subroutine find_inveq

  subroutine start_inveq(inv,prof,glb)
    use runTeq_mod, only : startinv
    type(profile_type), intent(inout) :: prof
    type(inv_type), intent(inout) :: inv
    type(global_type), intent(in) :: glb
    
    call connect_inveq(inv,prof)
    call startinv

  end subroutine start_inveq

  subroutine set_verbosity(level)

    use teqlib_input, only : nprt59

    integer, intent(in) :: level

    nprt59 = level

  end subroutine set_verbosity

  subroutine get_spline_coefficients
    use teqlib_input, only : w,v,splbdry
    use teqlib_output, only : wp,wpp,wppp,vp,vpp,vppp,psibar
    use sep_interp, only : spline_interp

    call spline_interp(psibar,w,splbdry,splbdry,wp,wpp,wppp,noint)
    call spline_interp(psibar,v,splbdry,splbdry,vp,vpp,vppp,noint)

  end subroutine get_spline_coefficients

  subroutine load_savefile(filename)

    use teqlib_input
    use teqlib_output
    use teq_mod
    use teqGS_mod
    use setTeq_mod, only : time_date
    use teqSubs_mod, only : t_stretch
    use diag_mod, only : limw_from_plates

    character(len = *), intent(in) :: filename

    external teq_interface, teqGS_interface

    call mach
    call read_savefile(filename)
    call teq_input
    call teq_interface
    call teqGS_interface
    call time_date
    write(logunit,*) "TEQ built ", codedate, " ", codetime, ": Run at ", &
         rundate, " ", runtime
    print *, "TEQ built ", codedate, " ", codetime, ": Run at ", rundate, &
         " ", runtime

    IF(nplates/=0) CAll limw_from_plates
    qsrf=qsave

  end subroutine load_savefile

  SUBROUTINE write_savefile(sname)

    use ioTeq_mod
    USE teq_mod
    USE teqGS_mod
    USE teqPol_mod, only : t_npo,t_ntet,t_rork
    USE sep_separatrix, only : s_pin
    USE teqlib_input

    IMPLICIT NONE

    include "debug.i"

    CHARACTER(len=*) :: sname
    INTEGER :: i
    OPEN(UNIT=ioun12,FILE=sname,STATUS="REPLACE")
    WRITE(ioun12,'(a)')TRIM(t_probid)
    WRITE(ioun12,'(a)')TRIM(t_note)
    WRITE(ioun12,'(a)')TRIM(t_shotName)
    WRITE(ioun12,*)t_shotTime
    WRITE(ioun12,*)t_npoly
    WRITE(ioun12,*)t_nbd
    WRITE(ioun12,*)t_nfbd
    WRITE(ioun12,*)t_nsol
    WRITE(ioun12,*)t_nlim
    WRITE(ioun12,*)t_nloop
    WRITE(ioun12,*)t_ircwt
    WRITE(ioun12,*)t_nc0p
    WRITE(ioun12,*)t_kbfc
    WRITE(ioun12,*)t_ixpt
    WRITE(ioun12,*)t_nsym
    WRITE(ioun12,*)t_nsymc
    WRITE(ioun12,*)t_iflxc
    WRITE(ioun12,*)t_nc
    WRITE(ioun12,*)t_jm
    WRITE(ioun12,*)t_km
    WRITE(ioun12,*)t_ipf
    WRITE(ioun12,*)t_ibdry
    WRITE(ioun12,*)t_bsph_flag
    WRITE(ioun12,*)t_keqic
    WRITE(ioun12,*)t_initflx
    WRITE(ioun12,*)t_map
    WRITE(ioun12,*)t_lelm
    WRITE(ioun12,*)t_inv_eq
    WRITE(ioun12,*)t_inv_flag
    WRITE(ioun12,*)t_lsrf
    WRITE(ioun12,*)t_jqm
    WRITE(ioun12,*)t_nsph
    WRITE(ioun12,*)t_lsph
    WRITE(ioun12,*)t_ipp
    WRITE(ioun12,*)t_irl
    WRITE(ioun12,*)t_liml
    WRITE(ioun12,*)t_lflat
    WRITE(ioun12,*)t_kedge
    WRITE(ioun12,*)t_ipj
    WRITE(ioun12,*)t_entropy_flag
    WRITE(ioun12,*)t_ncplot
    WRITE(ioun12,*)t_inv_k
    WRITE(ioun12,*)t_inv_p
    WRITE(ioun12,*)t_npp
    WRITE(ioun12,*)t_npf
    WRITE(ioun12,*)t_nasp
    WRITE(ioun12,*)t_nbsp
    WRITE(ioun12,*)ndbg16
    WRITE(ioun12,*)ndbg8
    WRITE(ioun12,*)ndbg10
    WRITE(ioun12,*)ldbg5
    WRITE(ioun12,*)ldbg9
    WRITE(ioun12,*)ldbg8
    WRITE(ioun12,*)ldbg7
    WRITE(ioun12,*)ldbg10
    WRITE(ioun12,*)ndbg12
    WRITE(ioun12,*)t_ngp
    WRITE(ioun12,*)t_ni
    WRITE(ioun12,*)t_kgreenc
    WRITE(ioun12,*)t_msrf
    WRITE(ioun12,*)t_n4
    WRITE(ioun12,*)t_mls
    WRITE(ioun12,*)t_nht
    WRITE(ioun12,*)t_fix_bound
    WRITE(ioun12,*)t_nplates
    WRITE(ioun12,*)t_one_pow
    WRITE(ioun12,*)t_lmax
    WRITE(ioun12,*)t_nl
    WRITE(ioun12,*)t_int_flag
    WRITE(ioun12,*)t_crdn
    WRITE(ioun12,*)t_gsph
    WRITE(ioun12,*)t_asph
    WRITE(ioun12,*)t_bsph
    WRITE(ioun12,*)t_alfa
    WRITE(ioun12,*)t_betp
    WRITE(ioun12,*)t_vltf
    WRITE(ioun12,*)t_thetac
    WRITE(ioun12,*)t_btor
    WRITE(ioun12,*)t_fefit
    WRITE(ioun12,*)t_rxpr
    WRITE(ioun12,*)t_zxpr
    WRITE(ioun12,*)t_plcm
    WRITE(ioun12,*)t_qmax
    WRITE(ioun12,*)t_zn
    WRITE(ioun12,*)t_zx
    WRITE(ioun12,*)t_rn
    WRITE(ioun12,*)t_pefit
    WRITE(ioun12,*)t_rx
    WRITE(ioun12,*)t_rcur
    WRITE(ioun12,*)t_zcur
    WRITE(ioun12,*)t_ro
    WRITE(ioun12,*)t_rb
    WRITE(ioun12,*)t_plcx
    WRITE(ioun12,*)t_raxis0
    WRITE(ioun12,*)t_zlim(0:t_nlim)
    WRITE(ioun12,*)t_zaxis0
    WRITE(ioun12,*)t_raxis
    WRITE(ioun12,*)t_zaxis
    WRITE(ioun12,*)t_wvert
    WRITE(ioun12,*)t_betaj
    WRITE(ioun12,*)t_qflat
    WRITE(ioun12,*)t_psil
    WRITE(ioun12,*)t_qcelm
    WRITE(ioun12,*)t_pcelm
    WRITE(ioun12,*)t_scelm
    WRITE(ioun12,*)t_alphac
    WRITE(ioun12,*)t_psil00
    WRITE(ioun12,*)t_thetat
    WRITE(ioun12,*)t_rlim(0:t_nlim)
    WRITE(ioun12,*)t_aap
    WRITE(ioun12,*)t_ipscl
    WRITE(ioun12,*)t_svec
    WRITE(ioun12,*)t_epsb
    WRITE(ioun12,*)t_scflat
    WRITE(ioun12,*)t_qrat
    WRITE(ioun12,*)t_dpsi00
    WRITE(ioun12,*)t_dlim(0:t_nlim)
    WRITE(ioun12,*)t_epsrk
    WRITE(ioun12,*)t_epskrk
    WRITE(ioun12,*)t_anun
    WRITE(ioun12,*)t_alfa0
    WRITE(ioun12,*)t_epsj
    WRITE(ioun12,*)s_pin
    WRITE(ioun12,*)t_epp
    WRITE(ioun12,*)t_epf
    WRITE(ioun12,*)t_prsx
    WRITE(ioun12,*)t_filter_p
    WRITE(ioun12,*)t_filter_wp
    WRITE(ioun12,*)t_scl
    WRITE(ioun12,*)t_dr
    WRITE(ioun12,*)t_dz
    WRITE(ioun12,*)t_hsrf
    WRITE(ioun12,*)t_psix
    WRITE(ioun12,*)t_el
    WRITE(ioun12,*)t_rl
    WRITE(ioun12,*)t_cejima
    WRITE(ioun12,*)t_jparsave
    WRITE(ioun12,*)t_qsave
    WHERE(t_ssave<1e-99_rq)
       t_ssave=0
    END WHERE
    WRITE(ioun12,*)t_ssave
    WHERE(t_psave<1e-99_rq)
       t_psave=0
    END WHERE
    WRITE(ioun12,*)t_psave
    WRITE(ioun12,*)t_jtsave
    WRITE(ioun12,*)t_fsave
    WRITE(ioun12,*)t_w
    WRITE(ioun12,*)t_v
    WRITE(ioun12,*)t_rhc
    WRITE(ioun12,*)t_ix
    WRITE(ioun12,*)t_ic
    WRITE(ioun12,*)t_cc
    WRITE(ioun12,*)t_gdc
    WRITE(ioun12,'(a)')(TRIM(t_pfid(i)),i=1,t_nc)
    WRITE(ioun12,*)t_zplate
    WRITE(ioun12,*)t_rc
    WRITE(ioun12,*)t_zc
    WRITE(ioun12,*)t_drc
    WRITE(ioun12,*)t_dzc
    WRITE(ioun12,*)t_ac
    WRITE(ioun12,*)t_ac2
    WRITE(ioun12,*)t_nrc
    WRITE(ioun12,*)t_nzc
    WRITE(ioun12,*)t_rxc
    WRITE(ioun12,*)t_thloop
    WRITE(ioun12,*)t_iloop
    WRITE(ioun12,*)t_sigloop
    WRITE(ioun12,*)t_floop0
    WRITE(ioun12,*)t_cc0
    WRITE(ioun12,*)t_rplate
    WRITE(ioun12,*)t_psi
    WRITE(ioun12,*)t_jwu
    WRITE(ioun12,*)t_jwl
    WRITE(ioun12,*)t_rwu
    WRITE(ioun12,*)t_rwl
    WRITE(ioun12,*)t_rbd(:t_nbd)
    WRITE(ioun12,*)t_zbd(:t_nbd)
    WRITE(ioun12,*)t_rfbd(:t_nfbd)
    WRITE(ioun12,*)t_zfbd(:t_nfbd)
    WRITE(ioun12,*)t_alfbd(:t_nfbd)
    WRITE(ioun12,*)t_pfps0
    WRITE(ioun12,*)t_whtz
    WRITE(ioun12,*)t_rloop
    WRITE(ioun12,*)t_zloop
    WRITE(ioun12,*)t_rls
    WRITE(ioun12,*)t_zls
    WRITE(ioun12,*)t_rork
    WRITE(ioun12,*)t_psibar
    CLOSE(ioun12)
    CALL freeus(ioun12)
  END SUBROUTINE write_savefile

  SUBROUTINE write_labeled_savefile(sname)


    use ioTeq_mod
    USE teq_mod
    USE teqGS_mod
    USE teqPol_mod, only : t_npo,t_ntet,t_rork
    USE sep_separatrix, only : s_pin

    IMPLICIT NONE

    include "debug.i"

    CHARACTER(len=*) :: sname
    INTEGER :: i

    OPEN(UNIT=ioun12,FILE=sname,STATUS="REPLACE")
    WRITE(ioun12,'(a)')"# probid S 1 : problem label "
    WRITE(ioun12,'(a)')TRIM(t_probid)
    WRITE(ioun12,'(a)')"# note S 1 : shot description "
    WRITE(ioun12,'(a)')TRIM(t_note)
    WRITE(ioun12,'(a)')"# shotName S 1 : shot label "
    WRITE(ioun12,'(a)')TRIM(t_shotName)
    WRITE(ioun12,'(a)')"# shotTime R 1 : time in shot "
    WRITE(ioun12,*)t_shotTime
    WRITE(ioun12,'(a)')"# npoly I 1 : number of polynomial in fit (filter_p, filter_wp) "
    WRITE(ioun12,*)t_npoly
    WRITE(ioun12,'(a)')"# nbd I 1 : constraints controlled by nbd,rbd,zbd, vltf,rl,cejima,ifxc. "
    WRITE(ioun12,*)t_nbd
    WRITE(ioun12,'(a)')"# nfbd I 1 : number of fuzzy points on boundary "
    WRITE(ioun12,*)t_nfbd
    WRITE(ioun12,'(a)')"# nsol I 1 : no def "
    WRITE(ioun12,*)t_nsol
    WRITE(ioun12,'(a)')"# nlim I 1 : number of limiter points "
    WRITE(ioun12,*)t_nlim
    WRITE(ioun12,'(a)')"# nloop I 1 : no def "
    WRITE(ioun12,*)t_nloop
    WRITE(ioun12,'(a)')"# ircwt I 1 : selects minimization functions, 2 total current, 1 dif from "
    WRITE(ioun12,*)t_ircwt
    WRITE(ioun12,'(a)')"# nc0p I 1 : no def "
    WRITE(ioun12,*)t_nc0p
    WRITE(ioun12,'(a)')"# kbfc I 1 : no def "
    WRITE(ioun12,*)t_kbfc
    WRITE(ioun12,'(a)')"# ixpt I 1 : flag for setting psil, the 0-pressure flux. "
    WRITE(ioun12,*)t_ixpt
    WRITE(ioun12,'(a)')"# nsym I 1 : 1 UP/DOWN symmetric; 2 asummetric "
    WRITE(ioun12,*)t_nsym
    WRITE(ioun12,'(a)')"# nsymc I 1 : "
    WRITE(ioun12,*)t_nsymc
    WRITE(ioun12,'(a)')"# iflxc I 1 : 1 runs circuit equations nbd!! etc. ic sets circuits "
    WRITE(ioun12,*)t_iflxc
    WRITE(ioun12,'(a)')"# nc I 1 : number of coils "
    WRITE(ioun12,*)t_nc
    WRITE(ioun12,'(a)')"# jm I 1 : number of psi grid points in r direction "
    WRITE(ioun12,*)t_jm
    WRITE(ioun12,'(a)')"# km I 1 : number of psi grid points in z direction "
    WRITE(ioun12,*)t_km
    WRITE(ioun12,'(a)')"# ipf I 1 : profile options; same as ipp "
    WRITE(ioun12,*)t_ipf
    WRITE(ioun12,'(a)')"# ibdry I 1 : option flag to set rbd,zbd arrays (pressure pts) you set r, "
    WRITE(ioun12,*)t_ibdry
    WRITE(ioun12,'(a)')"# bsph_flag I 1 : Spheromak option "
    WRITE(ioun12,*)t_bsph_flag
    WRITE(ioun12,'(a)')"# keqic I 1 : flag for package eq initial value "
    WRITE(ioun12,*)t_keqic
    WRITE(ioun12,'(a)')"# initflx I 1 : no def "
    WRITE(ioun12,*)t_initflx
    WRITE(ioun12,'(a)')"# map I 1 : no def "
    WRITE(ioun12,*)t_map
    WRITE(ioun12,'(a)')"# lelm I 1 : grid position where ELM occurs; if zero no ELM "
    WRITE(ioun12,*)t_lelm
    WRITE(ioun12,'(a)')"# inv_eq I 1 : inv_eq,& =1 inverse equilibrium is used "
    WRITE(ioun12,*)t_inv_eq
    WRITE(ioun12,'(a)')"# inv_flag I 1 : uses polar 1; =1 uses "
    WRITE(ioun12,*)t_inv_flag
    WRITE(ioun12,'(a)')"# lsrf I 1 : no def "
    WRITE(ioun12,*)t_lsrf
    WRITE(ioun12,'(a)')"# jqm I 1 : no def "
    WRITE(ioun12,*)t_jqm
    WRITE(ioun12,'(a)')"# nsph I 1 : no def "
    WRITE(ioun12,*)t_nsph
    WRITE(ioun12,'(a)')"# lsph I 1 : no def "
    WRITE(ioun12,*)t_lsph
    WRITE(ioun12,'(a)')"# ipp I 1 : no def "
    WRITE(ioun12,*)t_ipp
    WRITE(ioun12,'(a)')"# irl I 1 : no def "
    WRITE(ioun12,*)t_irl
    WRITE(ioun12,'(a)')"# liml I 1 : no def "
    WRITE(ioun12,*)t_liml
    WRITE(ioun12,'(a)')"# lflat I 1 : no def "
    WRITE(ioun12,*)t_lflat
    WRITE(ioun12,'(a)')"# kedge I 1 : edge-current-model flag: ...=0 => no correction "
    WRITE(ioun12,*)t_kedge
    WRITE(ioun12,'(a)')"# ipj I 1 : "
    WRITE(ioun12,*)t_ipj
    WRITE(ioun12,'(a)')"# entropy_flag I 1 : no def "
    WRITE(ioun12,*)t_entropy_flag
    WRITE(ioun12,'(a)')"# ncplot I 1 : no def "
    WRITE(ioun12,*)t_ncplot
    WRITE(ioun12,'(a)')"# inv_k I 1 : no def "
    WRITE(ioun12,*)t_inv_k
    WRITE(ioun12,'(a)')"# inv_p I 1 : "
    WRITE(ioun12,*)t_inv_p
    WRITE(ioun12,'(a)')"# npp I 1 : no def "
    WRITE(ioun12,*)t_npp
    WRITE(ioun12,'(a)')"# npf R 1 : no def "
    WRITE(ioun12,*)t_npf
    WRITE(ioun12,'(a)')"# nasp R 1 : "
    WRITE(ioun12,*)t_nasp
    WRITE(ioun12,'(a)')"# nbsp R 1 : nnumber of asph's used for reconstruction "
    WRITE(ioun12,*)t_nbsp
    WRITE(ioun12,'(a)')"# bg16 I 1 : debug? "
    WRITE(ioun12,*)ndbg16
    WRITE(ioun12,'(a)')"# bg8 I 1 : debug? "
    WRITE(ioun12,*)ndbg8
    WRITE(ioun12,'(a)')"# bg10 I 1 : debug? "
    WRITE(ioun12,*)ndbg10
    WRITE(ioun12,'(a)')"# bg5 I 1 : debug? "
    WRITE(ioun12,*)ldbg5
    WRITE(ioun12,'(a)')"# bg9 I 1 : debug? "
    WRITE(ioun12,*)ldbg9
    WRITE(ioun12,'(a)')"# bg8 I 1 : debug? "
    WRITE(ioun12,*)ldbg8
    WRITE(ioun12,'(a)')"# bg7 I 1 : debug? "
    WRITE(ioun12,*)ldbg7
    WRITE(ioun12,'(a)')"# bg10 I 1 : debug? "
    WRITE(ioun12,*)ldbg10
    WRITE(ioun12,'(a)')"# bg12 I 1 : no def "
    WRITE(ioun12,*)ndbg12
    WRITE(ioun12,'(a)')"# ngp I 1 : "
    WRITE(ioun12,*)t_ngp
    WRITE(ioun12,'(a)')"# ni I 1 : no def "
    WRITE(ioun12,*)t_ni
    WRITE(ioun12,'(a)')"# kgreenc I 1 : Green functions flag for gc and gp... "
    WRITE(ioun12,*)t_kgreenc
    WRITE(ioun12,'(a)')"# msrf I 1 : number of surfaces "
    WRITE(ioun12,*)t_msrf
    WRITE(ioun12,'(a)')"# n4 I 1 : 16 saves and uses all the bispline coefs for cps "
    WRITE(ioun12,*)t_n4
    WRITE(ioun12,'(a)')"# mls I 1 : size of grid in r direction? "
    WRITE(ioun12,*)t_mls
    WRITE(ioun12,'(a)')"# nht I 1 : no def "
    WRITE(ioun12,*)t_nht
    WRITE(ioun12,'(a)')"# fix_bound L 1 : if false boundary moves "
    WRITE(ioun12,*)t_fix_bound
    WRITE(ioun12,'(a)')"# nplates I 1 : number of first wall plates "
    WRITE(ioun12,*)t_nplates
    WRITE(ioun12,'(a)')"# one_pow I 1 : no def "
    WRITE(ioun12,*)t_one_pow
    WRITE(ioun12,'(a)')"# lmax I 1 : no def "
    WRITE(ioun12,*)t_lmax
    WRITE(ioun12,'(a)')"# nl I 1 : no def "
    WRITE(ioun12,*)t_nl
    WRITE(ioun12,'(a)')"# int_flag I 1 : no def "
    WRITE(ioun12,*)t_int_flag
    WRITE(ioun12,'(a)')"# crdn R 1 : no def "
    WRITE(ioun12,*)t_crdn
    WRITE(ioun12,'(a)')"# gsph R 1 : if not zero modifies private flux "
    WRITE(ioun12,*)t_gsph
    WRITE(ioun12,'(a)')"# asph RA 4 : Spheromak lamda profile "
    WRITE(ioun12,*)t_asph
    WRITE(ioun12,'(a)')"# bsph RA 4 : no def "
    WRITE(ioun12,*)t_bsph
    WRITE(ioun12,'(a)')"# alfa RA 2 : no def "
    WRITE(ioun12,*)t_alfa
    WRITE(ioun12,'(a)')"# betp RA 2 : no def "
    WRITE(ioun12,*)t_betp
    WRITE(ioun12,'(a)')"# vltf R 1 : no def "
    WRITE(ioun12,*)t_vltf
    WRITE(ioun12,'(a)')"# thetac R 1 : no def "
    WRITE(ioun12,*)t_thetac
    WRITE(ioun12,'(a)')"# btor R 1 : !fwall / ro !f wall = vacuum RBtor gauss-cm ! radial mid-po "
    WRITE(ioun12,*)t_btor
    WRITE(ioun12,'(a)')"# fefit RA 5 : no def "
    WRITE(ioun12,*)t_fefit
    WRITE(ioun12,'(a)')"# rxpr RA 2 : range in r for radial position of accepted axis "
    WRITE(ioun12,*)t_rxpr
    WRITE(ioun12,'(a)')"# zxpr RA 2 : range in z for axial position of accepted xpoint; "
    WRITE(ioun12,*)t_zxpr
    WRITE(ioun12,'(a)')"# plcm R 1 : plama current MA fixed "
    WRITE(ioun12,*)t_plcm
    WRITE(ioun12,'(a)')"# qmax R 1 : no def "
    WRITE(ioun12,*)t_qmax
    WRITE(ioun12,'(a)')"# zn R 1 : z start of z grid [cm] "
    WRITE(ioun12,*)t_zn
    WRITE(ioun12,'(a)')"# zx R 1 : no def "
    WRITE(ioun12,*)t_zx
    WRITE(ioun12,'(a)')"# rn R 1 : start of r grid [cm] "
    WRITE(ioun12,*)t_rn
    WRITE(ioun12,'(a)')"# pefit RA 5 : EFIT P' profiles "
    WRITE(ioun12,*)t_pefit
    WRITE(ioun12,'(a)')"# rx R 1 : maximum value of r (mesh) [cm] "
    WRITE(ioun12,*)t_rx
    WRITE(ioun12,'(a)')"# rcur R 1 : r at current centroid [cm] "
    WRITE(ioun12,*)t_rcur
    WRITE(ioun12,'(a)')"# zcur R 1 : z at current centroid [cm] "
    WRITE(ioun12,*)t_zcur
    WRITE(ioun12,'(a)')"# ro R 1 : r-grid midpoint value, occurs at j=jm/2+1 [cm] z at current "
    WRITE(ioun12,*)t_ro
    WRITE(ioun12,'(a)')"# rb R 1 : j=liml is at r=ro-rb [cm] "
    WRITE(ioun12,*)t_rb
    WRITE(ioun12,'(a)')"# plcx R 1 : forces psix to plcx in curcal "
    WRITE(ioun12,*)t_plcx
    WRITE(ioun12,'(a)')"# raxis0 R 1 : desired raxis [cm] (raxis r at magnetic axis [cm]) "
    WRITE(ioun12,*)t_raxis0
    WRITE(ioun12,'(a)')"# zlim RA nlim+1 : no def "
    WRITE(ioun12,*)t_zlim(0:t_nlim)
    WRITE(ioun12,'(a)')"# zaxis0 R 1 : desired zaxis [cm] "
    WRITE(ioun12,*)t_zaxis0
    WRITE(ioun12,'(a)')"# raxis R 1 : r at magnetic axis [cm] "
    WRITE(ioun12,*)t_raxis
    WRITE(ioun12,'(a)')"# zaxis R 1 : z at magnetic axis [cm] "
    WRITE(ioun12,*)t_zaxis
    WRITE(ioun12,'(a)')"# wvert R 1 : rq,& ellipticity on axis;used for quasi-polar coords unless "
    WRITE(ioun12,*)t_wvert
    WRITE(ioun12,'(a)')"# betaj R 1 : FF' is proportional to (1/betaj -1) "
    WRITE(ioun12,*)t_betaj
    WRITE(ioun12,'(a)')"# qflat R 1 : q flattens inside this value; stores profile in qelm "
    WRITE(ioun12,*)t_qflat
    WRITE(ioun12,'(a)')"# psil R 1 : psi on separatrix "
    WRITE(ioun12,*)t_psil
    WRITE(ioun12,'(a)')"# qcelm R 1 : coefficient of parabolic departure; "
    WRITE(ioun12,*)t_qcelm
    WRITE(ioun12,'(a)')"# pcelm R 1 : coefficient of parabolic departure;>0 P=P(1+pcelm*.) "
    WRITE(ioun12,*)t_pcelm
    WRITE(ioun12,'(a)')"# scelm R 1 : coefficient of parabolic departure "
    WRITE(ioun12,*)t_scelm
    WRITE(ioun12,'(a)')"# alphac R 1 : no def "
    WRITE(ioun12,*)t_alphac
    WRITE(ioun12,'(a)')"# psil00 R 1 : no def "
    WRITE(ioun12,*)t_psil00
    WRITE(ioun12,'(a)')"# thetat R 1 : psil = pxpt - thetac*( pxpt - psix ) "
    WRITE(ioun12,*)t_thetat
    WRITE(ioun12,'(a)')"# rlim RA nlim+1 : no def "
    WRITE(ioun12,*)t_rlim(0:t_nlim)
    WRITE(ioun12,'(a)')"# aap R 1 : P profile selection selection: ipp=2 : P' exp(-alfa(1))*x-a "
    WRITE(ioun12,*)t_aap
    WRITE(ioun12,'(a)')"# ipscl I 1 : ipscl=0,& scale Grad-Shafranov: =0 fix current (plcm), =1 f "
    WRITE(ioun12,*)t_ipscl
    WRITE(ioun12,'(a)')"# svec RA nc : no def "
    WRITE(ioun12,*)t_svec
    WRITE(ioun12,'(a)')"# epsb R 1 : epsb epsb=1.e-8_rq, resb must be less than epsb "
    WRITE(ioun12,*)t_epsb
    WRITE(ioun12,'(a)')"# scflat R 1 : ssave multiplier "
    WRITE(ioun12,*)t_scflat
    WRITE(ioun12,'(a)')"# qrat R 1 : The flat portion of q = qflat+qrat*(qsave(1)-qflat) "
    WRITE(ioun12,*)t_qrat
    WRITE(ioun12,'(a)')"# dpsi00 R 1 : no def "
    WRITE(ioun12,*)t_dpsi00
    WRITE(ioun12,'(a)')"# dlim RA nlim+1 : no def "
    WRITE(ioun12,*)t_dlim(0:t_nlim)
    WRITE(ioun12,'(a)')"# epsrk R 1 : no def "
    WRITE(ioun12,*)t_epsrk
    WRITE(ioun12,'(a)')"# epskrk R 1 : no def "
    WRITE(ioun12,*)t_epskrk
    WRITE(ioun12,'(a)')"# anun R 1 : no def "
    WRITE(ioun12,*)t_anun
    WRITE(ioun12,'(a)')"# alfa0 R 1 : no def "
    WRITE(ioun12,*)t_alfa0
    WRITE(ioun12,'(a)')"# epsj R 1 : no def "
    WRITE(ioun12,*)t_epsj
    WRITE(ioun12,'(a)')"# pin R 1 : no def "
    WRITE(ioun12,*)s_pin
    WRITE(ioun12,'(a)')"# epp R 1 : bump added to P ~x**npp *(1-x)**2 ;see epp (p-profile) "
    WRITE(ioun12,*)t_epp
    WRITE(ioun12,'(a)')"# epf R 1 : bump added to FF'(J0) ~epf* x**npf *(1.-x) last piece if np "
    WRITE(ioun12,*)t_epf
    WRITE(ioun12,'(a)')"# prsx R 1 : no def "
    WRITE(ioun12,*)t_prsx
    WRITE(ioun12,'(a)')"# filter_p R 1 : no def "
    WRITE(ioun12,*)t_filter_p
    WRITE(ioun12,'(a)')"# filter_wp R 1 : no def "
    WRITE(ioun12,*)t_filter_wp
    WRITE(ioun12,'(a)')"# scl R 1 : no def "
    WRITE(ioun12,*)t_scl
    WRITE(ioun12,'(a)')"# dr R 1 : r grid spacing [cm] "
    WRITE(ioun12,*)t_dr
    WRITE(ioun12,'(a)')"# dz R 1 : z grid spacing [cm] "
    WRITE(ioun12,*)t_dz
    WRITE(ioun12,'(a)')"# hsrf R 1 : hsrf = 0.5 parameter used for stretching; use default value "
    WRITE(ioun12,*)t_hsrf
    WRITE(ioun12,'(a)')"# psix R 1 : psi at magnetic axis [Gauss cm**2/radian] "
    WRITE(ioun12,*)t_psix
    WRITE(ioun12,'(a)')"# el R 1 : zx=el*rb*(jm/2) / ((jm/2)+1-liml) !also /geo/! "
    WRITE(ioun12,*)t_el
    WRITE(ioun12,'(a)')"# rl R 1 : distances between separatrices fixed in curcal... [cm] irl= "
    WRITE(ioun12,*)t_rl
    WRITE(ioun12,'(a)')"# cejima R 1 : psires=vltf-0.4*pi*cejima*plcm*ro/100 195- "
    WRITE(ioun12,*)t_cejima
    WRITE(ioun12,'(a)')"# jparsave RA msrf : parallel current as function of psi "
    WRITE(ioun12,*)t_jparsave
    WRITE(ioun12,'(a)')"# qsave RA msrf : q as function of psi "
    WRITE(ioun12,*)t_qsave
    WRITE(ioun12,'(a)')"# ssave RA msrf : psi on surfaces of psibar "
    WHERE(t_ssave<1e-99_rq)
       t_ssave=0
    END WHERE
    WRITE(ioun12,*)t_ssave
    WHERE(t_psave<1e-99_rq)
       t_psave=0
    END WHERE
    WRITE(ioun12,'(a)')"# psave RA msrf : saved prsrf - pressure as function of psi "
    WRITE(ioun12,*)t_psave
    WRITE(ioun12,'(a)')"# jtsave RA msrf : saved jtsrf toroidal current as function of psi "
    WRITE(ioun12,*)t_jtsave
    WRITE(ioun12,'(a)')"# fsave RA msrf : F as function of psi "
    WRITE(ioun12,*)t_fsave
    WRITE(ioun12,'(a)')"# w RA msrf : Spline at nodes F**2-F(msrf)**2)/(8*pi*dcpsi0*prsx) "
    WRITE(ioun12,*)t_w
    WRITE(ioun12,'(a)')"# v RA msrf : Spline at nodes P/(betaj*prsx) "
    WRITE(ioun12,*)t_v
    WRITE(ioun12,'(a)')"# rhc RA nc : resisitivity "
    WRITE(ioun12,*)t_rhc
    WRITE(ioun12,'(a)')"# ix IA nc : no def "
    WRITE(ioun12,*)t_ix
    WRITE(ioun12,'(a)')"# ic IA nc : Current circuit index... "
    WRITE(ioun12,*)t_ic
    WRITE(ioun12,'(a)')"# cc RA nc : coil currents [MA] "
    WRITE(ioun12,*)t_cc
    WRITE(ioun12,'(a)')"# gdc RA 6*nc : current grading ratino def "
    WRITE(ioun12,*)t_gdc
    WRITE(ioun12,'(a)')"# pfid SA nc : label for "
    WRITE(ioun12,'(a)')(TRIM(t_pfid(i)),i=1,t_nc)
    WRITE(ioun12,'(a)')"# zplate RA 2*nplates : z coordinates for wall [cm] "
    WRITE(ioun12,*)t_zplate
    WRITE(ioun12,'(a)')"# rc RA nc : coil centers [m] "
    WRITE(ioun12,*)t_rc
    WRITE(ioun12,'(a)')"# zc RA nc : coil centers [m] "
    WRITE(ioun12,*)t_zc
    WRITE(ioun12,'(a)')"# drc RA nc : coil r width [m] "
    WRITE(ioun12,*)t_drc
    WRITE(ioun12,'(a)')"# dzc RA nc : coil z width [m] "
    WRITE(ioun12,*)t_dzc
    WRITE(ioun12,'(a)')"# ac RA nc : no def "
    WRITE(ioun12,*)t_ac
    WRITE(ioun12,'(a)')"# ac2 RA nc : no def "
    WRITE(ioun12,*)t_ac2
    WRITE(ioun12,'(a)')"# nrc IA nc : number of filaments in r direction "
    WRITE(ioun12,*)t_nrc
    WRITE(ioun12,'(a)')"# nzc IA nc : number of filaments in z direction "
    WRITE(ioun12,*)t_nzc
    WRITE(ioun12,'(a)')"# rxc RA nc : no def "
    WRITE(ioun12,*)t_rxc
    WRITE(ioun12,'(a)')"# thloop RA nloop : loop orientation: Bpol=Br*sin(thloop)-Bz*cos(thloop) "
    WRITE(ioun12,*)t_thloop
    WRITE(ioun12,'(a)')"# iloop IA nloop : no def "
    WRITE(ioun12,*)t_iloop
    WRITE(ioun12,'(a)')"# sigloop RA nloop : error in measurement "
    WRITE(ioun12,*)t_sigloop
    WRITE(ioun12,'(a)')"# floop0 RA nloop : desired flux or field at meassuring loop[cgs] "
    WRITE(ioun12,*)t_floop0
    WRITE(ioun12,'(a)')"# cc0 RA nc : no def "
    WRITE(ioun12,*)t_cc0
    WRITE(ioun12,'(a)')"# rplate RA 2*nplates : r coordinates for wall [cm] "
    WRITE(ioun12,*)t_rplate
    WRITE(ioun12,'(a)')"# psi RA jm*km : psi function on grid "
    WRITE(ioun12,*)t_psi
    WRITE(ioun12,'(a)')"# jwu IA km : no def "
    WRITE(ioun12,*)t_jwu
    WRITE(ioun12,'(a)')"# jwl IA km : no def "
    WRITE(ioun12,*)t_jwl
    WRITE(ioun12,'(a)')"# rwu RA km : no def "
    WRITE(ioun12,*)t_rwu
    WRITE(ioun12,'(a)')"# rwl RA km : radius of inner wall boundary on z-grid "
    WRITE(ioun12,*)t_rwl
    WRITE(ioun12,'(a)')"# rbd RA nbd : r values of fuzzy boundary "
    WRITE(ioun12,*)t_rbd(:t_nbd)
    WRITE(ioun12,'(a)')"# zbd RA nbd : z values of fuzzy points on boudary "
    WRITE(ioun12,*)t_zbd(:t_nbd)
    WRITE(ioun12,'(a)')"# rfbd RA nfbd : r coordinates of fixed points on bnd. "
    WRITE(ioun12,*)t_rfbd(:t_nfbd)
    WRITE(ioun12,'(a)')"# zfbd RA nfbd : fuzzy boundary; see zbd "
    WRITE(ioun12,*)t_zfbd(:t_nfbd)
    WRITE(ioun12,'(a)')"# alfbd RA nfbd : fuzzy boundary weighting added to the regular1zation (see i "
    WRITE(ioun12,*)t_alfbd(:t_nfbd)
    WRITE(ioun12,'(a)')"# pfps0 RA nc : Target flux? "
    WRITE(ioun12,*)t_pfps0
    WRITE(ioun12,'(a)')"# whtz RA nbd : used to get SN generato "
    WRITE(ioun12,*)t_whtz
    WRITE(ioun12,'(a)')"# rloop RA nloop : radial position of meassuring loop;[cm] "
    WRITE(ioun12,*)t_rloop
    WRITE(ioun12,'(a)')"# zloop RA nloop : radial position of meassuring loop;[cm] "
    WRITE(ioun12,*)t_zloop
    WRITE(ioun12,'(a)')"# rls RA mls : value of r along plasma boundary, input/outpu "
    WRITE(ioun12,*)t_rls
    WRITE(ioun12,'(a)')"# zls RA mls : value of z along plasma boundary, input/output "
    WRITE(ioun12,*)t_zls
    WRITE(ioun12,'(a)')"# rork RA msrf*mls : no def "
    WRITE(ioun12,*)t_rork
    WRITE(ioun12,'(a)')"# psibar RA msrf : normalized psi "
    WRITE(ioun12,*)t_psibar
    CLOSE(ioun12)
    CALL freeus(ioun12)

  END SUBROUTINE write_labeled_savefile

  SUBROUTINE stripout
    USE teq_mod, only : ioun12
    IMPLICIT NONE
    CHARACTER(len=96) line
    INTEGER :: ios

    IF(.NOT.labeled) RETURN
    ios=0
    DO WHILE (ios==0)
       READ(ioun12,'(a)') line
       IF(line(1:1) /= '#') THEN
          BACKSPACE(ioun12)
          EXIT
       END IF
    END DO
  END SUBROUTINE stripout
    

  SUBROUTINE read_savefile(sname)

    USE teq_mod, only : ioun12
    USE sep_separatrix, only : s_pin
    USE teqlib_input

    IMPLICIT NONE

    include "debug.i"

    CHARACTER(len=1024) :: line
    CHARACTER(len=*) :: sname
    INTEGER :: i,j,ios=0
    REAL(rq) :: sz
    OPEN(UNIT=ioun12, FILE=sname, STATUS="OLD")
    READ(ioun12,'(a)') line
    IF( line(1:1) == '#') THEN
       ! begin modification for labeled savefiles
       labeled=.TRUE.
    ELSE
       labeled=.FALSE.
    END IF
    REWIND(ioun12)

    CALL stripout;READ(ioun12,'(a)')probid
    CALL stripout;READ(ioun12,'(a)')note
    CALL stripout;READ(ioun12,'(a)')shotName
    CALL stripout;READ(ioun12,*)shotTime
    CALL stripout;READ(ioun12,*)npoly
    CALL stripout;READ(ioun12,*)nbd
    CALL stripout;READ(ioun12,*)nfbd
    CALL stripout;READ(ioun12,*)nsol
    CALL stripout;READ(ioun12,*)nlim
    CALL stripout;READ(ioun12,*)nloop
    CALL stripout;READ(ioun12,*)ircwt
    CALL stripout;READ(ioun12,*)nc0p
    CALL stripout;READ(ioun12,*)kbfc
    CALL stripout;READ(ioun12,*)ixpt
    CALL stripout;READ(ioun12,*)nsym
    CALL stripout;READ(ioun12,*)nsymc
    CALL stripout;READ(ioun12,*)iflxc
    CALL stripout;READ(ioun12,*)nc
    CALL stripout;READ(ioun12,*)jm
    CALL stripout;READ(ioun12,*)km
    CALL stripout;READ(ioun12,*)ipf
    CALL stripout;READ(ioun12,*)ibdry
    CALL stripout;READ(ioun12,*)bsph_flag
    CALL stripout;READ(ioun12,*)keqic
    CALL stripout;READ(ioun12,*)initflx
    CALL stripout;READ(ioun12,*)map
    CALL stripout;READ(ioun12,*)lelm
    CALL stripout;READ(ioun12,*)inv_eq
    CALL stripout;READ(ioun12,*)inv_flag
    CALL stripout;READ(ioun12,*)lsrf
    CALL stripout;READ(ioun12,*)jqm
    CALL stripout;READ(ioun12,*)nsph
    CALL stripout;READ(ioun12,*)lsph
    CALL stripout;READ(ioun12,*)ipp
    CALL stripout;READ(ioun12,*)irl
    CALL stripout;READ(ioun12,*)liml
    CALL stripout;READ(ioun12,*)lflat
    CALL stripout;READ(ioun12,*)kedge
    CALL stripout;READ(ioun12,*)ipj
    CALL stripout;READ(ioun12,*)entropy_flag
    CALL stripout;READ(ioun12,*)ncplot
    CALL stripout;READ(ioun12,*)inv_k
    CALL stripout;READ(ioun12,*)inv_p
    CALL stripout;READ(ioun12,*)npp
    CALL stripout;READ(ioun12,*)npf
    CALL stripout;READ(ioun12,*)nasp
    CALL stripout;READ(ioun12,*)nbsp
    CALL stripout;READ(ioun12,*)ndbg16
    CALL stripout;READ(ioun12,*)ndbg8
    CALL stripout;READ(ioun12,*)ndbg10
    CALL stripout;READ(ioun12,*)ldbg5
    CALL stripout;READ(ioun12,*)ldbg9
    CALL stripout;READ(ioun12,*)ldbg8
    CALL stripout;READ(ioun12,*)ldbg7
    CALL stripout;READ(ioun12,*)ldbg10
    CALL stripout;READ(ioun12,*)ndbg12
    CALL stripout;READ(ioun12,*)ngp
    CALL stripout;READ(ioun12,*)ni
    CALL stripout;READ(ioun12,*)kgreenc
    CALL stripout;READ(ioun12,*)msrf
    CALL stripout;READ(ioun12,*)n4
    CALL stripout;READ(ioun12,*)mls
    CALL stripout;READ(ioun12,*)nht
    CALL stripout;READ(ioun12,*)fix_bound
    CALL stripout;READ(ioun12,*)nplates
    CALL stripout;READ(ioun12,*)one_pow
    CALL stripout;READ(ioun12,*)lmax
    CALL stripout;READ(ioun12,*)nl
    CALL stripout;READ(ioun12,*)int_flag
    
    jmkm=jm*km
    IF(inv_eq/=0) THEN
       npo=msrf
       ntet=mls
    END IF
    sz = 0; if (ALLOCATED(rork)) sz = SIZE(rork,1) * SIZE(rork,2)
    IF (sz/=msrf*mls) THEN
       IF(ALLOCATED(rork)) DEALLOCATE(rork)
       ALLOCATE(rork(msrf,mls))
       rork=0
    END IF

    CALL teq_input_allocate

    CALL stripout;READ(ioun12,*)crdn
    CALL stripout;READ(ioun12,*)gsph
    CALL stripout;READ(ioun12,*)asph
    CALL stripout;READ(ioun12,*)bsph
    CALL stripout;READ(ioun12,*)alfa
    CALL stripout;READ(ioun12,*)betp
    CALL stripout;READ(ioun12,*)vltf
    CALL stripout;READ(ioun12,*)thetac
    CALL stripout;READ(ioun12,*)btor
    CALL stripout;READ(ioun12,*)fefit
    CALL stripout;READ(ioun12,*)rxpr
    CALL stripout;READ(ioun12,*)zxpr
    CALL stripout;READ(ioun12,*)plcm
    CALL stripout;READ(ioun12,*)qmax
    CALL stripout;READ(ioun12,*)zn
    CALL stripout;READ(ioun12,*)zx
    CALL stripout;READ(ioun12,*)rn
    CALL stripout;READ(ioun12,*)pefit
    CALL stripout;READ(ioun12,*)rx
    CALL stripout;READ(ioun12,*)rcur
    CALL stripout;READ(ioun12,*)zcur
    CALL stripout;READ(ioun12,*)ro
    CALL stripout;READ(ioun12,*)rb
    CALL stripout;READ(ioun12,*)plcx
    CALL stripout;READ(ioun12,*)raxis0
    CALL stripout;READ(ioun12,*)zlim(0:nlim)
    CALL stripout;READ(ioun12,*)zaxis0
    CALL stripout;READ(ioun12,*)raxis
    CALL stripout;READ(ioun12,*)zaxis
    CALL stripout;READ(ioun12,*)wvert
    CALL stripout;READ(ioun12,*)betaj
    CALL stripout;READ(ioun12,*)qflat
    CALL stripout;READ(ioun12,*)psil
    CALL stripout;READ(ioun12,*)qcelm
    CALL stripout;READ(ioun12,*)pcelm
    CALL stripout;READ(ioun12,*)scelm
    CALL stripout;READ(ioun12,*)alphac
    CALL stripout;READ(ioun12,*)psil00
    CALL stripout;READ(ioun12,*)thetat
    CALL stripout;READ(ioun12,*)rlim(0:nlim)
    CALL stripout;READ(ioun12,*)aap
    CALL stripout;READ(ioun12,*)ipscl
    CALL stripout;READ(ioun12,*)svec(:nc)
    CALL stripout;READ(ioun12,*)epsb
    CALL stripout;READ(ioun12,*)scflat
    CALL stripout;READ(ioun12,*)qrat
    CALL stripout;READ(ioun12,*)dpsi00
    CALL stripout;READ(ioun12,*)dlim(0:nlim)
    CALL stripout;READ(ioun12,*)epsrk
    CALL stripout;READ(ioun12,*)epskrk
    CALL stripout;READ(ioun12,*)anun
    CALL stripout;READ(ioun12,*)alfa0
    CALL stripout;READ(ioun12,*)epsj
    CALL stripout;READ(ioun12,*)s_pin
    CALL stripout;READ(ioun12,*)epp
    CALL stripout;READ(ioun12,*)epf
    CALL stripout;READ(ioun12,*)prsx
    CALL stripout;READ(ioun12,*)filter_p
    CALL stripout;READ(ioun12,*)filter_wp
    CALL stripout;READ(ioun12,*)scl
    CALL stripout;READ(ioun12,*)dr
    CALL stripout;READ(ioun12,*)dz
    CALL stripout;READ(ioun12,*)hsrf
    CALL stripout;READ(ioun12,*)psix
    CALL stripout;READ(ioun12,*)el
    CALL stripout;READ(ioun12,*)rl
    CALL stripout;READ(ioun12,*)cejima
    CALL stripout;READ(ioun12,*)jparsave
    CALL stripout;READ(ioun12,*)qsave
    CALL stripout;READ(ioun12,*)ssave
    CALL stripout;READ(ioun12,*)psave
    CALL stripout;READ(ioun12,*)jtsave
    CALL stripout;READ(ioun12,*)fsave
    CALL stripout;READ(ioun12,*)w
    CALL stripout;READ(ioun12,*)v
    CALL stripout;READ(ioun12,*)rhc(:nc)
    CALL stripout;READ(ioun12,*)ix(:nc)
    CALL stripout;READ(ioun12,*)ic(:nc)
    CALL stripout;READ(ioun12,*)cc(:nc)
    CALL stripout;READ(ioun12,*)gdc
    CALL stripout;READ(ioun12,*)(pfid(i),i=1,nc)
    CALL stripout;READ(ioun12,*)zplate
    CALL stripout;READ(ioun12,*)rc(:nc)
    CALL stripout;READ(ioun12,*)zc(:nc)
    CALL stripout;READ(ioun12,*)drc(:nc)
    CALL stripout;READ(ioun12,*)dzc(:nc)
    CALL stripout;READ(ioun12,*)ac(:nc)
    CALL stripout;READ(ioun12,*)ac2(:nc)
    CALL stripout;READ(ioun12,*)nrc(:nc)
    CALL stripout;READ(ioun12,*)nzc(:nc)
    CALL stripout;READ(ioun12,*)rxc(:nc)
    CALL stripout;READ(ioun12,*)thloop
    CALL stripout;READ(ioun12,*)iloop
    CALL stripout;READ(ioun12,*)sigloop
    CALL stripout;READ(ioun12,*)floop0
    CALL stripout;READ(ioun12,*)cc0(:nc)
    CALL stripout;READ(ioun12,*)rplate
    CALL stripout;READ(ioun12,*)psi
    CALL stripout;READ(ioun12,*)jwu
    CALL stripout;READ(ioun12,*)jwl
    CALL stripout;READ(ioun12,*)rwu
    CALL stripout;READ(ioun12,*)rwl
    CALL stripout;READ(ioun12,*)rbd(:nbd)
    CALL stripout;READ(ioun12,*)zbd(:nbd)
    CALL stripout;READ(ioun12,*)rfbd(:nfbd)
    CALL stripout;READ(ioun12,*)zfbd(:nfbd)
    CALL stripout;READ(ioun12,*)alfbd(:nfbd)
    CALL stripout;READ(ioun12,*)pfps0(:nc)
    CALL stripout;READ(ioun12,*)whtz
    CALL stripout;READ(ioun12,*)rloop
    CALL stripout;READ(ioun12,*)zloop
    CALL stripout;READ(ioun12,*)rls
    CALL stripout;READ(ioun12,*)zls
    CALL stripout;READ(ioun12,*)rork
    CALL stripout;READ(ioun12,*,IOSTAT=ios)psibin
    IF(ios==-1) THEN
       CALL errdetec("error, past EOF in read_savefile",-1)
    END IF
    IF(rn==0) THEN
       rn=r(1);rx=r(jm)
       zn=z(1);zx=z(km)
       liml=-1 ! Uses rn, etc.
    END IF

    CLOSE(ioun12)
    CALL freeus(ioun12)

  END SUBROUTINE read_savefile
  
  SUBROUTINE read_greens(gname)

    use teqlib_input
    use teqlib_output
    USE teqinit
    USE teq_mod
    USE teqGS_mod
    USE teqSubs_mod

    IMPLICIT NONE

    CHARACTER(len=48) :: gname

    OPEN(UNIT=ioun12,FILE=gname,STATUS="OLD")
    PRINT *,"Getting Greens's functions from file ",gname
    READ(ioun12,*)lgrn
    READ(ioun12,*)jm0p
    READ(ioun12,*)km0p
    READ(ioun12,*)nc0p
    READ(ioun12,*)ncf
    READ(ioun12,*)kgreenc
    READ(ioun12,*)liml
    READ(ioun12,*)nsymco
    READ(ioun12,*)nsymo
    READ(ioun12,*)nc0b
    READ(ioun12,*)nloop0p
    READ(ioun12,*)rn
    READ(ioun12,*)rx
    READ(ioun12,*)zx

    CALL teqGS_p
    READ(ioun12,*)gc
    READ(ioun12,*)gfbr
    READ(ioun12,*)gfbz
    READ(ioun12,*)gp
    READ(ioun12,*)gpl
    READ(ioun12,*)pfim
    READ(ioun12,*)plim

  END SUBROUTINE read_greens

  SUBROUTINE write_greens(gname)

    USE teq_mod
    USE teqGS_mod

    IMPLICIT NONE

    CHARACTER(len=48) :: gname

    OPEN(UNIT=ioun12,FILE=gname,STATUS="REPLACE")
    WRITE(ioun12,*)t_lgrn
    WRITE(ioun12,*)t_jm0p
    WRITE(ioun12,*)t_km0p
    WRITE(ioun12,*)t_nc0p
    WRITE(ioun12,*)t_ncf
    WRITE(ioun12,*)t_kgreenc
    WRITE(ioun12,*)t_liml
    WRITE(ioun12,*)t_nsymco
    WRITE(ioun12,*)t_nsymo
    WRITE(ioun12,*)t_nc0b
    WRITE(ioun12,*)t_nloop0p
    WRITE(ioun12,*)t_rn
    WRITE(ioun12,*)t_rx
    WRITE(ioun12,*)t_zx
    WRITE(ioun12,*)t_gc
    WRITE(ioun12,*)t_gfbr
    WRITE(ioun12,*)t_gfbz
    WRITE(ioun12,*)t_gp
    WRITE(ioun12,*)t_gpl
    WRITE(ioun12,*)t_pfim
    WRITE(ioun12,*)t_plim
    CLOSE(ioun12)

  END SUBROUTINE write_greens

  SUBROUTINE translate(ain,fin,aout,fout)

    USE sep_math
    USE sep_interp, only : interp_interp
    USE teq_input_mod, only : t_splbdry

    IMPLICIT NONE

    REAL(rq), DIMENSION(:), INTENT(IN) :: ain,aout,fin
    REAL(rq), DIMENSION(:), INTENT(OUT) :: fout
    REAL(rq), DIMENSION(SIZE(aout)) :: dum2
    INTEGER :: mout

    CALL interp_interp(ain,fin,t_splbdry,t_splbdry,aout,fout,dum2)

  END SUBROUTINE translate

  SUBROUTINE gridup(dir,pf,inv,prof,glb,which)
    USE runTeq_mod, only : runTeq
    TYPE(dir_type), INTENT(INOUT) :: dir
    TYPE(pf_type), INTENT(INOUT) :: pf
    TYPE(inv_type), INTENT(INOUT) :: inv
    TYPE(profile_type), INTENT(INOUT) :: prof
    TYPE(global_type), INTENT(INOUT) :: glb
    CHARACTER(len=*), INTENT(INOUT) :: which
    dir%liml=-1
    IF(which=="x" .OR. which=="both") dir%psi%nx=2*dir%psi%nx-1
    IF(which=="y" .OR. which=="both") dir%psi%ny=2*dir%psi%ny-1
  END SUBROUTINE gridup

  SUBROUTINE griddown(dir,pf,inv,prof,glb,which)
    USE runTeq_mod, only : runTeq
    TYPE(dir_type), INTENT(INOUT) :: dir
    TYPE(pf_type), INTENT(INOUT) :: pf
    TYPE(inv_type), INTENT(INOUT) :: inv
    TYPE(profile_type), INTENT(INOUT) :: prof
    TYPE(global_type), INTENT(INOUT) :: glb
    CHARACTER(len=*), INTENT(INOUT) :: which
    dir%liml=-1
    IF(which=="x" .OR. which=="both") dir%psi%nx=dir%psi%nx/2+1
    IF(which=="y" .OR. which=="both") dir%psi%ny=dir%psi%ny/2+1
  END SUBROUTINE griddown

  SUBROUTINE set_global(glb)
    USE teqlib_input
    USE teq_mod, only : ioun7,ioun12,ioun13
    TYPE(global_type), INTENT(INOUT) :: glb
    glb%logunit  => logunit
    glb%logname  => logname
    glb%ioun7    => ioun7
    glb%ioun12   => ioun12
    glb%ioun13   => ioun13
  END SUBROUTINE set_global


  SUBROUTINE connect_inveq(inv,prof)
    use teqlib_input
    use teqlib_output
    type(profile_type), INTENT(INOUT) :: prof
    TYPE(inv_type), INTENT(INOUT) :: inv
    INTEGER :: i

    prof%qs        => qsave
    prof%jts       => jtsave
    prof%jpars     => jparsave
    prof%ps        => psave
    prof%fs        => fsave
    prof%w         => w
    prof%v         => v
    prof%psin      => psibin
    inv%rbnd       => rls
    inv%zbnd       => zls
    inv%raxis      => raxis
    inv%zaxis      => zaxis
    inv%dpsi00     => dpsi00
    inv%dphi00     => dphi00
    inv%dpsi0      => dpsi0
    inv%dphi0      => dphi0
    inv%epsrk      => epsrk
    inv%x          => inv_x
    inv%plc        => plcm
    inv%cur        => placur
    inv%fwall      => fwall
    inv%p          => inv_p
    inv%k          => inv_k
    inv%eq         => inv_eq
    inv%flag       => inv_flag
    inv%mpsi       => msrf
    inv%ls         => lsrf
    inv%mth        => mls
    inv%nht        => nht
    inv%R%nx       => inv%mth
    inv%R%ny       => inv%mpsi
    inv%Z%nx       => inv%mth
    inv%Z%ny       => inv%mpsi
    inv%fix_bnd    => fix_bound
    

    map            = mls / 2 + 1
    btor           = fwall / ro

    inv%R%x        => tswpts
    inv%R%y        => psibar
    inv%Z%x        => tswpts
    inv%Z%y        => psibar
    inv%R%f        => rlsd(:,:,1)
    inv%R%fx       => rlsd(:,:,2)
    inv%R%fy       => rlsd(:,:,3)
    inv%R%fs       => rlsd(:,:,4)
    inv%Z%f        => zlsd(:,:,1)
    inv%Z%fx       => zlsd(:,:,2)
    inv%Z%fy       => zlsd(:,:,3)
    inv%Z%fs       => zlsd(:,:,4)

    prof%q         => qsrf
    prof%p         => prsrf
    prof%pd        => pdsrf
    prof%jt        => jtsrf
    prof%jpar      => jparsrf
    prof%f         => frsrf
    prof%fd        => fpsrf
    prof%bsq       => bsqrf
    prof%phi       => phibar
    prof%psi       => psibar
    prof%cu        => cusrf
    prof%vpr       => vpsrf
    prof%bp        => bpsrf
    prof%rsqi      => rsqirf
    prof%a         => asrf
    prof%r         => rsrf
    inv%dpsi0      => dpsi0
    inv%dphi0      => dphi0

  END SUBROUTINE connect_inveq

  SUBROUTINE point_psi_cps(a,b,dir)
    USE teqlib_input, only : jm,km
    IMPLICIT NONE
    TYPE(dir_type), INTENT(INOUT) :: dir
    REAL(rq), DIMENSION(jm,km,3), TARGET, INTENT(INOUT) :: a
    REAL(rq), DIMENSION(jm,km),   TARGET, INTENT(INOUT) :: b
    dir%psi%f      =>  a(:,:,1)
    dir%psi%fx     =>  a(:,:,2)
    dir%psi%fy     =>  a(:,:,3)
    dir%psi%fs     =>  b
    dir%psi%nx      =>  jm
    dir%psi%ny      =>  km
  END SUBROUTINE point_psi_cps

  SUBROUTINE set_psi_cps(a,b,dir)
    USE teqlib_input, only : jm,km
    IMPLICIT NONE
    TYPE(dir_type), INTENT(INOUT) :: dir
    REAL(rq), DIMENSION(jm,km,3), INTENT(IN) :: a
    REAL(rq), DIMENSION(jm,km),   INTENT(IN) :: b
    dir%psi%f      =  a(:,:,1)
    dir%psi%fx     =  a(:,:,2)
    dir%psi%fy     =  a(:,:,3)
    dir%psi%fs     =  b
  END SUBROUTINE set_psi_cps

    
  SUBROUTINE connect_direq(dir,pf,inv,prof)
    use teqlib_input
    use teqlib_output
    USE teqinit
    USE sep_interp, only : i_cps
    USE sep_separatrix, only : s_nxps,s_rxps,s_zxps,s_pxps,s_limiterd,&
         s_rlse,s_zlse,s_mlse
    IMPLICIT NONE
    TYPE(dir_type), INTENT(INOUT) :: dir
    TYPE(pf_type), INTENT(INOUT) :: pf
    TYPE(inv_type), INTENT(INOUT) :: inv
    TYPE(profile_type), INTENT(INOUT) :: prof

    CALL connect_inveq(inv,prof)

    dir%psi%nx     => jm
    dir%psi%ny     => km
    dir%psi%x      => r
    dir%psi%y      => z
    CALL point_psi_cps(i_cps,bp,dir)
    dir%rxpt       => rxpt
    dir%zxpt       => zxpt
    dir%pxpt       => pxpt
    dir%paxis      => psix
    dir%rn         => rn
    dir%rx         => rx
    dir%ro         => ro
    dir%betaj      => betaj
    dir%zx         => zx
    dir%thc        => thetac
    dir%f_wp       => filter_wp
    dir%prsx       => prsx
    dir%rxpr       => rxpr
    dir%zxpr       => zxpr
    dir%alfa       => alfa
    dir%betp       => betp
    dir%li         => li
    dir%betap      => betap
    dir%pbnd       => psil
    dir%ipscl      => ipscl
    dir%ixpt       => ixpt
    dir%ipf        => ipf
    dir%ipj        => ipj
    dir%ipp        => ipp
    dir%irl        => irl
    dir%fix_bnd    => fix_bound
    dir%liml       => liml
    dir%epsj       => epsj
    dir%epsb       => epsb
    dir%aap        => aap
    dir%rxps       => s_rxps
    dir%zxps       => s_zxps
    dir%pxps       => s_pxps
    dir%nxps       => s_nxps
    dir%limd       => s_limiterd
    dir%msep       => s_mlse
    dir%zsep       => s_zlse
    dir%rsep       => s_rlse

    pf%ncircuit    => ncircuit
    pf%ngroup      => ngroup
    pf%nbd         => nbd
    pf%jcir        => jbdcir
    pf%nfbd        => nfbd
    pf%nc          => nc
    pf%ncp         => ncplot
    pf%ngp         => ngp
    pf%kax         => kaxis
    pf%kxp         => kxp
    pf%nlim        => nlim
    pf%nrc         => nrc
    pf%nzc         => nzc
    pf%ic          => ic
    pf%ix          => ix
    pf%ict         => ict
    pf%ic          => ic
    pf%cc          => cc
    pf%rc          => rc
    pf%zc          => zc
    pf%drc         => drc
    pf%dzc         => dzc
    pf%ps0         => pfps0
    pf%psi         => pfpsi
    pf%pci         => pfpci
    pf%pc0         => pfpc0
    pf%pfim        => pfim
    pf%rlim        => rlim
    pf%zlim        => zlim
    pf%rbd         => rbd
    pf%zbd         => zbd
    pf%rfbd        => rfbd
    pf%zfbd        => zfbd
    pf%alfbd       => alfbd
    pf%psix        => plcx
    pf%vltf        => vltf
    pf%cejima      => cejima
    pf%rl          => rl
    pf%irl         => irl
    pf%ircwt       => ircwt
    pf%iflxc       => iflxc
    pf%nsymc       => nsymc
    pf%nsym        => nsym
    pf%rax         => raxis0
    pf%zax         => zaxis0
    pf%rxp         => rxpt0
    pf%zxp         => zxpt0
    pf%skew        => skew
    pf%rminor      => rbore
    pf%rmajor      => rcntr
    pf%dsep        => dsep    
    pf%dsip        => dsip
    pf%lmax        => lmax
    pf%limw        => limw
    pf%rlimw       => rlimw
    pf%zlimw       => zlimw

  END SUBROUTINE connect_direq

END MODULE teqlib


