module SPmig_mod  !! WEI kerneled migration, Shot Profile style

  !! mosteverything
  use down_mod
  !!file stuff
  use S_mod
  use R_mod
  use D_mod
  use W_mod
  !!transforms
  use kmap_mod
  use xmap_mod
  use fft_mod
  !! extrapolation
  use kxmig_mod
  !! imaging condition
  use image_mod
  use taper_mod
  use xmap_mod
  implicit none

  !! files
  type(dat) ,public :: D,D_d,HD,HD_d
  type(imag),public :: R,M,N_u,N_d
  type(twfld),public:: W,W_d
  !! timers
  integer:: time_array(8),jwork,jstep
  real::startd,work(10),steps
  
contains
!----------------------------------------------------------------
  subroutine SPmig_init(SLin,WCin,FKin,FXin,IGin)
    integer :: st,er
    real::a
#ifdef DEBUG
    character(len=128), parameter :: unit='mig_init'
#endif
    interface !!-------------------------
       integer function    SLin() result(st)
       end function SLin
       integer function    WCin() result(st)
       end function WCin
       integer function    FKin() result(st)
       end function FKin
       integer function    FXin() result(st)
       end function FXin
       integer function    IGin() result(st)
       end function IGin
    end interface !!---------------------

    startd=0.
    !! initialize the main running variables
    if(.not. run_init()) &
    call erexit("trouble initializing run_init")
    if(.not. down_init()) &
    call erexit("trouble initializing down_init")

#ifdef DEBUG
    if(run%debug) call in(unit)
#endif
    !!bring in the files
    call file_io()

    !! convert frequency to radians
    call process_radians()

    !! init FFT
    if(.not.down%datum) then
       call fft_init_s(D_d%bin)  
    end if
    if(down%gathers)then
       call fft_init_r(D%bin)  
    end if

    !!linear maps of k values
    call kmap_init()

    !! init imaging
    call imaging_init()

    !! allocate slowness arrays for FK/FX ops
    call slow_allocate()

    !! cosine^2 taper for the wavefields
    if(down%taperme) call xytaper_init()

    !! init operators
    st=SLin()     !! FK slownesses init
    st=WCin()     !! WCop init
    st=FKin()     !! FKop init
    st=FXin()     !! FXop init
    st=IGin()     !! Imaging condition init 

    !! reset tag variables
    D_d%tag= trim(down%dat_d_)
    D%tag  = trim(down%dat_  )
    R%tag  = trim(down%mod_  )
    M%tag  = trim(down%m_    )
    N_d%tag= trim(down%n_d_  )
    N_u%tag= trim(down%n_u_  )
    W_d%tag= trim(down%w_d_  )
    W%tag  = trim(down%w_    )
    HD%tag = trim(down%h_d_  )
    HD_d%tag=trim(down%h_d_d_)
    
    steps=down%az%n*down%aw%n
    do st=1,size(work)
       work(st)=nint(steps/10./real(st))
    end do
    jstep=0;jwork=1;

#ifdef DEBUG
    if(run%debug) call out(unit)
#endif
  end subroutine SPmig_init
  !----------------------------------------------------------------
  integer function SPmig(adj,add,&
  SLop,WCop,FKop,FXop,IGop,MIGop,NDIGop,NUIGop)
    logical,intent(in):: adj,add
    integer,external ::  WCop,FKop,FXop,IGop,MIGop,NDIGop,NUIGop
    integer :: izb,iwb,isx
    integer :: st
    real::startSHOT,endSHOT
#ifdef DEBUG
    character(len=128), parameter :: unit='SPmig'
#endif
    interface !!----------------------------------------------
       integer function SLop() result(st)
       end function SLop
    end interface !!------------------------------------------
#ifdef DEBUG
    if(run%debug) call in(unit)
