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