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