!$Id: driver.f90,v 1.4 2007/07/31 20:13:30 pearls Exp $

program driver
  use teqlib
  use deadstart

  use teqerr

  implicit none
  
  real(rq), DIMENSION(:), ALLOCATABLE :: psuser,puser,juser

  integer :: muser
  
  type(profile_type) :: prof

  type(inv_type) :: inv

  type(dir_type) :: dir

  type(pf_type) :: pf
 
  type(global_type) :: glb

  integer :: ierr

! FOR A LIST OF THESE DEFINED TYPES LOOK AT THE TOP OF teqlib.f90
! IT SHOULD BE SELF EXPANATORY.I WILL ADD MORE COMMENTS AND ADD TO
! THE README FILE. IT IS NOW NECESSARY THAT NO DATA BE CHANGED UNTIL
! AFTER THE FIRST EQUILIBRIUM IS OBTAINED. IT IS AFTER THIS THAT ALL
! POINTERS, ETC ARE SET UP.

  character(len = 64) :: which

  integer :: i,logunit

!  logical :: do_deadstart = .true.
 logical :: do_deadstart = .false.
  logical :: do_test = .true.
  logical :: get_external = .false.


  nullify(prof%q,prof%qs,prof%p, prof%ps,prof%jpar,prof%jpars,prof%jt,prof%jts)
  nullify(prof%f,prof%fs,prof%pd,prof%bp,prof%bp,  prof%rsqi, prof%cu,prof%phi)
  nullify(prof%r,prof%a ,prof%w, prof%v ,prof%bsq, prof%psi , prof%vpr)
  nullify(inv%R%f, inv%mth, inv%rbnd, inv%raxis)
  nullify(dir%psi%f, dir%psi%nx, dir%ipp)
  nullify(pf%cc, pf%rlim, pf%rbd, pf%rfbd)

  call set_global(glb) ! Now sets pointer
  glb%logunit = 9
  glb%ioun7=7
  glb%ioun12=12
  glb%ioun13=13
  glb%logname="driver.log"
  logunit=glb%logunit
  open(unit = glb%logunit, file = glb%logname, status = "replace")

  glb%filename="input/iter.in"
