//dppwHnut - Obtain an H nutation curve using direct polarization based
//           on either the high-power specification pwH90_hp or the 
//           medium-power specification, pwH90_mp. Characterize B1 
//           homogeneity (R,F), calculate the desired amplitude aH90_hp 
//           or ah90_mp to obtain the specification, and calculate the 
//           predicted 180-degree null, pwH180_hp or pwH180_mp. 

//           Follow this calibration with dppwHnull to refine aH90_hp or 
//           or aH90_mp.

//           Argument 1 is the action: 'setup', 'process' or 'plot'. The 
//           action 'setup' initiates an experiment.  The actions 'process'
//           and 'plot' are called by chempackQ. 

//           Argument 2 is the nucleus, 'C13' or 'N15'.

//           Argument 3 is the region:
//                   'adam' (13C adamantane 37.77p), code 'HC'
//                   'amino' (15N glycine, code 'HN' 

//             Argument 4 = 'hp' chooses a high-power pwH90, typically used as the
//             first pulse of cross polarization. The value of aH90 is typically
//             used for decoupling. 

//             Argument 4 = 'mp' chooses a medium-power pwH90. Set pwH90=pwX90. The 
//             value of aH90 is typically used as the 0wr Hartmann-Hahn match. 

//             Argument 5 is not used. 

//===================
// The SETUP macro
//===================

