File: HEICH.FC of Tape: Various/ETH/fc2

(.FC,.FO Focal format converted to 'WRITE' listing) 

---

C-OS/8 FOCAL, 1972

01.01 C PROGRAMM FUER H EICHUNG MIT NMR
01.02 C LOC 00575 MUSS VON 0064 IN 5100 GEAENDERT SEIN (OD)
01.04 A ?ANFANGSFELD?;S H=AN-100;T !
01.05 S X=1/1.6548
01.06 S I=0
01.07 S M=0;S Z=FELD(M)
01.08 S T=3;S Z=FADC(T)
01.10 S H=H+100;S LG=1.1;G 2.01
01.20 S H=H+9;S LG=1.1;G 2.01
01.30 T "";S H=H+1;S LG=1.4;G 2.01
01.40 S H=H+1;S LG=1.5;G 2.01
01.50 S H=H+1;S LG=1.6;G 2.01
01.60 S H=H+1;S LG=1.7;G 2.01
01.70 T "";S H=H+8;S LG=1.8;G 2.01
01.80 S H=H+1;S LG=1.1;G 2.01

02.01 S I=I+1;S Z=FELD(H);S HB(I)=H
02.05 T !,%3.0,I,%5.0,"   HB=",HB(I)
02.08 S $=0
02.10 I ($)2.2,4.1,2.2
02.20 S $=0;S NU=FADC(Q);T "    NU=",%5.0,NU
02.30 S HR(I)=X*NU;T "   HR=",HR(I)
02.40 T "   DH=",%4.01,HB(I)-HR(I),
02.45 T "   ",%5.0,NU+164,
02.50 G LG

03.01 C TEST EICHGENAUIGKEIT
03.02 C H(REAL) EINGEBEN - NU(NMR) + H(BRUKER) RECHNEN
03.03 C NU(NMR) MESSEN - H(REAL) RECHNEN
03.05 S X=4.2576
03.06 S M=0;S Z=FELD(M);S T=3;S Z=FADC(T)
03.10 A !, H;T %6.0,H*X
03.20 D 14;S Z=FELD(H);S $=0
03.30 I ($)3.4,3.9,3.4
03.40 S $=0;S NU=FADC(Q);S HN=NU/X;T NU,HN
03.85 G 3.1
03.90 S Z=FADC(S);F J=0,10;S Z=FSIN(8);
03.95 S Z=FADC(R);G 3.3

04.01 C TEST 2
04.02 C NU EINSTELLEN (RANDOM) - H RECHNEN - HB RECHNEN - STAUNEN
04.10 S X=4.2576
04.12 S M=0;S Z=FELD(M);S T=3;S Z=FADC(T)
04.20 S $=0
04.22 I ($)4.3,4.9,4.3
04.30 S $=0;S NU=FADC(Q);S H=NU/X;
04.40 D 14;S Z=FELD(H)
04.50 G 4.2
04.90 D 3.9;S Z=FADC(R);G 4.22

06.10 O O HEIC11;F I=1,42;T %5.0,HB(I),HR(I)
06.20 O C;Q

14.01 C H(REAL) IN H(BRUKER) UMRECHNUNG
14.02 C ROUTINE RECHNET IN KGAUSS
14.10 S H=H/1000
14.20 I (H-20)14.4;I (H-22)14.6,14.8,14.8
14.40 S DH=1.636812E-2 - 1.789E-3*H + 1.0831E-3*H*H
14.41 S DH=DH - 4.798575E-5*H*H*H + 6.266462E-7*H^4
14.42 G 14.9
14.60 S DH=-4.61032E-1 + 5.5322E-2*H - 1.289E-3*H*H;G 14.9
14.80 S DH=8.1269E-1 - 6.64736E-2*H + 1.6159E-3*H*H
14.90 S H=FITR(1000*(H+DH));R

---