Spaghetti Code / Basic Beispiel
 
StartSeite | SpaghettiCode/ | Neues | TestSeite | ForumSeite | Teilnehmer | Kategorien | Index | Hilfe | Einstellungen | Ändern

Der vorliegende Code ist ein gutes Beispiel für SpaghettiCode und ist im Jahre 1987 auf meinem Schreibtisch gelandet. Auftrag: Analyse der Funktionsweise und Vorarbeiten für bestimmte Wartungsarbeiten. Ursprung des Codes: die technische Abteilung eines großen und renomierten technisch orientierten Konzerns (Steuerprogramm für ein Messgerät).

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


KategorieBasic KategorieProgrammierStil
StartSeite | SpaghettiCode/ | Neues | TestSeite | ForumSeite | Teilnehmer | Kategorien | Index | Hilfe | Einstellungen | Ändern
Text dieser Seite ändern (zuletzt geändert: 7. August 2002 23:48 (diff))
Suchbegriff: gesucht wird
im Titel
im Text