#endif
    if(run%verb)write(run%io,*) '        * Start parallel'
    call sep_begin_prog()
    if(run%verb)write(run%io,*) '        * '
    down%shotnum=0

    shot: do isx=1,down%evnt%n
       call start_timer(startSHOT)
       if (run%verb)then
          if(down%passive.or.down%datum) then
             call line()
             write(run%io,'(a,i5,a,i5)')"         *  Event number",&
             down%shotnum+1,' of',down%evnt%n
          else
             call line()
             write(run%io,'(a,i5,a,i5)')"         *  Shot number",&
             down%shotnum+1,' of',down%evnt%n
          end if
       end if

       call data_position(D,isx) 
       call data_position_report()
       call source_pos(D_d,isx)
       call source_report(D_d)

       SPmig=SPmigof(isx,SLop,WCop,FKop,FXop,IGop,MIGop,NDIGop,NUIGop)
       call end_timer(endSHOT,startSHOT)
       if(down%passive.or.down%datum) then
          if(run%verb)write(run%io,'(a,i4,a,f7.3,a)') &
          '         *       Finished migrating event',down%shotnum +1,&
          ' in',endSHOT/60.,'(m)'
       else
          if(run%verb)write(run%io,'(a,i4,a,f7.3,a)') &
          '         *       Finished migrating shot',down%shotnum +1,&
          ' in',endSHOT/60.,'(m)'
       end if

       down%shotnum=down%shotnum+1
       if (down%sourcefn) then
          st=sseek(D_d%tag,0,0) !! rewind to beginning of source
       end if
    end do shot
    
    if(down%passive)call aux_unlink('D_d')
    call writeparams()
    call message("Done and Done")
#ifdef DEBUG
    if(run%debug) call out(unit)
#endif
    SPmig=OK
  end function SPmig
!--------------------------------------------------------------------
  integer function SPmigof(isx,SLop,WCop,FKop,FXop,IGop,MIGop,NDIGop,NUIGop)
    integer,external ::                 WCop,FKop,FXop,IGop,MIGop,NDIGop,NUIGop
    integer :: izb,iwb,position
    integer :: st,ierr,isx
#ifdef DEBUG
    character(len=128), parameter :: unit='migof'
#endif
    interface !!----------------------------------------------
       integer function SLop() result(st)
       end function SLop
    end interface !!------------------------------------------

    if(down%adj) then !! MIGRATION
#ifdef DEBUG
       if(run%debug) call in('migration')
#endif 

       wbA: do iwb=1,down%bw%n
          down%bw%o = down%bw%o + (iwb-1)*down%bw%d
          if(run%verb)write(run%io,'(a,i3,a,i3)') &
             '         * Frequency block ',iwb,' of ',down%bw%n

          call read_data_source(iwb)

          zbA: do izb=1,down%bz%n
             call read_image(izb)
             call read_slowness(izb) !! read a slowness block
             st = SLop() !! setup sS, sR, s(z) for working space
             call wemig  (izb,iwb,WCop,FKop,FXop,IGop,MIGop,NDIGop,NUIGop)
             call write_image(izb)
          end do zbA
          call writewavefields(down%nzs+1,izb-1,iwb) !! last depth       
       end do wbA

#ifdef DEBUG
       if(run%debug) call out('migration')
#endif
    else         !! MODELING
#ifdef DEBUG
       if(run%debug) call in('modeling')
#endif
       wbAm: do iwb=1,down%bw%n
          down%bw%o = down%bw%o + (iwb-1)*down%bw%d

          if(run%verb)write(run%io,'(a,i2,a,i2)') &
             '         *   Frequency block ',iwb,' of ',down%bw%n
          if(down%datum) then
             if(.not.down%headD) then
                position=down%shotnum*down%bw%n + (iwb-1)
                if(.not. data_read(D,position)) &
                call seperr("trouble reading D data") !! read data at block top
             else
                position=(iwb-1)
                if(.not. data_sort_read(D,D_d,position,HD)) &
                call seperr("trouble reading/sorting D data") !! read data at block top
             end if
          else
             if(.not. source_read(D_d,iwb-1)) & !!read the source file
             call seperr("trouble reading D_d data")
          end if

          zbAm: do izb=1,down%bz%n
             call read_image(izb)
             call read_slowness(izb) !! read a slowness block
             st = SLop() !! setup sS, sR, s(z) for working space
             call wemig_model(izb,iwb,WCop,FKop,FXop,IGop,MIGop,NDIGop,NUIGop)
             call write_image(izb)
          end do zbAm
          call writewavefields(down%nzs+1,izb-1,iwb) !! last depth                    
       end do wbAm
#ifdef DEBUG
       if(run%debug) call out('modeling')
#endif
    end if
#ifdef DEBUG
    if(run%debug) call out(unit)
#endif
    SPmigof=OK
  end function SPmigof
