Fortran demonstration program
Keywords: class-filler

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