module class_addons
  use gildas_def
  integer(kind=1), save :: mem_user(8)
  integer(kind=address_length), save :: addr_user
  integer(kind=address_length), save :: ip_user
end module class_addons
!
subroutine class_languages(user_function)
  use class_dependencies_interfaces
  use class_interfaces, except_this=>class_languages
  use class_addons
  !---------------------------------------------------------------------
  ! @ private
  ! LAS initialization routine
  ! SIC is loaded with LAS and ANALYSE languages, plot library is
  ! initialized, and SIC variables are defined.
  !---------------------------------------------------------------------
  logical, external :: user_function
  ! Local
  integer, parameter :: mlas=115  ! LAS          language
  integer, parameter :: mana=62   ! ANALYSE      language
  integer, parameter :: mfit=17   ! FIT          language
  integer, parameter :: mdec=11   ! DECONV       language
  integer, parameter :: mexp=22   ! EXPERIMENTAL language
  character(len=12) :: vocab_las(mlas)
  character(len=12) :: vocab_ana(mana)
  character(len=12) :: vocab_fit(mfit)
  character(len=12) :: vocab_dec(mdec)
  character(len=12) :: vocab_exp(mexp)
  character(len=20) :: version
  logical :: error
  ! Data
  data vocab_las /  &
       ' ACCUMULATE', '/RESAMPLE','/NOCHECK','/WEIGHT',                      &
       ' ASSOCIATE', '/BAD','/UNIT','/DELETE',                               &
       ' AVERAGE', '/NOMATCH','/RESAMPLE','/NOCHECK','/WEIGHT',              &
       ' BASE', '/PLOT','/CONTINUUM','/INDEX','/OBS',                        &
       ' BOX', '/INDEX','/OBS','/UNIT',                                      &
       ' CATALOG', '/STATUS','/SORT',                                        &
       ' CONSISTENCY', '/NOCHECK',                                           &
       ' COPY', '/SORTED',                                                   &
       ' DROP',                                                              &
       ' DUMP', '/SECTION',                                                  &
       ' EXTRACT', '/INDEX',                                                 &
       ' FILE', '/OVERWRITE',                                                &
       ' FIND', '/ALL','/LINE','/NUMBER','/SCAN','/OFFSET','/SOURCE',        &
                '/RANGE','/QUALITY','/TELESCOPE', '/SUBSCAN','/ENTRY',       &
                '/OBSERVED','/REDUCED','/FREQUENCY','/SECTION','/USER',      &
                '/MASK','/POSITION','/SWITCHMODE',                           &
       ' FITS', '/BITS','/STYLE','/XTENSION','/MODE','/CHECK',               &
       ' FOLD', '/BOUNDARIES',                                               &
       ' GET',                                                               &
       ' HEADER',                                                            &
       ' IGNORE', '/SCAN',                                                   &
       ' LIST', '/BRIEF','/LONG','/SCAN','/OUTPUT','/TOC','/VARIABLE',       &
       ' LOAD', '/NOCHECK',                                                  &
       ' MERGE',                                                             &
       ' MODIFY', '/RUZE',                                                   &
       ' MULTIPLY',                                                          &
       ' NEW_DATA',                                                          &
       ' PLOT', '/INDEX','/OBS',                                             &
       ' SAVE',                                                              &
       ' SET', '/NOCURSOR','/DEFAULT','/POLYGON','/VARIABLE','/ASSOCIATED',  &
       ' SHOW',                                                              &
       ' SPECTRUM', '/INDEX','/OBS','/PEN',                                  &
       ' STITCH', '/NOMATCH','/RESAMPLE','/IMAGE','/LINE','/TELESCOPE',      &
                  '/NOCHECK','/WEIGHT',                                      &
       ' SWAP',                                                              &
       ' TAG',                                                               &
       ' TITLE', '/INDEX','/OBS','/BRIEF','/LONG','/FULL',                   &
       ' UPDATE',                                                            &
       ' WRITE' /
  data vocab_ana /  &
       ' COMMENT',                                                           &
       ' DIVIDE',                                                            &
       ' DRAW', '/PEN',                                                      &
       ' FFT', '/REMOVE','/KILL','/INDEX','/OBS','/NOCURS','/CURS',          &
       ' FILL', '/INTER','/NOISE','/BLANK',                                  &
       ' GREG', '/FORMATTED','/READ',                                        &
       ' LMV', '/SCAN','/STEP','/LINE','/FORCE',                             &
       ' MAP', '/CELL','/GRID','/NOLABEL','/NUMBER','/BASE',                 &
       ' MEMORIZE', '/DELETE',                                               &
       ' MODEL', '/BLANK','/REGULAR','/FREQUENCY','/XAXIS',                  &
       ' NOISE',                                                             &
       ' POPUP',                                                             &
       ' PRINT', '/OUTPUT','/TABLE',                                         &
       ' REDUCE',                                                            &
       ' RESAMPLE', '/FFT','/NOFFT','/LIKE',                                 &
       ' RETRIEVE',                                                          &
       ' SMOOTH',                                                            &
       ' STAMP', '/LABEL',                                                   &
       ' STRIP',                                                             &
       ' TABLE', '/MATH','/RANGE','/RESAMPLE','/FFT','/FREQUENCY',           &
                 '/NOCHECK','/SIGMA','/WEIGHT','/LIKE','/NASMYTH'  /
  data vocab_fit /  &
       ' DISPLAY', '/NOPLOT','/METHOD',                                      &
       ' ITERATE', '/NOCHECK',                                               &
       ' KEEP',                                                              &
       ' LINES', '/NOCURSOR','/INPUT','/SHOW',                               &
       ' METHOD',                                                            &
       ' MINIMIZE', '/NOCHECK',                                              &
       ' RESIDUAL',                                                          &
       ' RESULT',                                                            &
       ' VISUALIZE', '/PEN'/
  data vocab_dec /  &
       ' INITIALIZE', '/MODEL','/SIMULATE','/WEIGHT','/BMSW',                &
       ' DECONVOLVE', '/GAIN','/DERIV','/BMSW','/NOCHANNELS','/KEEP'/
  data vocab_exp /  &
       ' DIFF',                                                              &
       ' FILTER', '/STORE',                                                  &
       ' MEDIAN',                                                            &
       ' RMS', '/NOCHECK','/RESAMPLE','/WEIGHT',                             &
       ' SUBTRACT',                                                          &
       ' UNBLANK', '/MODE',                                                  &
       ' UV_ZERO', '/VERBOSE','/NEW','/NOCHECK','/LIKE',                     &
       ' VARIABLE', '/MODE','/INDEX',                                        &
       ' WAVELET', '/BASE','/PLOT'/
  !
  error = .false.
  !
  ! Code
  version = '6.0 15-JUN-2005'
  call sic_begin('LAS','GAG_HELP_LAS',mlas,vocab_las,   &
                 version//'  PHB - SG - JP - RL', run_sas, class_error)
  call sic_begin('ANALYSE','GAG_HELP_ANALYSE',mana,vocab_ana,   &
                 version//'  PHB - SG - JP - RL', run_ana, class_error)
  call sic_begin('FIT','GAG_HELP_FIT',mfit,vocab_fit,   &
                 version//'  PHB - SG - JP - RL', run_fit, class_error)
  call sic_begin('DSB2SSB','GAG_HELP_DSB2SSB',mdec,vocab_dec,   &
                 version//'  PHB - SG - JP - RL', run_dec, class_error)
  call sic_begin('EXPERIMENTAL','GAG_HELP_EXPERIMENTAL',mexp,vocab_exp,  &
                 version//'  JP - SB - PG', run_exp, class_error)
  !
  addr_user = locwrd(user_function)
  ip_user = bytpnt(addr_user,mem_user)
end subroutine class_languages
!
function class_error()
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for the error status of the library. Does nothing
  ! here.
  !---------------------------------------------------------------------
  logical :: class_error  ! Function value on return
  !
  class_error = .false.
  !
end function class_error
!
!-----------------------------------------------------------------------
!
subroutine run_sas(line,comm,error)
  use class_addons
  use class_rt
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Support routine for LAS\ language
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  character(len=*), intent(in)  :: comm   ! Command name
  logical,          intent(out) :: error  ! Error status
  !
  call sub_sas(line,comm,error,mem_user(ip_user))
end subroutine run_sas
!
subroutine run_ana(line,comm,error)
  use class_addons
  use class_rt
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Support routine for ANALYSE\ language
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line   ! Command line
  character(len=*), intent(in)    :: comm   ! Command name
  logical,          intent(out)   :: error  ! Error status
  !
  call sub_ana(line,comm,error,mem_user(ip_user))
end subroutine run_ana
!
subroutine run_fit(line,comm,error)
  use class_addons
  use class_rt
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Support routine for FIT\ language
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  character(len=*), intent(in)  :: comm   ! Command name
  logical,          intent(out) :: error  ! Error status
  !
  call sub_fit(line,comm,error,mem_user(ip_user))
end subroutine run_fit
!
subroutine run_dec(line,comm,error)
  use class_addons
  use class_rt
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Support routine for DSB2SSB\ language
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  character(len=*), intent(in)  :: comm   ! Command name
  logical,          intent(out) :: error  ! Error status
  !
  call sub_dec(line,comm,error,mem_user(ip_user))
end subroutine run_dec
!
subroutine run_exp(line,comm,error)
  use class_addons
  use class_rt
  !---------------------------------------------------------------------
  ! @ private-mandatory
  ! Support routine for EXPERIMENTAL\ language
  !---------------------------------------------------------------------
  character(len=*), intent(in)  :: line   ! Command line
  character(len=*), intent(in)  :: comm   ! Command name
  logical,          intent(out) :: error  ! Error status
  !
  call sub_exp(line,comm,error,mem_user(ip_user))
end subroutine run_exp
!
!-----------------------------------------------------------------------
subroutine sub_sas(line,comm,error,user_function)
  use gbl_message
  use class_dependencies_interfaces
  use class_interfaces
  use class_setup
  use class_rt
  !----------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! CLASS Main routine for language LAS\
  ! Call appropriate subroutine according to COMM
  !----------------------------------------------------------------------
  character(len=*),  intent(in)    :: line           ! Command line
  character(len=*),  intent(in)    :: comm           ! Command name
  logical,           intent(out)   :: error          ! Error status
  logical,           external      :: user_function  !
  ! Local
  character(len=*), parameter :: rname='LAS'
  integer(kind=4) :: i
  integer(kind=4), save :: icall=0
  !
  if (icall.ne.0) then
     Print *,'Re-entrant call to RUN_LAS ',comm,', type a number to continue'
     read(5,*) i
  endif
  icall = icall+1
  !
  call class_message(seve%c,rname,line)
  !
  error = .false.
  if (r%is_otf) then
    select case (comm)
    case ('COPY')
      call class_copy(set,line,error,user_function)
    case ('FILE')
      call class_file(set,line,error)
    case ('FIND')
      call find(set,line,error)
    case ('GET')
      call get(set,line,r,error,user_function)
    case ('LIST')
      call class_list(set,line,error)
    case ('SET')
      call class_set_command(set,line,r,error)
    case ('SHOW')
      call class_show_comm(set,line,r,error)
    case ('WRITE')
      call class_write_comm(set,line,r,error,user_function)
    case default
      call class_message(seve%e,rname,'Command forbidden on OTF data')
      call class_message(seve%e,rname,'Use WRITE to convert this data into spectra')
      error = .true.
    end select
    icall = icall-1
    return
  endif
  !
  select case (comm)
  case ('ACCUMULATE')
    call class_accumulate(set,line,r,t,error)
  case ('ASSOCIATE')
    call class_associate(set,line,r,error)
  case ('AVERAGE')
    call copyrt(user_function,'FREE')
    call class_average(set,line,r,error,user_function)
  case ('BASE')
    call copyrt(user_function,'KEEP')
    call baseline(set,line,r,error,user_function)
  case ('BOX')
    call class_box(set,line,r,error)
  case ('CATALOG')
    call class_catalog(line,error)
  case ('CONSISTENCY')
    call index_consistency_check(set,line,error,user_function)
  case ('COPY')
    call class_copy(set,line,error,user_function)
  case ('DROP')
    call class_drop(line,r,error)
  case ('DUMP')
    call class_dump(line,r,t,error)
  case ('EXTRACT')
    call copyrt(user_function,'FREE')
    call extract(set,line,r,error,user_function)
  case ('FILE')
    call class_file(set,line,error)
  case ('FIND')
    call find(set,line,error)
  case ('FITS')
    call copyrt(user_function,'FREE')
    call fits_class(set,line,r,error,user_function)
  case ('FOLD')
    call copyrt(user_function,'KEEP')
    call class_fold(set,line,r,error,user_function)
  case ('GET')
    call copyrt(user_function,'FREE')
    call get(set,line,r,error,user_function)
  case ('HEADER')
    call class_header(set,r,error)
  case ('IGNORE')
    call ignore(line,error)
  case ('LIST')
    call class_list(set,line,error)
  case ('LOAD')
    call load_2d(set,line,error,user_function)
  case ('MERGE')
    call copyrt(user_function,'FREE')
    call merge(set,r,error,user_function)
  case ('MODIFY')
    call modify(set,line,r,error)
  case ('MULTIPLY')
    call multi(set,line,r,error)
  case ('NEW_DATA')
    call new_data(line,error)
  case ('PLOT')
    call class_plot(set,line,r,error)
  case ('SAVE')
    call class_save(set,line,error)
  case ('SET')
    call class_set_command(set,line,r,error)
  case ('SHOW')
    call class_show_comm(set,line,r,error)
  case ('SPECTRUM')
    call class_spectrum(set,line,r,error)
  case ('STITCH')
    call copyrt(user_function,'FREE')
    call class_stitch(set,line,r,error,user_function)
  case ('SWAP')
    call class_swap(line,error,user_function)
  case ('TAG')
    call tagout(line,r,error)
  case ('TITLE')
    call class_title(set,line,r,error)
  case ('UPDATE')
    ! Do not try to write it in case of error !...
    call class_update_comm(set,r,error,user_function)
  case ('WRITE')
    call class_write_comm(set,line,r,error,user_function)
  case default
    call class_message(seve%e,rname,'You are using an undocumented, unsupported feature')
    call class_message(seve%e,rname,trim(comm)//' not yet implemented')
    call class_message(seve%e,rname,'Command line: '//line)
    error = .true.
  end select
  icall = icall-1
end subroutine sub_sas
!
subroutine sub_ana(line,comm,error,user_function)
  use gbl_message
  use class_dependencies_interfaces
  use class_interfaces
  use class_rt
  use class_setup
  !----------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! CLASS Main routine for language ANALYSE\
  ! Call appropriate subroutine according to COMM
  !----------------------------------------------------------------------
  character(len=*),  intent(inout) :: line           ! Command line (inout because of command DRAW)
  character(len=*),  intent(in)    :: comm           ! Command name
  logical,           intent(out)   :: error          ! Error status
  logical,           external      :: user_function  !
  ! Local
  character(len=*), parameter :: rname='ANALYSE'
  character(len=message_length) :: mess
  integer(kind=4) :: i
  integer(kind=4), save :: icall=0
  !
  if (icall.ne.0) then
     Print *,'Re-entrant call to RUN_ANA ',comm,', type a number to continue'
     read(5,*) i
  endif
  !
  call class_message(seve%c,rname,line)
  !
  if (r%is_otf) then
     call class_message(seve%e,rname,'Command forbidden on OTF data')
     call class_message(seve%e,rname,'Use WRITE to convert this data into spectra')
     error = .true.
     return
  endif
  icall = icall+1
  !
  select case (comm)
  case ('COMMENT')
    call class_comment(line,r,error)
  case ('DIVIDE')
    call class_divide(set,line,r,t,error)
  case ('DRAW')
    call class_draw(set,line,r,error)
  case ('FILL')
    call copyrt(user_function,'KEEP')
    call class_fill(set,line,r,error,user_function)
  case ('FFT')
    call copyrt(user_function,'KEEP')
    call class_fft(set,line,r,error,user_function)
  case ('GREG')
    call copyrt(user_function,'FREE')
    call class_greg(set,line,r,error,user_function)
  case ('LMV')
    call class_lmv(set,line,error,user_function)
  case ('MAP')
    call class_cells(set,line,error,user_function)
  case ('MEMORIZE')
    call memorize(line,r,error)
  case ('MODEL')
    call copyrt(user_function,'FREE')
    call model (set,line,r,t,error,user_function)
  case ('NOISE')
    call copyrt(user_function,'FREE')
    call class_noise(set,line,r,error,user_function)
  case ('POPUP')
    call popup(set,line,error,user_function)
  case ('PRINT')
    call class_print(set,line,error)
  case ('RESAMPLE')
    call copyrt(user_function,'FREE')
    call class_resample(set,line,r,error)
    if (error)  call swaprt(comm,error,user_function)
  case ('RETRIEVE')
    call copyrt(user_function,'KEEP')
    call retrieve(set,line,r,error,user_function)
    if (error)  call swaprt(comm,error,user_function)
  case ('SMOOTH')
    call copyrt(user_function,'FREE')
    call smooth(set,line,r,t,error,user_function)
  case ('STAMP')
    call stamp(set,line,error,user_function)
  case ('STRIP')
    call class_strip(set,line,error,user_function)
  case ('TABLE')
    call copyrt(user_function,'FREE')
    call class_table(set,line,r,error,user_function)
    call swaprt(comm,error,user_function)  ! R buffer may have been modified (/MATH mode)
  case ('REDUCE')
    call class_message(seve%e,rname,'REDUCE not yet implemented')
    error = .true.
    ! if (r%head%gen%kind.eq.kind_sky) then
    !   call redsky(line,r,error)
    ! else
    !   call class_message(seve%w,'REDUCE','Only valid for skydips')
    ! endif
  case default
    mess = 'ANALYSE'//char(92)//comm//' not yet implemented'
    call class_message(seve%i,rname,mess)
    error = .true.
  end select
  icall = icall-1
end subroutine sub_ana
!
subroutine sub_fit(line,comm,error,user_function)
  use gbl_constant
  use gbl_message
  use class_dependencies_interfaces
  use class_interfaces
  use class_rt
  use class_setup
  !----------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! CLASS Main routine for language FIT\
  !   Call appropriate subroutine according to COMM
  !----------------------------------------------------------------------
  character(len=*),  intent(in)    :: line           ! Command line
  character(len=*),  intent(in)    :: comm           ! Command name
  logical,           intent(out)   :: error          ! Error status
  logical,           external      :: user_function  !
  ! Local
  character(len=*), parameter :: rname='FIT'
  character(len=message_length) :: mess
  integer(kind=4) :: i
  integer(kind=4), save :: icall=0
  !
  if (icall.ne.0) then
     Print *,'Re-entrant call to RUN_FIT ',comm,', type a number to continue'
     read(5,*) i
  endif
  !
  call class_message(seve%c,rname,line)
  !
  if (r%is_otf) then
     call class_message(seve%e,rname,'Command forbidden on OTF data')
     call class_message(seve%e,rname,'Use WRITE to convert this data into spectra')
     error = .true.
     return
  endif
  icall = icall+1
  !
  select case (comm)
  case ('DISPLAY')
    call display(set,line,r,error)
  case ('ITERATE')
    call iterate_fit(set,line,r,error)
  case ('KEEP')
    call keepfi(set,r,error)
  case ('LINES')
    call fitlines(set,line,r,error)
  case ('METHOD')
    call class_method(set,line,error)
  case ('MINIMIZE')
    call minimize(set,line,r,error)
  case ('RESIDUAL')
    call copyrt(user_function,'KEEP')
    call residu_comm(set,line,r,user_function,error)
  case ('RESULT')
    call copyrt(user_function,'KEEP')
    call result_comm(set,line,r,user_function,error)
  case ('VISUALIZE')
    call plotfit(set,line,r,error)
  case default
    mess = 'FIT'//char(92)//comm//' not yet implemented'
    call class_message(seve%i,rname,mess)
    error = .true.
  end select
  icall = icall-1
end subroutine sub_fit
!
subroutine sub_dec(line,comm,error,user_function)
  use gbl_message
  use class_dependencies_interfaces
  use class_interfaces
  use class_rt
  use class_setup
  !----------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! CLASS Main routine for language DSB2SSB\
  !  Call appropriate subroutine according to COMM
  !----------------------------------------------------------------------
  character(len=*),  intent(in)    :: line           ! Command line
  character(len=*),  intent(in)    :: comm           ! Command name
  logical,           intent(out)   :: error          ! Error status
  logical,           external      :: user_function  !
  ! Local
  character(len=*), parameter :: rname='DSB2SSB'
  character(len=message_length) :: mess
  integer(kind=4) :: i
  integer(kind=4), save :: icall=0
  !
  if (icall.ne.0) then
     Print *,'Re-entrant call to RUN_DECONV ',comm,', type a number to continue'
     read(5,*) i
  endif
  !
  call class_message(seve%c,rname,line)
  !
  if (r%is_otf) then
     call class_message(seve%e,rname,'Command forbidden on OTF data')
     call class_message(seve%e,rname,'Use WRITE to convert this data into spectra')
     error = .true.
     return
  endif
  icall = icall+1
  !
  select case (comm)
  case ('DECONVOLVE')
    call copyrt(user_function,'FREE')
    call deconv(set,line,r,error,user_function)
  case ('INITIALIZE')
    call deconv_init(set,line,r,error,user_function)
  case default
    mess = rname//char(92)//comm//' not yet implemented'
    call class_message(seve%i,rname,mess)
    error = .true.
  end select
  icall = icall-1
end subroutine sub_dec
!
subroutine sub_exp(line,comm,error,user_function)
  use gbl_message
  use class_dependencies_interfaces
  use class_interfaces
  use class_rt
  use class_setup
  !----------------------------------------------------------------------
  ! @ no-interface (because of argument type mismatch)
  ! CLASS Main routine for language EXPERIMENTAL\
  !  Call appropriate subroutine according to COMM
  !----------------------------------------------------------------------
  character(len=*),  intent(in)    :: line           ! Command line
  character(len=*),  intent(in)    :: comm           ! Command name
  logical,           intent(out)   :: error          ! Error status
  logical,           external      :: user_function  !
  ! Local
  character(len=*), parameter :: rname='EXPERIMENTAL'
  character(len=message_length) :: mess
  integer(kind=4) :: i
  integer(kind=4), save :: icall=0
  !
  if (icall.ne.0) then
     Print *,'Re-entrant call to RUN_EXPERIMENTAL ',comm,', type a number to continue'
     read(5,*) i
  endif
  !
  call class_message(seve%c,rname,line)
  !
  if (r%is_otf) then
     call class_message(seve%e,rname,'Command forbidden on OTF data')
     call class_message(seve%e,rname,'Use WRITE to convert this data into spectra')
     error = .true.
     return
  endif
  icall = icall+1
  !
  select case (comm)
  case ('DIFF')
    call class_diff(set,line,r,t,error,user_function)
  case ('FILTER')
    call class_filter(line,r,error)
  case ('MEDIAN')
    call class_median(set,line,r,error)
  case ('RMS')
    call copyrt(user_function,'FREE')
    call class_rms(set,line,r,error,user_function)
  case ('SUBTRACT')
    call class_subtract_comm(set,line,r,t,error)
  case ('UNBLANK')
    call class_unblank(line,error)
  case ('UV_ZERO')
    call class_uvt(set,line,r,error,user_function)
  case ('VARIABLE')
    call class_variable(set,line,error,user_function)
  case ('WAVELET')
    call copyrt(user_function,'FREE')
    call class_wavelet(line,r,error,user_function)
  case default
    mess = rname//char(92)//comm//' not yet implemented'
    call class_message(seve%i,rname,mess)
    error = .true.
  end select
  icall = icall-1
end subroutine sub_exp