!---------------------------------------------------------------
  subroutine wemig(     izb,iwb,WCop,FKop,FXop,IGop,MIGOP,NDIGop,NUIGop)
    integer,intent(in)::izb,iwb
    integer,external    ::      WCop,FKop,FXop,IGop,MIGOP,NDIGop,NUIGop
    integer :: izs,nzs,a,currentz
    real    :: startIC,finishIC,startEX,finishEX
    integer:: div
#ifdef DEBUG
    character(len=128), parameter :: unit='wemig'
    if(run%debug) call in(unit)
#endif
    startIC=0.;finishIC=0.;startEX=0.;finishEX=0.
    div=min(10,down%nzs)
       if (down%image_freqs) a=sseek(R%tag,0,0)
          finishIC=0.
          finishEX=0.
          write(run%io,*) "        *       Migration begins!"
          call start_timer(startd)
       zsA: do izs=1,down%nzs          !LOOP OVER z STEPS
#ifdef TIME
          call start_timer(startIC)
#endif
          call writewavefields(izs,izb,iwb)
          call imagingcondition(izs,IGop,MIGOP,NDIGop,NUIGop)
#ifdef TIME
          call end_timer(finishIC,startIC)
          call start_timer(startEX)
#endif 
          call kxmig(izs,D%bin,D_d%bin,WCop,FKop,FXop)
#ifdef TIME
          call end_timer(finishEX,startEX)
#endif
          jstep=jstep+down%nws
          if (work(jwork)==jstep) call depth_report(jwork)
       end do zsA
#ifdef TIME
       finishIC=finishIC/60.
       finishEX=finishEX/60.
       write(run%io,'(8x,a,f6.2,a)')' *       Time imaging       :', &
         finishIC,' (m)'
       write(run%io,'(8x,a,f6.2,a)')' *       Time extrapolating :', &
         finishEX,' (m)'
#endif

#ifdef DEBUG
    if(run%debug) call out(unit)
#endif
  end subroutine wemig
!---------------------------------------------------------------
  subroutine wemig_model(izb,iwb,WCop,FKop,FXop,IGop,MIGOP,NDIGop,NUIGop)
    integer,intent(in):: izb,iwb
    integer,external ::          WCop,FKop,FXop,IGop,MIGOP,NDIGop,NUIGop
    integer :: izs,nzs,a,currentz
    real    :: startIC,finishIC,startEX,finishEX
#ifdef DEBUG
    character(len=128), parameter :: unit='wemig'
    if(run%debug) call in(unit)
#endif
    startIC=0.;finishIC=0.;startEX=0.;finishEX=0.

    if (down%image_freqs) a=sseek(R%tag,0,0)
    finishIC=0.
    finishEX=0.
    write(run%io,*) "        *       Modeling begins!"
    call start_timer(startd)

    if(down%datum) then  !! subtract time from D

       zsA: do izs=1,down%nzs          !LOOP OVER z STEPS
#ifdef TIME
          call start_timer(startIC)
#endif
          call writewavefields(izs,izb,iwb) !! main output
          call imagingcondition(izs,IGop,MIGOP,NDIGop,NUIGop)
#ifdef TIME
          call end_timer(finishIC,startIC)
          call start_timer(startEX)
#endif 
          call kxmig_model(izs,D%bin,WCop,FKop,FXop)
#ifdef TIME
          call end_timer(finishEX,startEX)
#endif
          jstep=jstep+down%nws
          if (work(jwork)==jstep) call depth_report(jwork)
       end do zsA

    else !! !! make Greens Functions with (add time to) D_d

       zsB: do izs=1,down%nzs          !LOOP OVER z STEPS
#ifdef TIME
          call start_timer(startIC)
#endif
          call writewavefields(izs,izb,iwb) !! main output
          call imagingcondition(izs,IGop,MIGOP,NDIGop,NUIGop) 
#ifdef TIME
          call end_timer(finishIC,startIC)
          call start_timer(startEX)
#endif 
          call kxmig_model(izs,D_d%bin,WCop,FKop,FXop)
#ifdef TIME
          call end_timer(finishEX,startEX)
#endif          
          jstep=jstep+down%nws
          if (work(jwork)==jstep) call depth_report(jwork)
       end do zsB
    end if

#ifdef TIME
    finishIC=finishIC/60.
    finishEX=finishEX/60.
    write(run%io,'(8x,a,f10.3,a)')' *       Time imaging       :', &
    finishIC,' (m)'
    write(run%io,'(8x,a,f10.3,a)')' *       Time extrapolating :', &
    finishEX,' (m)'
#endif

#ifdef DEBUG
    if(run%debug) call out(unit)
