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