c**ft2d_states
;
; $Id: ft2d_states.mac,v 1.1 1999/12/23 00:05:25 abild Exp abild $
;
ty ft2d_states
;
;Define the processing parameters appropriate for your data
;
; File names, may be provided as arguments to this macro
;  (first argument: data file, second argument: matrix file)
;  or simply defined below
if &_args eq 2 then
   def dat_fl &_arg1
   def mat_fl &_arg2
els
   def dat_fl his31ala	;name of the data file (.dat)
   def mat_fl his31ala	;name of the matrix file (.mat). Will be created if not already there.
eif
;
;
def ctd_d1 2048		;complex points in D1 FID: Bruker TD/2
def ctd_d2 256		;complex points in D2 FID: Bruker "1 TD"/2 or L4
;
def csz_d1 4096		;complex points in D1 FID after zero-filling, usually 2*ctd_d1
def csz_d2 512		;complex points in D2 FID after zero-filling, usually 2*ctd_d2
eva svszd1 (&csz_d1/2)	;complex points to save after FT of D1 (use this with
			; svofd1 to chop out a subsection of D1 after FT)
def svofd1 0		;number of points to discard at the left after FT in D1
;
def dcim 16		;decimation rate, use "uxgrep decim" to extract from Bruker acqus file
def dfvs 10		;dsp firmware number, use "uxgrep dspfvs" to extract from Bruker acqus file
;
; Here we figure out the length of the FID after correction for digital filters
; (you shouldn't have to change this):
;
exr digphs &dcim &dfvs
eva fidlen (&ctd_d1-&digdel)
;
; Set the window functions and corresponding parameters
;
def wdw_d1 ss		;name of the window type for D1
def wp1_d1 &fidlen	;first parameter
def wp2_d1 90		;second parameter (blank if n/a)
;
def wdw_d2 ss		;name of the window type for D2
def wp1_d2 &ctd_d2	;first parameter
def wp2_d2 90		;second parameter (blank if n/a)
;
; Phase parameters
;
def ph0_d1 -155.3	;zero order phase angle for D1
def ph1_d1 0		;first order phase angle for D1
;
def ph0_d2 90		;zero order phase angle for D2
def ph1_d2 -180		;first order phase angle for D2
;
; What dimensions to process (1=processing will be done, 0=no processing)
;
def prc_d1 1		;process D1
def prc_d2 1		;process D2
;
; What dimensions to phase correct after FT (0=no phasing, 1=phasing will be performed)
;
def phs_d1 0		;phase D1
def phs_d2 1		;phase D2
;
; If a particular dimension has a reversed ch. sh. axis, set rev_d? to 1
;
def rev_d1 0		;reverse d1 if 1
def rev_d2 0		;reverse d2 if 1
;
; Which dimensions to do the Gibbs trick on
;
def gib_d1 0		;Gibbs filter D1, 0=off, 1=on (divide 1st pt. by 2)
def gib_d2 0		;Gibbs filter D2, 0=off, 1=on (divide 1st pt. by 2)
;
; Set the sweep width in D1 and D2
;
def sw_d1 12019.231 	;Sweep width in Hz in D1 (Bruker sw_h: uxgrep sw_h)
def sw_d2 1923.077	;Sweep width in Hz in D2 (1/(in0*2))
;
; More referencing information:
;
eva refpt1 (&csz_d1/2+1-&svofd1)	; Reference point D1
eva refpt2 (&csz_d2/2+1)		; Reference point D2 
def refsh1 4.700			; Reference shift D1
def refsh2 119.000			; Reference shift D2
def sfreq1 600.13			; Spectrometer frequency D1
def sfreq2 60.811			; Spectrometer frequency D2
eva redsw1 (&sw_d1*&svszd1/&csz_d1)	; Reduced sweep width in D1
;
;
; That's all
;
eva rtd_d1 (&ctd_d1*2)
eva rtd_d2 (&ctd_d2*2)
eva rsz_d1 (&csz_d1*2)
eva rsz_d2 (&csz_d2*2)
def msz_d1 &svszd1
def msz_d2 &csz_d2


cal bldmat

cal refmat

if &prc_d1 eq 1 then
   cal proc_d1
eif
if &prc_d2 eq 1 then
   cal proc_d2
eif

go quit

; Subroutines here

;proc_d1

proc_d1:
   cl
   def datype 1
   def datsiz &fidlen
   set 1
   def swidth &sw_d1
   &wdw_d1 &wp1_d1 &wp2_d1
   stb 1
   def gibbs &gib_d1
   ty Working on D1...
   def nexrow 64
   def rownr 1
   for row 1 &rtd_d2
      esc out
      if &out ne 0 quit
      cal ftvec_d1
      red
      sto 0 &row
      if &row ge &nexrow then
	 ty done D1 &row / &rtd_d2 $
	 eva nexrow (&nexrow+64)
      eif
   next
   ty done D1 &row / &rtd_d2
ret


; proc_d2

proc_d2:
   def datype 1
   def datsiz &ctd_d2
   set 1
   def swidth &sw_d2
   &wdw_d2 &wp1_d2 &wp2_d2
   stb 1
   def gibbs &gib_d2
   bun 2
   def nexvec 64
   ty Working on D2...
   for vec 1 &vector
      esc out
      if &out ne 0 quit
      lwb 
      def datype 1
      def datsiz &ctd_d2
      if &rev_d2 eq 1 then
	 cnj
      eif
      mwb 1
      zf &csz_d2
      ft
      if &phs_d2 eq 1 then
	 def phase0 &ph0_d2
	 def phase1 &ph1_d2
	 ph
      eif
      red 
      swb
      if &vec ge &nexvec then
	 ty done D2 &vec / &vector $
	 eva nexvec (&nexvec+64)
      eif
   next
   ty done D2 &vec / &vector
   bun 0
ret


; ftvec_d1

ftvec_d1:
   rn &dat_fl
   def datype 1
   exr digphs &dcim &dfvs 1
   def datsiz &fidlen
   if &rev_d1 eq 1 then
      cnj
   eif
   mwb 1
   zf &csz_d1
   ft
   if &phs_d1 eq 1 then
      def phase0 &ph0_d1
      def phase1 &ph1_d1
      ph
   eif
   if &svofd1 gt 0 then
      shl &svofd1
   eif
   def datsiz &svszd1
ret


;bldmat

bldmat:
   cmx
   inq mat &mat_fl exist
   if &exist eq 1 then
     mat &mat_fl w
     if &dimen ne 2 then
	ty The matrix &mat_fl exists but has the wrong dimensionality
	go quit
     eif
     if &d1size ne &msz_d1 or &d2size ne &msz_d2 then
	ty The matrix &mat_fl exists but has the wrong size
	go quit
     eif
   els
     ty Building the matrix (&mat_fl)...
     bld &mat_fl 2 &msz_d1 &msz_d2
     mat &mat_fl w
   eif
ret


; refmat

refmat:
   rmx 1 &sfreq1 &redsw1 3 &refpt1 &refsh1 H
   rmx 2 &sfreq2 &sw_d2  3 &refpt2 &refsh2 N
ret


quit:
ret
end