#endif
  end subroutine wemig_model
!----------------------------------------------------------------
  subroutine read_data_source(iwb)
    integer:: iwb,position

    if(.not.down%headD) then !! read data
       position=down%shotnum*down%bw%n + (iwb-1)
       if(.not. data_read(D,position)) &
       call seperr("trouble reading D data") !! read data at block top
       if(.not.down%passive) then !! read the source function
          if(.not. source_read(D_d,iwb-1)) & !!read the source file (conjugate at same time)
          call seperr("trouble reading from D_d.")
       else !!use conj of data as source wavefield
          call data_copy_conjg(D,D_d)
       end if
    else !! read data with header locations
       position=(iwb-1)
       if(.not. data_sort_read(D,D_d,position,HD)) &
       call seperr("trouble reading from D or HD.") !! read data at block top
       if(.not.down%passive) then
          if(.not. source_read(D_d,iwb-1)) & !!read the source file (conjugate at same time)
            call seperr("trouble reading from D_d.")
       end if
    end if
    
  end subroutine read_data_source
!----------------------------------------------------------------
  subroutine writewavefields(izs,izb,iwb)
    integer, intent(in) ::   izs,izb,iwb
    integer::z

    z=(izb-1)*down%nzs+izs
    !! write wavefields if you want them
    if (down%wIOu)then
       if(z.ge.down%firstzW) then !! limit W file size when min. target depth known
          if (.not. wavefield_write(W  ,D%bin  ,iwb,izb,izs-down%firstzW+1)) &
          call seperr('wavefield_write(W ==badness') 
       end if
    end if
    if (down%wIOd)then
       if(z.ge.down%firstzW) then !! limit W file size when min. target depth known
          if (.not. wavefield_write(W_d,D_d%bin,iwb,izb,izs-down%firstzW+1)) &
          call seperr('wavefield_write(W_d ==badness')
       end if
    endif
  end subroutine writewavefields
!----------------------------------------------------------------
  subroutine imagingcondition(izs,IGop,MIGOP,NDIGop,NUIGop)
    integer, intent(in) ::    izs
    integer,external ::           IGop,MIGOP,NDIGop,NUIGop

    !! taper the edges of the wavefields
    if(down%taperme) then
!       if(down%gathers) call taperwfld(D%bin)
       if(down%sourcefn)call taperwfld(D_d%bin)
    end if
    !! all the various imaging conditions
    if(down%normu)call SPimg(izs,D%bin,D_d%bin,N_u%bin,NUIGop)!UU*
    if(down%normd)call SPimg(izs,D%bin,D_d%bin,N_d%bin,NDIGop)!DD*
    if(down%image)call SPimg(izs,D%bin,D_d%bin,R%bin  ,IGop) !UD*
    if(down%mult) call SPimg(izs,D%bin,D_d%bin,M%bin  ,MIGop)!UU
  end subroutine imagingcondition
!----------------------------------------------------------------
  subroutine writeparams()
    if(down%normu)call param_write(N_u%tag)
    if(down%normd)call param_write(N_d%tag)
    if(down%image)call param_write(R%tag)
    if(down%mult) call param_write(M%tag)
    if(down%wIOu) call param_write(W%tag)
    if(down%wIOd) call param_write(W_d%tag)
  end subroutine writeparams
!----------------------------------------------------------------
  subroutine depth_report(m)
    integer :: m,pcent
    real:: stopd
    stopd=0.
    call end_timer(stopd,startd)
    stopd=stopd/60.
    if(run%verb) then
       write(run%io,'(a,i4,a,i4,a,i2,a,f6.2,a)')'         *    Finished ',&
         work(m),' of',steps,' (',int(10*m),'%):',stopd,'(m)'
       call start_timer(startd)
    end if
  end subroutine depth_report
!----------------------------------------------------------------
  subroutine file_io()
    integer:: err
    logical:: output
    character(len=1024):: present
    output=F
    down%WIOu=F;down%WIOd=F
    down%image=F;down%mult=F;
    down%normu=F;down%normd=F
    down%gathers=F;down%sourcefn=F
    down%headD=F;down%headD_d=F

    !! . .  save the file tags in case they change
    down%dat_d_ = down%D_d !SOURCE DATA IS FREQUENCY SLICES
    down%dat_   = down%D   !DATA IS FREQUENCY SLICES
    down%mod_   = down%R   !IMAGE SPACE (REFLECTIVITY)
