subroutine dat_ccl c ------------------ external dat_ccl_desc external dat_ccl_opts external dat_ccl_read integer dtype/0/ call dat_init_desc(dtype, dat_ccl_desc) call dat_init_opts(dtype, dat_ccl_opts) call dat_init_read(dtype, dat_ccl_read) end subroutine dat_ccl_desc(text) ! ----------------------------- character*(*) text ! (out) description ! type description ! ---------------------------------- text='CCL TriCS single detector multiscan' end subroutine dat_ccl_opts ! ----------------------- print '(x,a)' 1,'from,to: dataset range' end subroutine dat_ccl_read 1 (lun, forced, nread, putval, nmax, xx, yy, ss, ww) ! ---------------------------------------------------- implicit none integer lun ! (in) logical unit number (file will be closed if successful) integer forced ! 0: read only if type is sure; 1: forced read integer nread ! (out) >=0: = number of points read, file closed ! -1: not correct type, file rewinded ! -2: correct type, but unreadable, file rewinded external putval ! (in) subroutine to put name/value pairs. ! for numeric data: call putval('name', value) ! value must be real ! for character data: call putval('name=text', 0.0) integer nmax ! max. number of points real xx(*) ! x-values real yy(*) ! y-values real ss(*) ! sigma real ww(*) ! weights (original monitor) ! local integer i, idx, nranges, i1, i2, j, m, cnt(10) real temp, h, k, l, step, offset, junk, mf real twoth, omega, chi, phi, ymon character line*132, date*20, tail*32 read(lun, '(a)', err=100, end=100) line if (line(1:3) .ne. 'CCL') then if (forced .le. 0) goto 100 rewind lun endif if (line(4:) .eq. ' ') then ! new syntax do while (line(1:6) .ne. '# data' 1 .and. line(1:5) .ne. '#data') read(lun, '(a)', err=100, end=100) line enddo endif call dat_start_options i1=0 call dat_int_option('from', i1) i2=0 call dat_int_option('to', i2) if (i2 .eq. 0) then if (i1 .eq. 0) then i1=1 else i2=i1 endif endif call dat_get_index(idx) if (idx .eq. 0) then if (i2 .gt. i1) then print *,'for CCL files only one dataset allowed' endif else i1=i1+idx-1 if (i1 .gt. i2 .and. i2 .ne. 0) goto 98 endif nranges=0 do i=1,i1-1 nranges=i-1 read(lun, *, err=97, end=97) read(lun, *, err=99, end=99) nread do j=1,nread,10 read(lun,*,err=99, end=99) enddo enddo if (nread .ge. nmax) goto 99 ymon=1 read(lun, '(a)', err=97, end=97) line read(line, *, err=33, end=33) junk,h,k,l,twoth,omega,chi,phi 1 ,junk,junk 33 read(lun, '(i3,f8.0,f10.0,f8.0,x,a)', err=99, end=99) 1 nread, step , ymon, temp, tail i=index(tail,':') mf=-9999 if (i .gt. 13) then date=tail(i-13:) if (tail(1:12) .ne. ' -0.000000') then read(tail, *, err=34, end=34) mf 34 endif else date=tail endif write(line,'(3(a,f8.3))') 'h=',h,' k=',k,' l=',l call putval('Monitor', ymon) call putval('Temp', temp) call putval('Date='//date, 0.0) call putval('Title='//line, 0.0) call putval('two_theta', twoth) call putval('omega', omega) call putval('chi', chi) call putval('phi', phi) call putval('h', h) call putval('k', k) call putval('l', l) call putval('step', step) if (mf .ne. -9999) then call putval('magfield', mf) endif call putval('XAxis=omega',0.0) write(line, '(i4)') i1 call putval('Range='//line,0.0) offset=omega-0.5*step*(nread+1) do j=1,nread,10 read(lun,'(10i8)',err=99, end=99) cnt do m=j,min(nread,j+9) xx(m)=offset+step*m yy(m)=cnt(m-j+1) ss(m)=sqrt(float(max(1,cnt(m-j+1)))) ww(m)=ymon enddo enddo close(lun) return 97 print *,'DAT_CCL: Only ',nranges,' scans in this file' 98 nread=-2 rewind lun return 99 print *,'DAT_CCL: error during read' nread=-2 rewind lun return 100 nread=-1 rewind lun end