!  glb%filename="input/iter_inv.in"
!  glb%filename="input/iter_dir-inv.in"
!  glb%filename="input/fire.in"
!  glb%filename="input/fire_inv.in"
!  glb%filename="input/ignitor_sof.in"
!  glb%filename="input/jet.in"
!  glb%filename="input/jet_inv.in"
!  glb%filename="input/d3d.in"
!  glb%filename="input/d3d_inv.in"
!  glb%filename="input/cmod.in"
!  glb%filename="input/cmod_inv.in"
!  glb%filename="input/nstx.in"
!  glb%filename="input/nstx_sym.in"
!  glb%filename="input/nstx_inv.in"
!  glb%filename="input/sspx_bcs.in"
!  glb%filename="input/sspx_bcm.in"
!  glb%filename="input/kstar.in"
!  glb%filename="input/kstar_inv.in"
!  glb%filename="input/mst.in"
!  glb%filename="input/mast-sn.in"
!  glb%filename="input/pegasus.in"
!  glb%filename="input/pegasus_snl.in"
!  glb%filename="input/east_snl.in"
!  glb%filename="input/tftr.in"
!  glb%filename="input/tftr_inv.in"
!  glb%tokamak ="input/kstar-tokamak.inp"
!  glb%pfcoil  ="input/kstar-pfcoil.inp"
!  glb%tokamak ="input/pegasus-tokamak.inp"
!  glb%pfcoil  ="input/pegasus-pfcoil.inp"
!  glb%filename="driver.in"

  stop_on_error = .false.

  ! Put an exception handler around all of the calls
  exceptions_enabled = .true.

  if (do_deadstart .and. glb%filename == "input/kstar.in") then
     write(*,*)"deadstart with ",trim(glb%tokamak)," and ",glb%pfcoil
     write(logunit,*)"deadstart with ",trim(glb%tokamak)," and ",glb%pfcoil
     call catch_dead_start(ierr,glb)
    if(ierr/=0) then
        print *, 'An exception occurred, the error message is: ', &
             trim(error_msg), '. Bailing out...'
        write(logunit,*) 'An exception occurred, the error message is: ', &
             trim(error_msg), '. Bailing out...'
        ! user intervenes
        stop
     end if
  elseif (do_deadstart .and. glb%filename == "input/pegasus.in") then
     write(*,*)"deadstart with ",trim(glb%tokamak)," and ",glb%pfcoil
     write(logunit,*)"deadstart with ",trim(glb%tokamak)," and ",glb%pfcoil
     call set_verbosity(1)
     call catch_dead_start(ierr,glb)
     if(ierr/=0) then
        print *, 'An exception occurred, the error message is: ', &
             trim(error_msg), '. Bailing out...'
        write(logunit,*) 'An exception occurred, the error message is: ', &
             trim(error_msg), '. Bailing out...'
        ! user intervenes
        stop
     end if
  else
     call remark("Using "//glb%filename)
     write(logunit,*)"Using "//glb%filename
     call catch_load_savefile(ierr,glb,dir,pf,inv,prof)
     write(*,*) inv%fix_bnd
     if(ierr/=0) then
        print *, 'An exception occurred, the error message is: ', &
             trim(error_msg), '. Bailing out...'
        write(logunit,*) 'An exception occurred, the error message is: ', &
             trim(error_msg), '. Bailing out...'
        ! user intervenes
        stop
     end if

     if(get_external==.true.) then 
        ! This logic is to be used to get the external flux (free-boundary
        ! calculation) after a fixed-boundary calculation
        ! During a run all you should need is the last "call catch_direq"
        ! Note that if you are starting up from an inverse savefile with
        ! inv%fix_bnd=.true., you will need to do all of the below in order
        ! to synchronize with the derived types, otherwise you are ready to go.
        ! During a seqhence of fixed-boundary calculations one needa only call
        ! catch_direq after each catch_inveq.
        inv%eq=1
        inv%nht=6
        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(glb%filename=="input/d3d_inv.in") then
           pf%ic(:pf%ncp)=(/(i,i=1,pf%ncp)/)
           ! pf%ncp is the number of shaping coils in DIII-D
           ! otherwise it is the number of active coils.
           ! you may want to intervene here
           pf%nfbd=inv%mth
           pf%alfbd(:pf%nfbd)=pf%alfbd(1)
           pf%rfbd(:pf%nfbd)=inv%rbnd
           pf%zfbd(:pf%nfbd)=inv%zbnd
        end if
        pf%nbd=0 ! no fixed boundary points
        pf%psix=dir%paxis
        ! force the flux on axis in free_boundary to be that of fixed_boundary
        call catch_direq(ierr,dir,pf,inv,prof,glb)
        call write_savefile("driver.in")
        stop
     endif

     if((inv%eq==0 .or. (inv%eq==1 .and. .not.inv%fix_bnd)) &
          .and. .not. do_test) then
! direct solve
!        call set_verbosity(1)  

        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        if(glb%filename=="input/sspx_bcm.in" .or. &
             glb%filename=="input/sspx_bcs.in") then
           stop
        end if
        ! note in the direct solve all inactive save arrays are reset

        inv%mth=81
        inv%mpsi=81
        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        dir%thc = 0.01! move boundary inside separatrix in dimensionless flux;
                      ! necessary for inverse solves and direct solves if q is
                      ! is the inputted profile: ipj=5

        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        ! this option is the "adiabatic option"
        dir%ipj = 5   ! compute from qsave and psave
        dir%ipscl = -1! do not scale to fix current or flux
        inv%p = 0     ! fixes F on boundary to fwall
                      ! note that in this case the options are the same
                      ! as for the inverse solver
        dir%f_wp=999  ! smoothes current at edge
        inv%eq=0      ! in case the starting direct solver was using the
                      ! inverse solver for the solution inside the separatrix

        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        !
        dir%ipscl = 0 ! fixes plasma current;ipscl=1 fixes flux
                      !  
        dir%ipj = 1   ! compute from jtsave and psave

        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        which="both"
        call gridup(dir,pf,inv,prof,glb,which) ! changes grid
        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        which ="y"
        call griddown(dir,pf,inv,prof,glb,which) ! changes grid
        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        which ="x"
        call griddown(dir,pf,inv,prof,glb,which) ! changes grid
        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        inv%nht = 200; inv%epsrk = 1.0e-6
        call set_verbosity(2)
        inv%p = 0     ! fixes F_bound to fwall
        inv%k = 0     ! uses q-profile (qsave)
        inv%eq=-2     ! first time after direct equilibrium, uses internal data
        call catch_inveq(ierr,inv,prof,glb) ! first inverse solve
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if
!        inv%p = -1    ! fixes polflux(GS) across plasma to dpsi00 (cgs)
        inv%p = 1     ! fixes current, uses plcm (MA)
        inv%k = 3     ! uses jparsave (<J.B>/<B.B>
        ! Uses previous solution as starting point

        call catch_inveq(ierr,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        ! if in the course of running there is a STOP or a major change in 
        ! the boundary make sure inv%rbnd and inv%zbnd are properly set

        ! and set inv%eq=-1 and call catch_inveq(ierr,inv,prof,glb)
        ! for the profiles options!
        ! inv%k=0 or inv_k%3 are preferred since output profiles are equal to
        ! input profiles; if inv%k=1,2 output profiles are only proportional
        ! to the input profiles
        inv%eq = 0 ! This value tells the free-boundary solver not to use
                   ! the inverse solver for the solution inside separatrix.
        dir%thc = 0
        call set_verbosity(1)

        call catch_direq(ierr,dir,pf,inv,prof,glb) ! back to direct solve
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        ! constrict spline coefficients for the input profiles
        prof%fs = prof%f
        prof%w  = (prof%fs**2 - prof%f(dir%psi%nx)**2) / &
             (8  * pi * inv%dpsi0 * dir%prsx)
        prof%v  = prof%ps / (dir%betaj * inv%dpsi0 * dir%prsx)
        call get_spline_coefficients ! The spline coefficients for w and v
        ! end construct

        ! set input parameters to use spline coefficients
        dir%ipp = 999
        dir%ipf = 999
        dir%ipj = 0
        ! end set

        call catch_direq(ierr,dir,pf,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

     elseif(.not.do_test) then
        call set_verbosity(2)
        call catch_inveq(ierr,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        inv%p=0 ! Fwall scaler boundary condition

        ! user provides input profiles on dimensionless poloidal flux profiles
        muser=51
        allocate(psuser(muser),puser(muser),juser(muser))
        psuser=sqrt((/(i,i=0,muser-1)/)/(muser-1.0_rq)) ! dim-less pol-flux

        ! just interpolate the profiles to the user coord. to get user profiles
        call translate(prof%psi,prof%qs,psuser,juser) ! from teq coordinates
        call translate(prof%psi,prof%ps,psuser,puser) ! from teq coordinates

        ! next transform user profiles to teq coordinates 
        call translate(psuser,juser,prof%psi,prof%qs)
        call translate(psuser,puser,prof%psi,prof%ps)
        ! note the only change for this example is from grid resolution
        
        call catch_inveq(ierr,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if
        inv%rbnd=inv%rbnd+0.25_rq*prof%a(inv%mpsi)
        inv%zbnd=inv%zbnd+0.25_rq*prof%a(inv%mpsi)
        
        inv%eq=-1 ! Do not use internal geoemetry info if boundary points
                  ! are moved. If there is a "gentle" motion during surveys,
                  ! this should not be necessary
        inv%eq=0  ! This is the prefrred option with a boundary move: note
                  ! the comnents in libteq.f90 for inv_type
        call catch_inveq(ierr,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        ! now transform back to user coord.
        call translate(prof%psi,prof%qs,psuser,juser) ! from teq coordinates
        call translate(prof%psi,prof%ps,psuser,puser) ! from teq coordinates

        ! Move boundary points
        inv%rbnd=inv%rbnd-0.25_rq*prof%a(inv%mpsi)
        inv%zbnd=inv%zbnd-0.25_rq*prof%a(inv%mpsi)
        inv%eq=-1 ! Do not use internal geoemetry info if boundary points
                  ! are moved. If there is a "gentle" motion during surveys,
                  ! this should not be necessary

        inv%eq=0

        call catch_inveq(ierr,inv,prof,glb)
        if(ierr/=0) then
           print *, 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           write(logunit,*) 'An exception occurred, the error message is: ', &
                trim(error_msg), '. Bailing out...'
           ! user intervenes
           stop
        end if

        if(glb%filename=="input/nstx_inv.in") then
           prof%qs=10*prof%qs

           call catch_inveq(ierr,inv,prof,glb)
           if (ierr /= 0) then
             print *, 'An exception occurred, the error message is: ', &
                 trim(error_msg), '. Bailing out...'
             write(logunit,*)'An exception occurred, the error message is: ', &
                 trim(error_msg), '. Bailing out...'
     ! new calculation
             prof%qs=0.1_rq*prof%qs
             inv%eq=-2 ! This uses the old flux geometry, but re-initializes.
             ! inv%eq=-1 ! This uses no prior information; just initializes
             inv%x=.9 ! modifies FF' beyond pssibar=.9 to force FF'=0 at bndry
             call catch_inveq(ierr,inv,prof,glb)
             if (ierr /= 0) then
              print *, 'An exception occurred, the error message is: ', &
                 trim(error_msg), '. Bailing out...no really...'
              write(logunit,*) 'Exception occurred, the error message is: ', &
                 trim(error_msg), '. Bailing out...no really...'
              stop
             end if
           end if

        end if
     end if
  end if
  call write_savefile("driver.in")
  if(do_test) then
     write(*,*) " "
     write(logunit,*) " "
     write(*,*) "OUTPUT"
     write(logunit,*) "OUTPUT"
     if(inv%eq==0 .or. .not.inv%fix_bnd) then
        write(*,*) "coil currents and pbnd   ",pf%cc(:pf%nc),&
             dir%pbnd
        write(logunit,*) "coil currents and pbnd   ",pf%cc(:pf%nc),&
             dir%pbnd
     else
        if(inv%k==0) then
           write(*,*) "q(1) and P(1)            ",prof%q(1),prof%p(1)
           write(logunit,*) "q(1) and P(1)            ",prof%q(1),prof%p(1)
        elseif(inv%k==1) then
           write(*,*) "F(1) and P(1)            ",prof%f(1),prof%p(1)
           write(logunit,*) "F(1) and P(1)            ",prof%f(1),prof%p(1)
        elseif(inv%k==2) then
           write(*,*) "jt(1) and P(1)           ",prof%jt(1),prof%p(1)
           write(logunit,*) "jt(1) and P(1)           ",prof%jt(1),prof%p(1)
        elseif(inv%k==3) then
           write(*,*) "jpar(1) and P(1)         ",prof%jpar(1),prof%p(1)
           write(logunit,*) "jpar(1) and P(1)         ",prof%jpar(1),prof%p(1)
        endif
     end if
     write(*,*) "boundary point           ",inv%rbnd(25),inv%zbnd(25)
     write(logunit,*) "boundary point           ",inv%rbnd(25),inv%zbnd(25)
     write(*,*) "scaler constraints -dpsi0,cur,fwall- two can be bad &
          since only one is used"
     write(logunit,*) "scaler constraints -dpsi0,cur,fwall- two can be bad &
          since only one is used"
     write(*,*) inv%dpsi0,inv%cur,prof%f(inv%mpsi)
     write(logunit,*) inv%dpsi0,inv%cur,prof%f(inv%mpsi)

     call read_savefile(glb%filename)

     write(*,*)" "
     write(logunit,*)" "
     write(*,*) "INPUT"
     write(logunit,*) "INPUT"
     if(inv%eq==0 .or. .not.inv%fix_bnd) then
        write(*,*) "coil currents and pbnd   ",pf%cc(:pf%nc),&
             dir%pbnd
        write(logunit,*) "coil currents and pbnd   ",pf%cc(:pf%nc),&
             dir%pbnd
     else
        if(inv%k==0) then
           write(*,*) "q(1) and P(1)            ",prof%qs(1),prof%ps(1)
           write(logunit,*) "q(1) and P(1)            ",prof%qs(1),prof%ps(1)
        elseif(inv%k==1) then
           write(*,*) "F(1) and P(1)            ",prof%fs(1),prof%ps(1)
           write(logunit,*) "F(1) and P(1)            ",prof%fs(1),prof%ps(1)
        elseif(inv%k==2) then
           write(*,*) "jt(1) and P(1)           ",prof%jts(1),prof%ps(1)
           write(logunit,*) "jt(1) and P(1)           ",prof%jts(1),prof%ps(1)
        elseif(inv%k==3) then
           write(*,*) "jpar(1) and P(1)         ",prof%jpars(1),prof%ps(1)
           write(logunit,*) "jpar(1) and P(1)         ",prof%jpars(1),prof%ps(1)
        end if
     end if
     write(*,*)"boundary point           ",inv%rbnd(25),inv%zbnd(25)
     write(logunit,*) "boundary point           ",inv%rbnd(25),inv%zbnd(25)
     write(*,*) "scaler constraints -dpsi0,cur,fwall- two can be bad &
          since only one is used"
     write(logunit,*) "scaler constraints -dpsi0,cur,fwall- two can be bad &
          since only one is used"
     write(*,*) inv%dpsi00,inv%plc*1.e6,inv%fwall
     write(logunit,*) inv%dpsi00,inv%plc*1.e6,inv%fwall

     endif
  stop
end program driver