!    down%mod_s_ = down%R_s !subsampled xy-axes, all offsets
    down%m_     = down%M   !image space SRME model
    down%n_u_   = down%N_u !image space SRME model
    down%n_d_   = down%N_d !image space SRME model
    down%w_d_   = down%W_d !downgoing wfld
    down%w_     = down%W   !upcomping wfld
    down%h_d_   = down%HD   !headers 
    down%h_d_d_ = down%HD_d   !headers 

    !! initialize objects/files

    err=getch("D",'s',present)
    if (0.ne.err) then
       err=getch("HD",'s',present)
       if(0.ne.err) then
          down%headD=.true.
          if(run%verb)write(run%io,*)'        ************************************************'
          if(run%verb)write(run%io,*)'        *  D/= sep77.  Workspace sized from parameters'
          if(.not.data_sort_init(D,down%D,HD,down%HD)) &
          call erexit("trouble initializing D for sort_read ")
       else
          if(.not. data_init(D,down%D)) &
          call erexit("trouble initializing D")
       end if
       down%gathers=.true.
    else
       if(run%verb)write(run%io,*)'        ************************************************'
       if(run%verb)write(run%io,*)'        *    No data.  Workspace sized from parameters'
       if(.not.workspace_params(D)) call seperr("Badness in workspace_params")
    end if

    if (down%passive)then
       if(.not. aux_data_init(D_d,down%D_d)) &
          call erexit("trouble initializing D_d")
    elseif(.not.down%datum) then
       err=getch("D_d",'s',present)
       if (0.ne.err) then
          if(.not. source_init(D_d,down%D_d)) & 
             call erexit("trouble initializing D_d")
          down%sourcefn=.true.
          err=getch("HD_d",'s',present)

          if(0.ne.err) then
             down%headD_d=.true.
             if(.not.source_sort_init(D_d,down%D_d,HD_d,down%HD_d)) &
                 call erexit("trouble initializing D_d with headers for sort_read ")
          end if
       else
          call seperr("Need source (D_d=file.H) you moron.")
       end if
    end if

    !! make array of source locations
    if(down%headD_d) then
       call smap_init_HD_d(HD_d)
    else
       call smap_init()
    end if

    if(down%gathers.and.(.not.down%headD)) then
       call global_var_calc(D)    !! image domain coordinate calculations
    else
       down%aix=down%amx;down%aiy=down%amy 
    end if

    if (down%gathers.and.(.not.down%datum)) then
       err=getch("R",'s',present)
       if (0.ne.err) then
		  down%image=.true.
          if(.not. image_init(R,down%R)) &
          call erexit("trouble initializing image R")
          if(run%verb) write(run%io,*) "        *      Image Space     (UD*)          R=",down%image
          output=.true.
       end if

       err=getch("M",'s',present)
       if (0.ne.err ) then
          down%mult=.true.
          if (.not.output) then
             if(.not. image_init(M,down%M)) &
             call erexit("trouble initializing image M")
             if(run%verb) write(run%io,*) "        *      Image Space SRMP (UU)          M=",down%mult
             output=.true.
          else
             if(.not. aux_image_init(M,R,down%M))call seperr('badness at image_init(M)')
             if(run%verb) write(run%io,*) "        *      Image Space SRMP (UU)          M=",down%mult
          end if

       end if    
	end if

    err=getch("N_d",'s',present)
    if (0.ne.err )then
       down%normd=.true.
       if(output) then
          if(down%image) then
             if(.not. aux_image_init(N_d,R,down%N_d))call seperr('badness at bwfld_init(N_d)')
          else
             if(down%mult) then
                if(.not. aux_image_init(N_d,M,down%N_d))call seperr('badness at bwfld_init(N_d)')
             end if
          end if
       else
          if(.not. image_init(N_d,down%N_d)) &
          call erexit("trouble initializing image N_d")
          output=.true.
       end if
       if(run%verb) write(run%io,*)'        ************************************************'
       if(run%verb) write(run%io,*) "        *      Writing normalization (DD*)    N_d=",down%normd
    end if

    if (down%gathers) then
       err=getch("N_u",'s',present) 
       if (0.ne.err)then
          down%normu=.true.
          if(output) then
             if(down%image) then
                if(.not. aux_image_init(N_u,R,down%N_u))call seperr('badness at image_init(N_u)')
             else
                if(down%mult) then
                   if(.not. aux_image_init(N_u,M,down%N_u))call seperr('badness at bwfld_init(N_u)')
                else
                   if(down%normd) then
                      if(.not. aux_image_init(N_u,N_d,down%N_u))call seperr('badness at bwfld_init(N_u)')

                   end if
                end if
             end if
          else
             if(.not. image_init(N_u,down%N_u)) &
             call erexit("trouble initializing image N_u")
             output=.true.
          end if
          if(run%verb) write(run%io,*)'        ************************************************'
          if(run%verb) write(run%io,*) "        *      Writing normalization (UU*)    N_u=",down%normu
       end if

       if (0.ne.getch("W",'s',present) )then
          if(down%image_freqs)call seperr("piss off, you cant have everything")
          down%wIOu=.true.
          if(.not. bwfld_init(W,down%W))call seperr('badness at bwfld_init(W)')