if (($# > 0) and ($1='setup')) then

// Set the Nuclei and Region

   rtppar('Settancpx')
   AhX 
   pseq = 'two'

// Set the Region

   $reg='' $pwr='' $nuc=''
   $macroname = $0 + '(\'region\',$2,$3,$4,0):$reg,$pwr,$nuc'
   exec($macroname)

// Get the Spinrate

   exists('SPspinrateon','parameter','global'):$e
   if ($e<0.5) then 
      create('SPspinrateon','string','global')
      SPspinrateon='n'
   endif
   if (SPspinrateon='y') then 
      $macronamespin = $0 + '(\'spinrate\'):$srate'
      exec($macronamespin)
   else 
      probeparamgroup('getlocal',$reg,'H1','','srateHX'):srate
   endif

// Calibrate setddrtc for CP

   exists('ddrpm','parameter'):$e
   if ($e < 0.5) then
      create('ddrpm','string')
      ddrpm='r'
   endif   
   rof2=rd-0.6 alfa=ad

// Check the Spinrate

   probeparamgroup('getlocal',$reg,'H1','','srateHX'):$srate
   if (((srate < 0.995*$srate) or (srate > 1.005*$srate)) and (SPspinrateon='y')) then       
      write('error','Warning: Warning: srate=%f Hz and srateHX=%f Hz in the Probe File Disagree\n',srate,$srate)
   endif

// Obtain Standard CP and Decoupling Parameters from Probe File

   probeparamgroup('getlocal',$reg,$nuc,'','ofX90','dbX90'):$tof,tpwr
   tof=$tof
   probeparamgroup('getlocal',$reg,'H1','','ofX90','dbX90'):$dof,dpwr
   dof=$dof
   probeparamgroup('get',$reg,'H1','HX','ch','sh','to','fr',
                                         'aH','b','d','t','of')
   probeparamgroup('get',$reg,$nuc,'HX','aX')
   probeparamgroup('get','hp'+$reg,'H1','90H','a','pw')
   probeparamgroup('get',$reg,$nuc,'90X','a','pw')
   probeparamgroup('get',$reg,'H1','tppmH','a','pw','ph')
   probeparamgroup('get',$reg,'H1','spinalH','a','pw','ph','alp')
   Hseq = 'spinal'

// Set Proton Region and Switch Basic Parameters

   setsolidsprobedata('tn')
   setsolidsprobedata('dn') 
   tn='H1' dn=$nuc d1=2 nt=1 wc = 200 sc =10
   ad=16.0 rd=4.0 ddrtc=20.0 rp=0 lp=0 ss=2 bs=4
   sw=100000.0 at=0.01 fn=16.0*np sb=at/2.0 sb='y' sbs='n' lb=50 gain=0  
   setref setoffset('H1',1.8):tof tof=0.1*trunc(tof/0.1 + 0.5) sp=-38.2p wp=80p
   getsolidsprobedata('tn')
   getsolidsprobedata('dn')

// Decoupler Off

   aHspinal=0.0 phHspinal=0.0 alpHspinal=0.0
   aHtppm=0.0 phHtppm=0.0

// Get the appropriate 1H Specification and Set as X

   probeparamgroup('getlocal',$pwr+$reg,'H1','','aH90'):aX90
   probeparamgroup('getlocal',$pwr+$reg,'H1','','pwH90'):$pwX90_sp

// Set Up the 1H Nutation Array

   $pwX90step=$pwX90_sp/10.0

// Set the Auto Display to Absolute Value

   $macroname = $0 + '(\'maxamp\',100)'
   wnt='vp=0 sb=\'y\' wft setref av ' + $macroname + ' noislm(1.0) dssh'

// Set the 1H Nutation Array

   array('pwX90',50,$pwX90step,$pwX90step)

// Set Macro-Specific Processing and Plotting

   wexp = 'chempackQ'
   execprocess = $0 + '(\'process\',\''+$2+'\',\''+$3+'\',\''+$4+'\',0)'
   execplot=''
   clear(2)
//   au
   return
endif

//===========================
// Macro-Specific Processing
//===========================

if (($# > 0) and ($1 = 'process')) then 

// Analyze the 1H Nutation Curve

   $macroname = $0 + '(\'nutationx\',$2,$3,$4,0)'
   exec($macroname)  
endif

//===========================
// Macro-Specific Plotting
//===========================

if (($# > 0) and ($1 = 'plot')) then 
   wc = 50 sc = 50
   plot1d
   return  
endif 

//==================================
// Begin AutoCalibration Utilities
//==================================

//--------------------
// The maxamp function
//--------------------

if (($# > 0) and ($1 = 'maxamp')) then
   select(celem) 
   if (celem=1) then 
      vsadj($2) 
   endif
   peak:$ht
   if ($ht>$2) then 
      vsadj($2) 
   endif 
   return    
endif  

//--------------------------
// The  minmaxfit function
//--------------------------

if (($# > 0) and ($1 = 'minmaxfit')) then 

   $bestone=$2
   $lim=2
   if ($#>3) then $lim=$4 endif

// Prepare 'analyze.inp'

   $file=curexp+'/analyze.inp'
   exists($file,'file'):$a
   if ($a>0.5) then 
      write('reset',$file) 
   endif

   format((2*$lim+1),2,0):$sizes

   write('file',$file,'AMPLITUDE')
   write('file',$file,'INTENSITY')
   write('file',$file,'%12s%13s%7s%7s\n','1',$sizes,'linear','linear')
   format((2*$lim+1),2,0):$sizes
   write('file',$file,'%8s%5s','NEXT',$sizes)
   write('file',$file,'1')

   $step=$bestone-$lim
   repeat
      select($step)
      peak:$ht
      write('file',$file,'%14.1f%12.2f',$step,$ht)
      $step=$step+1
   until ($step>$bestone+$lim)

// 'poly2 Analysis with 'expfit'

   analyze('expfit','regression','poly2')
   $file=curexp+'/analyze.out'
   lookup('file',$file)
   lookup('seek','NEXT','skip', '2','read','4'):$a0s,$a1s,$a2s
   format($a0s,8,4):$a0
   format($a1s,8,4):$a1
   format($a2s,8,4):$a2
   $inf=-$a1/(2.0*$a2)
   $infval=$a0+$a1*$inf+$a2*$inf*$inf

// Mean Value from 'poly0' 

   analyze('expfit','regression','poly0')
   lookup('file',$file)
   lookup('seek','NEXT','skip', '2','read','4'):$a0s,$a1s,$a2s
   format($a0s,8,4):$a0
   $mean=$a0
//   write('line3','$inf=%f $infval=%f $mean=%f',$inf,$infval,$mean)
//   write('line3','$2 = %f',$2)

// Min ($minmax<0) or Max ($minmax>0) or none ($minmax=0)

   $minmax=0 $ret=0.0
   if (($bestone-$lim)<$inf)and($inf<($bestone+$lim)) then 
      $ret=$inf
      if ($infval<$mean) then 
         $minmax=-1
      else
         $minmax=1
      endif
   endif

//   write('line3','$xmin = %f $ret = %f $xmax = %f $minmax=%f',$bestone-$lim,$ret,$bestone+$lim,$minmax)

// Return the new $bestone and a Fraction After $bestone,
// else Return $bestone=$2 and $remainder=0.0 

   $remainder=0 
   if (($3='min')and($minmax<0)) then 
      $bestone=trunc($ret) 
      $remainder=$ret-$bestone
   endif
   if (($3='max')and($minmax>0)) then 
      $bestone=trunc($ret) 
      $remainder=$ret-$bestone
   endif
   if ($minmax=0) then
      $bestone=$2 
      $remainder=0.0
   endif
//   write('line3','$bestone=%f',$bestone)
   return($bestone,$remainder)
endif 

//----------------------
// The Nutation-1 Macro
//----------------------

if (($# > 0) and ($1 = 'nutationx')) then

// Set the Region

   $reg='' $pwr='' $nuc=''
   $macroname = $0 + '(\'region\',$2,$3,$4,0):$reg,$pwr,$nuc'
   exec($macroname)  

// Process the Nutation Curve
 
   $macroname90 = $0 +  '(\'minmaxfit\',$best90,\'max\'):$best90,$rem90'
   $macroname180 = $0 + '(\'minmaxfit\',$best180,\'min\'):$best180,$rem180'
   $macroname270 = $0 + '(\'minmaxfit\',$best270,\'max\'):$best270,$rem270'
   $macroname360 = $0 + '(\'minmaxfit\',$best360,\'min\'):$best360,$rem360'

   $best90=0 $best180=0 $best270=0 $best360=0
   $rem90=0.0 $rem180=0.0 $rem270=0.0 $rem360=0.0
   $pw90=0.0 $pw180=0.0 $pw270=0.0 $pw360=0.0
   $counter=0 $trial=0

   fn=16*np vp=0 av wft
   if ($counter<(arraydim-1)) then 
   repeat
      $counter=$counter+1
      if ($counter<=arraydim) then
         select($counter)
         peak:$ht
         if ($ht>$trial) then $trial=$ht $best90=$counter endif
      endif
   until (($ht<0.75*$trial)or($counter>=arraydim))
   $best901=$best90
   $pw90=pwX90[$best90]
   if (($best90>1)and($best90<arraydim-1)) then 
      exec($macroname90) //SS_AutoCal_minmaxfit($best90,'max'):$best90,$rem90
      $pw90=pwX90[$best90] + $rem90*(pwX90[$best90+1]-pwX90[$best90])
   endif endif 

   if ($counter<(arraydim-1)) then
   repeat
      $counter=$counter+1
      if ($counter<=arraydim) then
         select($counter)
         peak:$ht
         if ($ht<$trial) then $trial=$ht $best180=$counter endif
      endif
   until (($ht>1.25*$trial)or($counter>=arraydim))
   $pw180=pwX90[$best180]
   if (($best180>1)and($best180<arraydim-1)) then
      exec($macroname180) //SS_AutoCal_minmaxfit($best180,'min'):$best180,$rem180
      $pw180=pwX90[$best180] + $rem180*(pwX90[$best180+1]-pwX90[$best180])
   endif endif

   if ($counter<(arraydim)-1) then
   repeat
      $counter=$counter+1
      if ($counter<=arraydim) then
         select($counter)
         peak:$ht
         if ($ht>$trial) then $trial=$ht $best270=$counter endif
      endif
   until (($ht<0.75*$trial)or($counter>arraydim))
   $pw270=pwX90[$best270]
   if (($best270>1)and($best270<arraydim-1)) then 
      exec($macroname270) //SS_AutoCal_minmaxfit($best270,'max'):$best270,$rem270
      $pw270=pwX90[$best270] + $rem270*(pwX90[$best270+1]-pwX90[$best270])
   endif endif

   if ($counter<(arraydim)-1) then 
   repeat
      $counter=$counter+1
      if ($counter<=arraydim) then
         select($counter)
         peak:$ht
         if ($ht<$trial) then $trial=$ht $best360=$counter endif
      endif
   until (($ht>1.25*$trial)or($counter>=arraydim))
   $pw360=pwX90[$best360]
   if (($best360>1)and($best360<arraydim-1)) then
      exec($macroname270) //SS_AutoCal_minmaxfit($best360,'min'):$best360,$rem360  
      $pw360=pwX90[$best360] + $rem360*(pwX90[$best360+1]-pwX90[$best360])
   endif endif

// Analyze Data - Determine $pwX90calc from the (pw360-pw180)/2.0 if Possible,
//                Use pw180/2.0 or pw90, Depending on the Length of the Nutation

   $R=1 $F=0
   if ($best360>0) then 
      $R=$pw360/(2.0*$pw180)
      $pwX90calc=($R-0.5)*$pw180
      $F=4
   elseif ($best180>0) then 
      $pwX90calc=$pw180/2.0
      $F=2
   else
      $pwX90calc=$pw90
      $F=1
   endif
   
   if (($F=0)or($R<=0.75)) then 
      banner('H1 Nutation Failed')
      write('line3','Abort: R = %f\n F = %d\n',$R,$F)
      abort
   endif

// Update $R and $F and set pwX180

   $Rs='' format($R,6,4):$Rs
   $Fs='' format($F,1,0):$Fs

   probeparamgroup('setstring',$pwr+$reg,'H1','','R', $Rs, 
                                             'F', $Fs)
   probeparamgroup('getlocal',$pwr+$reg,'H1','','pwH90'):$pwX90_mp
   $aX90=aX90*($pwX90calc/$pwX90_mp) "adjust the amplitude"  
   $aX90=trunc($aX90 + 0.5)
   $pwX180=$pwX90_mp/($R-0.5) "set the 180-degree pulse" 
   $pwX180=0.0125*trunc($pwX180/0.0125 + 0.5)
   probeparamgroup('setlocal',$pwr+$reg,'H1','','pwH180',$pwX180,
                                          'aH90',$aX90)
endif
                                        
//-------------------
// The Region Macro
//-------------------

if (($# > 0) and ($1 = 'region')) then
   $nuc=$2
   $reg=''
   $pwr=$4
   if (($# > 4) and ($5 = 1)) then 
      if ($2='C13') then 
         tn='C13' dn='H1' dn2='N15' dn3=''   
         wc = 200 sc =10
         ad=4.0 rd=4.0 ddrtc=8.0 rp=0 lp=0 d1=2.0 nt=1 ss=2 bs=4
         sw=100000.0 at=0.01 fn=16.0*np sb=at/2.0 sb='y' sbs='n' lb=50 gain=30
         ofHX=0.0
         if ($3='alpha') then
            d1=2.0 nt=1
            setref setoffset('C13',63):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=38p wp=50p
            $reg='HCa'
        elseif ($3='salpha') then
            d1=2.0 nt=1
            setref setoffset('C13',175):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=38p wp=50p
            $reg='sHCa'
         elseif ($3='carbonyl') then 
            d1=2.0 nt=1
            setref setoffset('C13',175):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=165p wp=20p
            $reg='HCO'
         elseif ($3='scarbonyl') then 
            d1=2.0 nt=1
            setref setoffset('C13',63):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=165p wp=20p
            $reg='sHCO'
         elseif ($3='adam') then 
            d1=2.0 nt=1.0
            setref setoffset('C13',33.3):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=28p wp=20p
            $reg='HC'
         endif
      elseif ($2='N15') then 
         tn='N15' dn='H1' dn2='C13'  dn3=''   
         wc = 200 sc =10
         ad=16.0 rd=4.0 ddrtc=20.0 rp=0 lp=0 ss=2 bs=4
         sw=100000.0 at=0.01 fn=16.0*np sb=at/2.0 sb='y' sbs='n' lb=0  lb='n' gain=30  
         ofHX=0.0
         if ($3='amide') then
            d1=2.0 nt=4
            setref setoffset('N15',115):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=90p wp=50p
            $reg='HNai'
         elseif ($3='amine') then
            d1=2.0 nt=1 
            setref setoffset('N15',35):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=15p wp=40p
            $reg='HNam'
         elseif ($3='amino') then 
            d1=2.0 nt=1
            setref setoffset('N15',35):$tof tof=0.1*trunc($tof/0.1 + 0.5) sp=15p wp=40p
            $reg='HN'
         endif         
      endif
      probeparamgroup('setlocal',$reg,$nuc,'','ofX90',tof)
   else
      if ($2='C13') then 
         if ($3='alpha') then
            $reg='HCa'
         elseif ($3='salpha') then
            $reg='sHCa'
         elseif ($3='carbonyl') then 
            $reg='HCO'
         elseif ($3='scarbonyl') then 
            $reg='sHCO'
         elseif ($3='adam') then 
            $reg='HC'
         endif
      elseif ($2='N15') then 
         if ($3='amide') then
            $reg='HNai'
         elseif ($3='amine') then 
            $reg='HNam'
         elseif ($3='amino') then 
            $reg='HN'
         endif
      endif
   endif
   return($reg,$pwr,$nuc)
endif

//---------------------
// The Spin Rate Macro
//---------------------

if (($# > 0) and ($1 = 'spinrate')) then

// Get the Current Spin Rate with an Average of 10

   banner('Measuring Spinning Rate and Stability')
   $count=1 srate=0
   repeat
      $index=''
      if ($count<10) then
         format($count,1,0):$index
      else
         format($count,2,0):$index
      endif
      $dest=curexp+'/stat'+$index
      shell('showstat > ',$dest):$dummy
 
      lookup('file',$dest,'currently', 'at:','read'):$masrate,$ret
      if $ret then
         format($masrate,5,0):srate[$count]
      endif
      echo($masrate)
      shell('sleep 1')
      $count=$count+1
   until ($count>10)

   averag(srate[1],srate[2],srate[3],srate[4],srate[5],srate[6],
       srate[7],srate[8],srate[9],srate[10]):$avgsrate,$dev

   $avgsrate = trunc($avgsrate + 0.5)  

//Check the Spin Rate 

   if ($avgsrate<500) then 
      $message='MAS Spin Rate Measurement is Less Than 500 Hz - Aborting with 0.0 '
      banner($message)
      srate = 0.0
//      abort
   else
      srate = $avgsrate
      return($avgsrate)
   endif 

// Remove Files Generated by the Spin Rate Measurement

   $count=1
   repeat
      $index=''
      if ($count<10) then
         format($count,1,0):$index
      else
         format($count,2,0):$index
      endif
      $dest=curexp+'/stat'+$index
      rm($dest):$dummy
      $count=$count+1
   until ($count>10)
   return(srate)
endif 
