next up previous contents
Next: API description Up: The Fortran API Previous: The Fortran API   Contents


Fortran demonstration program

program classdemo
  use class_api
  ! Local
  logical :: error
  !
  ! Init
  error = .false.
  call class_write_init(error)
  if (error)  stop
  !
  ! Open (or overwrite) a Class file
  call classdemo_openfile(error)
  if (error)  stop
  !
  ! Write all the observations
  call classdemo_writeall(error)
  if (error)  continue  ! Continue to ensure correct cleaning
  !
  ! Close the Class file
  call classdemo_closefile(error)
  if (error)  continue  ! Continue to ensure correct cleaning
  !
  ! Quit Class cleanly
  call class_write_clean(error)
  if (error)  stop
  !
end program classdemo
!
subroutine classdemo_openfile(error)
  use gildas_def
  use class_api
  logical, intent(inout) :: error
  ! Local
  character(len=filename_length) :: file
  integer(kind=entry_length) :: size
  logical :: new,over,single
  !
  file = 'classdemo.30m'  ! Output file name
  new = .true.            ! Create new file or append?
  over = .true.           ! Overwrite file if it already exists?
  size = 1000             ! Maximum number of observations per (V1) file
  single = .true.         ! Single/multiple file kind
  call class_fileout_open(file,new,over,size,single,error)
  if (error)  return
  !
end subroutine classdemo_openfile
!
subroutine classdemo_closefile(error)
  use class_api
  logical, intent(inout) :: error
  !
  call class_fileout_close(error)
  if (error)  return
end subroutine classdemo_closefile
!
subroutine classdemo_writeall(error)
  use class_api
  logical, intent(inout) :: error
  ! Local
  type(observation) :: obs  ! Use a custom observation, not the R buffer
  integer(kind=4) :: iobs
  !
  call class_obs_init(obs,error)
  if (error)  return
  !
  do iobs=1,100
    call classdemo_fillobs(obs,error)
    if (error)  return
    !
    call class_obs_write(obs,error)
    if (error)  return
  enddo
  !
  call class_obs_clean(obs,error)
  if (error)  return
  !
end subroutine classdemo_writeall
!
subroutine classdemo_fillobs(obs,error)
  use gbl_constant
  use phys_const
  use class_api
  type(observation), intent(inout) :: obs    !
  logical,           intent(inout) :: error  !
  ! Local
  integer(kind=4) :: nchan,ichan
  !
  nchan = 128
  !
  call class_obs_reset(obs,nchan,error)
  if (error)  return
  !
  obs%head%presec(:) = .false.  ! Disable all sections (except next ones)
  !
  ! General
  obs%head%presec(class_sec_gen_id) = .true.
  obs%head%gen%num = 0  ! 0 = Automatic numbering
  obs%head%gen%ver = 0  ! 0 = Automatic increment at write time
  obs%head%gen%teles = 'MYTELES'
  obs%head%gen%dobs = 0
  obs%head%gen%dred = 0
  obs%head%gen%kind = kind_spec
  obs%head%gen%qual = 0
  obs%head%gen%scan = 1
  obs%head%gen%subscan = 1
  obs%head%gen%ut = 0.d0
  obs%head%gen%st = 0.d0
  obs%head%gen%az = 0.
  obs%head%gen%el = 0.
  obs%head%gen%tau = 0.
  obs%head%gen%tsys = 100.
  obs%head%gen%time = 100.
  obs%head%gen%parang = 0.
  obs%head%gen%xunit = 0
  !
  ! Position
  obs%head%presec(class_sec_pos_id) = .true.
  obs%head%pos%sourc = 'MYSOURCE'
  obs%head%pos%system = type_eq
  obs%head%pos%equinox = 2000.0
  obs%head%pos%proj  = p_none
  obs%head%pos%lam   = pi/2.d0
  obs%head%pos%bet   = pi/2.d0
  obs%head%pos%projang = 0.d0
  obs%head%pos%lamof = 0.
  obs%head%pos%betof = 0.
  !
  ! Spectro
  obs%head%presec(class_sec_spe_id) = .true.
  obs%head%spe%line = 'MYLINE'
  obs%head%spe%restf = 123456.d0
  obs%head%spe%nchan = nchan
  obs%head%spe%rchan = 1.
  obs%head%spe%fres = 1.
  obs%head%spe%vres = -1.
  obs%head%spe%voff = 0.
  obs%head%spe%bad = -1000.
  obs%head%spe%image = 98765.d0
  obs%head%spe%vtype = vel_obs
  obs%head%spe%vconv = vconv_rad
  obs%head%spe%doppler = 0.d0
  !
  ! Data
  do ichan=1,nchan
    ! Fill with dummy values
    obs%data1(ichan) = sin(2.*pi*ichan/nchan)**2
  enddo
  !
end subroutine classdemo_fillobs



Gildas manager 2023-06-01