729 lines
25 KiB
Plaintext
729 lines
25 KiB
Plaintext
*$noreference
|
|
!
|
|
! This is the common block for CAD4
|
|
! VAX/VMS to PDP11/02 transfer program.
|
|
!
|
|
! modified: 03-jan-1985 LCB adaption for SBC-21 target processor
|
|
!
|
|
! Logical assignments used in CAD4 system
|
|
!
|
|
! CAn_term device name of communication channel with lsi-11
|
|
! LB0 default device for [1,3n]GONCAn.DAT;1 data files
|
|
! cad4$nrcsys default directory specification for .EXE
|
|
! cad4$error default task error device
|
|
!
|
|
! Assumed process name CAD4?_CAn
|
|
!
|
|
!
|
|
! Filename of GONCAn.DAT file
|
|
!
|
|
character*22 def_gon_spec
|
|
parameter (def_gon_spec='LB0:[1,40]GONCAn.DAT;1')
|
|
character*18 gon_file_spec
|
|
!
|
|
! Filename of monitor task image
|
|
!
|
|
character*21 def_mon_spec
|
|
parameter (def_mon_spec='CAD4M.TSK')
|
|
character*22 mon_file_spec
|
|
!
|
|
! Default mother task image name
|
|
!
|
|
character*18 def_mother_spec
|
|
parameter (def_mother_spec='nrccad')
|
|
!
|
|
! Input filenames
|
|
!
|
|
character*63 mother_file_spec
|
|
character*63 daughter_file_spec
|
|
!
|
|
! Test send message definitions
|
|
!
|
|
character*120 message_text
|
|
integer*1 message_buffer
|
|
integer*4 message_descr
|
|
dimension message_buffer(128),message_descr(2)
|
|
equivalence (message_buffer(9),message_text)
|
|
!
|
|
parameter (l_unit=6 ) ! Logical unit number for log file
|
|
logical*1 l_unit_open ! True if file open
|
|
!
|
|
! Define QIO function codes and modifiers
|
|
!
|
|
external tt$v_eightbit,tt$v_noecho,tt$v_passall
|
|
external tt$v_nobrdcst,tt$v_escape,tt$v_hostsync
|
|
external tt$v_ttsync,tt$v_readsync,tt$v_halfdup
|
|
external io$_setmode,io$_ttyreadpall,io$_writelblk
|
|
external io$_ttyreadall,io$m_timed,io$m_noecho
|
|
external io$m_noformat,io$m_purge
|
|
!
|
|
! Define QIO status codes
|
|
!
|
|
integer*4 ss$_normal,ss$_badchksum,ss$_bufferovf
|
|
integer*4 ss$_abort,ss$_timeout,ss$_nodata
|
|
!
|
|
parameter (ss$_normal = #1) ! Normal return
|
|
parameter (ss$_timeout = #22c) ! Timeout
|
|
!
|
|
! Internal status codes returned in one byte
|
|
!
|
|
integer*2 result,e_suc,e_tos,e_tol,e_seq
|
|
integer*2 e_crc,e_typ,e_ovf,e_pnd
|
|
!
|
|
parameter (e_suc = #0) ! success
|
|
parameter (e_tos = #4) ! tmo + data
|
|
parameter (e_tol = #8) ! tmo , no data
|
|
parameter (e_seq = #c) ! Unexpected sequence number
|
|
parameter (e_crc = #10) ! CRC error
|
|
parameter (e_typ = #14) ! Unexpected function code
|
|
parameter (e_ovf = #18) ! Buffer overflow
|
|
parameter (e_pnd = #1c) ! Any system service fail.
|
|
!
|
|
integer*2 m_seq,m_efl,m_fun
|
|
!
|
|
parameter (m_seq = #3) ! Mask to get seq. bits
|
|
parameter (m_efl = #1c) ! Mask to get error flag
|
|
parameter (m_fun = #e0) ! Mask to get function bits
|
|
!
|
|
! Function codes for CAD4_IO routine
|
|
!
|
|
integer*2 io_func,f_init,f_xfr_asc,f_xfr_mem,f_tr_swr
|
|
integer*2 f_tr_gon,f_tr_asc,f_req_mem,f_req_asc
|
|
!
|
|
parameter (f_init = #0) ! Bootstrap 11/02
|
|
parameter (f_xfr_asc = #20) ! Xfr ASCII buffer to 11/02
|
|
parameter (f_xfr_mem = #40) ! Xfr code block to 11/02
|
|
parameter (f_tr_swr = #60) ! Trm. and rec. SWR
|
|
parameter (f_tr_gon = #ff80) ! Trm. and rec. goniometer data
|
|
parameter (f_tr_asc = #ffa0) ! Trm. and rec. ASCII buffer
|
|
parameter (f_req_mem = #ffc0) ! Request code block from 11/02
|
|
parameter (f_req_asc = #ffe0) ! Request ASCII buffer from 11/02
|
|
!
|
|
! Data used by CAD4_IO routine
|
|
!
|
|
integer*2 io_coswr ! Switch options register from vax to 11/02
|
|
integer*2 io_cobnr ! No. of calls to 11/02
|
|
integer*1 io_cohex ! Header from VAX to 11/02
|
|
! bit 0-1 : seq. no. of the calls to 11/02
|
|
! bit 2-4 : result code
|
|
! bit 5-7 : function
|
|
!
|
|
! Flags to define command string options
|
|
! 0 - no option
|
|
! -1 - negated option
|
|
! +1 - positive option
|
|
!
|
|
integer*1 mt_flag,ex_flag
|
|
!
|
|
! Flag for cad4_prompt routine
|
|
! 0 - no error message
|
|
! 1 - command input error
|
|
! -1 - daughter file cannot be opened
|
|
! -2 - " " " " read
|
|
!
|
|
integer*1 io_prompt_flag
|
|
!
|
|
! Define baud rate constants for CAD4 terminal
|
|
!
|
|
integer*2 baud_38400,baud_19200,baud_9600,baud_4800
|
|
integer*2 baud_2400,baud_1200,baud_600,baud_300
|
|
!
|
|
parameter (baud_38400 = 3)
|
|
parameter (baud_19200 = 2*baud_38400)
|
|
parameter (baud_9600 = 2*baud_19200)
|
|
parameter (baud_4800 = 2*baud_9600)
|
|
parameter (baud_2400 = 2*baud_4800)
|
|
parameter (baud_1200 = 2*baud_2400)
|
|
parameter (baud_600 = 2*baud_1200)
|
|
parameter (baud_300 = 2*baud_600)
|
|
!
|
|
! Default goniometer parameter (goncan.dat record 8)
|
|
! system constants as will be expected at bottom of LSI target computer
|
|
!
|
|
integer*2 lsi_bottom ! LSI memory size (bytes)
|
|
parameter (lsi_bottom=#8000)
|
|
integer*2 sbc_bottom ! SBC user memory bottom
|
|
parameter (sbc_bottom=#ec00)
|
|
integer*2 lsypar ! value of LSI syspar address
|
|
integer*2 sbcp_bottom ! SBC PLUS memory bottom
|
|
parameter (sbcp_bottom=#7F80)
|
|
!
|
|
integer*2 syspar_def_1,syspar_def_2,syspar_def_3
|
|
integer*2 syspar_def_4,syspar_def_5,syspar_def_6
|
|
integer*2 syspar_def_7,syspar_def_8,syspar_def_9
|
|
integer*2 syspar_def_10,syspar_def_11,syspar_def_12
|
|
integer*2 syspar_def_13,syspar_def_14,syspar_def_15
|
|
integer*2 syspar_def_16,syspar_def_17
|
|
!
|
|
parameter (syspar_def_1 = #ff-((640-255)/3) )
|
|
! Photomultiplier hv setting of 640 volts
|
|
parameter (syspar_def_2 = #ff-(120/5) )
|
|
! Lower level setting of 120
|
|
parameter (syspar_def_3 = #ff-(750/5) )
|
|
! Discrimination window setting
|
|
parameter (syspar_def_4 = 0)
|
|
parameter (syspar_def_5 = 0)
|
|
! Deadtime correction factor (default 0, I*4)
|
|
parameter (syspar_def_6 = baud_300.and.#ff)
|
|
! CAD4 terminal baudrate setting of ...
|
|
parameter (syspar_def_7 = baud_300/#100)
|
|
! 300 baud default
|
|
parameter (syspar_def_8 = 0)
|
|
parameter (syspar_def_9 = 18)
|
|
! System clock speed default = 400 cycles/sec.
|
|
parameter (syspar_def_10 = 2)
|
|
! Default positioning accuracy is 2 steps
|
|
!
|
|
!
|
|
! common for load syspar data
|
|
!
|
|
integer*2 slave_load_address !address to load syspar in lsi
|
|
integer*2 nr_load_byte !number of bytes to load
|
|
!
|
|
character*1 bvers_c
|
|
integer*1 bvers !bootstrap version character if not 0
|
|
equivalence (bvers,bvers_c(1:1))
|
|
!
|
|
!
|
|
! 5 Axes gain list
|
|
!
|
|
! output = calculated value*(32.-gain)/32.
|
|
!
|
|
parameter (syspar_def_11 = 24) ! Theta motorgain
|
|
parameter (syspar_def_12 = 28) ! Phi motorgain
|
|
parameter (syspar_def_13 = 24) ! Omega motorgain
|
|
parameter (syspar_def_14 = 24) ! Kappa motorgain
|
|
parameter (syspar_def_15 = 24) ! Dial motorgain
|
|
!
|
|
! System flag word
|
|
!
|
|
! 1 - High voltage sense
|
|
! 4 - Switch limit for phi: present = set
|
|
! 10 - Special collar: present = set
|
|
! 20 - Cryostat: present = set
|
|
!
|
|
parameter (syspar_def_16 = 0) ! System flag word
|
|
!
|
|
parameter (syspar_def_17 = (60-10)*3/10 )
|
|
! Maximum emission allowed of 60 mA
|
|
!
|
|
integer*2 syspar_def
|
|
dimension syspar_def(32)
|
|
!
|
|
! Define syspar values as read from goncan.dat file
|
|
!
|
|
integer*2 syspar_val
|
|
dimension syspar_val(32)
|
|
!
|
|
! Define code for $getdvi system service
|
|
!
|
|
integer*4 dvi$_devdepend,dvi$_devdepend2
|
|
integer*4 dvi$_devclass,dvi$_devtype
|
|
parameter (dvi$_devclass = #00000004)
|
|
parameter (dvi$_devdepend = #0000000A)
|
|
parameter (dvi$_devdepend2= #0000001C)
|
|
parameter (dvi$_devtype = #00000006)
|
|
!
|
|
! Define system services as integer*4 to allow function call
|
|
!
|
|
integer*4 io_status ! I/O status code
|
|
integer*4 exmess_status !i/o status code memory for exit
|
|
integer*4 cli$present,cli$get_value,sys$exit,sys$alloc
|
|
integer*4 sys$assign,sys$qiow,sys$getdvi,sys$dclexh,sys$sndopr
|
|
integer*4 sys$setprn,sys$getjpi,sys$creprc,sys$getmsg
|
|
!
|
|
! Cad4 buffer format
|
|
!
|
|
! 15 0
|
|
! +-----------------------+
|
|
! + header byte +
|
|
! +------------------------------------------------+
|
|
! + length(high byte) + length (low byte) +
|
|
! +------------------------------------------------+
|
|
! ! switch register word or load address +
|
|
! +------------------------------------------------+
|
|
! ! switch register word or load address +
|
|
! +------------------------------------------------+
|
|
! ! !
|
|
! ! ... !
|
|
!
|
|
! ! 256 words data (512. bytes) !
|
|
! +------------------------------------------------+
|
|
! + CRC (16. bit) +
|
|
! +------------------------------------------------+
|
|
!
|
|
!
|
|
! Define argumensts for cad4_readprompt routine
|
|
!
|
|
integer*1 prompt_buffer ! Buffer to save prompt
|
|
dimension prompt_buffer(521) ! send to pdp11/02
|
|
integer*1 output_buffer ! Same as Output buffer
|
|
dimension output_buffer(521) ! for cad4_writelogical
|
|
equivalence (prompt_buffer(1),output_buffer(1))
|
|
character*521 output_buffer_c ! Allow use of ICHAR function
|
|
equivalence (prompt_buffer(1),output_buffer_c)
|
|
!
|
|
integer*4 prompt_size ! Size of prompt (for QIO)
|
|
integer*4 output_size ! "
|
|
equivalence (prompt_size,output_size)
|
|
!
|
|
integer*1 input_buffer ! Input buffer to read record
|
|
dimension input_buffer(521)
|
|
integer*4 input_size ! Size of input buff for Qio
|
|
character*521 input_buffer_c ! Allow use of ICHAR function
|
|
equivalence (input_buffer(1),input_buffer_c)
|
|
!
|
|
! Buffer for input and output are the same
|
|
!
|
|
equivalence (input_buffer(1),output_buffer(1))
|
|
!
|
|
! Define structure of I/O blocks
|
|
!
|
|
integer*1 prompt_header ! Header byte of output block
|
|
integer*1 output_header ! "
|
|
equivalence (prompt_buffer(1),prompt_header)
|
|
equivalence (prompt_buffer(1),output_header)
|
|
!
|
|
integer*2 prompt_length ! Length send to pdp11/02
|
|
integer*2 output_length ! "
|
|
equivalence (prompt_buffer(2),prompt_length)
|
|
equivalence (prompt_buffer(2),output_length)
|
|
!
|
|
integer*1 prompt_data ! Data bytes send to pdp11/02!
|
|
integer*1 output_data ! "
|
|
integer*2 output_data_w !
|
|
character*518 output_data_c !
|
|
dimension prompt_data(512+2+2+2)
|
|
dimension output_data(512+2+2+2)
|
|
dimension output_data_w((512+2+2+2)/2)
|
|
equivalence (prompt_buffer(4),output_data_c)
|
|
equivalence (prompt_buffer(4),prompt_data(1))
|
|
equivalence (prompt_buffer(4),output_data(1))
|
|
equivalence (prompt_buffer(4),output_data_w(1))
|
|
!
|
|
integer*1 input_header ! Header byte received from 11
|
|
equivalence (input_buffer(1),input_header)
|
|
!
|
|
integer*2 input_length ! Length received from pdp11/02
|
|
equivalence (input_buffer(2),input_length)
|
|
!
|
|
integer*1 input_data ! Data read from pdp11/02
|
|
integer*2 input_data_w !
|
|
dimension input_data(512+2+2+2)
|
|
dimension input_data_w((512+2+2+2)/2)
|
|
equivalence (input_buffer(4),input_data(1))
|
|
character*518 input_data_c !
|
|
equivalence (input_buffer(4),input_data_c)
|
|
equivalence (input_buffer(4),input_data_w)
|
|
!
|
|
! Define word to compute CRC
|
|
!
|
|
integer*4 iconst !crc-constant
|
|
parameter (iconst=#a001) ! value of constant
|
|
integer*4 crchar !crc-character
|
|
integer*4 isum !to remember received crc
|
|
integer*4 isum_w ! 16 bit CRC
|
|
integer*1 isum_b ! 8 bit (low&high 16 bit CRC)
|
|
dimension isum_b(2)
|
|
equivalence (isum_w,isum_b)
|
|
!
|
|
! Define item list for $getdvi system service
|
|
!
|
|
integer*4 item_list_i4 ! Item list for $getdvi
|
|
integer*2 item_list_i2 ! information
|
|
integer*1 item_list_i1
|
|
dimension item_list_i4(13) ! 4* 3 + 1 longword
|
|
dimension item_list_i2(13*2)
|
|
dimension item_list_i1(13*4)
|
|
equivalence (item_list_i4,item_list_i2)
|
|
equivalence (item_list_i4,item_list_i1)
|
|
!
|
|
! Define item list for $getjpi system service
|
|
!
|
|
integer*4 getjpi_list_l
|
|
integer*2 getjpi_list_w
|
|
dimension getjpi_list_l(13)
|
|
dimension getjpi_list_w(2*13)
|
|
equivalence (getjpi_list_l,getjpi_list_w)
|
|
!
|
|
! Define info var from $getjpi
|
|
!
|
|
character*15 process_name_c
|
|
integer*1 process_name_b
|
|
dimension process_name_b(15)
|
|
equivalence (process_name_c(1:1),process_name_b(1))
|
|
integer*2 process_name_len
|
|
!
|
|
integer*4 process_uic_l
|
|
integer*2 process_uic_w
|
|
dimension process_uic_w(2)
|
|
equivalence (process_uic_l,process_uic_w)
|
|
integer*2 process_uic_len
|
|
!
|
|
character*63 process_image_c
|
|
integer*1 process_image_b
|
|
dimension process_image_b(63)
|
|
equivalence (process_image_c(1:1),process_image_b(1))
|
|
integer*2 process_image_len
|
|
!
|
|
integer*4 process_prio_l
|
|
integer*2 process_prio_len
|
|
!
|
|
! Define buffer for io$_setmode QIO
|
|
!
|
|
integer*4 char_buff_i4 ! Item list for $getdvi
|
|
integer*2 char_buff_i2 ! information
|
|
integer*1 char_buff_i1
|
|
dimension char_buff_i4(3) ! Three longwords
|
|
dimension char_buff_i2(3*2)
|
|
dimension char_buff_i1(3*4)
|
|
equivalence (char_buff_i4,char_buff_i2)
|
|
equivalence (char_buff_i4,char_buff_i1)
|
|
!
|
|
! Define characteristics returned by $getdvi and used for
|
|
! $qiow (io$_setmode).
|
|
!
|
|
integer*4 cad4_devclass ! Device class
|
|
integer*4 cad4_devtype ! Device type
|
|
integer*4 cad4_devdepend ! Device characteristics
|
|
integer*4 cad4_devdepend2 !
|
|
integer*2 cad4_pagewidth ! Width of a page
|
|
integer*1 cad4_pagelength ! Length of a page
|
|
equivalence (char_buff_i1(1),cad4_devclass)
|
|
equivalence (char_buff_i1(2),cad4_devtype)
|
|
equivalence (char_buff_i2(2),cad4_pagewidth)
|
|
equivalence (char_buff_i4(2),cad4_devdepend)
|
|
equivalence (char_buff_i4(3),cad4_devdepend2)
|
|
equivalence (char_buff_i1(8),cad4_pagelength)
|
|
!
|
|
integer*4 cad4_devdepend_old ! Save old characteristics here
|
|
!
|
|
!
|
|
! Define arguments for QIOW system service to cad4
|
|
!
|
|
integer*4 qio_status ! Qio status code
|
|
integer*2 cad4_chan ! Channel number
|
|
integer*4 cad4_event_flag ! Event flag number
|
|
parameter (cad4_event_flag=8) !
|
|
integer*4 cad4_iosb ! I/O status
|
|
integer*2 cad4_iosb_i2 ! words
|
|
dimension cad4_iosb(2) ! quadword
|
|
dimension cad4_iosb_i2(4)
|
|
equivalence (cad4_iosb,cad4_iosb_i2)
|
|
integer*4 cad4_l_timo ! Long time out count
|
|
parameter (cad4_l_timo=25) ! 25 seconds
|
|
integer*4 cad4_timeout ! Short timeout count
|
|
parameter (cad4_timeout=2) ! Two seconds
|
|
integer*4 cad4_terminator ! Line terminator bit mask
|
|
dimension cad4_terminator(2) ! quadword (short form)
|
|
!
|
|
! Define argument block for declare exit handler directive
|
|
!
|
|
integer*4 exit_block ! Exit handler control block
|
|
dimension exit_block(4)
|
|
integer*4 exit_status
|
|
!
|
|
! Define parameters for $assign system service
|
|
!
|
|
character*10 cad4_term_name ! Physical name of transfer
|
|
! terminal
|
|
integer*4 cad4_term_len ! Length of physical
|
|
! name string
|
|
!
|
|
! Variable to save instrument name
|
|
!
|
|
! ibycan_b 1. byte : integer CA?: unit number
|
|
! 2.-4. byte : ASCII device name ('CAn')
|
|
!
|
|
integer*1 ibycan_b
|
|
dimension ibycan_b(4)
|
|
integer*2 ibycan
|
|
dimension ibycan(2)
|
|
character*4 ibycan_c
|
|
equivalence (ibycan_b(1),ibycan_c(1:1))
|
|
equivalence (ibycan_b(1),ibycan(1))
|
|
integer*2 ir5can !radix-50 name of channel for RSX
|
|
!
|
|
! Variable to save current process name name and uic
|
|
!
|
|
! Common block for all I/O routines
|
|
!
|
|
integer*4 img_io_record ! Record no. of task image
|
|
integer*4 img_io_status ! FORTRAN I/O status code
|
|
!
|
|
! Define file I/O buffer
|
|
!
|
|
integer*4 img_io_buffer_l
|
|
integer*2 img_io_buffer_w
|
|
integer*1 img_io_buffer_b
|
|
dimension img_io_buffer_l(128),img_io_buffer_w(256)
|
|
equivalence (img_io_buffer_l,img_io_buffer_w)
|
|
equivalence (img_io_buffer_l,img_io_buffer_b)
|
|
!
|
|
! Define read bookkeeping
|
|
!
|
|
integer*2 img_io_bsa ! Base address (bytes)
|
|
integer*2 img_io_ldz ! Load size (32. word blocks)
|
|
integer*2 img_io_xfr ! Transfer address
|
|
integer*4 img_io_pointer ! Pointer
|
|
!
|
|
!
|
|
! common declaration for blank common block
|
|
integer*2 nswreg !slave switch register
|
|
integer*2 iroutf !routine flag
|
|
integer*2 incr1 !master increment
|
|
integer*2 incr2 !slave increment
|
|
integer*2 npi1 !inverse of scanspeed for master
|
|
integer*2 npi2 !relative scanspeed for slave
|
|
integer*2 iscanw !scanwidth tensor
|
|
integer*2 motw !motor selection word
|
|
integer*2 ishutf !shutter flag
|
|
integer*2 ibalf !balance filter flag
|
|
integer*2 iattf !attenuator filter flag
|
|
integer*2 iresf !reserve flag
|
|
integer*2 ierrf !result error flag
|
|
integer*2 intfl !intensity result flag
|
|
real*4 xrayt !x-ray time
|
|
real*4 tthp !limit value for detector
|
|
real*4 tthn !limit value for neg side
|
|
real*4 aptw !wanted encoder value for aperture
|
|
real*4 want !wanted values for gonio-angles
|
|
real*4 spare !spare locs
|
|
real*4 aptm !measured encoder value of aperture
|
|
real*4 cmeas !measured gonio angles
|
|
real*4 dump !intensity dumps
|
|
!
|
|
! cad4-handler offsets
|
|
!
|
|
integer*2 c4h_swreg
|
|
integer*2 c4h_routfl
|
|
integer*2 c4h_errfl
|
|
integer*2 c4h_intfl
|
|
integer*2 c4h_tthmxh
|
|
integer*2 c4h_tthmnh
|
|
integer*2 c4h_sasysc
|
|
integer*2 c4h_xrtim
|
|
integer*2 c4h_mselw
|
|
integer*2 c4h_nrd
|
|
integer*2 c4h_nid
|
|
integer*2 c4h_incr
|
|
integer*2 c4h_inci
|
|
integer*2 c4h_dincr
|
|
integer*2 c4h_nrinc
|
|
integer*2 c4h_thwh
|
|
integer*2 c4h_phwh
|
|
integer*2 c4h_omwh
|
|
integer*2 c4h_kawh
|
|
integer*2 c4h_apwh
|
|
integer*2 c4h_apwl
|
|
integer*2 c4h_thmh
|
|
integer*2 c4h_phmh
|
|
integer*2 c4h_ommh
|
|
integer*2 c4h_kamh
|
|
integer*2 c4h_apmh
|
|
integer*2 c4h_dump0
|
|
!
|
|
parameter (c4h_swreg =1)
|
|
parameter (c4h_routfl =2)
|
|
parameter (c4h_errfl =3)
|
|
parameter (c4h_intfl =4)
|
|
parameter (c4h_tthmxh =5)
|
|
parameter (c4h_tthmnh =7)
|
|
parameter (c4h_sasysc =9)
|
|
parameter (c4h_xrtim =10)
|
|
parameter (c4h_mselw =12)
|
|
parameter (c4h_nrd =13)
|
|
parameter (c4h_nid =14)
|
|
parameter (c4h_incr =12)
|
|
parameter (c4h_inci =0)
|
|
parameter (c4h_dincr =1)
|
|
parameter (c4h_nrinc =2)
|
|
parameter (c4h_thwh =30)
|
|
parameter (c4h_phwh =32)
|
|
parameter (c4h_omwh =34)
|
|
parameter (c4h_kawh =36)
|
|
parameter (c4h_apwh =38)
|
|
parameter (c4h_apwl =39)
|
|
parameter (c4h_thmh =40)
|
|
parameter (c4h_phmh =42)
|
|
parameter (c4h_ommh =44)
|
|
parameter (c4h_kamh =46)
|
|
parameter (c4h_apmh =48)
|
|
parameter (c4h_dump0 =50)
|
|
!
|
|
! c4h_routfl function table
|
|
!
|
|
integer*2 rf_swi
|
|
integer*2 rf_mea
|
|
integer*2 rf_col
|
|
integer*2 rf_poc
|
|
integer*2 rf_pos
|
|
integer*2 rf_pof
|
|
integer*2 rf_sap
|
|
integer*2 rf_sca
|
|
integer*2 rf_scd
|
|
integer*2 rf_res
|
|
integer*2 routbl(16)
|
|
!
|
|
parameter (rf_swi =#0)
|
|
parameter (rf_mea =#4)
|
|
parameter (rf_col =#8)
|
|
parameter (rf_poc =#10)
|
|
parameter (rf_pos =#20)
|
|
parameter (rf_pof =#40)
|
|
parameter (rf_sap =#80)
|
|
parameter (rf_sca =#100)
|
|
parameter (rf_scd =#200)
|
|
parameter (rf_res =#8000)
|
|
!
|
|
integer*2 rout0,rout1,rout2,rout3,rout4,rout5
|
|
integer*2 rout6,rout7,rout8,rout9,rout10,rout11
|
|
integer*2 rout12,rout13,rout14,rout15
|
|
!
|
|
parameter (rout0 = rf_swi+rf_res)
|
|
parameter (rout1 = rf_swi+rf_mea+rf_res)
|
|
parameter (rout2 = rf_swi+rf_col+rf_res)
|
|
parameter (rout3 = rf_swi+rf_pos+rf_res)
|
|
parameter (rout4 = rf_swi+rf_pof+rf_res)
|
|
parameter (rout5 = rf_swi+rf_poc+rf_pof+rf_res)
|
|
parameter (rout6 = rf_swi+rf_sca+rf_res)
|
|
parameter (rout7 = rf_swi+rf_sap+rf_sca+rf_res)
|
|
parameter (rout8 = rf_swi+rf_poc+rf_pof+rf_sap+rf_sca+rf_res)
|
|
parameter (rout9 = rf_swi+rf_scd+rf_res)
|
|
parameter (rout10= rf_swi+rf_sap+rf_scd+rf_res)
|
|
parameter (rout11= rf_swi+rf_poc+rf_pof+rf_sap+rf_scd+rf_res)
|
|
parameter (rout12= rf_swi+rf_poc+rf_res)
|
|
parameter (rout13= rf_swi+rf_sap+rf_res)
|
|
parameter (rout14= rf_swi+rf_res) !free
|
|
parameter (rout15= rf_swi+rf_res) !free
|
|
!
|
|
! cad4_handler error table
|
|
!
|
|
integer*2 errtbl(15)
|
|
!
|
|
! cad4_handler intensity error table
|
|
!
|
|
integer*2 inttbl(15)
|
|
!
|
|
!
|
|
! cad4-handler sasysc table
|
|
!
|
|
integer*2 sa_att
|
|
integer*2 sa_shu
|
|
!
|
|
parameter (sa_att = #4000)
|
|
parameter (sa_shu = #8000)
|
|
!
|
|
integer*2 satbl(4),sas0,sas1,sas2,sas3
|
|
!
|
|
parameter (sas0 = #0)
|
|
parameter (sas1 = sa_att)
|
|
parameter (sas2 = sa_shu)
|
|
parameter (sas3 = sa_att+sa_shu)
|
|
!
|
|
! fortran blank common array for angles
|
|
!
|
|
integer*2 for_ph
|
|
integer*2 for_om
|
|
integer*2 for_ka
|
|
integer*2 for_th
|
|
!
|
|
parameter (for_ph = 1)
|
|
parameter (for_om = 2)
|
|
parameter (for_ka = 3)
|
|
parameter (for_th = 4)
|
|
!
|
|
! number of dumps used
|
|
!
|
|
integer ndumps
|
|
!
|
|
common /cad4_main/nswreg ,iroutf ,incr1 ,incr2 ,npi1 ,
|
|
1 npi2 ,iscanw ,motw ,ishutf ,ibalf ,iattf ,
|
|
2 iresf ,ierrf ,intfl ,xrayt ,tthp ,tthn ,
|
|
3 aptw ,want(4) ,spare(6) ,aptm ,
|
|
4 cmeas(4),ndumps, dump(512)
|
|
!
|
|
!
|
|
! Common for cad4 ascii buffer in cad4b
|
|
!
|
|
integer*2 nr_ascii_byte !number of ascii in BUFA
|
|
character*1 bufa !ascii buffer
|
|
dimension bufa(134)
|
|
!
|
|
!
|
|
common /mesg/bufa !ascii buffer for cad4b
|
|
!
|
|
!
|
|
! Common blocks for integer and logical variables
|
|
!
|
|
common /cad4_integer/ io_status,cad4_term_len,
|
|
1 item_list_i4,char_buff_i4,cad4_devdepend_old,
|
|
2 exit_block,cad4_chan,cad4_iosb,qio_status,
|
|
3 cad4_terminator,isum_w,l_unit_open,
|
|
4 message_buffer,message_descr,
|
|
5 img_io_buffer_l,img_io_bsa,img_io_ldz,img_io_xfr,
|
|
6 img_io_record,img_io_pointer,img_io_status,
|
|
7 getjpi_list_l,process_name_b,process_uic_l,
|
|
8 process_image_b,process_name_len,process_uic_len,
|
|
9 process_image_len,process_prio_l,process_prio_len,
|
|
1 mt_flag,ex_flag,io_prompt_flag,syspar_def,
|
|
2 slave_load_address,nr_load_byte,nr_ascii_byte,
|
|
3 bvers
|
|
!
|
|
!
|
|
! Common block for transfer buffer
|
|
!
|
|
common /tbuf/output_size,output_buffer,input_size
|
|
|
|
!
|
|
!
|
|
! Common block for communication channel name and communication values
|
|
!
|
|
common /cacomm/ibycan,ir5can,lsypar,io_coswr,io_cobnr,
|
|
1 io_cohex
|
|
!
|
|
!
|
|
! Common block for syspar values (shadow of 11/02 lsi_bottom)
|
|
!
|
|
common /syspar/syspar_val
|
|
!
|
|
!
|
|
! Common block for character variables
|
|
!
|
|
common /cad4_character/ cad4_term_name,
|
|
1 mother_file_spec,daughter_file_spec,
|
|
2 gon_file_spec
|
|
!
|
|
common /cad4_sysval/ freq, ragmxt
|
|
!
|
|
! cad4-handler motor table
|
|
!
|
|
integer*2 mottbl(8) !no,ap,ph,om,ka,th,no,no
|
|
! !converted to
|
|
data mottbl /0,5,2,3,4,1,0,0/ !no,th,ph,om,ka,ap,no,no
|
|
!
|
|
data syspar_def /syspar_def_1,syspar_def_2,syspar_def_3,
|
|
1 syspar_def_4,syspar_def_5,syspar_def_6,
|
|
2 syspar_def_7,syspar_def_8,syspar_def_9,
|
|
3 syspar_def_10,syspar_def_11,syspar_def_12,
|
|
4 syspar_def_13,syspar_def_14,syspar_def_15,
|
|
5 syspar_def_16,syspar_def_17,15*0/
|
|
!
|
|
data routbl /rout0,rout1,rout2,rout3,
|
|
1 rout4,rout5,rout6,rout7,rout8,
|
|
2 rout9,rout10,rout11,rout12,rout13,
|
|
3 rout14,rout15/
|
|
!
|
|
data errtbl /1,2,3,4,5,5,5,0,0,0,0,0,0,0,0/
|
|
!
|
|
data inttbl /-1,1,0,0,0,0,0,0,0,0,0,0,0,0,0/
|
|
!
|
|
data satbl/sas0,sas1,sas2,sas3/
|
|
!
|
|
data ndumps /512/
|
|
!
|
|
!
|
|
!
|
|
*$reference
|
|
|