STAK  "z    ڋ^@> K""""""""̪3̪3 @"""""D"DĀ hC0&0 "U""U"U"UU"Uwwww݀UUUUH0 D9D"AA"A>"t"%2d$LA*@ @ "t"G"q]APPon OpenStack global oft global cf set the numberformat to "0.00000000" --SiO2 Faktoren fr Sauerstoffquotient oft und Kationenquotient cf put 2/60.0843 into line 1 of oft put 1/60.0843 into line 1 of cf -- TiO2 put 2/79.8658 into line 2 of oft put 1/79.8958 into line 2 of cf -- ZrO2 put 2/123.2228 into line 3 of oft put 1/123.2228 into line 3 of cf -- Al2O3 put 3/101.961276 into line 4 of oft put 2/101.961276 into line 4 of cf -- V2O3 put 3/149.8812 into line 5 of oft put 2/149.8812 into line 5 of cf -- Cr2O3 put 3/151.9904 into line 6 of oft put 2/151.9904 into line 6 of cf -- Mn2O3 put 3/157.874298 into line 7 of oft put 2/157.874298 into line 7 of cf -- Fe2O3 put 3/159.6882 into line 8 of oft put 2/159.6882 into line 8 of cf -- MgO put 1/40.3044 into line 9 of oft put 1/40.3044 into line 9 of cf -- MnO put 1/70.937449 into line 10 of oft put 1/70.937449 into line 10 of cf -- FeO put 1/71.8444 into line 11 of oft put 1/71.8444 into line 11 of cf -- NiO put 1/74.6928 into line 12 of oft put 1/74.6928 into line 12 of cf -- CoO put 1/74.9326 into line 13 of oft put 1/74.9326 into line 13 of cf -- ZnO put 1/81.4084 into line 14 of oft put 1/81.4084 into line 14 of cf -- CaO put 1/56.0774 into line 15 of oft put 1/56.0774 into line 15 of cf -- SrO put 1/103.6194 into line 16 of oft put 1/103.6194 into line 16 of cf -- BaO put 1/153.3264 into line 17 of oft put 1/153.3264 into line 17 of cf -- Li2O put 1/29.8814 into line 18 of oft put 2/29.8814 into line 18 of cf -- Na2O put 1/61.97894 into line 19 of oft put 2/61.97894 into line 19 of cf -- K2O put 1/94.196 into line 20 of oft put 2/94.196 into line 20 of cf -- H2O put 1/18.01528 into line 21 of oft put 2/18.01528 into line 21 of cf -- F put 1/18.9984032 into line 22 of oft put 1/18.9984032 into line 22 of cf -- Cl put 1/35.453 into line 23 of oft put 1/35.453 into line 23 of cf end openStack tor -- F put 1/18.9984032 into line 22 of ofactor put 1/18.9984032 into line 22 of cfactor -- Cl put 1/35.453 into line 23 of ofactor p MASTsKeZzujLISTz BPAGEz$"lezۄ_m-?F= `  BKGD Z@##P^\-")?" ?o@ "(p "!@ "):s "!:r@ ")r) "!H( @ " )(o  " !!nM@ " )n+M " !(Nz@ " )Gh ") ")+: ")9H ")&G ")S(t "-'x")d "N ")# "!$[@ ")O]e "(] ")$  "!@ " )  "!!N'{ ""!' "#!5CK "$!5C "%!Q_K "&!Q_ "'!zK "(!y *) amphgroup**} amphname-^l? New Buttonon mouseUp global neu,fe2o3,feo,mn2o3,mno IF line 1 of BG FLD(2) <> EMPTY THEN if neu =1 then put fe2o3 into line 8 of bg fld(2) put feo into line 11 of bg fld(2) put mn2o3 into line 7 of bg fld(2) put mno into line 10 of bg fld(2) put 0 into neu -- if hilite of bg button(18) is true and neu=1 then -- put fe2o3 into bg fld(6) -- put feo into bg fld(9) end if -- put 0 into neu --if hilite of bg button(19) is true then -- put "recalculating without Normalisation" into msg -- beep --put oxno into oxnoold -- put 23 into oxno --put oxno into msg --end if send mouseup to bg button "calculate" END IF end mouseUp .n|S? New Buttonon mouseUp global oxno, neu,fe2o3,feo,mn2o3,mno IF line 1 of BG FLD(2) <> EMPTY THEN if neu =1 then put fe2o3 into line 8 of bg fld(2) put feo into line 11 of bg fld(2) put mn2o3 into line 7 of bg fld(2) put mno into line 10 of bg fld(2) put 0 into neu put 0 into neu end if put "recalculating without Normalisation" into msg wait 30 hide msg send mouseup to bg button "calculate" END IF end mouseUp/~? New Buttonon mouseUp global oxno,fe2o3,feo,mn2o3,mno,neu IF line 1 of BG FLD(2) <> EMPTY THEN set numberformat to "0.00" if hilite of bg button(3) is true then put line 8 of bg fld(2) into fe2o3 put line 11 of bg fld(2) into feo put fe2o3/1.1114 +feo into line 11 of bg fld(2) put empty into line 8 of bg fld(2) put line 7 of bg fld(2) into mn2o3 put line 10 of bg fld(2) into mno put mn2o3/1.11277 + mno into line 10 of bg fld(2) PUT empty INTO line 7 of BG FLD(2) put 23 into oxno put 1 into neu put "recalculating with Normalisation" into msg wait 30 hide msg send mouseup to bg button "calculate" end if END IF end mouseUp0(  Home-- Quitting EMP-AMPH on mouseUp if the freeSize of this stack > 1000 then doMenu Compact Stack end if doMenu Quit Hypercard end mouseUp P1*r  file importon mouseUp answer file "Choose an amphibole data file:" of type text if it is empty then exit to HyperCard put it into fileName lock screen put the userlevel into saveLevel set userlevel to 5 set the itemDelimiter to tab put 0 into numberofAnalyses open file fileName put 0 into i repeat read from file fileName until return if it is empty then close file fileName set userlevel to saveLevel go last card of background "analysis" set the loc of message to 20,140 set numberFormat to 0 put "Just done..." into message put numberofAnalyses && "Analyses imported and calculated" wait 2 second hide message set numberFormat to 0.000 exit to HyperCard else put numberofAnalyses + 1 into numberofAnalyses put empty into sample put empty into analysnumber put empty into x_axis put empty into y_axis put 0 into SiO2 put 0 into TiO2 put 0 into ZrO2 put 0 into Al2O3 put 0 into V2O3 put 0 into Cr2O3 put 0 into Mn2O3 put 0 into Fe2O3 put 0 into MgO put 0 into MnO put 0 into FeO put 0 into NiO put 0 into CoO put 0 into ZnO put 0 into CaO put 0 into SrO put 0 into BaO put 0 into Li2O put 0 into Na2O put 0 into K2O put 0 into H2O put 0 into F put 0 into Cl put number of items of variables into i repeat with j= i down to 1 delete item j of variables delete item j of values end repeat repeat until length of last item of it <> 0 delete last item of it end repeat put number of items of it into zaehler if zaehler mod 2 <> 0 then add 1 to zaehler repeat with i=1 to zaehler/2 put item (2*i-1) of it into item i of variables put item (2*i) of it into item i of values end repeat if number of items of values < zaehler/2 then put 0 into item(zaehler/2) of values repeat with i = 1 to the number of items of variables if length of item i of values = 0 then put 0 into item i of values end if do "put" && "item i of values" && "into" && item i of variables end repeat if line 1 of bg fld(2) is not empty then send mouseUp to background button "new analysis" end if unlock screen set numberformat to "0.00" put sample into bg fld (21) if SiO2 is 0 then put empty into line 1 of bg fld(2) else put SiO2*1 into line 1 of bg fld(2) end if if TiO2 is 0 then put empty into line 2 of bg fld(2) else put TiO2*1 into line 2 of bg fld(2) end if if ZrO2 is 0 then put empty into line 3 of bg fld(2) else put ZrO2*1 into line 3 of bg fld(2) end if if Al2O3 is 0 then put empty into line 4 of bg fld(2) else put Al2O3*1 into line 4 of bg fld(2) end if if V2O3 is 0 then put empty into line 5 of bg fld(2) else put V2O3*1 into line 5 of bg fld(2) end if if Cr2O3 is 0 then put empty into line 6 of bg fld(2) else put Cr2O3*1 into line 6 of bg fld(2) end if if Mn2O3 is 0 then put empty into line 7 of bg fld(2) else put Mn2O3*1 into line 7 of bg fld(2) end if if Fe2O3 is 0 then put empty into line 8 of bg fld(2) else put Fe2O3*1 into line 8 of bg fld(2) end if if MgO is 0 then put empty into line 9 of bg fld(2) else put MgO*1 into line 9 of bg fld(2) end if if MnO is 0 then put empty into line 10 of bg fld(2) else put MnO*1 into line 10 of bg fld(2) end if if FeO is 0 then put empty into line 11 of bg fld(2) else put FeO*1 into line 11 of bg fld(2) end if if NiO is 0 then put empty into line 12 of bg fld(2) else put NiO*1 into line 12 of bg fld(2) end if if CoO is 0 then put empty into line 13 of bg fld(2) else put CoO*1 into line 13 of bg fld(2) end if if ZnO is 0 then put empty into line 14 of bg fld(2) else put ZnO*1 into line 14 of bg fld(2) end if if CaO is 0 then put empty into line 15 of bg fld(2) else put CaO*1 into line 15 of bg fld(2) end if if SrO is 0 then put empty into line 16 of bg fld(2) else put SrO*1 into line 16 of bg fld(2) end if if BaO is 0 then put empty into line 17 of bg fld(2) else put BaO*1 into line 17 of bg fld(2) end if if Li2O is 0 then put empty into line 18 of bg fld(2) else put Li2O*1 into line 18 of bg fld(2) end if if Na2O is 0 then put empty into line 19 of bg fld(2) else put Na2O*1 into line 19 of bg fld(2) end if if K2O is 0 then put empty into line 20 of bg fld(2) else put K2O*1 into line 20 of bg fld(2) end if if H2O is 0 then put empty into line 21 of bg fld(2) else put H2O*1 into line 21 of bg fld(2) end if if F is 0 then put empty into line 221 of bg fld(2) else put F*1 into line 22 of bg fld(2) end if if Cl is 0 then put empty into line 23 of bg fld(2) else put Cl*1 into line 23 of bg fld(2) end if unlock screen unlock screen lock screen --if Fe2O3 <> 0 and line 21 of bg fld(2) is empty then --set hilite of bg button (2) to true --else --set hilite of bg button (1) to true --end if send mouseUp to background button "calculate" unlock screen end repeat end mouseupT2t  calculateon mouseUp global oft,oq,cf, cq,kf,fe2,fe3,factor, Xfactor, Nfactor, normal, Dellav put 0 into total put 0 into antot put 0 into norhombic put "true" into normal put "false" into Dellav put 0 into kf IF length of line 1 of BG FLD(4) >= 1 THEN --lock screen repeat with i=27 down to 1 delete line i of bg fld(4) end repeat repeat with i=4 down to 1 delete line i of bg fld(6) end repeat repeat with i=16 down to 1 delete line i of bg fld(8) end repeat repeat with i=14 down to 1 delete line i of bg fld(10) end repeat repeat with i=7 down to 1 delete line i of bg fld(12) end repeat repeat with i=27 down to 24 delete line i of bg fld(2) end repeat end if if hilite of bg btn (1) is false and hilite of bg btn(2) is false and hilite of bg btn(3) is false then if line 8 of bg fld(2) <> empty and line 21 of bg fld(2) is empty then set hilite of bg button (2) to true else set hilite of bg button (1) to true end if end if unlock screen lock screen lock screen if bg fld(65) is not empty then if bg fld(65) = "X" then put line 6 of bg fld(64)-1 into line 6 of bg fld(64) else put line bg fld(65) of bg fld(64)-1 into line bg fld(65) of bg fld(64) if line bg fld(65) of bg fld(64) = 0 then delete line bg fld(65) of bg fld(64) end if end if set numberformat to "0.000000" repeat with i=1 to 20 add line i of bg fld (2) to total add line i of bg fld (2) * line i of oft to antot put line i of bg fld (2) * line i of oft into line i of oq put line i of bg fld (2) * line i of cf into line i of cq end repeat put 0 into anO3 repeat with i=21 to 23 add line i of bg fld (2) to total add line i of bg fld (2) * line i of oft to anO3 put line i of bg fld (2) * line i of oft into line i of oq put line i of bg fld (2) * line i of cf into line i of cq end repeat set numberformat to "0.00" put total into line 24 of bg fld (2) put (line 22 of bg fld (2)*-0.4211 + line 23 of bg fld (2)*-0.2256) into line 25 of bg fld (2) put line 24 of bg fld (2) + line 25 of bg fld (2) into line 26 of bg fld (2) set numberformat to "0.000" if (line 8 of bg fld (2)=0 or line 8 of bg fld (2) = empty) and (line 7 of bg fld (2)=0 or line 7 of bg fld(2) = empty) then put 23 into line 26 of bg fld (4) else if hilite of bg button (2) or hilite of bg button (3) is true then put 23 into line 26 of bg fld (4) else add -.5*line 22 of oq -.5*line 23 of oq to antot put 24 into line 26 of bg fld (4) add anO3 to antot end if end if set numberformat to "0.000" put empty into line 1 of bg fld(23) put empty into line 2 of bg fld(23) unlock screen repeat with i=1 to 20 put line 26 of bg fld(4)*line i of cq/antot into line i of bg fld(4) end repeat put 0 into line 21 of bg fld (4) repeat with i=1 to 20 add line i of bg fld(4) to line 21 of bg fld (4) end repeat repeat with i=21 to 23 put line 26 of bg fld(4)*line i of cq/antot into line i+1 of bg fld(4) end repeat put line 22 of bg fld (4) into OHr unlock screen if hilite of bg btn(2) is false and line 26 of bg fld(4) =23 then delete first item of fe2 delete first item of fe3 unlock screen set numberformat to "0.000000" -- min. Fe3+ put line 1 of bg fld(4) into SiT put line 21 of bg fld(4)-line 20 of bg fld(4)-line 19 of bg fld(4)-line 17 of bg fld(4)-line 16 of bg fld(4) into SumCa put 8/SiT into SiTfactor put 15/ SumCa into SumCafactor put 16/line 21 of bg fld(4) into CATfactor put min(1, SiTfactor, SumCafactor, CATfactor) into Minfactor put Minfactor into Xfactor -- max. Fe3+ put SumCa - line 15 of bg fld(4) into SumFM put line 21 of bg fld(4) - line 20 of bg fld(4) into SumNa if 13/SumFM <= 1 then put 13/SumFM into SumFMfactor else put 0 into SumFMfactor end if if 15/SumNa <= 1 then put 15/SumNa into SumNafactor else put 0 into SumNafactor end if put 23/(23+line 11 of bg fld(4)*0.5) into allferric put 8/(line 1 of bg fld(4)+line 4 of bg fld(4)) into SiAl8 put max(allferric,SiAl8,SumFMfactor, SumNafactor) into Maxfactor --if Minfactor <= 1 and Maxfactor <= 1 then if Maxfactor <= Minfactor then put (Maxfactor+Minfactor)/2 into Nfactor -- put Minfactor into Nfactor else put Minfactor into Nfactor end if --else --put 1 into Nfactor --end if end if put line 26 of bg fld(4)/antot into factor unlock screen if line 26 of bg fld(4) =23 and (hilite of bg btn (2) is false or hilite of bg btn(3) is true) then set numberformat to "0.000000" if Nfactor <> 1 then normalization Nfactor*factor Febalance end if set numberformat to "0.000" siteoccupancies -- Sum O3-anions if line 26 of bg fld(4) =23 and line 21 of bg fld(2) is empty then if line 23 of bg fld(4) + line 24 of bg fld(4) > 2 then put 0 into line 22 of bg fld(4) else put 2 - line 23 of bg fld(4) - line 24 of bg fld(4) into line 22 of bg fld (4) put line 22 of bg fld (4) + line 23 of bg fld(4) + line 24 of bg fld(4) into line 25 of bg fld (4) set numberformat to "0.00" put line 22 of bg fld (4)/factor/Nfactor/line 21 of cf into line 27 of bg fld (2) --put "H2O calc." into line 27 of bg fld(2) end if else delete line 27 of bg fld(2) put line 22 of bg fld (4) + line 23 of bg fld(4) + line 24 of bg fld (4) into line 25 of bg fld (4) end if -- Amphibole nomenclature put bg fld(31) into CaNaB put bg fld(30) into NaB put line 1 of bg fld(12) into ACa put bg fld(32) into NaKA put line 26 of bg fld(4) into oxno put line 8 of bg fld(10) into LiB put bg fld(29) into MB put bg fld(33) into XMg put bg fld(34) into XMgMn put bg fld(35) into Mntot put bg fld(36) into AlFM put "" into line 1 of bg fld(38) put "" into line 2 of bg fld(38) put "" into fluoro put "" into chloro put "" into mangano put "" into permangano put "" into potassic put "" into sodic put "" into titano put "" into alumino put "" into mangani put "" into ferri put "" into chromio put "" into modifiers put "" into group put "" into amph1 put "" into amph put "" into prefixes put "" into ampgroup put "" into kf put "false" into extra put "false" into groupwahl put "false" into Mnflag1 put "false" into Mnflag2 If MB > 0.5 and MB < 1.5 and CaNaB >= 0.5 and CaNaB <= 1.5 then If LiB > 0.5 then -- normale Gruppe 5 Namensgebung nach A- Site und Si und XMg put 5 into ampgroup if oxno =23 then if hilite of bg btn(2) is false then put "Na-Ca-Mg-Fe-Mn-Li-Amphibole" into group else put "Na-Ca-Mg-Fe-Mn-Li Amphibole, name based on 23 oxygens" into group end if else put "Na-Ca-Mg-Fe-Mn-Li Amphibole, name based on 24 anions" into group end if if line 1 of bg fld(4) >= 7.0 then if line 7 of bg fld(12) < 0.5 then if XMg >= 0.5 then put "ottoliniite" into amph else put "ferro-ottoliniite" into amph end if else if XMg >= 0.5 then put "whittakerite" into amph else put "ferrowhittakerite" into amph end if end if put "false" into extra put "true" into groupwahl end if else -- Sondername mit parvo bzw. magno fr Gruppen  II, III, IV bzw. I put "true" into extra put "false" into groupwahl end if end if If groupwahl = "false" then If CaNaB >= 1.0 then If NaB < 0.5 then If extra = "true" then put "parvo " into prefixes end if If MB < 0.5 or extra ="true" then put 2 into ampgroup if oxno =23 then if hilite of bg btn(2) is false then put "Calcic Amphibole" into group else put "Calcic Amphibole, name based on 23 oxygens" into group end if else put "Calcic Amphibole, name based on 24 anions" into group end if if line 2 of bg fld(4) >= 0.5 then put 1 into kf if oxno =23 then --if line 7 of bg fld(2) is not empty or line 8 of bg fld(2) is not empty then put 23.5/23*factor into factor put 1 into Xfactor --end if put 23.500 into line 26 of bg fld(4) normalization Xfactor*factor put line 27 of bg fld(4) *Xfactor into line 27 of bg fld(4) siteoccupancies put line 21 of cq*factor*xfactor into line 22 of bg fld(4) put line 22 of bg fld(4) + line 23 of bg fld(4)+ line 24 of bg fld(4) into line 25 of bg fld(4) Mndistribution 47 end if if line 21 of bg fld(2) is empty then delete line 27 of bg fld(2) if line 23 of bg fld(4) + line 24 of bg fld(4) >= 1 then put 0 into line 22 of bg fld(4) else put 1 - line 23 of bg fld(4) - line 24 of bg fld(4) into line 22 of bg fld (4) put line 22 of bg fld (4) + line 23 of bg fld(4) + line 24 of bg fld(4) into line 25 of bg fld (4) set numberformat to "0.00" put line 22 of bg fld (4)/2/factor * 18.01528 into line 27 of bg fld (2) end if end if if line 1 of bg fld(4) < 6.5 and line 1 of bg fld(4) >= 5.5 then if XMg >= 0.5 then put "kaersutite" into amph else put "ferrokaersutite" into amph end if end if else if NaKA <0.5 then if ACa < 0.5 then if line 1 of bg fld(4) >= 7.5 then if XMg >=0.9 then put "tremolite" into amph else if XMg >=0.5 then put "actinolite" into amph else put "ferro-actinolite" into amph end if end if else if line 1 of bg fld(4) >=6.5 then if XMg >=0.5 then put "magnesiohornblende" into amph else put "ferrohornblende" into amph end if else if line 1 of bg fld(4) >= 5.5 then if XMg >=0.5 then put "tschermakite" into amph else put "ferrotschermakite" into amph end if end if end if end if else put "cannilloite" into amph end if else if line 1 of bg fld(4) >=6.5 then if XMg >=0.5 then put "edenite" into amph else put "ferroedenite" into amph end if else if line 1 of bg fld(4) >=5.5 then if line 1 of bg fld(8) >= line 4 of bg fld(8) then if XMg >=0.5 then put "pargasite" into amph else put "ferropargasite" into amph end if else if XMg >=0.5 then put "magnesiohastingsite" into amph else put "hastingsite" into amph end if end if else if line 1 of bg fld(4) >= 4.5 then if XMg >=0.5 then put "magnesiosadanagaite" into amph else put "sadanagaite" into amph end if end if end if end if end if end if end if put "true" into groupwahl else If NaB < 1.5 then -- Behandlung der Sodic-calcic group If extra = "true" then put "parvo " into prefixes end if If MB < 0.5 or extra ="true" then put "true" into groupwahl put 3 into ampgroup if oxno =23 then if hilite of bg btn(2) is false then put "Sodic-calcic Amphibole" into group else put "Sodic-calcic Amphibole, name based on 23 oxygens" into group end if else put "Sodic-calcic Amphibole, name based on 24 anions" into group end if if NaKA <0.5 then if line 1 of bg fld(4) >= 6.5 and line 1 of bg fld(4) < 7.5 then if XMg >=0.5 then put "barroisite" into amph else put "ferrobarroisite" into amph end if else if line 1 of bg fld(4) >=7.5 then if XMg >=0.5 then put "winchite" into amph else put "ferrowinchite" into amph end if end if end if else if line 1 of bg fld(4) >= 5.5 and line 1 of bg fld(4) <6.5 then if XMg >=0.5 then put "magnesiotaramite" into amph else put "taramite" into amph end if else if line 1 of bg fld(4) >= 6.5 and line 1 of bg fld(4) <7.5 then if XMg >=0.5 then put "magnesiokatophorite" into amph else put "katophorite" into amph end if else if XMg >=0.5 then put "richterite" into amph else put "ferrorichterite" into amph end if end if end if end if end if end if end if end if end if If groupwahl = "False" then If NaB >= 1.5 then If extra ="True" then put "parvo " into prefixes end if If MB < 0.5 or extra ="True" then -- Criteria for sodic amphiboles are valid put "True" into groupwahl put 4 into ampgroup if oxno =23 then if hilite of bg btn(2) is false then put "Sodic Amphibole" into group else put "Sodic Amphibole, name based on 23 oxygens" into group end if else put "Sodic Amphibole, name based on 24 anions" into group end if if line 18 of bg fld(4) < 0.5 then if Mntot < AlFM then if NaKA < 0.5 then if line 1 of bg fld(4) > 7.0 then if line 1 of bg fld(8) >= line 4 of bg fld(8) then if XMg >=0.5 then put "glaucophane" into amph else put "ferroglaucophane" into amph end if else if XMg >=0.5 then put "magnesioriebeckite" into amph else put "riebeckite" into amph end if end if end if else if line 1 of bg fld(4) >= 6.5 and line 1 of bg fld(4) <7.5 then if line 1 of bg fld(8) >= line 4 of bg fld(8) then if XMg >=0.5 then put "nybite" into amph else put "ferronybite" into amph end if else if XMg >=0.5 then put "ferricnybite" into amph else put "ferric-ferronybite" into amph end if end if else -- Obertiite, Eckermannite, Arfvedsonite if line 2 of bg fld(4) >= 0.5 then if hilite of bg btn(2) is false then if line 26 of bg fld(4) =23 and (hilite of bg btn (2) is false or hilite of bg btn(3) is true) then set numberformat to "0.000000" normalization Xfactor*factor put line 27 of bg fld(4) *Xfactor into line 27 of bg fld(4) siteoccupancies end if put 24 into line 26 of bg fld(4) put 0 into line 22 of bg fld(4) put line 22 of bg fld(4) + line 23 of bg fld(4)+ line 24 of bg fld(4) into line 25 of bg fld(4) Mndistribution 48 end if put line 21 of cq*factor*xfactor into line 22 of bg fld(4) put line 22 of bg fld(4) + line 23 of bg fld(4)+ line 24 of bg fld(4) into line 25 of bg fld(4) put empty into line 27 of bg fld(2) if line 25 of bg fld(4) <1 and XMg >= 0.5 then put "obertiite" into amph put "Sodic Amphibole, name based on 24 anions" into group end if else if line 1 of bg fld(8) >= line 4 of bg fld(8) then if XMg >=0.5 then put "eckermannite" into amph else put "ferroeckermannite" into amph end if else if XMg >=0.5 then put "magnesio-arfvedsonite" into amph else put "arfvedsonite" into amph end if end if end if end if end if else if NaKA >= 0.5 and line 1 of bg fld(4) >= 7.5 then if hilite of bg btn (2) is false then if oxno=23 then set the numberformat to "0.000" put 46 into Ldg if line 1 of bg fld(8)+line 9 of bg fld(8) <.2 then put OHr into line 22 of bg fld(4) add OHr to line 27 of bg fld(4) put 24 into line 26 of bg fld(4) put 48 into Ldg end if --add line 22 of bg fld(4) to line 27 of bg fld(4) Mndistribution ldg end if end if if XMgMn < 0.5 then if line 25 of bg fld(4) <1 then put "ungarettiite" into amph put empty into line 27 of bg fld(2) put "Sodic Amphibole, name based on 24 anions" into group put "true" into Mnflag2 else put "kozulite" into amph end if put "true" into Mnflag1 end if end if end if else -- Li>=0.5 case if hilite of bg btn (2) is false then if line 26 of bg fld(4) =23 then if line 2 of bg fld (4) >= 0.5 then put 24 into line 26 of bg fld(4) normalization Xfactor*factor put line 27 of bg fld(4) *Xfactor into line 27 of bg fld(4) put "false" into normal siteoccupancies put line 21 of cq*factor*xfactor into line 22 of bg fld(4) --put 0 into line 22 of bg fld(4) put empty into line 27 of bg fld(2) add line 22 of bg fld(4) to line 27 of bg fld(4) Mndistribution 48 add line 22 of bg fld(4) to line 27 of bg fld(4) else put 23 into line 26 of bg fld(4) put 2 - line 24 of bg fld(4)-line 23 of bg fld(4) into line 22 of bg fld(4) put line 22 of bg fld(4) + line 23 of bg fld(4)+ line 24 of bg fld(4) into line 25 of bg fld(4) Mndistribution 46 end if end if end if if line 4 of bg fld(8) >= line 7 of bg fld(8) then if XMg >=0.5 then put "leakeite" into amph else put "ferroleakeite" into amph end if else put "true" into Mnflag2 put line 21 of cq*factor*Nfactor into line 22 of bg fld(4) put line 22 of bg fld(4) + line 23 of bg fld(4)+ line 24 of bg fld(4) into line 25 of bg fld(4) put empty into line 27 of bg fld(2) if line 25 of bg fld(4) < 1 then put "dellaventuraite" into amph put "Sodic Amphibole, name based on 24 anions" into group put "true" into Dellav else if bg fld(34) >= 0.5 then put "kornite" into amph end if end if end if end if end if else If extra = "True" then put "magno " into prefixes end if If MB >= 1.5 or extra ="true" then --Criteria for Mg-Fe-Mn-Li amphiboles are valid put "True" into groupwahl put 1 into ampgroup if oxno =23 then if hilite of bg btn(2) is false then put "Mg-Fe-Mn-Li-Amphibole" into group else put "Mg-Fe-Mn-Li Amphibole, name based on 23 oxygens" into group end if else put "Mg-Fe-Mn-Li Amphibole, name based on 24 anions" into group end if -- special prefixes and modifiers for Fe-Mg-Mn-Li amphiboles only IF line 15 of bg fld(4) >.5 THEN put modifiers & "calcian " into modifiers end if IF line 19 of bg fld(4) >.5 THEN put "sodic-" into sodic end if IF line 19 of bg fld(4) >.25 AND line 19 of bg fld(4)<=0.49 THEN put modifiers & "sodian " into modifiers end if -- Mg-Fe-Mn-Li amphibole if line 8 of bg fld (10) < 1 then if line 15 of bg fld(8) < 0.5 then if line 1 of bg fld(4) >=7 then if XMg >= 0.5 then put "cummingtonite (mkl)" into amph1 put "anthophyllite (orh)" into amph else put "grunerite (mkl)" into amph1 put "ferro-anthophyllite (orh)" into amph end if else if XMg >= 0.5 then put "gedrite (orh)" into amph else put "ferro-gedrite (orh)" into amph end if end if end if else if line 15 of bg fld(8)< 0.5 then if line 1 of bg fld(4) >= 7 then if XMg >= 0.5 then put "clinoholmquistite (mkl)" into amph1 put "holmquistite (orh)" into amph else put "clinoferroholmquistite (mkl)" into amph1 put "ferroholmquistite (orh)" into amph end if end if else if line 1 of bg fld(4) >= 7 then put 1 into norhombic if XMg >= 0.5 then put "pedrizite (mkl)" into amph1 else put "ferropedrizite (mkl)" into amph1 end if end if end if end if end if end if end if -- General Prefixes IF line 24 of bkgnd field (4) >1 THEN put "chloro-" into chloro end if IF line 24 of bkgnd field (4) >.25 AND line 24 of bkgnd field (4)<=0.99 THEN put modifiers & "chlorian " into modifiers end if IF line 6 of bkgnd field (4) >1 THEN put "chromio-" into chromio end if IF line 6 of bkgnd field (4)>=.25 AND line 6 of bkgnd field (4) <1 THEN put modifiers & "chromian " into modifiers end if if line 8 of bkgnd field (4) >=.75 AND line 8 of bkgnd field (4) <1 and ampgroup <> 4 then put modifiers & "ferrian " into modifiers end if IF line 23 of bkgnd field (4) >1 THEN put "fluoro-" into fluoro end if IF line 23 of bkgnd field (4) >=.25 AND line 23 of bkgnd field (4) <0.99 THEN put modifiers & "fluorian " into modifiers end if IF line 10 of bkgnd field (4) >=1 AND line 10 of bkgnd field (4)<2.99 and Mnflag1 = "false" THEN put "mangano-" into mangano end if if line 10 of bkgnd field (4) >=3 AND line 10 of bkgnd field (4) <4.99 and Mnflag1 = "false" THEN put "permangano-" into permangano end if IF line 10 of bkgnd field (4) >=0.25 AND line 10 of bkgnd field (4) <0.99 and Mnflag1 ="false" Then put modifiers & "manganoan " into modifiers end if IF line 7 of bkgnd field (4) >1 and Mnflag2 ="false" THEN put "mangani-" into mangani end if if line 7 of bg fld(4) >=0.25 and line 7 of bg fld(4)<0.99 and Mnflag2="false" then put modifiers & "manganian " into modifiers end if IF line 20 of bkgnd field (4) >.5 THEN put "potassic-" into potassic end if IF line 20 of bkgnd field (4) >=.25 and line 20 of bkgnd field (4) <0.49 THEN put modifiers & "potassian " into modifiers end if IF line 2 of bkgnd field (4) >0.5 and Tiflag="false" THEN put "titano-" into titano end if IF line 2 of bkgnd field (4) >=.25 AND line 2 of bkgnd field (4) <.49 THEN put modifiers & "titanian " into modifiers end if IF line 14 of bkgnd field (4) >1 THEN put "zinco-" into zinco end if IF line 14 of bkgnd field (4) >.1 and line 14 of bkgnd field (4) <0.99 THEN put modifiers & "zincian " into modifiers end if IF line 3 of bkgnd field (4) >0.10 THEN put modifiers & "zirconian " into modifiers end if IF line 25 of bkgnd field (4) <1 AND ampgroup <> 4 THEN put modifiers & "oxygenian " into modifiers end if IF line 18 of bkgnd field (4) >0.25 AND Liflag="false" then put modifiers & "lithian " into modifiers end if IF line 8 of bkgnd field (4) >1 AND ampgroup <> 4 THEN put "ferri-" into ferri end if IF line 1 of bkgnd field (8) >1 and (ampgroup =2 or ampgroup =3 or ampgroup=5) THEN put "alumino-" into alumino end if IF line 17 of bkgnd field (4) > 0.1 THEN put modifiers & "barian " into modifiers end if IF line 12 of bkgnd field (4) > 0.1 THEN put modifiers & "nickeloan " into modifiers end if IF line 5 of bkgnd field (4) > 0.1 THEN put modifiers & "vanadian " into modifiers end if IF line 16 of bkgnd field (4) > 0.1 THEN put modifiers & "strontian " into modifiers end if put prefixes & fluoro & chloro & mangano & permangano & potassic & sodic & titano & alumino & mangani & ferri & chromio into prefixes If groupwahl ="False" then put " no amphibole name given" into amph put "X" into bg fld(65) else set numberformat to "0" put ampgroup into bg fld(65) end if put group into bg fld(37) if ampgroup = 1 then put length of prefixes -1 into chrs put character chrs of prefixes into v if v ="i" or v="o" then delete last char of prefixes end if if amph1 is not empty then put modifiers && prefixes & amph1 into line 2 of bg fld(38) end if if amph is not empty then if character chrs of prefixes ="c" then if first char of amph ="a" then delete last char of prefixes end if else end if if norhombic is 0 then put modifiers && prefixes & amph into line 1 of bg fld(38) end if else end if else put first character of amph into f if f <> "a" and f <> "e" and f <> "i" and f <> "o" and f <> "u" then delete last char of prefixes put last character of prefixes into v put first char of amph into w if v = "i" or v="o" then if w ="a" or w="e" or w="o" or w="u" then put prefixes &"-" into prefixes end if end if if last character of prefixes ="c" and first char of amph ="c" then put prefixes &"-" into prefixes end if end if put modifiers && prefixes & amph into line 2 of bg fld(38) end if set numberformat to "0" -- amphibolegroup statistics if bg fld(65) = "X" then add 1 to line 6 of bg fld(64) else add 1 to line bg fld(65) of bg fld(64) end if --put factor * xfactor into xp1 --set numberformat to "0.0000" --put factor * xfactor into xp2 if hilite of bg button(3) is true or (hilite of bg button (1) is true and line 26 of bg fld (4) <>24) then set numberformat to ".00" unlock screen if line 8 of bg fld(4) > 0 then put line 8 of bg fld(4)/factor/Nfactor/line 8 of cf into line 1 of bg fld(23) put line 11 of bg fld(4)/factor/Nfactor/line 11 of cf into line 2 of bg fld(23) end if end if unlock screen end mouseup |3  new analysison mouseUp lock screen go last card domenu "new card" unlock screen end mouseUp<4*  deleteon mouseUp global ampgroup lock screen answer "Delete how many cards?" with "This card" or "multiple" or "Cancel" if it is "This card" then if number of cards is 2 THEN doMenu "new card" go to previous card end if groupcount doMenu "delete card" if number of this card is 1 then go to last card of background analysis end if put "marked cards" && number of marked cards into bg fld(61) else if it is "multiple" then answer "delete cards?" with "marked cards" or "all cards" or "Cancel" if it is "all cards" then answer "Do you really want to delete all cards?" with "Yes" or "Cancel" if it is "Yes" then go to first card of bg analysis doMenu "new card" go to previous card doMenu "delete card" go to next card repeat until number of cards < 3 domenu "delete card" end repeat go to card 1 of bg analysis repeat with count= number of lines of bg fld(64) down to 1 delete line count of bg fld(64) end repeat else exit mouseup end if else if it is "Cancel" then exit mouseup else if number of cards-1 is number of marked cards then go to last card of bg analysis doMenu "new card" go to previous card groupcount domenu "delete card" end if go to first marked card repeat until number of marked cards < 1 groupcount doMenu "delete card" go to next marked card end repeat go to last card of bg analysis put "marked cards" && number of marked cards into bg fld(61) end if end if end mouseup on groupcount set numberformat to "0" if bg fld(65) is not empty then if bg fld(65) = "X" then put line 6 of bg fld(64)-1 into line 6 of bg fld(64) if line 6 of bg fld(64) = 0 then put empty into line 6 of bg fld(64) end if else put line bg fld(65) of bg fld(64)-1 into line bg fld(65) of bg fld(64) if line bg fld(65) of bg fld(64) = 0 then put empty into line bg fld(65) of bg fld(64) end if end if end if end groupcount 45,K  sorton mouseUp answer "Sort all cards of this stack according to:" with "Sample" or "AMPH-Name" or "Cancel" if it is "Sample" then sort ascending by bkgnd field (21) if it is "AMPH-Name" then sort by last word of second line of bkgnd field (38) go to last card end mouseUp 6Mq  printon mouseUp lock screen push card answer "Print multiple cards or single card?" with "Multiple Cds" or "This Card" or "Cancel" if it = "Cancel" then exit mouseup else if it = "This Card" then doMenu Print Card else if it = "Multiple Cds" then answer "All cards of stack or selection only?" with "All cards" or "Selected cds" or "Cancel" if it is "Cancel" then exit mouseUp else if it is "All cards" then go second cd doMenu Print Stack... else if it is "Selected cds" then answer "Selection by Sample or by AMPH-Name?" with "Sample" or "AMPH-Name" or "cancel" if it is "Cancel" then exit mouseUp else if it is "Sample" then put "21" into search_field else if it is "AMPH-Name" then put "38" into search_field end if ask "Please enter your search string " with "search string" put it into search_string put the number of cards into counter go card 2 repeat with j = 2 to counter if search_string is in background field search_field then doMenu Print Card go next card else go next next repeat end if end repeat end if end if put "Done with printing!" wait 1 seconds hide message pop card unlock screen end mouseUp 7s  fileon mouseUp push card put the number of cards into counter go to second card ask file "Name of Output-file" put it into tfilename put "Writing to file " & tfilename & ". Please wait..."into message if counter <= 255 then put 1 into times else put (counter+254) div 255 into times end if put 2 into start if counter <= 255 then put counter into final else put 256 into final repeat with k=1 to times open file tfilename write "Name" & tab to file tfilename repeat with j=start to final if line 1 of bg fld (38) of card J is not empty then write (line 1 of bg fld "amphname" of card j) to file tfilename write " " to file tfilename end if write (line 2 of bg fld (38) of card j) to file tfilename write tab to file tfilename end repeat -- Sample write return & "Sample" & tab to file tfilename repeat with j=start to final write (bg fld (21) of card j) & tab to file tfilename end repeat -- Ox.wt% repeat with k=1 to 27 write return & line k of bg fld(1) & tab to file tfilename repeat with j=start to final write (line k of bkgnd field (2) of card j) & tab to file tfilename end repeat end repeat write return & "Fe2O3 c." & tab to file tfilename repeat with j=start to final write (line 1 of bkgnd field (23) of card j) & tab to file tfilename end repeat write return & "FeO c." & tab to file tfilename repeat with j=start to final write (line 2 of bkgnd field (23) of card j) & tab to file tfilename end repeat -- T repeat with k=1 to 4 write return & line k of bg fld(5) & tab to file tfilename repeat with j=start to final write (line k of bkgnd field (6) of card j) & tab to file tfilename end repeat end repeat -- C repeat with k = 2 to 3 write return & line k of bg fld(5) & tab to file tfilename repeat with j=start to final write (line (k-1) of bkgnd field (8) of card j) & tab to file tfilename end repeat end repeat repeat with k = 1 to 13 write return & line k of bg fld(7) & tab to file tfilename repeat with j=start to final write (line (k+3) of bkgnd field (8) of card j) & tab to file tfilename end repeat end repeat -- B repeat with k = 5 to 12 write return & line k of bg fld(7) & tab to file tfilename repeat with j=start to final write (line (k-4) of bkgnd field (10) of card j) & tab to file tfilename end repeat end repeat repeat with k = 1 to 5 write return & line k of bg fld(9) & tab to file tfilename repeat with j=start to final write (line (k+9) of bkgnd field (10) of card j) & tab to file tfilename end repeat end repeat -- A repeat with k = 1 to 4 write return & line k of bg fld(9) & tab to file tfilename repeat with j=start to final write (line k of bkgnd field (12) of card j) & tab to file tfilename end repeat end repeat repeat with k = 1 to 2 write return & line k of bg fld(11) & tab to file tfilename repeat with j=start to final write (line (k+5) of bkgnd field (12) of card j) & tab to file tfilename end repeat end repeat -- param write return & "catsum" & tab to file tfilename repeat with j=start to final write (line 21 of bg fld(4) of card j) & tab to file tfilename end repeat write return & "OH" & tab to file tfilename repeat with j=start to final write (line 22 of bg fld(4) of card j) & tab to file tfilename end repeat write return & "F" & tab to file tfilename repeat with j=start to final write (line 23 of bg fld(4) of card j) & tab to file tfilename end repeat write return & "Cl" & tab to file tfilename repeat with j=start to final write (line 24 of bg fld(4) of card j) & tab to file tfilename end repeat write return & "sumO(3)" & tab to file tfilename repeat with j=start to final write (line 25 of bg fld(4) of card j) & tab to file tfilename end repeat write return & "Oxeq" & tab to file tfilename repeat with j=start to final write (line 26 of bg fld(4) of card j) & tab to file tfilename end repeat write return & "(Mg+Fe+Mn+Li)B" & tab to file tfilename repeat with j=start to final write (bg fld(29) of card j) & tab to file tfilename end repeat write return & "(Ca+Na)B" & tab to file tfilename repeat with j=start to final write (bg fld(31) of card j) & tab to file tfilename end repeat write return & "NaB" & tab to file tfilename repeat with j=start to final write (bg fld(30) of card j) & tab to file tfilename end repeat write return & "(Na+K)A" & tab to file tfilename repeat with j=start to final write (bg fld(32) of card j) & tab to file tfilename end repeat write return & "Mg/(Mg+Fe2)" & tab to file tfilename repeat with j=start to final write (bg fld(33) of card j) & tab to file tfilename end repeat write return & "Mg/(Mg+Mn)" & tab to file tfilename repeat with j=start to final write (bg fld(34) of card j) & tab to file tfilename end repeat close file tfilename add 255 to start add 255 to final if counter < final then put counter into final end if put tfilename & numtochar(65+k) into tfilename end repeat put "Done ..." wait 2 sec hide message pop card end mouseUp";()H  "<)$ ">("$4 "@(#=0O "A('  "B( - "C(6D  "D(<I "E(6lD  "F(;H "G(Le  "H(S` "I(Mhg  "J(Ta "K({  "L(w "M(w  "N(z`  "O(v~ "P(v "Q(vWi vTD^$U  Previous cardon mouseUp --global neu go to previous card --put 0 into neu end mouseUppU_yi  Next cardon mouseUp --global neu go to next card -- put 0 into neu end mouseUpVB mark cardon mouseUp put the hilite of bg button "mark card" into checkbox IF checkbox is true then mark card else unmark card end if lock screen -- put "Card" && number of this card-1 && " of" && number of cards-1 -- into background field "Card Number" put "marked cards" && number of marked cards into bg fld "Cardmarking" unlock screen end mouseUpW Card Numberon deleteField -- When you delete this field this script automatically deletes -- another script that updates the card numbers. -- That script is in the background. set script of background "Address Template" to empty end deleteFieldX ^ Cardmarkingon deleteField -- When you delete this field this script automatically deletes -- another script that updates the card numbers. -- That script is in the background. --set script of background "Address Template" to empty end deleteField,Y)08| statistics*Z9B[@ amphgroup*\99]|@ amphcount"]MZ "^ [ SiO2 TiO2 ZrO2 Al2O3 V2O3 Cr2O3 Mn2O3 Fe2O3 MgO MnO FeO NiO CoO ZnO CaO SrO BaO Li2O Na2O K2O H2O F Cl Total -O=F,Cl Total H2O calc.*   >? JK V Si Ti Zr Al V Cr Mn3+ Fe3+ Mg Mn Fe Ni Co Zn Ca Sr Ba Li Na K S c OH F Cl S a An, Ox +Charge&  Si Al Ti S T\.  "%*+ -Fe3+ V Cr Mn3+ Zr Mg Zn Ni Co Fe2+ Mn2+ Li S C ! Ca Sr Ba Na S B  K S A wt%cationsSAMPLE= AMPH-IMA 2004 A. Mogessie, K. Ettinger & B.E. Leake calculation scheme24 anions or 23 (O)-normalised 23 (O) without normalisation 23 (O)- Fe2O3 as FeO, Mn2O3 as MnO normalisedTCBA classification parameter  warning;(Mg+Fe +Mn +Li)<2+>2+@BANaBBC(Ca+Na)DBE(Na+K)FAG Mg Mg+FeH2+I Mg Mg+MnJ2+KMn +MnL2+M3+NAl+Fe +Fe +MgO3+P2+QVI% Fe2O3 calc FeO calc.hiliteXmarked cards 0Z#1 #2 #3 #4 #5 n.a.Ygroup counter^actualanalysison openCard global neu put 0 into neu set numberformat to "0" put "Card" && number of this card-1 && " of" && number of cards-1 into background field "Card Number" end openCard on normalization factor global cq, oq, cf, kf, fe2,fe3 set the numberformat to "0.00000" put 0 into catot put 0 into tempanionsum set numberformat to "0.000" repeat with i=1 to 23 put line i of cq * factor into line i of tempcation if (i <=20) then add line i of oq * factor to tempanionsum add line i of cq * factor to catot end if end repeat if kf <> 1 then put 23 into XO else put 23.5 into XO end if if hilite of bg btn(2) is false then put 2*(XO-tempanionsum) into fe3 if fe3 <0 then put 0 into fe3 put line 11 of cq * factor-fe3 into fe2 if fe3 > line 11 of cq * factor then set the numberformat to "0.000" put line 11 of cq*factor into fe3 put 0 into fe2 end if unlock screen -- if hilite of bg button(3) is true or (hilite of bg button (1) is true --and line 26 of bg fld (4) =23) then -- set the numberformat to "0.00" -- put fe3/factor/line 8 of cf into line 1 of bg fld(23) -- put fe2/factor/line 11 of cf into line 2 of bg fld(23) --set the numberformat to "0.000" --end if end if repeat with i= 1 to 20 put line i of tempcation into line i of bg fld (4) put catot into line 21 of bg fld(4) end repeat if kf <> 1 then put fe3 into line 8 of bg fld(4) put fe2 into line 11 of bg fld(4) end if end normalization on siteoccupancies global normal, Dellav set the numberformat to "0.000" lock screen --if Dellav is "false" then -- charge calculation put (line 1 of bg fld(4)+line 2 of bg fld(4) + line 3 of bg fld(4))*4+ (line 4 of bg fld(4)+ line 5 of bg fld(4)+line 6 of bg fld(4)+ line 7 of bg fld(4)+ line 8 of bg fld(4))*3+ (line 9 of bg fld(4)+line 10 of bg fld(4)+line 11 of bg fld(4)+line 12 of bg fld(4)+line 13 of bg fld(4)+ line 14 of bg fld(4)+line 15 of bg fld(4)+line 16 of bg fld(4)+ line 17 of bg fld(4))*2+ line 18 of bg fld(4)+line 19 of bg fld(4)+ line 20 of bg fld(4) into line 27 of bg fld(4) if line 26 of bg fld(4) = 24 and normal is true then add line 22 of bg fld (4) to line 27 of bg fld(4) end if -- T site assignment if line 1 of bg fld (4) >=8 then put line 1 of bg fld(4) into line 1 of bg fld (6) put 0 into line 2 of bg fld(6) put 0 into line 3 of bg fld(6) else if line 1 of bg fld(4)+line 4 of bg fld(4) >=8 then put 8 - line 1 of bg fld(4) into line 2 of bg fld(6) put 0 into line 3 of bg fld(6) else if line 1 of bg fld(4)+ line 4 of bg fld(4)+ line 2 of bg fld(4) >= 8 then put 8 -line 1 of bg fld(4)-line 4 of bg fld(4) into line 3 of bg fld(6) else put line 2 of bg fld(4) into line 3 of bg fld(6) end if put line 4 of bg fld(4) into line 2 of bg fld(6) end if put line 1 of bg fld(4) into line 1 of bg fld(6) end if put line 4 of bg fld(4) -line 2 of bg fld(6) into line 1 of bg fld(8) put line 2 of bg fld(4) -line 3 of bg fld(6) into line 2 of bg fld(8) put line 1 of bg fld(6) + line 2 of bg fld(6) + line 3 of bg fld(6) into line 4 of bg fld(6) -- C site assigment put 0 into Cexcess put line 8 of bg fld(4) into line 4 of bg fld(8) --Fe3+ put line 5 of bg fld(4) into line 5 of bg fld(8) --V put line 6 of bg fld(4) into line 6 of bg fld(8) --Cr3+ put line 7 of bg fld(4) into line 7 of bg fld(8) --Mn3+ put line 3 of bg fld(4) into line 8 of bg fld(8) --Zr put line 9 of bg fld(4) into line 9 of bg fld(8) --Mg put line 14 of bg fld(4) into line 10 of bg fld(8) --Zn put line 12 of bg fld(4) into line 11 of bg fld(8) --Ni put line 13 of bg fld(4) into line 12 of bg fld(8) --Co put line 11 of bg fld(4) into line 13 of bg fld(8) --Fe2+ put line 10 of bg fld(4) into line 14 of bg fld(8) --Mn2+ put line 18 of bg fld(4) into line 15 of bg fld(8) --Li put 0 into sumC put 15 into j repeat with i= 1 to 15 add line i of bg fld(8) to sumC if sumC > 5 then put i into j exit repeat end if end repeat if sumC < 5 then put sumC into line 16 of bg fld(8) add 1 to j else put sumC-5 into line j-7 of bg fld(10) put 5 into line 16 of bg fld(8) put line j of bg fld(8) - line j-7 of bg fld(10) into line j of bg fld(8) repeat with i= j+1 to 15 put line i of bg fld(8) into line i-7 of bg fld(10) put 0 into line i of bg fld(8) end repeat end if repeat with i=1 to j-8 put 0 into line i of bg fld(10) end repeat -- B put 0 into sumB put 0 into Bexcess put line 15 of bg fld(4) into line 10 of bg fld(10) -- Ca put line 16 of bg fld(4) into line 11 of bg fld(10) -- Sr put line 17 of bg fld(4) into line 12 of bg fld(10) -- Ba put line 19 of bg fld(4) into line 13 of bg fld(10) -- Na put 13 into j repeat with i=1 to 8 add line i of bg fld(10) to sumB end repeat if sumB >= 2 then put sumB into line 14 of bg fld(10) repeat with i=10 to 13 put line i of bg fld(10) into line i-9 of bg fld(12) put 0 into line i of bg fld(10) end repeat else repeat with i=10 to 13 add line i of bg fld(10) to sumB if sumB > 2 then put i into j exit repeat end if end repeat if sumB < 2 then put sumB into line 14 of bg fld(10) add 1 to j else put sumB -2 into line j-9 of bg fld(12) put line j of bg fld(10)-line j-9 of bg fld(12) into line j of bg fld(10) put 2 into line 14 of bg fld(10) repeat with i=j+1 to 13 put line i of bg fld(10) into line i-9 of bg fld(12) put 0 into line i of bg fld(10) end repeat end if -- A site assigment repeat with i=1 to j-10 put 0 into line i of bg fld(12) end repeat end if put 0 into sumA put line 20 of bg fld(4) into line 6 of bg fld(12) repeat with i= 1 to 6 add line i of bg fld(12) to sumA end repeat put sumA into line 7 of bg fld(12) -- Warning display put "" into bg fld(27) set the numberformat to "0.000" if line 1 of bg fld(6) > 8 then put "Si ="&& line 1 of bg fld(6) && "in T is > 8" &return into bg fld(27) end if if line 4 of bg fld(6) < 8 then put bg fld(27) &"Sum of T-cations =" && line 4 of bg fld(6)&& "is < 8" & return into bg fld(27) end if if line 16 of bg fld(8) < 5 then put bg fld(27) &"Sum of C-cations =" && line 16 of bg fld(8) && "is < 5" & return into bg fld(27) else if line 16 of bg fld(8) > 5 then put bg fld(27) &"Sum of C-cations =" && line 16 of bg fld(8) && "is > 5" & return into bg fld(27) end if end if if line 14 of bg fld(10) < 2 then put bg fld(27) &"Sum of B-cations =" && line 14 of bg fld(10) && "is < 2" & return into bg fld(27) else repeat with i=1 to 8 if line i of bg fld(10) > 2 then put bg fld(27) & "in B:" && line i+4 of bg fld(7) && "=" && line i of bg fld(12) && "is > 2" &return into bg fld(27) end if end repeat repeat with i=10 to 13 if line i of bg fld(10) > 2 then put bg fld(27) & "in B:" && line i-9 of bg fld(9) && "=" && line i of bg fld(12) && "is > 2" &return into bg fld(27) end if end repeat if line 14 of bg fld(10) > 2 then put bg fld(27) &"Sum of B-cations =" && line 14 of bg fld(10) && "is > 2" & return into bg fld(27) end if end if repeat with i= 1 to 4 if line i of bg fld(12) > 1 then put bg fld(27) & "in A:" && line i of bg fld(9) && "=" && line i of bg fld(12) && "is > 1" &return into bg fld(27) end if end repeat if line 6 of bg fld (12) > 1 then put bg fld(27) &"K =" && line 6 of bg fld(12) && "is > 1" & return into bg fld(27) end if if line 7 of bg fld (12) > 1 then put bg fld(27) &"Sum of A-cations =" && line 7 of bg fld(12) && "is > 1" & return into bg fld(27) end if put line 2 of bg fld(10)+line 6 of bg fld(10)+ line 7 of bg fld(10) + line 8 of bg fld(10) into bg fld(29) --(Mg+Fe2+Mn2+Li)B put line 13 of bg fld(10) into bg fld (30) -- NaB put line 10 of bg fld(10)+ line 13 of bg fld (10) into bg fld(31) --(Ca+Na)B put line 4 of bg fld(12)+line 6 of bg fld(12) into bg fld(32) --(Na+K)A if line 9 of bg fld(4)+ line 11 of bg fld(4) >0 then put line 9 of bg fld(4)/(line 9 of bg fld(4)+ line 11 of bg fld(4)) into bg fld(33) -- XMg else put 0 into bg fld(33) end if if line 9 of bg fld(4)+ line 10 of bg fld(4) >0 then put line 9 of bg fld(4)/(line 9 of bg fld(4)+ line 10 of bg fld(4)) into bg fld(34) -- XMg* else put 0 into bg fld(34) end if put line 10 of bg fld(4)+ line 7 of bg fld(4) into bg fld(35) --Mn tot put line 1 of bg fld(8)+line 8 of bg fld(4) +line 11 of bg fld(4)+ line 9 of bg fld(4) into bg fld(36) -- AlVi+Fe tot+Mg end siteoccupancies on Febalance -- charge calculation set the numberformat to "0.000" put (line 1 of bg fld(4)+line 2 of bg fld(4) + line 3 of bg fld(4))*4+ (line 4 of bg fld(4)+ line 5 of bg fld(4)+line 6 of bg fld(4)+ line 7 of bg fld(4)+ line 8 of bg fld(4))*3+ (line 9 of bg fld(4)+line 10 of bg fld(4)+line 11 of bg fld(4)+line 12 of bg fld(4)+line 13 of bg fld(4)+ line 14 of bg fld(4)+line 15 of bg fld(4)+line 16 of bg fld(4)+ line 17 of bg fld(4))*2+ line 18 of bg fld(4)+line 19 of bg fld(4)+ line 20 of bg fld(4) into line 27 of bg fld(4) put line 27 of bg fld(4) - 46 into change put line 8 of bg fld(4)*3 + line 11 of bg fld(4)*2 into FeL if change > 0 then if line 8 of bg fld(4) >change then subtract change from line 8 of bg fld(4) add change to line 11 of bg fld(4) else add line 8 of bg fld(4) to line 11 of bg fld(4) put 0 into line 8 of bg fld(4) end if else if line 11 of bg fld(4)> abs(change) then add abs(change) to line 8 of bg fld(4) add change to line 11 of bg fld(4) else add line 11 of bg fld(4) to line 8 of bg fld(4) put 0 into line 11 of bg fld(4) end if end if add (line 8 of bg fld(4)*3 + line 11 of bg fld(4)*2-FeL) to line 27 of bg fld(4) --siteoccupancies end Febalance on Mndistribution charge --global fe2, fe3 if hilite of bg btn(2) is true then exit Mndistribution if line 10 of bg fld(4) >= line 11 of bg fld(4) then if charge- line 27 of bg fld(4) <= line 10 of bg fld(4) then put charge - line 27 of bg fld(4) into Mn3inc add Mn3inc to line 7 of bg fld(4) --add charge - line 27 of bg fld(4) to line 7 of bg fld(4) put line 10 of bg fld(4) - Mn3inc into line 10 of bg fld(4) else put line 10 of bg fld(4) into Mn3inc add Mn3inc to line 7 of bg fld(4) put 0 into line 10 of bg fld(4) end if add Mn3inc to line 27 of bg fld(4) end if if charge - line 27 of bg fld(4) > 0 then if line 11 of bg fld(4) >= charge - line 27 of bg fld(4) then put charge - line 27 of bg fld(4) into Fe3inc add Fe3inc to line 8 of bg fld(4) put line 11 of bg fld(4) - Fe3inc into line 11 of bg fld(4) else put line 11 of bg fld(4) into Fe3inc add Fe3inc to line 8 of bg fld(4) put 0 into line 11 of bg fld(4) end if add Fe3inc to line 27 of bg fld(4) end if put line 22 of bg fld(4) + line 23 of bg fld(4) + line 24 of bg fld(4) into line 25 of bg fld(4) siteoccupancies end MndistributionBMAPZT[\ BKGD# 0"+ "-y "/J "0~ P*? New Buttonon mouseUp go next card end mouseUp BEGIN @BMAPCARD" @#Oy? QUIT-- Quitting EMP-AMPH on mouseUp if the freeSize of this stack > 1000 then -- answer "Compacting stack " doMenu Compact Stack end if if menuItem 3 of menu "File" is "Close Stack" then --if property of menuItem 3 of menu "File" is set to true then if the enabled of menuItem 3 of menu "File" is true then doMenu Close Stack else doMenu Quit Hypercard end if else doMenu Quit Hypercard end if end mouseUp +/A. Mogessie, K. Ettinger, B.E. Leake 2004 -Welcome to AMPH-IMA 2004/S This program can be used in conjunction with the IMA amphibole classification scheme 2004 by A. Mogessie, K. Ettinger and B.E. Leake (compiled from Leake et al. 1997 and 2004). The amphibole classification scheme is published (2004) as a chart by the Mineralogical Society, 41 Queen's Gate, London SW7 5HR, UK (www.minersoc.org) 0--click on card to continue --FirstCard@BMAP `CARD  W Card 1 of 1`STBL K          (_N^NuNVHB->JfNv`B/-/