DECLARE FUNCTION maj$ (chaine$)
DECLARE SUB centre (p, a$)
DECLARE FUNCTION trunc (number)
CLEAR
CLS
CALL centre(1, "Equation de JORGENSEN pour les complexes des metaux de Transitions")
CALL centre(2, "(c) 1993 Gilles OLIVE - Version PC 1.01 du 26 novembre 1993")
CALL centre(5, "Calcul de Delta O pour Complexe ML6 Oh")
CALL centre(6, " _______________")
PRINT
DIM confi(5), confi$(5), tempo$(5)
DIM metal$(12, 7)
FOR n% = 1 TO 12
READ metal$(n%, 1), metal$(n%, 2), metal$(n%, 3), metal$(n%, 4), metal$(n%, 5), metal$(n%, 6), metal$(n%, 7)
NEXT n%
DIM ligand$(14, 7)
FOR n% = 1 TO 14
READ ligand$(n%, 1), ligand$(n%, 2), ligand$(n%, 3), ligand$(n%, 4), ligand$(n%, 5), ligand$(n%, 6), ligand$(n%, 7)
NEXT n%
DIM couleur(9, 2), couleur$(9, 2)
FOR n% = 1 TO 9
READ couleur(n%, 1), couleur(n%, 2), couleur$(n%, 1), couleur$(n%, 2)
NEXT n%
DO
DO
PRINT "Metaux possibles:";
FOR n% = 1 TO 12
PRINT " "; metal$(n%, 1); ";";
IF n% = 6 THEN PRINT : PRINT TAB(17);
NEXT n%
PRINT : PRINT
PRINT "Quit pour Sortir"
PRINT
INPUT "Donnez le metal "; rep$
IF maj$(rep$) = "QUIT" THEN GOTO 6000
g = 0
FOR n% = 1 TO 12
IF maj$(metal$(n%, 1)) = maj$(rep$) THEN
complexe$ = " [ " + metal$(n%, 1) + " (d" + metal$(n%, 3) + ")"
g = VAL(metal$(n%, 2)) * 1000
K = VAL(metal$(n%, 6))
poidsmol = VAL(metal$(n%, 7))
electron = VAL(metal$(n%, 3))
electronmetal = VAL(metal$(n%, 3))
charge = VAL(metal$(n%, 4))
pairing$ = metal$(n%, 5)
END IF
IF g <> 0 THEN EXIT FOR
NEXT n%
LOOP UNTIL g <> 0
PRINT "Ligandes possibles: ";
FOR n% = 1 TO 14
PRINT ligand$(n%, 2); " ["; ligand$(n%, 1); "];";
IF n% = 4 OR n% = 7 OR n% = 10 OR n% = 12 OR n% = 13 THEN PRINT : PRINT TAB(20);
NEXT n%
PRINT
PRINT TAB(20); "-:Veut dire pas de ligande"
PRINT
PRINT "Quit pour Sortir"
PRINT
f = 0
h = 0
m% = 1
DO
DO
PRINT "Donnez le ligande "; m%; " (Lettres entre [] au dessus) ";
INPUT rep$
IF maj$(rep$) = "QUIT" OR rep$ = "-" THEN EXIT DO
GOSUB 1000
IF fl <> 0 THEN EXIT DO
LOOP
IF maj$(rep$) = "QUIT" THEN GOTO 6000
IF rep$ = "-" THEN fl = 0: h$ = "0"
f = f + fl
IF h$ <> "Inc" AND h >= 0 THEN h = h + VAL(h$) ELSE h = -1
IF m% = 6 THEN EXIT DO
m% = m% + 1
LOOP
IF maj$(rep$) = "QUIT" THEN GOTO 6000
f = f / 6
h = h / 6
delta = g * f
lambda = 1 / delta * 100000000
l = lambda: GOSUB 2000
absorbee$ = a$
complementaire$ = c$
temperature = (6.6260755D-34 * 299792458 * delta) / 1.380658E-23
b = 1 - (h * K)
IF h >= 0 THEN b$ = "= " + STR$(b) ELSE b$ = "est INCONNU"
' k$ = "CON:"
' e$ = ""
' DO
PRINT "Complexe : "; complexe$; " ]"; ABS(charge); MID$("- +", 2 + SGN(charge), 1); " ("; electron; " electrons) (PM="; poidsmol; " g/mol)"
IF VAL(pairing$) <> 0 THEN
IF delta > VAL(pairing$) THEN sp$ = "W" ELSE sp$ = "S"
ELSE sp$ = pairing$
END IF
IF sp$ = "W" THEN spin$ = "faible" ELSE IF sp$ = "S" THEN spin$ = "FORT" ELSE spin$ = "Inconnu"
PRINT "Complexe a Spin "; spin$
IF sp$ = "S" THEN
nbrelectron = electronmetal: GOSUB 3000
GOSUB 5000
confi$ = confi$ + " (æs=" + STR$(SQR(neceli * (neceli + 2))) + ")"
END IF
IF sp$ = "W" THEN
nbrelectron = electronmetal: GOSUB 4000
GOSUB 5000
confi$ = confi$ + " (æs=" + STR$(SQR(neceli * (neceli + 2))) + ")"
END IF
espinw$ = ""
espins$ = ""
musw$ = ""
muss$ = ""
IF sp$ = "I" THEN
nbrelectron = electronmetal: GOSUB 4000
GOSUB 5000
FOR n = 1 TO 5: tempo$(n) = "": NEXT n
FOR n = 1 TO 5: tempo$(n) = confi$(n): NEXT n
tempo$ = confi$
IF confi(1) <> 2 THEN
energie = 0
multi = -2 / 5
FOR n = 1 TO 5: energie = energie + confi(n) * multi * delta
IF n = 3 THEN multi = 3 / 5
NEXT n
espinw$ = "E sf=" + STR$(trunc(energie)) + " cm^-1"
ELSE
espinw$ = "E sf= Impossible"
END IF
musw$ = "æs sf=" + STR$(SQR(neceli * (neceli + 2)))
nbrelectron = electronmetal: GOSUB 3000
GOSUB 5000
FOR n = 1 TO 5
IF n <> 1 THEN
confi$(n) = confi$(n) + " " + tempo$(n)
ELSE
confi$(n) = confi$(n) + "Spin FORT " + tempo$(n) + "Spin faible"
END IF
NEXT n
confi$ = confi$ + " " + tempo$
IF confi(1) <> 2 THEN
energie = 0
multi = -2 / 5
FOR n = 1 TO 5: energie = energie + confi(n) * multi * delta
IF n = 3 THEN multi = 3 / 5
NEXT n
espins$ = "E SF=" + STR$(trunc(energie)) + " cm^-1"
ELSE
espins$ = "E SF= Impossible"
END IF
muss$ = "æs SF=" + STR$(SQR(neceli * (neceli + 2)))
MID$(confi$(5), 12, 2) = "ou"
END IF
energie = 0
multi = -2 / 5
IF VAL(pairing$) <> 0 THEN
FOR n = 1 TO 5
energie = energie + confi(n) * multi * delta
IF confi(n) = 2 THEN energie = energie + VAL(pairing$)
IF n = 3 THEN multi = 3 / 5
NEXT n
PRINT "Energie totale complexe:"; trunc(energie); " cm^-1 (Energie d'appariement:"; pairing$; " cm^-1)"
ELSE
IF confi(1) <> 2 AND sp$ <> "I" THEN
FOR n = 1 TO 5
energie = energie + confi(n) * multi * delta
IF n = 3 THEN multi = 3 / 5
NEXT n
PRINT "Energie totale complexe:"; trunc(energie); " cm^-1"
ELSE
IF sp$ = "I" THEN
PRINT "Voir l'energie totale complexe en dessous"
ELSE
PRINT "Energie totale complexe inconnue car energie d'appariement non connue !"
END IF
END IF
END IF
PRINT "Configuration electronique:"; TAB(30); confi$(5)
PRINT TAB(25); "eg*"; TAB(30); confi$(4)
PRINT CHR$(13)
PRINT espins$; TAB(30); confi$(3)
PRINT muss$; TAB(25); "t2g*"; TAB(30); confi$(2)
PRINT espinw$; TAB(30); confi$(1)
PRINT musw$; TAB(25); confi$
PRINT "Delta o = "; delta; " cm^-1 (E="; delta * 299792458 * 6.6260755D-34 * 100 * 6.0221367D+23; " joules/mole = ";
PRINT (delta * 299792458 * 6.6260755D-34 * 100 * 6.0221367D+23) / 1.60217733D-19; " eV/mole)"
PRINT "Temperature = "; temperature; " K ("; temperature - 273.15; " øC)"
PRINT "Lambda = "; lambda; " Amgstrom (E="; 299792458 * 6.6260755D-34 / (lambda * 1E-10); " joules/molecules = ";
PRINT (299792458 * 6.6260755D-34 / (lambda * 1E-10)) / 1.60217733D-19; " eV/molecules)"
PRINT "Couleur Absorbee : "; absorbee$;
PRINT " - Couleur probable du Complexe : "; complementaire$
PRINT "á (Serie Nephelauxetique) "; b$
PRINT "Toutes choses etant egales par ailleurs :"
PRINT "Delta t = "; 4 * delta / 9; " cm^-1"
lambda2 = 1 / (4 * delta / 9) * 1E+08
PRINT "Lambda2 = "; lambda2; " Amgstrom"
l = lambda2: GOSUB 2000
absorbee2$ = a$
complementaire2$ = c$
PRINT "Couleur Absorbee : "; absorbee2$;
PRINT " - Couleur probable du Complexe : "; complementaire2$
PRINT SPC(30); "Appuyez sur une touche";
10 IF INKEY$ = "" THEN 10
' LOOP
PRINT "-----------------------------------------------------------------------------"
PRINT : PRINT
LOOP
1000 fl = 0
h$ = ""
FOR n% = 1 TO 14
IF maj$(rep$) = maj$(ligand$(n%, 1)) THEN
fl = VAL(ligand$(n%, 3))
complexe$ = complexe$ + ", " + ligand$(n%, 1)
electron = electron + VAL(ligand$(n%, 4))
charge = charge + VAL(ligand$(n%, 5))
poidsmol = poidsmol + VAL(ligand$(n%, 7))
h$ = ligand$(n%, 6)
END IF
NEXT n%
IF fl = 0 THEN
PRINT "Ligandes possibles:";
FOR n% = 1 TO 14
IF n% = 9 THEN PRINT : PRINT TAB(9);
PRINT " ["; ligand$(n%, 1); "];";
NEXT n%
PRINT
END IF
RETURN
2000 IF l < 4000 THEN
a$ = "Ultra Violet"
c$ = "Ultra Violet"
ELSE
IF l > 7200 THEN
a$ = "Infra Rouge"
c$ = "Infra Rouge"
ELSE
FOR n% = 1 TO 9
IF l > couleur(n%, 1) AND l < couleur(n%, 2) THEN
a$ = couleur$(n%, 1)
c$ = couleur$(n%, 2)
END IF
NEXT n%
END IF
END IF
RETURN
3000 FOR n = 1 TO 5: confi(n) = 0: NEXT n
compteur = 1
nbre = 0
DO
IF nbre = nbrelectron THEN EXIT DO
confi(compteur) = confi(compteur) + 1
nbre = nbre + 1
IF compteur = 5 THEN compteur = 0
compteur = compteur + 1
LOOP
RETURN
4000 FOR n = 1 TO 5: confi(n) = 0: NEXT n
compteur = 1
total = 1
nbre = 0
DO
IF nbre = nbrelectron THEN EXIT DO
confi(compteur) = confi(compteur) + 1
nbre = nbre + 1
IF compteur = 3 AND total = 1 THEN compteur = 0: total = 2
IF compteur = 5 AND total = 2 THEN compteur = 3
compteur = compteur + 1
LOOP
RETURN
5000 FOR n = 1 TO 5: confi$(n) = "": NEXT n
confi$ = "Diamagnetique"
neceli = 0
FOR n = 1 TO 5
IF confi(n) = 0 THEN confi$(n) = "----"
IF confi(n) = 1 THEN confi$(n) = "-*--"
IF confi(n) = 2 THEN confi$(n) = "-**-"
IF confi(n) = 1 THEN confi$ = "Paramagnetique": neceli = neceli + 1
NEXT n
RETURN
DATA V(II),12.3,3,2,I,0.08,50.942,Cr(III),17.4,3,3,I,0.21,51.996,Mn(II),8.0,5,2,25500,0.07,54.938,Mn(IV),23,3,4,I,0.5,54.938,Fe(III),14.0,5,3,30000,0.24,55.847,Co(III),19.0,6,3,21000,0.35,58.933
DATA Ni(II),8.9,8,2,I,0.12,58.69,Mo(III),24,3,3,W,0.15,95.94,Rh(III),27,6,3,28000,0.30,102.91,Re(IV),35,3,4,W,0.2,186.2,Ir(III),32,6,3,W,0.3,192.22,Pt(IV),36,6,4,W,0.5,195.08
DATA F,6F-,0.9,2,-1,0.8,18.998,H2O,6H2O,1.00,2,0,1.0,18.02,Uree,6Uree,0.91,2,0,1.2,60.06,NH3,6NH3,1.25,2,0,1.4,17.03,en,3en (Ethylene Diamine),2.56,4,0,1.5,60.099
DATA ox,3ox-2 (Oxalate),1.96,4,-2,1.5,88.01,Cl,6Cl-,0.80,2,-1,2.0,35.453,CN,6CN-,1.7,2,-1,2.0,26.017,Br,6Br-,0.76,2,-1,2.3,79.904,dtp,3dtp- (Diethyldithiophosphate),1.72,4,-1,2.8,186.22,Py,6Py (Pyridine),1.25,2,0,Inc,79.10
DATA DMA,6DMA (Di Methyl Acetamide),0.85,2,0,Inc,87.12,DMSO,6DMSO (Di Methyl Sulfoxyde),0.91,2,0,Inc,78.13,DMF,6DMF (Di Methyl Formamide),0.98,2,0,Inc,73.10
DATA 4000,4200,Violet Jaune,Jaune Verdatre,4200,4450,Bleu Indigo,Jaune,4450,4900,Bleu,Orange
DATA 4900,5100,Bleu Vert,Rouge,5100,5300,Vert,Pourpre,5300,5450,Vert Jaune,Violet
DATA 5450,5800,Jaune,Bleu Indigo,5800,6300,Orange,Bleu,6300,7200,Rouge,Bleu Vert
6000 RANDOMIZE TIMER
a = RND
IF a < .35 THEN
CLS
CALL centre(1, "Equation de JORGENSEN pour les complexes des metaux de Transitions")
CALL centre(2, "(c) 1993 Gilles OLIVE - Version PC 1.0 du 1 mai 1993")
PRINT : PRINT
PRINT "JORGENSEN inaugure un nouveau concept qui est le 'ScienceWare'.Ce concept "
PRINT "se rencontre pour des logiciels scientifiques, et se base sur une collaboration"
PRINT "entre scientifiques. Ce concept se rapproche un peu du Shareware, mais au lieu"
PRINT "d'envoyer de l'argent pour avoir la derniere version, il suffit de me faire "
PRINT "parvenir une information manquante (par expl une energie d'appariement de spin)."
PRINT "Vous pouvez librement le copier tant que vous ne modifiez pas le message de"
PRINT "depart, ni la notice l'accompagnant."
PRINT
PRINT "Pour l'instant, pour avoir la derniere version (qui inclura d'office vos infor-"
PRINT "mations), fournissez une (ou plusieurs) donnee(s) ainsi que vos coordonnees a la"
PRINT "personne qui vous a fournit JORGENSEN, et ainsi de suite jusqu'a moi."
PRINT "Vous serez alors enregistres, et vous recevrez les dernieres versions."
PRINT
PRINT "Malgre les soins apportees et les nombreuses verifications effectuees, je ne"
PRINT "peux pas etre tenu responsable des erreurs comises par ce logiciel."
CALL centre(24, "Appuyer sur une touche")
6010 IF INKEY$ = "" THEN 6010
END IF
END
SUB centre (p, a$)
z% = 40 - (LEN(a$) / 2)
LOCATE p, z%: PRINT a$;
END SUB
FUNCTION maj$ (chaine$)
a$ = chaine$
FOR n = 1 TO LEN(a$)
IF MID$(a$, n, 1) >= "a" AND MID$(a$, n, 1) <= "z" THEN MID$(a$, n, 1) = CHR$(ASC(MID$(a$, n, 1)) - 32)
NEXT n
maj$ = a$
END FUNCTION
FUNCTION trunc (number)
IF number >= 0 THEN trunc = INT(number) ELSE IF INT(number) <> number THEN trunc = INT(number) + 1 ELSE trunc = INT(number)
END FUNCTION
(
geocities.com/tokyo)