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

MODULE DeadStart

  USE sep_math

  IMPLICIT none

  REAL(rq) :: r_major, r_minor, z_axis
  REAL(rq) :: kappa_95, delta_95, delta_sep, beta_p, l_i, psi_ext
  REAL(rq) :: rtor
  REAL(rq) :: rgrid1, rgrid2, zgrid1, zgrid2

CONTAINS

  subroutine do_dead_start(paramsfile, coilsfile)

    use runTeq_mod
!    use DeadStart

    character(len = *), intent(in) :: paramsfile, coilsfile
    call mach
    call read_coils(coilsfile)
    call read_params(paramsfile)
    call teqGS_interface
    call teq_interface

    ! mach() must be called before genTeq(), or errb_rq won't get initialized

    call genTeq
!  call write_coils("coils.inp")
    call dead_start

  end subroutine do_dead_start

  SUBROUTINE read_coils(filename)

    USE teqlib_input
    IMPLICIT none
    CHARACTER (LEN=*), INTENT(IN) :: filename
    INTEGER, SAVE :: io=0
    CHARACTER (LEN=16) :: coil_set
    INTEGER :: i

    CALL freeus(io)
    OPEN(UNIT=io, FILE=filename, DELIM='QUOTE')
    READ(io,*) coil_set
    READ(io,*) nc
    READ(io,*)
    CALL teq_input_allocate
    DO i=1,nc
       READ(io,*) pfid(i),rc(i),zc(i),drc(i),dzc(i)
    END DO
    CLOSE(io)



  END SUBROUTINE read_coils

  SUBROUTINE write_coils(filename)

    USE teqlib_input
    IMPLICIT none
    CHARACTER (LEN=*), INTENT(IN) :: filename
    INTEGER, SAVE :: io=0
    INTEGER :: i
    CHARACTER (LEN=16) :: coil_set="<TBD>"
    EXTERNAL freeus

    CALL freeus(io)
    OPEN(UNIT=io, FILE=filename, DELIM='QUOTE')
    WRITE(io,'(2a)') coil_set,"TEQ needs variable to hold coil set name"
    WRITE(io,'(I5," coils")') nc
    WRITE(io,'("pfid        rc [m]    zc [m]   drc [m]   dzc [m]")')
    WRITE(io,'(a,4F10.4)') (pfid(i),rc(i),zc(i),drc(i),dzc(i),i=1,nc)
    CLOSE(io)

  END SUBROUTINE write_coils

  SUBROUTINE read_params(filename)

    USE sep_math
    USE teqlib_input
    USE teqlib_output
    USE teq_output_mod
    IMPLICIT none
    CHARACTER (LEN=*), INTENT(IN) :: filename
    CHARACTER (LEN=32) :: heading
    CHARACTER (LEN=1) :: token
    INTEGER :: i, io
    EXTERNAL freeus

    CALL freeus(io)
    initflx=0
    psix=0
    prsx=0
    lsrf=0
    jqm=0
    mls=0
    nplates=0
    lmax=0
    plcx=0
    wvert=0
    psil=0
    dpsi00=0
    scl=0
    dr=0
    dz=0

    OPEN(UNIT=io, FILE=filename)
    DO
       READ(io,*) heading
       IF (heading(1:6) == 'Plasma') EXIT
    END DO
    READ(io,*) plcm
    READ(io,*) r_major
    READ(io,*) r_minor
    READ(io,*) z_axis
    READ(io,*) kappa_95
    READ(io,*) delta_95
    READ(io,*) delta_sep
    READ(io,*) beta_p
    READ(io,*) l_i
    READ(io,*) psi_ext
    DO
       READ(io,*) heading
       IF (heading(1:8) == 'Toroidal') EXIT
    END DO
    READ(io,*) btor, token, token, token, token, rtor
    DO
       READ(io,*) heading
       IF (heading(1:4) == 'Comp') EXIT
    END DO
    READ(io,*) rgrid1
    READ(io,*) rgrid2
    READ(io,*) zgrid1
    READ(io,*) zgrid2
    READ(io,*) jm, token, km
    CLOSE(io)
    
    r_major=r_major*100
    r_minor=r_minor*100
    z_axis=z_axis*100
    btor=btor*1d4
    rtor=rtor*100
    rgrid1=rgrid1*100
    rgrid2=rgrid2*100
    zgrid1=zgrid1*100
    zgrid2=zgrid2*100
    
    ! Specify computational grid
    liml=(jm-1)/8+1