!          if(run%verb) call line()
!          if(run%verb) write(run%io,*) "        *      Writing wavefield file W.    wIOu =",down%wIOu
          output=.true.
       else
          if(down%datum) call seperr("Source modeling needs output. W=")
       end if

    endif 

    if (0.ne.getch("W_d",'s',present) ) then
       down%wIOd=.true.
       if(down%image_freqs.or.down%datum)call seperr("piss off, you cant have everything")
       if(.not. bwfld_init(W_d,down%W_d))call seperr('badness at bwfld_init(W_d)')
!       if(run%verb) call line()
!       if(run%verb) write(run%io,*) "        *      Writing wavefield file W_d.  wIOd =",down%wIOd
       output=.true.
    end if

    if(.not.output) then
       call seperr("You must have some output idiot.")
    end if

    if(.not. slow_init(S,down%VS,down%VR))&
    call erexit("trouble initializing slowness/velocity")

  end subroutine file_io
!----------------------------------------------------------------
  subroutine read_image(izb)
    integer,intent(in)::izb
    
    if (down%image) then
       call image_location(R)
       call image_read(R,izb)      
    end if

    if(down%mult) then !! IS-SRMP output=UU
       if(down%image)then
          call update_index(M,R)
       else
          call image_location(M)
          call update_index(R,M)
       end if
       call image_read(M,izb)
    end if

    if(down%normd) then !! normalization output=DD* 
       if(down%image.or.down%mult)then
          call update_index(N_d,R)
       else
          call image_location(N_d)
          call update_index(R,N_d)
       end if
       call image_read(N_d,izb)
    end if

    if(down%normu) then!! normalization output=UU*
       if(down%image.or.down%mult.or.down%normd)then
          call update_index(N_u,R)
       else
          call image_location(N_u)
          call update_index(R,N_u)
       end if
       call image_read(N_u,izb)
    end if
  end subroutine read_image
!----------------------------------------------------------------
  subroutine write_image(izb)
    integer,intent(in)::izb
    if (.not. down%image_freqs) then
       if(down%image)call image_write(R  ,izb)!! migration output=UD*
       if(down%mult )call image_write(M  ,izb)!! IS-SRMP output=UU
       if(down%normd)call image_write(N_d,izb)!! normalization output=DD* 
       if(down%normu)call image_write(N_u,izb)!! normalization output=UU*
    end if
  end subroutine write_image
!----------------------------------------------------------------
  subroutine start_timer(time)
    real        ::time
    call date_and_time(values=time_array)
    time = time_array (5) * 3600 + time_array (6) * 60 &
         + time_array (7) + 0.001 * time_array (8)
  end subroutine start_timer
!----------------------------------------------------------------
  subroutine end_timer(ftime,stime)
    real::ftime,stime
    call date_and_time(values=time_array)
    ftime = ftime + (-stime+( time_array (5) * 3600 + time_array (6) * 60 &
                  + time_array (7) + 0.001 * time_array (8)))
  end subroutine end_timer
!----------------------------------------------------------------
!  subroutine mig_outnull()
!  !ZERO OUTPUT IF REQUESTED
!#ifdef DEBUG
!    character(len=128), parameter :: unit='mig_outnull'
!    if(run%debug) call in(unit)
!#endif
!
!    if(down%adj) then !! R<-D
!       call     image_assign(R,(0.,0.))
!    else             !! R->D
!       call      data_assign(D ,(0.,0.))
!    end if
!
!#ifdef DEBUG
!    if(run%debug) call out(unit)
!#endif
!  end subroutine mig_outnull
!----------------------------------------------------------------
end module SPmig_mod