Diese Kleinod der Programmierkunst war jahrelang aus meinem Gesichtskreis verschwunden und ist zufällig wieder aufgetaucht. Ich dachte, vielleicht macht das jemand Spaß (vermutlich bekommt man so etwas heute nicht mehr zu sehen). -- HelmutLeitner

[Der Fairness halber muss ich dazusagen, dass diese Fassung damals von einem Papierausdruck abgetippt wurde um bestimmte Umformungen auszuprobieren, zwar doppelt kontrolliert wurde, jedoch trotzdem möglicherweise nicht ganz frei von Tippfehlern ist.]

10 REM 20 REM *** comment block deleted *** 30 REM 40 REM 50 output 710 using "16A";"FFFFFFFFFFFFFFF0": REM Prober rücksetzen 60 output 717;"F1A6B1M2" 61 output 707;"F1R4T2": REM V-Meter setzen 70 printer is 16 80 rad 90 standard 100 com short umos(200),cmess(200) 110 integer mber(200),range(5) 120 short c(50),n(750),w(750),cmessneu(500) 121 dim korr(5) 130 dim schnr$[100] 140 com real xg(1:2,1:2) 150 dim lcr$[32],remote$[18],level$[12],key$[25],range$[3],frequ$[3],resol$[2],ampl$[2] 160 image 32A 170 range$="R31" 180 print "Mögliche Meßfrequenzen:" 190 print " 10kHz 20 kHz 40 kHz" 200 print "100kHz 200 kHz 400 kHz" 210 print " 1MHz 2 MHz 4 MHz 10MHz" 220 input "Meß-Frequenz eingeben: ",frequenz 230 if frequenz=1E4 then frequ$="F11" 240 if frequenz=20000 then frequ$="F12" 250 if frequenz=40000 then frequ$="F13" 260 if frequenz=1.00E5 then frequ$="F14" 270 if frequenz=2.00E5 then frequ$="F15" 280 if frequenz=4.00E5 then frequ$="F16" 290 if frequenz=1E6 then frequ$="F17" 300 if frequenz=2E6 then frequ$="F18" 310 if frequenz=4E6 then frequ$="F19" 320 if frequenz=1.00E7 then frequ$="F20" 330 if (val(frequ$[2,3]>=11) and (val(frequ$[2,3])<=20) then 350 340 goto 220 350 input "mit welcher Auflösung soll gemessen werden High=1 Low=0",resol 360 resol$="H"&val$(resol) 370 ampl$="M3" 380 gosub remote 390 omega=2*pi*frequenz 400 trigger 730 410 enter 730 using 160;lcr$ 420 input "Scheiben-Nr oder Proben-Nr eingeben!",schnr$ 430 input "Auswertung mit Profilberechnung Ja=1 Nein=0",Mipro 440 input "Negativste Spannung=?V",Uneg 450 input "Positivste Spannung=?V",Upos 460 if mipro=0 then 500 470 input "Untere Grenze der Dotierungs-Skala=? nur ganze 10-er Potenzen",dotmin 480 input "Obere Grenze der Dotierungs-Skala=",dotmax 490 input "Größte Meßtiefe=",wmax 500 input "Leitfähigkeitstyp des Siziliums P: -1 N: +2",sign_$ 510 input "Temperatur=? Gr.Cels",Te 520 umaxi$="10" 530 imaxi$="7" 540 input "Fläche des MOS-Kondensators in qcm",f 550 input "gemessene Oxiddicke=? nm",doxmes 560 input "parasitäre Kapazität bei Akk. =? pF",cparo 570 input "parasitäre Kapazität bei Depl.=? pF",cparu 580 input "Anzahl der Messungen am LCR-Meter >1 Ja,wie viele",wie 590 if mipro=1 then input "Spannweite der Ausgleichs-Geraden=?",spaw 600 if wie<1 then wie=1 610 if spaw<1 then spaw=1 620 input "Glätten Stufe 1 2 3 oder 0",spagla 630 input "Wie soll C(U)-Kurve durchlaufen werden ? Sprung=0 Kont=1",spru 640 image SD.7D: REM für output 650 disp "Spitze über zu messendes System einstellen---OSC-Level voll cont" 660 pause 670 output 730;"R31LV" 680 enter 730 using "12A";level$ 690 if val(level$[5,12])>.95 then 740 700 disp "OSC-Level ganz aufdrehen Cont" 710 pause 720 wait 1000 730 goto 670 740 disp 750 output 730;"H1ZO" 760 disp "Wenn Abgleich fertig, Cont" 770 pause 780 trigger 730 790 enter 730 using 160;lcr$ 800 if lcr$[4,4]="N" then 850 810 disp "Abgleich nicht in Ordnung" 820 beep 830 wait 1000 840 goto 650 850 output 730;"M2" 860 disp "OSC-Level auf 0.2 stellen Cont" 870 pause 880 wait 1000 890 output 730;"LV" 900 enter 730 using "12A";level$ 910 level=val(level$[5,12]) 920 if (level>=.019) and (level<=.021) then 931 930 goto 860 931 rem for z=1 to 5 932 rem range$="R"&val$(10+Z) 933 rem output 730;range$ 934 rem wait 500 935 rem trigger 730 936 rem enter 730 using 160;lcr$ 937 rem korr(z)=val(lcr$[6,17])*1E12 938 rem if korr(z)=1.9999E32 then 935 939 rem next 940 rem range$="R31" 941 rem for z=1 to 5 942 rem print "korr(";z;")=";korr(z) 943 rem next 950 ampl$="M2" 960 resol$="H0" 970 gosub remote 980 disp "Spitze aufsetzen Licht aus Deckel zu !!!! Cont " 990 pause 991 printer is 0 1000 trigger 730 1010 enter 730 using 160;lcr$ 1020 if lcr$[4,4]="N" then 1050 1030 wait 1000 1040 goto 1000 1050 disp 1060 output 730;"R32" 1070 output 730;"K" 1080 enter 730 using "25A";key$ 1090 range$=key$[19,21] 1100 range=val(range$[2,3]) 1110 gosub remote 1120 wait 1000 1130 disp 1140 sign=sgn(val(sign_$)) 1150 u=u+sign*1 1160 i=i+1 1170 gosub undig 1190 for z=1 to wie 1200 trigger 730 1210 enter 730 using 160;lcr$ 1220 gosub enter 1230 if berum=1 then 1200 1240 cmesss=cmesss+cmess 1250 next 1260 cmess=cmesss/wie 1270 cmesss=0 1280 cmess(i)=cmess 1290 umos(i)=u 1300 if doxmes>0 then f=doxmes*1E-7*cmess(i)/3.455E-1 1310 if doxmes>0 then print "F=";f 1320 dox=3.455E-1*f/cmess(i): rem [cm] 1330 if abs(umos(i))=49 then cox=cmess(i) 1340 if (abs(umos(i)/dox)>1E6) and (abs((cmess(i)-cmess(i-1))/cmess(i))<1E-3) then cox=cmess(i) 1350 print umos(i),cmess(i),rser 1360 if cox>0 then 1420 1370 if abs(umos(i)/dox)>3E6 then 1390 1380 goto 1150 1390 disp "Spannung zu hoch falls fortgefahren werden soll Cont" 1400 cox=cmess(i) 1410 pause 1420 rserox=rser 1430 umosak=umos(i) 1440 if val(lcr$[6,14])<.15 then range=range-1 1450 rangestart=range 1460 range$="R"&val$(range) 1470 output 730;range$ 1480 wait 500 1490 trigger 730 1500 enter 730 using 160;lcr$ 1510 gosub enter 1520 if berum=1 then wait 500 1530 if berum=1 then 1490 1540 cox=cmess 1550 mberox=rangestart 1560 dox=3.455E-1*f/cox 1570 i=0 1580 dox_=dox*1e4 1590 sri=10*dround(dox_,1) 1600 if sri<1 then sri=1 1610 u=u-sign*sri 1620 if abs(u)>abs(umosak) then 1970 1630 i=i+1 1640 if licht=1 then 1760 1650 gosub undig 1670 umos(i)=umos 1680 wait 100 1690 trigger 730 1700 enter 730 using 160;lcr$ 1710 gosub enter 1720 if berum=1 then 1690 1730 cmess(I)=cmess 1740 if (cmess(1)-cmess(i))/cmess(1)<5E-2 then 1610 1750 licht=1 1760 gosub undig 1780 output 711 using "16A";"FFFFF0FF99999999" : REM Licht ein 1790 wait 5000 1800 output 711 using "16A";"FFFFFCFF99999999" : REM Licht aus 1810 umos(i)=umos 1820 ta=ta+1 1830 wait 1000 1840 trigger 730 1850 enter 730 using 160;lcr$ 1860 gosub enter 1870 if berum=1 then 1840 1880 c(ta)=cmess 1890 if ta=1 then 1820 1900 if abs((c(ta-1)-c(ta))/c(ta))<1E-2 then 1920 1910 goto 1820 1920 ta=0 1930 cmess(i)=cmess 1940 print umos(i),cmess(i) 1950 if i=1 then 1610 1960 if ((cmess(i-1)-cmess(i))/cmess(i)>1E-3) or (cmess(i)>.95*cox) then 1610 1970 umosinv_=umos(i-1) 1980 cinv_=cmess(i-1) 1990 rem 2000 rem 2010 rem grobe Auswertung nach C(U)-2 <<<<<<<<<<< 2020 rem 2030 coxn=cox/f*1e-12 2040 cinvn_=cinv_/f*1e-12 2050 t=te+273.2 2060 vt=8.62E-5*t 2070 ni=3.87E16*t^(3/2)*exp(-1.2/(2*8.62E-5*t)) 2080 k=2.409E31*vt*coxn^2/(coxn/cinvn_-1)^2 2090 nv=k 2100 goto 2120 2110 nv=n 2120 n=k*(1+log(nv/ni)) 2130 if abs((nv-n)/n)>1E-3 then 2110 2140 dox=3.455E6/coxn*1E-12: rem [nm] 2150 co=sqr(1.66E-31*n/vt) 2160 cfb=coxn*co/(co+coxn)*f*1e12 2170 print "Cfb= ";cfb 2171 pause 2180 rem Ermitteln der vorl. Flachbandspannung 2190 gru=1 2200 gro=i-1 2210 if rl=1 then gru=0 2220 if rl=1 then gro=19 2230 for z=gru to gro 2240 if (cmess(z)>cfb) and (cmess(z+1)<=cfb) then 2255 2250 next 2252 beep 2253 print "Bedingung für Cfb nicht gefunden" 2254 end 2255 umosfb_=umos(z) 2260 if rl=1 then 2460 2270 rl=1 2280 for z=0 to 20 2290 u=umosfb_-sign*z*sri/20 2300 gosub undig 2320 trigger 730 2330 enter 730 using 160;lcr$ 2340 gosub enter 2350 if berum=1 then wait 500 2360 if berum=1 then 2320 2370 cmess(z)=cmess 2380 umos(z)=umos 2390 next 2391 rem pause 2400 goto 2210 2410 rem 2420 rem 2430 rem 2440 rem 2450 rem 2460 rem Ermitteln der Spannunggrenzen 2470 print "Umosfb= ";umosfb_ 2471 rem pause 2480 i=0 2490 ufb_inv=abs(umosfb_-umosinv_) 2500 if sign<0 then 2690 2510 uu_=uneg 2520 if uu_<-50 then uu_=-50 2530 uo_=upos 2540 if uo_>50 then uo_=50 2550 call schritte(uo_,uu_,0,sign,uo,umosfb_,imax) 2560 call schritte(uu_,uo_,imax,-1*sign,uu,umosfb_,jmax) 2570 if jmax<500 then 2660 2580 for i=1 to 10 2590 beep 2600 wait 300 2610 next 2620 i=0 2630 disp "zu viele Werte Felder in 110,4510,4920 u. 5140 ändern " 2640 stop 2650 uparo=uo 2660 uparo=upos 2670 uparu=uneg 2680 goto 2830 2690 uu_=uneg 2700 if uu_<-50 then uu_=-50 2710 uo_=upos 2720 if uo_>50 then uo_=50 2730 call schritte(uu_,uo_,0,sign,uu,umosfb_,imax) 2740 call schritte(uo_,uu_,imax,-1*sign,uo,umosfb_,jmax) 2750 if jmax>500 then 2580 2760 uparu=upos 2770 uparo=uneg 2780 rem 2790 rem 2800 rem Messung beginnt 2810 rem 2820 rem 2830 print "Jmax= ";jmax,"Imax= ";imax: rem <--- von 2680 2831 rem pause 2835 plotter is 13,"GRAPHICS" 2840 graphics 2850 frame 2860 locate 5,115,15,90 2870 uu=uneg 2880 uo=upos 2890 umax=max(abs(uu),uo) 2900 mtic=10^(int(lgt(umax))-1) 2910 scale uu,uo,0,1 2920 axes mtic,1E-1,0,0,5,5 2930 csize 3 2940 lorg 2 2950 ldir -(pi/2) 2960 for z=0 to uo step 5*mtic 2970 move z,0 2980 label using "XM2D.D";z 2990 next 3000 lorg 1 3010 ldir 0 3020 move uo+1E-2*(uu+uo),0 3030 csize 4 3040 label "U" 3050 label "[V]" 3060 lorg 4 3070 move 0,1.05 3080 label " C/Cox" 3090 lorg 2 3100 csize 3 3110 ldir -(pi/2) 3120 for z=0 to uu step -5*mtic 3130 move z,0 3140 label using "XM2D.D";z 3150 next 3160 ldir 0 3170 lorg 1 3180 csize 2.5 3190 move uu,-.18 3200 label "TE MOS 14/GUECKEL" 3210 short umos_(300) 3220 for z=imax to 0 step -1 3230 umos_(i)=umos(z) 3240 i=i+1 3250 next 3260 for z=0 to imax 3270 umos(z)=umos_(z) 3280 next 3290 u0=umos(3) 3300 u=0 3310 gosub undig 3330 range=rangestart 3340 range$="R"&val$(range) 3350 output 730;range$ 3360 wait 1000 3370 for z=0 to jmax 3380 if spru=1 then wie=1 3390 cmesss=0 3400 for i=1 to wie 3410 if spru=1 then 3460 3420 u=u0 3430 gosub undig 3450 wait 10 3460 u=umos(z) 3470 gosub undig 3490 if z=0 then wait 500 3500 wait 100 3510 if cmess>cinv_ then wait 100 3511 trigger 707 3512 enter 707;umes 3520 trigger 730 3530 enter 730 using 160;lcr$ 3540 gosub enter 3550 if berum=1 then wait 1000 3560 if berum=1 then 3420 3570 cmesss=cmesss+cmess 3580 next 3590 cmess=cmesss/wie 3600 umos(z)=umos 3610 cpar=cparu+(cparu-cparo)/(uparu-uparo)*(umos(z)-uparu) 3620 cmess(z)=cmess-cpar 3630 mber(z)=range 3640 plot umos(z),(cmess(z)+cpar)/cox 3650 print umos(z);tab(10);umes;tab(20);cmess(z);tab(30);rser;tab(40);mber(z) 3660 next 3670 penup 3680 beep: rem Licht kurz einschalten 3690 rem 3700 rem 3710 rem Rücklauf 3720 rem 3730 line type 3 3740 cinv=1e99 3750 waitmax=0 3760 wait=100 3770 mod=5 3780 r=jmax 3790 for z=jmax to 1 step -1 3800 if rue mod mod<>0 then 4370 3810 u=umos(z) 3820 r=r+1 3830 gosub undig 3850 wait 50 3860 output 711 using "16A";"FFFFF0FF99999999": rem Licht ein 3870 wait 20*wait 3880 output 711 using "16A";"FFFFFCFF99999999": rem Licht aus 3890 if mod=1 then wait=0 3900 wait 20*wait 3910 trigger 730 3920 enter 730 using 160;lcr$ 3930 gosub enter 3940 if berum=1 then 3910 3950 if wait=0 then 4100 3960 tau=tau+1 3970 if tau>1 then 4000 3980 cmessvor=cmess 3990 if tau=1 then 4010 4000 cmessnach=cmess 4010 if abs(cmessvor-cmessnach)/cmessvor<1E-3 then 4070 4020 if tau>1 then cmessvor=cmessnach 4030 if wait=1500 then 4070 4040 wait=wait+100 4050 if wait>waitmax then waitmax=wait 4060 goto 3910 4070 print "Tau= ";tau 4071 tau=0 4080 cmessvor=cmessnach=0 4090 wait=100 4100 if mod>1 then 4190 4110 if range=mber(z) then 4190 4120 range=mber(z) 4130 range$="R"&val$(range) 4140 output 730;range$ 4150 wait 500 4160 trigger 730 4170 enter 730 using 160;lcr$ 4180 gosub enter 4181 pause 4182 pause 4185 print tab(5);umos(z);tab(15);cmess(z);tab(25);rser;tab(35);mber(z) 4190 cmess(r)=cmess 4200 umos(r)=umos(z) 4210 rem 4220 rem Prüfung: konst. Inversions-Kap., Minimum, Hysterese 4230 rem 4240 if r=jmax+1 then 4270 4250 if mod=1 then 4290 4260 if (cmess(r-1)-cmess(r))/cmess(r)>1E-2 then ch=ch+1 4270 if cmess(r)<cinv then cinv=cmess(r) 4280 if mod=10 then 4320 4290 if (cmess(r)-cmess(z))/cmess(z)>1E-2 then hyst=hyst+1 4300 if (cmess(r)-cmess(z))/cmess(z)<-1E-2 then hyst_=hyst_+1 4310 if mod=1 then 4340 4320 if r=jmax+1 then 4340 4330 if (cmess(r)-cmess(z))/cmess(r)<5e-2 then mod=1 4340 plot umos(r),cmess(r)/cox 4350 mber(r)=range 4355 print umos(r);tab(10);cmess(r);tab(20);rser;tab(30);mber(r) 4360 if mod=1 then spal=spal+1 4370 rue=rue+1 4380 next 4390 for z=jmax+1 to r-spal 4400 if abs(cmess(z)-cinv)/cinv<1E-2 then echt=echt+1 4410 next 4420 if spagla=0 then 4720 4430 move umos(0),cmess(0)/cox 4440 pen -1 4450 for z=0 to r 4460 plot umos(z),cmess(z)/cox 4470 next 4480 pen 1 4490 exit graphics 4500 for z=spagla to jmax-spagla 4510 disp z 4520 call glatt(z,cneu,spagla) 4530 cmessneu(z)=cneu 4540 next 4550 for z=spagla to jmax-spagla 4560 cmess(z)=cmessneu(z) 4570 next 4571 print "Jmax= ";jmax 4580 disp 4590 graphics 4600 line type 1 4610 move umos(0),cmess(0)/cox 4620 for z=0 to jmax 4630 plot umos(z),cmess(z)/cox 4640 next 4641 beep 4642 pause 4650 line type 3 4660 move umos(jmax+1),cmess(jmax+1)/cox 4670 for z=jmax+1 to r 4680 plot umos(z),cmess(z)/cox 4690 next 4691 beep 4700 for z=0 to jmax 4701 for i=1 to 5 4702 if mber(z)=10+i then cmess(z)=cmess(z)-korr(i) 4703 next 4704 next 4705 for i=1 to 5 4706 if merox=10+i then cox=cox-korr(i) 4707 next 4710 rem 4720 rem 2. Auswertung nach c(u)-2 4730 rem 4740 rem 4750 coxn=(cox-cparo)/f*1E-12 4760 cinvn=(cinv-cparu)/f*1E-12 4770 k=2.409e31*vt*coxn^2/(coxn/cinvn-1)^2 4780 nv=k 4790 goto 4810 4800 nv=n 4810 n=k*(1+log(nv/ni)) 4820 if abs((nv-n)/n)>1e-3 then 4800 4830 dox=3.455e6/coxn*1e-12: rem [nm] 4840 co=sqr(1.66e-31*n/vt) 4850 cfb=coxn*co/(co+coxn)*f*1e12 4860 rem 4870 rem 4880 rem Ermitteln der Flachbandspannung 4890 rem 4891 beep 4892 beep 4893 rem pause 4900 for z=0 to jmax-1 4910 if (cmess(z)>cfb) and (cmess(z+1)<cfb) then 4925 4920 next 4922 beep 4923 print "Cfb Bedingung nicht gefunden" 4924 end 4925 zfp=z+1 4930 call ausgl(zfp,spaw) 4940 umosfb=(cfb-xg(1,1))/xg(2,1) 4950 cmessfbdiff=xg(2,1) 4960 cdifftheo=sgn(val(sign_$))*cox^3*co/(3*vt*(co*f*1e12+cox)^3)*f*1e12 4970 rem 4971 rem pause 4980 rem 4990 rem Papierausdruck 5000 rem 5010 printer is 0 5011 print page 5020 if (einbla=1) and (mipro=1) then 5050 5030 dump graphics 5040 print "",lin(2) 5050 print schnr$,lin(1) 5060 print "Messung und Auswertung nach Programm CUCLR Version1",LIN(2) 5070 float 3 5080 print "Mess-Frequ.=";Frequenz;"[Hz]";tab(40);"Ampl.=";Level;"[V]" 5090 print "Fläche=";f;"[qcm]";tab(40); 5100 standard 5110 print "Temp.=";te;"[Gr.Cels.]" 5120 fixed 3 5130 print "Par.Kap. in Akk.=";cparo;tab(40);"Par.Kap. in Depl>=";cparu;"[pF]" 5140 if spu=0 then print "C-Messung mit U(Akk)--->U(Depl)" 5150 if spu=1 then print "C-Messung kontinuierlich" 5160 print lin(1) 5170 fixed 2 5180 print "Oxid-Dicke=";dox;"[nm]";tab(40);"Cox=";cox;"[pF]" 5190 print tab(40);"rser=";rserox;"[Ohm]" 5200 float 3 5210 print "N_=";n;"[at/ccm]";tab(40); 5220 fixed 3 5230 print "UFB_=";umosfb;"[V]" 5240 standard 5250 print "Konst.-Inv.-Kap.:";echt;"x";tab(40);"Max.Wartezeit:";waitmax/50;[Sek.] 5260 if echt<0.25*ch then print "CHANNELANKOPPLUNG" 5270 if waitmax<300 then print "LICHTEINSTRAHLUNG oder SCHLECHTE LEBENSDAUER" 5280 if abs(cmess(r)-cmess(1))/cmess(1)>.005 then print "SCHLECHTER KONTAKT" 5290 print 5300 exit graphics 5310 if mipro=0 then 6520 5320 printer is 16 5330 rem 5340 rem 5350 rem 5360 rem Dotierungs-Profil 5370 rem 5380 P=P_=0 5381 if zfp<20+2*spaw then zfp=20+2*spaw 5390 for z=zfp-20-spaw to jmax-spaw 5392 print z 5400 call ausgl(z,spaw) 5410 umos=umos(z) 5420 gosub ziegler 5430 next 5440 printer is 0 5450 if spawi>0 then 5490 5460 fixed 3 5470 print "Iterat. best. Flachbandspannung=";umosfbit;" [V]" 5480 print "",lin(2) 5490 standard 5500 gclear 5510 rem 5520 rem 5530 rem 5540 rem Bestimmung eines geeigneten Koordinaten-Systems für N(X) 5550 rem 5560 p=p-1 5590 mticw=10^(int(lgt(wmax))-1) 5600 nu=int(lgt(dotmin)) 5610 no=int(lgt(dotmax))+1 5620 nuu=lgt(dotmin) 5630 noo=lgt(dotmax) 5640 rem 5650 rem 5660 rem 5670 rem Plotten des Dot.-Profils 5680 rem 5690 graphics 5700 locate 0,123.13,0,100 5710 line type 1 5720 frame 5730 locate 15,105,15,90 5740 scale 0,wmax,nu,noo 5750 axes mticw,1,0,nu,5,1 5760 for zlog=nu to no 5770 for z=2 to 9 5780 move 0,lgt(z*10^zlog) 5790 draw .008*wmax,lgt(z*10^zlog) 5800 next 5810 next 5820 csize 3 5830 lorg 8 5840 ldir 0 5850 for zlog=nu to no 5860 move 0,zlog 5870 label using "MDEX";10^zlog 5880 next 5890 lorg 1 5900 csize 4 5910 move 0,nuu+1.05*(noo-nuu) 5920 label "N [at/ccm]" 5930 move 1.02*wmax,nuu 5940 label "X" 5950 label "[micro]" 5960 csize 2.5 5970 move .85*wmax,nuu-.18*(noo-nuu) 5980 label "TE MOS 14/GUECKEL" 5990 lorg 2 6000 csize 3 6010 ldir -(pi/2) 6020 for z=0 to wmax step 5*mticw 6030 if skalfest=1 then move z,nuu 6040 if skalfest=1 then 6060 6050 move z,nu 6060 label using "M2M.2D";z 6070 next 6080 nimpl=0 6090 for z=0 to p 6100 if (w(z)<=0) or (n(z)<=0) then 6140 6110 if z=0 then nimpl=nimpl+n(z)*w(z) 6120 if z>0 then nimpl=nimpl+.5*(n(z-1)+n(z))*(w(z)-w(z-1)) 6130 plot 1e4*w(z),lgt(n(z)) 6140 next 6150 lorg 5 6160 ldir 0 6170 csize 3 6180 ngrund=0 6190 for z=p to p-20 step -5 6200 if n(z)>0 then move w(z)*1e4,lgt(n(z)) 6210 if n(z)>0 then label using "A";"O" 6220 ngrund=ngrund+n(z) 6230 next 6240 nimpl=nimpl-ngrund/5*w(p) 6250 pause 6260 exit graphics 6270 input "ist Dotierungs-Skala in Ordnung Ja=1 Nein=0",grawi 6280 if grawi=1 then 6390 6290 input "neue untere Grenze für Dotierungs-Skala",dotmin 6300 input "neue obere Grenze für Dotierungs-Skala",dotmax 6310 input "neue max. Meßtiefe",wmax 6320 input "Dotierungs-Berechnung mit anderer Ausgleichs-Spannweite",spawi 6330 if spawi=spaw then 6370 6340 spaw=spawi 6350 goto 5380 6360 skalfest=1 6370 gclear 6380 goto 5590 6390 print page 6400 dump graphics 6410 print "";lin(2) 6420 print schnr$,lin(1) 6430 print "Dotierungs-Profil nach Klausmann und Ziegler Progr.: CULCR Version 1",lin(1) 6440 standard 6450 print "Spagla=";spagla 6460 print "Spannweite der Ausglaichsgeraden:";spaw;" +1+ ";spaw;" Punkte" 6470 float 3 6480 print "Implantierte Dosis:";nimpl;" [at/qcm]" 6490 print "Bulk-Dotierung :";ngrund/5;"[at/qcm]" 6500 standard 6510 exit graphics 6520 print page 6560 end 6570 rem 6580 rem 6590 rem 6600 rem Unterprogramm UNDIG ************************************ 6610 rem umaxi$ ist im Hauptprogramm zunächst mit "10" festgelegt 6620 undig: if (uu=0) and (uo=0) then 6640 6630 if max(abs(uu),uo)<10 then umaxi$="01" 6640 if u>=0 then sign$="+2" 6650 if u<0 then sign$="-1" 6660 rem imaxi$="7" 6670 fixed 4 6680 u_=1e-1/val(umaxi$)*abs(u) 6690 rem u$=val$(u_) 6700 standard 6710 rem undig$=sign$&u$&umaxi$&imaxi$ 6720 rem if u=0 then undig$=sign$&".0000"&umaxi$&imaxi$ 6730 rem undig=val(undig$) 6740 umos=10*val(umaxi$)*u_*sgn(u) 6741 umoss=dround(umos,3) 6742 output 730;"BI"&val$(umoss)&"E0V" 6750 return 6760 rem output 7,4 using ...... image SD./d ; Undig ********** 6770 rem 6780 rem 6790 rem 6800 rem Unterprogramm ENTER ************************************* 6810 rem enter 3 using ...... image 12A,3A ; A$ B$ 6820 enter: berum=0 6830 if val(lcr$[6,13])>1.8 then range=range+1 6840 if val(lcr$[6,13])<.17 then range=range-1 6850 if (val(lcr$[6,13])>=.17) and (val(lcr$[6,13])<=1.8) then 6900 6860 range$="R"&val$(range) 6870 output 730;range$ 6880 berum=1 6890 if berum=1 then 6970 6900 tang=-1e95 6910 lcr1=val(lcr$[6,17]) : rem Cs 6920 lcr2=val(lcr$[21,32]): rem Rs 6921 cmess=lcr1*1e12 6922 rser=lcr2 6923 goto 6980 6930 deg 6940 if abs(lcr2)<90 then tang=tan(lcr2) 6950 cmess=sqr((1+1/tang^2)/(omega^2*lcr1^2))*1e12 6960 rser=-1/(omega*cmess*1e12*tang) 6970 rad 6980 return 6990 rem 7000 remote: remote$[1,2]="A2" 7010 remote$[3,4]="B3" 7020 remote$[5,6]="C2" 7030 remote$[7,9]=range$ 7040 remote$[10,12]=frequ$ 7050 remote$[13,14]=resol$ 7060 remote$[15,16]=ampl$ 7070 remote$[17,18]="T3" 7080 output 730;remote$ 7090 return 7100 rem 7110 rem 7120 rem Dot.-Profil-Berechnung nach Klausmann, Ziegler und Kar ****** 7130 rem 7140 ziegler: c_n=(xg(2,1)*umos+xg(1,1))/f*1e-12 7150 diff=-2*xg(2,1)/(c_n^3*f)*1e-12 7160 if val(sign_$)>0 then 7190 7170 if diff<=0 then return 7180 goto 7200 7190 if diff>=0 then return 7200 g1=-1*sgn(val(sign_$))*vt*c_n^2/(1-c_n/coxn)^2*diff 7210 if g1>.66 then p=p+1 7220 if g1>.66 then return 7230 if p>0 then 7320 7240 umos=umos(z-1) 7250 deltaumos=abs(umos(z)-umos(z-1)) 7260 umos=umos-sign*1e-1*deltaumos 7270 c_n=(xg(2,1)*umos+xg(1,1))/f*1e-12 7280 diff=-2*xg(2,1)/(c_n^3*f)*1e-12 7290 g1=-1*sgn(val(sign_$))*vt*c_n^2/(1-c_n/coxn)^2*diff 7300 if g1>.66 then 7260 7310 if p=0 then umosfbit=umos 7320 if g1>.3 then zvor=6-9*g1 7330 if g1<=.3 then zvor=(1+g1)/g1 7340 ha=1-exp(-zvor) 7350 yh=zvor-ha 7360 znach=zvor-((2-g1)*ha*yh+ha^2-2*yh)/((2-g1)*(ha^2-(ha-1)yh)-2*ha^2) 7370 if abs((zvor-znach)/znach)<1e-5 then 7400 7380 zvor=znach 7390 goto 7340 7400 gz=exp(-znach) 7410 wla=sqr(yh) 7420 g2=1/(1-gz)*(1-2*wla^2*gz/(1-gz)^2) 7430 n(p)=-1*sgn(val(sign_$))*2/1.035e-12/1.6e-19/diff*g2 7440 lam=sqr(2*vt*1.035e-12/1.6e-19/n(p)) 7450 w(p)=wla*lam 7460 disp "P=";p;"P_=";p_ 7470 P=P+1 7480 if sign=1 then 7510 7490 if umos<=umos(z) then 7260 7500 goto 7520 7510 if umos>=umos(z) then 7260 7520 return: rem ******************************************************** 7530 rem 7540 rem 7550 rem externes Unterprogramm zur Erzeugung geeigneter Spannungsschritte 7560 rem 7570 SUB schritte(ugr_,ugr__,zaeanf,sign,ugr,umosfb_,zaemax) 7580 com short umos(200) 7590 zae=zaeanf 7600 if (zae=0) and (zaemax=0) then 7670 7610 zae=zae+1 7620 if (abs(ugr_)>9.999) or (abs(ugr__)>9.999) then 7650 7630 uvar=uvar+2e-3*(zae-zaeanf) 7640 if (abs(ugr_)<=9.999) or (abs(ugr__)<=9.999) then 7660 7650 uvar=uvar+1e-2*(zae-zaeanf) 7660 if (umosfb_+sign*uvar)*sign>=abs(ugr_) then ugr=umosfb_+sign*uvar 7670 umos(zae)=umosfb_+sign*uvar 7680 if abs(ugr)>0 then 7700 7690 goto 7610 7700 zaemax=zae-1 7710 subend 7720 rem 7730 rem 7740 rem Externes Unterprogramm für Ausgleichsgeraden ********************* 7750 rem 7760 SUB ausgl(a,spaw) 7770 com short umos(200),cmess(200) 7780 dim ag(1:2,1:2) 7790 dim yg(1:2,1:2) 7800 com real xg(1:2,1:2) 7810 dim al(1:2,1:2) 7820 ag(1,1)=1+2*spaw 7830 ag(1,2)=ag(2,2)=yg(1,1)=yg(2,1)=0 7840 for hi=-spaw to spaw 7850 ag(1,2)=ag(1,2)+umos(a+hi) 7860 ag(2,2)=ag(2,2)+umos(a+hi)^2 7870 yg(1,1)=yg(1,1)+cmess(a+hi) 7880 yg(2,1)=yg(2,1)+umos(a+hi)*cmess(a+hi) 7890 next 7900 ag(2,1)=ag(1,2) 7910 mat al=inv(ag) 7920 mat xg=al*yg 7930 subend: rem ****************************************************** 7940 rem Externes Unterprogramm für Ausgleichsparabel 7950 rem 7960 sub glatt(a,c,weite) 7970 com short umos(200),cmess(200) 7980 dim ag(1:2,1:2) 7990 dim yg(1:2,1:2) 8000 dim xgp(1:2,1:2) 8010 dim al(1:2,1:2) 8020 ag(1,1)=2*weite+1 8030 for hi=-weite to weite 8040 ag(1,2)=ag(1,2)+umos(a+hi) 8050 ag(2,2)=ag(2,2)=umos(a+hi)^2 8060 yg(1,1)=yg(1,1)=cmess(a+hi) 8070 yg(2,1)=yg(2,1)=umos(a+hi)*cmess(a+hi) 8080 next 8090 ag(2,1)=ag(1,2) 8100 if det(ag)=0 then 8150 8110 mat al=inv(ag) 8120 mat xgp=al*yg 8130 c=xgp(1,1)+xgp(2,1)*umos(a) 8140 goto 8160 8150 c=cmess(a) 8160 subend