!    fwall=btor*rtor
    IF (rgrid1 <= 0) THEN
       rgrid1=errt_rq
       rgrid2=rgrid2+errt_rq
    END IF
    ro=0.5*(rgrid1+rgrid2)
    dr=(rgrid2-rgrid1)/(jm-1)
    rb=(dr/1.0017469212_rq)*((jm+1)/2-liml)
    rfix=0
    el=(zgrid2-zgrid1)/(rgrid2-rgrid1)
    rlim(0)=ro-rb
    zlim(0)=0
    
    ! Specify x-point search-box
    rxpr(1)=MAX(ro-rb,100*(MINVAL(rc(:nc))+2*MAXVAL(drc(:nc))))
    rxpr(2)=MIN(ro+rb,100*(MAXVAL(rc(:nc))+2*MINVAL(drc(:nc))))
    zxpr(2)=MIN(zgrid2,100*(MAXVAL(zc(:nc))-3*MINVAL(drc(:nc))))
    zxpr(1)=-zxpr(2)

   
    ! Parameters for plasma boundary generation
    nsym=2
    ibdry=1
    nbd=MIN(7,2*((nc+1)/2)-1)
    ebdu=kappa_95
    dbdu=delta_95
    ebdl=ebdu
    dbdl=dbdu
    
    ! Coil regularization parameters
    nsymc=2
    ircwt=3
    cc(:nc)=-1
    ic(:nc)=(/ (i, i=1,nc) /)
    vltf=0
    
    ! Specify profile parameters
    betaj=0.1
    ipp=1
    ipf=1
    alfa(1)=-1
    alfa(0)=-1
    
    ! Equilibrium parameters
    ixpt=1
    keqic=1
    psix=plcm*1d8
    nl=200
    ni=1
    map=64
    alphac=0.5
    
  END SUBROUTINE read_params
  
  SUBROUTINE dead_start

    USE teqlib_input
    USE teqlib_output
    USE runTeq_mod
    IMPLICIT none
    INTEGER :: i
    REAL(rq) :: t

    !CALL mach
    PRINT *,"DEADSTART: Initial equilibrium with simple profiles"
    ngp=0
    
    CALL runTeq

    PRINT *,"DEADSTART: Install fuzzy markers"
    nfbd=64
    nbd=0
    CALL teq_interface
    DO i=1,nfbd
       t=2*PI*FLOAT(i-1)/nfbd
       rfbd(i)=ro+rb*COS(t+dbdu*SIN(t))
       zfbd(i)=ebdu*rb*SIN(t) ! ? NEED Z0
    END DO
    rlim(0)=rfbd(1)
    zlim(0)=zfbd(1)
    alfbd=(PI*1d9)/(plcm*ro**2)
    alfbd=2**(INT(LOG(alfbd(1))/LOG(2.0)+1))
    CALL runTeq

    IF (s_limiterd == 0 .AND. delta_sep /= 0 .AND. ABS(delta_sep) < 0.001) THEN
       PRINT *,"DEADSTART: Add separatrix separation constraint for ~DN"
       nbd=1
       rbd(1)=MINVAL(rfbd)
       zbd(1)=0
       IF (s_limiterd == 1) THEN
          IF (rlim(0) > s_rcntr) THEN
             rlim(0)=rlim(0)+dr
          ELSE
             rlim(0)=rlim(0)-dr
          END IF
       END IF
       irl=0
       IF (delta_sep == 0) THEN
          rl=-1e-6_rq
       ELSE
          rl=SIGN(1.0e-06_rq,delta_sep)
       END IF
       CALL runTeq
    ELSE IF (ABS(delta_Sep) >= 0.001) THEN
       PRINT *,"DEADSTART: Add separatrix separation constraint for SN"
       IF (s_limiterd == 1) THEN
          IF (rlim(0) > s_rcntr) THEN
             rlim(0)=rlim(0)+dr
          ELSE
             rlim(0)=rlim(0)-dr
          END IF
       END IF
       IF (ABS(delta_sep) > 0) THEN
          DO WHILE (s_dsep < 10*ABS(delta_sep) .and. rl/=0)
             rl=10*rl
             CALL runTeq
          END DO
          IF (delta_sep > 0) THEN ! SNT
             irl=-1
          ELSE ! SNB
             irl=1
          END IF
          rl=100*ABS(delta_sep)
          CALL runTeq
       END IF
    END IF

    PRINT *,"DEADSTART: Install ohmic profiles"
    nfbd=mls
    CALL teq_interface
    alfbd=100
    rfbd(:nfbd)=rls(:nfbd)
    zfbd(:nfbd)=zls(:nfbd)
    aap=0
    msrf=51
    lsrf=-1
    ipj=2
    ipp=3
    alfa(1)=2
    betp(1)=1
    ipf=3
    alfa(0)=2
    betp(0)=1
    alfa(0)=2
    betp(0)=1
    betaj=0.2
    CALL runTeq

  END SUBROUTINE dead_start

END MODULE DeadStart
