Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
Sodium Chloride Bonding Model
#1
This is a program which tries to simulate the chemical bonding in a sodium chloride crystal by using the attractive and repulsive forces of sodium (positive) and chlorine (negative) ions moving to create a crystalline structure.  The movement of the ions has little relation to actual chemistry but the graphics output are absorbing to watch.  So I put this old program here.

   

The crystalline structure of sodium chloride is FCC (Face-centred Cubic).  In this model I start with sodium (smaller, red) ions and chlorine (larger, blue) ions in an FCC array.  Forces between the ions are modelled - electrostatic inverse-square and close chemical bonding, based very simply on orthogonal bonds (p-orbitals).  The orthogonal (x-, y-, z-) close bonding should ensure a cubic structure.


.zip   Sodium Chloride Bonding.zip (Size: 59.44 KB / Downloads: 18)
Unzip the file and extract the folder into your PEQB64 directory.  In the IDE make sure that you have the Run Option “Save EXE in source folder” checked.


When you first run the program, you need to set your normal mouse button.

At the start of the program, the ions quickly restructure themselves away from the FCC lattice into some other bonded array.  After about 2 minutes, other sodium-chlorine pairs are introduced and they get added to the structure.


The video is a clip of the running program:




This model is one of 9 which I made when playing with ionic sodium chloride bonding.  With various bonding assumptions.    I may add all the other models to this section for completeness.

Code: (Select All)
'Simple Model of Ionic Crystal v6 by Madgha 2025-12-16 ex Qwerkey

CONST False = 0, True = NOT False
CONST A0! = 100, A1! = 2, R0! = 250, R1! = 2.3, A2! = 200, R2! = 115, F2! = 3000, FMin! = -5 '-55
CONST TotMolecules%% = 125, NoSeed%% = 75, Atom! = 110, Xstal! = 0.98, Kelvin! = 0.35
CONST ChlorineSize%% = 35, SodiumSize%% = 25, ZOffset% = 730, ScreenX% = 1260, ScreenY% = 800, ThetaMax! = 0.5

DIM SHARED SodiumPos!(TotMolecules%% - 1, 2), ChlorinePos!(TotMolecules%% - 1, 2), NoMolecules%%
DIM SHARED SodiumVel!(TotMolecules%% - 1, 2), ChlorineVel!(TotMolecules%% - 1, 2), ViewAngle!
DIM SodiumAcc!(TotMolecules%% - 1, 2), ChlorineAcc!(TotMolecules%% - 1, 2), AtomsStats%(3, 2)

_TITLE "Highly Realistic Quantum Physics Model"
RANDOMIZE (TIMER)

'Routine to Set Mouse Buttons and Location (First Time Only)
IF NOT _FILEEXISTS("mouse.cfg") THEN
    Mousey& = _LOADIMAGE("Mus Musculus.png", 32)
    SCREEN _NEWIMAGE(500, 500, 32)
    _SCREENMOVE 100, 100
    _DEST 0
    CLS
    _PUTIMAGE (50, 100), Mousey&
    LOCATE 2, 7
    PRINT "Click on the mouse below with your normal button";
    LOCATE 3, 5
    PRINT "Click (not double-click) to make this screen disappear";
    LOCATE 5, 6
    PRINT "There may be a delay - Please wait for next screen";
    CorrectButton%% = False
    WHILE NOT CorrectButton%%
        _LIMIT 60
        'Assumes hardware has mouse buttons, value <=5
        IF _MOUSEINPUT THEN
            CorrectButton%% = False
            MouseButton%% = 1
            WHILE NOT CorrectButton%% AND MouseButton%% <= 5
                IF _MOUSEBUTTON(MouseButton%%) THEN
                    CorrectButton%% = True
                ELSE
                    MouseButton%% = MouseButton%% + 1
                END IF
            WEND
        END IF
    WEND
    _FREEIMAGE Mousey&
    OPEN "mouse.cfg" FOR OUTPUT AS #2
    PRINT #2, MouseButton%%
    CLOSE #2
    _DELAY 0.2
    DO 'Make sure that mouse button is released
        Dum%% = _MOUSEINPUT
    LOOP UNTIL NOT _MOUSEBUTTON(MouseButton%%)
    _AUTODISPLAY
    CLS
ELSE
    OPEN "mouse.cfg" FOR INPUT AS #1
    INPUT #1, MouseButton%%
    CLOSE #1
END IF

_TITLE "Highly Realistic Quantum Physics Model - Esc to Quit"
'Set Seed Crystal
Default! = 0.69 * Atom!
FOR I%% = -2 TO 2
    FOR J%% = -2 TO 2
        FOR K%% = -1 TO 1
            IF J%% \ 2 <> J%% / 1 THEN
                ChlorinePos!(N%%, 0) = Default! * I%%
                ChlorinePos!(N%%, 1) = Default! * J%%
                ChlorinePos!(N%%, 2) = 2 * Default! * K%%
                SodiumPos!(N%%, 0) = ChlorinePos!(N%%, 0)
                SodiumPos!(N%%, 1) = ChlorinePos!(N%%, 1)
                SodiumPos!(N%%, 2) = ChlorinePos!(N%%, 2) - Default!
            ELSE
                ChlorinePos!(N%%, 0) = Default! * I%%
                ChlorinePos!(N%%, 1) = Default! * J%%
                ChlorinePos!(N%%, 2) = 2 * Default! * K%% - Default!
                SodiumPos!(N%%, 0) = ChlorinePos!(N%%, 0)
                SodiumPos!(N%%, 1) = ChlorinePos!(N%%, 1)
                SodiumPos!(N%%, 2) = ChlorinePos!(N%%, 2) + Default!
            END IF
            N%% = N%% + 1
        NEXT K%%
    NEXT J%%
NEXT I%%
FOR N%% = 0 TO NoSeed%% - 1
    FOR M%% = 0 TO 2
        ChlorineVel!(N%%, M%%) = (RND - 0.5) * Kelvin!
        SodiumVel!(N%%, M%%) = (RND - 0.5) * Kelvin!
    NEXT M%%
NEXT N%%
'Additional atom properties
FOR N%% = NoSeed% TO TotMolecules%% - 1
    Xi! = RND * _PI / 4 '0.5
    ChlorinePos!(N%%, 0) = (1 + 0.75 * RND) * ScreenX% / 3
    IF RND > 0.5 THEN ChlorinePos!(N%%, 0) = ChlorinePos!(N%%, 0) * -1
    Chi! = 2 * _PI * RND
    RPosn! = ChlorinePos!(N%%, 0) * TAN(Xi!)
    ChlorinePos!(N%%, 1) = RPosn! * SIN(Chi!)
    ChlorinePos!(N%%, 2) = RPosn! * COS(Chi!)
    FOR M%% = 0 TO 2
        IF RND > 0.5 THEN ChlorinePos!(N%%, M%%) = -ChlorinePos!(N%%, M%%)
        ChlorineVel!(N%%, M%%) = (RND - 0.5) * Kelvin!
        SodiumVel!(N%%, M%%) = (RND - 0.5) * Kelvin!
    NEXT M%%
    Chi! = 2 * _PI * RND
    Psi! = _PI * RND
    SodiumPos!(N%%, 2) = ChlorinePos!(N%%, 2) + Atom! * SIN(Psi!) * COS(Chi!)
    SodiumPos!(N%%, 0) = ChlorinePos!(N%%, 0) + Atom! * SIN(Psi!) * SIN(Chi!)
    SodiumPos!(N%%, 1) = ChlorinePos!(N%%, 1) + Atom! * COS(Psi!)
NEXT N%%

' Atom Colours (Cyperium Method)
DATA 0,0,255
DATA 255,0,0
DATA 217,163,173
DATA 0,200,200
FOR N%% = 0 TO 3
    FOR P%% = 0 TO 2
        READ AtomsStats%(N%%, P%%)
    NEXT P%%
    TempImage& = _NEWIMAGE(256, 256, 32)
    _DEST TempImage&
    COLOR _RGBA(AtomsStats%(N%%, 0), AtomsStats%(N%%, 1), AtomsStats%(N%%, 2), 65), _RGBA(0, 0, 0, 0)
    'Image data goes from 1 to 255 (not 0 to 255)
    FOR Z% = 128 TO 255
        FOR X% = 1 TO 255
            FOR Y% = 1 TO 255
                DeltaX% = X% - 127
                DeltaY% = Y% - 127
                DeltaZ% = Z% - 127
                Dist! = SQR((DeltaX% * DeltaX%) + (DeltaY% * DeltaY%) + (DeltaZ% * DeltaZ%))
                IF Dist! > 125 AND Dist! < 127 THEN PSET (X%, Y%), _RGBA(CINT(Z% * AtomsStats%(N%%, 0) * (1 - (XBright! * X% / 255)) / 255), CINT(Z% * AtomsStats%(N%%, 1) * (1 - (XBright! * X% / 255)) / 255), CINT(Z% * AtomsStats%(N%%, 2) * (1 - (XBright! * X% / 255)) / 255), 65)
            NEXT
        NEXT
    NEXT
    IF N%% = 0 THEN
        Sodium& = _COPYIMAGE(TempImage&, 33)
    ELSEIF N%% = 1 THEN
        Chlorine& = _COPYIMAGE(TempImage&, 33)
    ELSEIF N%% = 2 THEN
        Pink& = _COPYIMAGE(TempImage&, 33)
    ELSE
        Cyan& = _COPYIMAGE(TempImage&, 33)
    END IF
    _FREEIMAGE TempImage&
NEXT N%%

'Images
TempImage& = _NEWIMAGE(102, 52, 32)
_DEST TempImage&
LINE (0, 0)-(101, 51), _RGB32(255, 255, 255), BF
LineImage& = _COPYIMAGE(TempImage&, 33)
_FREEIMAGE TempImage&
TempImage& = _NEWIMAGE(80, 100, 32)
_DEST TempImage&
COLOR _RGB32(150, 150, 150), _RGB32(80, 80, 80)
CLS
_PRINTSTRING (20, 40), "Pause"
Pause& = _COPYIMAGE(TempImage&, 33)
_FREEIMAGE TempImage&
TempImage& = _NEWIMAGE(80, 100, 32)
_DEST TempImage&
COLOR _RGB32(150, 150, 150), _RGB32(80, 80, 80)
CLS
_PRINTSTRING (8, 40), "Continue"
Continue& = _COPYIMAGE(TempImage&, 33)
_FREEIMAGE TempImage&
TempImage& = _NEWIMAGE(80, 100, 32)
_DEST TempImage&
COLOR _RGB32(150, 150, 150), _RGB32(80, 80, 80)
CLS
_PRINTSTRING (20, 30), "Draw"
_PRINTSTRING (20, 60), "Bonds"
Bonds& = _COPYIMAGE(TempImage&, 33)
_FREEIMAGE TempImage&
TempImage& = _NEWIMAGE(80, 100, 32)
_DEST TempImage&
COLOR _RGB32(150, 150, 150), _RGB32(80, 80, 80)
CLS
_PRINTSTRING (20, 25), "Don't"
_PRINTSTRING (20, 45), "Draw"
_PRINTSTRING (20, 65), "Bonds"
NoBonds& = _COPYIMAGE(TempImage&, 33)
_FREEIMAGE TempImage&
TempImage& = _NEWIMAGE(80, 100, 32)
_DEST TempImage&
COLOR _RGB32(150, 150, 150), _RGB32(80, 80, 80)
CLS
_PRINTSTRING (24, 40), "Quit"
Quit& = _COPYIMAGE(TempImage&, 33)

'Create screen
SCREEN _NEWIMAGE(ScreenX%, ScreenY%, 32)
_SCREENMOVE 50, 13
_DEST 0
_DISPLAYORDER _HARDWARE , _SOFTWARE

'Run simulation
NoMolecules%% = NoSeed%%
Count% = 0
ViewAngle! = _PI * (1 - RND)
DrawBonds%% = True 'False
Paused%% = False
ASaltyDog%% = True
WHILE ASaltyDog%%
    _LIMIT 25
    CALL CentreOfMass
    'Mouse Input
    WHILE _MOUSEINPUT
        XMouse% = _MOUSEX
        YMouse% = _MOUSEY
        IF _MOUSEBUTTON(MouseButton%%) THEN
            IF XMouse% > ScreenX% - 199 AND XMouse% < ScreenX% - 121 AND YMouse% > 21 AND YMouse% < 119 THEN
                IF DrawBonds%% THEN
                    DrawBonds%% = False
                ELSE
                    DrawBonds%% = True
                END IF
            ELSEIF XMouse% > ScreenX% - 99 AND XMouse% < ScreenX% - 21 AND YMouse% > 21 AND YMouse% < 119 THEN
                IF Paused%% THEN
                    Paused%% = False
                ELSE
                    Paused%% = True
                END IF
            ELSEIF XMouse% > ScreenX% - 99 AND XMouse% < ScreenX% - 21 AND YMouse% > ScreenY% - 119 AND YMouse% < ScreenY% - 21 THEN
                ASaltyDog%% = False
            END IF
        END IF
    WEND
    'Display atoms and calculate forces
    MaxDist! = 0
    F1! = 900 + 100 * ((NoMolecules%% - NoSeed%%) / (TotMolecules%% - NoSeed%%))
    FOR N%% = 0 TO NoMolecules%% - 1
        XTemp! = XDash!((ChlorinePos!(N%%, 0)), (ChlorinePos!(N%%, 2))): ZTemp! = ZDash!((ChlorinePos!(N%%, 0)), (ChlorinePos!(N%%, 2)))
        IF N%% <= NoSeed%% - 1 THEN
            _MAPTRIANGLE (0, 0)-(255, 0)-(0, 255), Chlorine& TO(-(ChlorineSize%% - 1) \ 2 + XTemp!, (ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-((ChlorineSize%% - 1) \ 2 + XTemp!, (ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-(-(ChlorineSize%% - 1) \ 2 + XTemp!, -(ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)
            _MAPTRIANGLE (255, 255)-(0, 255)-(255, 0), Chlorine& TO((ChlorineSize%% - 1) \ 2 + XTemp!, -(ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-(-(ChlorineSize%% - 1) \ 2 + XTemp!, -(ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-((ChlorineSize%% - 1) \ 2 + XTemp!, (ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)
        ELSE
            _MAPTRIANGLE (0, 0)-(255, 0)-(0, 255), Pink& TO(-(ChlorineSize%% - 1) \ 2 + XTemp!, (ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-((ChlorineSize%% - 1) \ 2 + XTemp!, (ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-(-(ChlorineSize%% - 1) \ 2 + XTemp!, -(ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)
            _MAPTRIANGLE (255, 255)-(0, 255)-(255, 0), Pink& TO((ChlorineSize%% - 1) \ 2 + XTemp!, -(ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-(-(ChlorineSize%% - 1) \ 2 + XTemp!, -(ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)-((ChlorineSize%% - 1) \ 2 + XTemp!, (ChlorineSize%% - 1) \ 2 + ChlorinePos!(N%%, 1), ZTemp! - ZOffset%)
        END IF
        XTemp! = XDash!((SodiumPos!(N%%, 0)), (SodiumPos!(N%%, 2))): ZTemp! = ZDash!((SodiumPos!(N%%, 0)), (SodiumPos!(N%%, 2)))
        IF N%% <= NoSeed%% - 1 THEN
            _MAPTRIANGLE (0, 0)-(255, 0)-(0, 255), Sodium& TO(-(SodiumSize%% - 1) \ 2 + XTemp!, (SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-((SodiumSize%% - 1) \ 2 + XTemp!, (SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-(-(SodiumSize%% - 1) \ 2 + XTemp!, -(SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)
            _MAPTRIANGLE (255, 255)-(0, 255)-(255, 0), Sodium& TO((SodiumSize%% - 1) \ 2 + XTemp!, -(SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-(-(SodiumSize%% - 1) \ 2 + XTemp!, -(SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-((SodiumSize%% - 1) \ 2 + XTemp!, (SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)
        ELSE
            _MAPTRIANGLE (0, 0)-(255, 0)-(0, 255), Cyan& TO(-(SodiumSize%% - 1) \ 2 + XTemp!, (SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-((SodiumSize%% - 1) \ 2 + XTemp!, (SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-(-(SodiumSize%% - 1) \ 2 + XTemp!, -(SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)
            _MAPTRIANGLE (255, 255)-(0, 255)-(255, 0), Cyan& TO((SodiumSize%% - 1) \ 2 + XTemp!, -(SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-(-(SodiumSize%% - 1) \ 2 + XTemp!, -(SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)-((SodiumSize%% - 1) \ 2 + XTemp!, (SodiumSize%% - 1) \ 2 + SodiumPos!(N%%, 1), ZTemp! - ZOffset%)
        END IF
        FOR M%% = 0 TO 2
            SodiumAcc!(N%%, M%%) = 0
        NEXT M%%
        FOR M%% = 0 TO 2
            ChlorineAcc!(N%%, M%%) = 0
        NEXT M%%
        FOR L%% = 0 TO NoMolecules%% - 1
            'opposites
            D! = SQR((SodiumPos!(N%%, 0) - ChlorinePos!(L%%, 0)) * (SodiumPos!(N%%, 0) - ChlorinePos!(L%%, 0)) + (SodiumPos!(N%%, 1) - ChlorinePos!(L%%, 1)) * (SodiumPos!(N%%, 1) - ChlorinePos!(L%%, 1)) + (SodiumPos!(N%%, 2) - ChlorinePos!(L%%, 2)) * (SodiumPos!(N%%, 2) - ChlorinePos!(L%%, 2)))
            F! = (Attraction!(D!) + Repulsion!(D!)) / F1!
            'IF F! < FMin! / F1! THEN F! = FMin! / F1!
            FOR M%% = 0 TO 2
                SodiumAcc!(N%%, M%%) = -F! * (SodiumPos!(N%%, M%%) - ChlorinePos!(L%%, M%%)) / D! + SodiumAcc!(N%%, M%%)
            NEXT M%%
            IF D! < 0.9 * Atom! AND DrawBonds%% THEN _MAPTRIANGLE (0, 0)-(101, 0)-(101, 51), LineImage& TO(XDash!(SodiumPos!(N%%, 0), SodiumPos!(N%%, 2)), SodiumPos!(N%%, 1), ZDash!(SodiumPos!(N%%, 0), SodiumPos!(N%%, 2)) - ZOffset%)-(XDash!(ChlorinePos!(L%%, 0), ChlorinePos!(L%%, 2)), ChlorinePos!(L%%, 1), ZDash!(ChlorinePos!(L%%, 0), ChlorinePos!(L%%, 2)) - ZOffset%)-(XDash!(ChlorinePos!(L%%, 0), ChlorinePos!(L%%, 2)), ChlorinePos!(L%%, 1), ZDash!(ChlorinePos!(L%%, 0), ChlorinePos!(L%%, 2)) - ZOffset% - 1), , _SMOOTH
            D! = SQR((SodiumPos!(L%%, 0) - ChlorinePos!(N%%, 0)) * (SodiumPos!(L%%, 0) - ChlorinePos!(N%%, 0)) + (SodiumPos!(L%%, 1) - ChlorinePos!(N%%, 1)) * (SodiumPos!(L%%, 1) - ChlorinePos!(N%%, 1)) + (SodiumPos!(L%%, 2) - ChlorinePos!(N%%, 2)) * (SodiumPos!(L%%, 2) - ChlorinePos!(N%%, 2)))
            F! = (Attraction!(D!) + Repulsion!(D!)) / F1!
            'IF F! < FMin! / F1! THEN F! = FMin! / F1!
            FOR M%% = 0 TO 2
                ChlorineAcc!(N%%, M%%) = F! * (SodiumPos!(L%%, M%%) - ChlorinePos!(N%%, M%%)) / D! + ChlorineAcc!(N%%, M%%)
            NEXT M%%
            IF L%% <> N%% THEN
                'same type
                D! = SQR((SodiumPos!(N%%, 0) - SodiumPos!(L%%, 0)) * (SodiumPos!(N%%, 0) - SodiumPos!(L%%, 0)) + (SodiumPos!(N%%, 1) - SodiumPos!(L%%, 1)) * (SodiumPos!(N%%, 1) - SodiumPos!(L%%, 1)) + (SodiumPos!(N%%, 2) - SodiumPos!(L%%, 2)) * (SodiumPos!(N%%, 2) - SodiumPos!(L%%, 2)))
                F! = -(Attraction!(D!)) / F2!
                FOR M%% = 0 TO 2
                    SodiumAcc!(N%%, M%%) = -F! * (SodiumPos!(N%%, M%%) - SodiumPos!(L%%, M%%)) / D! + SodiumAcc!(N%%, M%%)
                NEXT M%%
                D! = SQR((ChlorinePos!(N%%, 0) - ChlorinePos!(L%%, 0)) * (ChlorinePos!(N%%, 0) - ChlorinePos!(L%%, 0)) + (ChlorinePos!(N%%, 1) - ChlorinePos!(L%%, 1)) * (ChlorinePos!(N%%, 1) - ChlorinePos!(L%%, 1)) + (ChlorinePos!(N%%, 2) - ChlorinePos!(L%%, 2)) * (ChlorinePos!(N%%, 2) - ChlorinePos!(L%%, 2)))
                F! = -(Attraction!(D!)) / F2!
                FOR M%% = 0 TO 2
                    ChlorineAcc!(N%%, M%%) = -F! * (ChlorinePos!(N%%, M%%) - ChlorinePos!(L%%, M%%)) / D! + ChlorineAcc!(N%%, M%%)
                NEXT M%%
            END IF
        NEXT L%%
        'Pause
        IF NOT Paused%% THEN
            FOR M%% = 0 TO 2
                SodiumPos!(N%%, M%%) = SodiumPos!(N%%, M%%) + SodiumVel!(N%%, M%%)
                ChlorinePos!(N%%, M%%) = ChlorinePos!(N%%, M%%) + ChlorineVel!(N%%, M%%)
                SodiumVel!(N%%, M%%) = SodiumVel!(N%%, M%%) + SodiumAcc!(N%%, M%%)
                IF ABS(SodiumVel!(N%%, M%%)) > Kelvin! THEN SodiumVel!(N%%, M%%) = Kelvin! * (ABS(SodiumVel!(N%%, M%%)) / SodiumVel!(N%%, M%%))
                ChlorineVel!(N%%, M%%) = ChlorineVel!(N%%, M%%) + ChlorineAcc!(N%%, M%%)
                IF ABS(ChlorineVel!(N%%, M%%)) > Kelvin! THEN ChlorineVel!(N%%, M%%) = Kelvin! * (ABS(ChlorineVel!(N%%, M%%)) / ChlorineVel!(N%%, M%%))
            NEXT M%%
        END IF
    NEXT N%%
    'Pause/Adjust for orthogonal forces
    IF NOT Paused%% THEN
        _PUTIMAGE (ScreenX% - 100, 20), Pause&
        FOR N%% = 0 TO NoMolecules%% - 1
            FOR M%% = 0 TO 5 'the six orthogonal positions from each sodium atom
                CALL Orthogonal(N%%, M%%) 'Move chlorine atom
            NEXT M%%
        NEXT N%%
        ViewAngle! = ViewAngle! + 0.008
        IF ViewAngle! > _PI THEN ViewAngle! = ViewAngle! - 2 * _PI
        IF NoMolecules%% < TotMolecules%% THEN Count% = Count% + 1
        IF NoMolecules%% = NoSeed%% THEN
            IF Count% >= 2000 AND ((ViewAngle! > -0.05 AND ViewAngle! < 0.05) OR (ViewAngle! > -_PI - 0.05 AND ViewAngle! < 0.05 - _PI)) THEN
                NoMolecules%% = NoMolecules%% + 2
                Count% = 0
            END IF
            'might try the angle of the next atom, not just viewing angle - future version
        ELSEIF Count% >= 100 AND NoMolecules%% < TotMolecules%% AND ((ViewAngle! > -0.05 AND ViewAngle! < 0.05) OR (ViewAngle! > -_PI - 0.05 AND ViewAngle! < 0.05 - _PI)) THEN
            NoMolecules%% = NoMolecules%% + 2
            Count% = 0
        END IF
    ELSE
        _PUTIMAGE (ScreenX% - 100, 20), Continue&
    END IF
    'Draw Bonds
    IF NOT DrawBonds%% THEN
        _PUTIMAGE (ScreenX% - 200, 20), Bonds&
    ELSE
        _PUTIMAGE (ScreenX% - 200, 20), NoBonds&
    END IF
    _PUTIMAGE (ScreenX% - 100, ScreenY% - 120), Quit&
    LOCATE 1, 1: PRINT " Number of Molecules:"; NoMolecules%%;
    _DISPLAY
    IF INKEY$ <> "" THEN ASaltyDog%% = False
WEND

SYSTEM

FUNCTION Attraction! (Dist!)
    Attraction! = A0! * (1 / (Dist! / A2!) ^ A1!)
END FUNCTION

FUNCTION Repulsion! (Dist!)
    Repulsion! = -R0! * (1 / (Dist! / R2!) ^ R1!)
END FUNCTION

FUNCTION XDash! (X!, Z!)
    XDash! = X! * COS(ViewAngle!) + Z! * SIN(ViewAngle!)
END FUNCTION

FUNCTION ZDash! (X!, Z!)
    ZDash! = -X! * SIN(ViewAngle!) + Z! * COS(ViewAngle!)
END FUNCTION

SUB Orthogonal (P%%, Q%%)
    OnlyOneChlorine%% = True
    NoChlorines%% = 0
    R%% = 0
    WHILE R%% <= NoMolecules%% - 1 AND OnlyOneChlorine%%
        IF R%% <> P%% THEN
            Sepn! = SQR((SodiumPos!(R%%, 0) - SodiumPos!(P%%, 0)) * (SodiumPos!(R%%, 0) - SodiumPos!(P%%, 0)) + (SodiumPos!(R%%, 1) - SodiumPos!(P%%, 1)) * (SodiumPos!(R%%, 1) - SodiumPos!(P%%, 1)) + (SodiumPos!(R%%, 2) - SodiumPos!(P%%, 2)) * (SodiumPos!(R%%, 2) - SodiumPos!(P%%, 2)))
            IF Sepn! < Atom! THEN
                X! = SodiumPos!(R%%, 0) - SodiumPos!(P%%, 0)
                Y! = SodiumPos!(R%%, 1) - SodiumPos!(P%%, 1)
                Z! = SodiumPos!(R%%, 2) - SodiumPos!(P%%, 2)
                SELECT CASE Q%%
                    CASE 0
                        S1! = SQR(Y! * Y! + Z! * Z!)
                        Theta! = _ATAN2(S1!, X!)
                        IF X! > 0 AND X! < Atom! AND ABS(Theta!) < ThetaMax! THEN OnlyOneChlorine%% = False
                    CASE 1
                        S1! = SQR(X! * X! + Z! * Z!)
                        Theta! = _ATAN2(S1!, Y!)
                        IF Y! > 0 AND Y! < Atom! AND ABS(Theta!) < ThetaMax! THEN OnlyOneChlorine%% = False
                    CASE 2
                        S1! = SQR(Y! * Y! + X! * X!)
                        Theta! = _ATAN2(S1!, Z!)
                        IF Z! > 0 AND Z! < Atom! AND ABS(Theta!) < ThetaMax! THEN OnlyOneChlorine%% = False
                    CASE 3
                        S1! = SQR(Y! * Y! + Z! * Z!)
                        Theta! = _ATAN2(S1!, -X!)
                        IF X! < 0 AND X! > -Atom! AND ABS(Theta!) < ThetaMax! THEN OnlyOneChlorine%% = False
                    CASE 4
                        S1! = SQR(X! * X! + Z! * Z!)
                        Theta! = _ATAN2(S1!, -Y!)
                        IF Y! < 0 AND Y! > -Atom! AND ABS(Theta!) < ThetaMax! THEN OnlyOneChlorine%% = False
                    CASE ELSE '5
                        S1! = SQR(Y! * Y! + X! * X!)
                        Theta! = _ATAN2(S1!, -Z!)
                        IF Z! < 0 AND Z! > -Atom! AND ABS(Theta!) < ThetaMax! THEN OnlyOneChlorine%% = False
                END SELECT
            END IF
        END IF
        IF OnlyOneChlorine%% THEN
            Sepn! = SQR((ChlorinePos!(R%%, 0) - SodiumPos!(P%%, 0)) * (ChlorinePos!(R%%, 0) - SodiumPos!(P%%, 0)) + (ChlorinePos!(R%%, 1) - SodiumPos!(P%%, 1)) * (ChlorinePos!(R%%, 1) - SodiumPos!(P%%, 1)) + (ChlorinePos!(R%%, 2) - SodiumPos!(P%%, 2)) * (ChlorinePos!(R%%, 2) - SodiumPos!(P%%, 2)))
            IF Sepn! < Atom! THEN
                X! = ChlorinePos!(R%%, 0) - SodiumPos!(P%%, 0)
                Y! = ChlorinePos!(R%%, 1) - SodiumPos!(P%%, 1)
                Z! = ChlorinePos!(R%%, 2) - SodiumPos!(P%%, 2)
                SELECT CASE Q%%
                    CASE 0
                        S1! = SQR(Y! * Y! + Z! * Z!)
                        Theta! = _ATAN2(S1!, X!)
                        IF X! > 0 AND X! < Atom! AND ABS(Theta!) < ThetaMax! THEN
                            NoChlorines%% = NoChlorines%% + 1
                            ROne%% = R%%
                        END IF
                    CASE 1
                        S1! = SQR(X! * X! + Z! * Z!)
                        Theta! = _ATAN2(S1!, Y!)
                        IF Y! > 0 AND Y! < Atom! AND ABS(Theta!) < ThetaMax! THEN
                            NoChlorines%% = NoChlorines%% + 1
                            ROne%% = R%%
                        END IF
                    CASE 2
                        S1! = SQR(Y! * Y! + X! * X!)
                        Theta! = _ATAN2(S1!, Z!)
                        IF Z! > 0 AND Z! < Atom! AND ABS(Theta!) < ThetaMax! THEN
                            NoChlorines%% = NoChlorines%% + 1
                            ROne%% = R%%
                        END IF
                    CASE 3
                        S1! = SQR(Y! * Y! + Z! * Z!)
                        Theta! = _ATAN2(S1!, -X!)
                        IF X! < 0 AND X! > -Atom! AND ABS(Theta!) < ThetaMax! THEN
                            NoChlorines%% = NoChlorines%% + 1
                            ROne%% = R%%
                        END IF
                    CASE 4
                        S1! = SQR(X! * X! + Z! * Z!)
                        Theta! = _ATAN2(S1!, -Y!)
                        IF Y! < 0 AND Y! > -Atom! AND ABS(Theta!) < ThetaMax! THEN
                            NoChlorines%% = NoChlorines%% + 1
                            ROne%% = R%%
                        END IF
                    CASE ELSE '5
                        S1! = SQR(Y! * Y! + X! * X!)
                        Theta! = _ATAN2(S1!, -Z!)
                        IF Z! < 0 AND Z! > -Atom! AND ABS(Theta!) < ThetaMax! THEN
                            NoChlorines%% = NoChlorines%% + 1
                            ROne%% = R%%
                        END IF
                END SELECT
                IF NoChlorines%% > 1 THEN OnlyOneChlorine%% = False
            END IF
        END IF
        R%% = R%% + 1
    WEND
    IF NoChlorines%% = 0 THEN OnlyOneChlorine%% = False
    IF OnlyOneChlorine%% THEN
        'Move Chlorine Atom
        X! = ChlorinePos!(ROne%%, 0) - SodiumPos!(P%%, 0)
        Y! = ChlorinePos!(ROne%%, 1) - SodiumPos!(P%%, 1)
        Z! = ChlorinePos!(ROne%%, 2) - SodiumPos!(P%%, 2)
        SELECT CASE Q%%
            CASE 0, 3
                ChlorinePos!(ROne%%, 1) = ChlorinePos!(ROne%%, 1) - Y! * (1 - Xstal!)
                ChlorinePos!(ROne%%, 2) = ChlorinePos!(ROne%%, 2) - Z! * (1 - Xstal!)
            CASE 1, 4
                ChlorinePos!(ROne%%, 0) = ChlorinePos!(ROne%%, 0) - X! * (1 - Xstal!)
                ChlorinePos!(ROne%%, 2) = ChlorinePos!(ROne%%, 2) - Z! * (1 - Xstal!)
            CASE 2, 5
                ChlorinePos!(ROne%%, 0) = ChlorinePos!(ROne%%, 0) - X! * (1 - Xstal!)
                ChlorinePos!(ROne%%, 1) = ChlorinePos!(ROne%%, 1) - Y! * (1 - Xstal!)
        END SELECT
    END IF
END SUB

SUB CentreOfMass 'centre on original seed atoms
    TotMass! = 0
    MRx! = 0: MRy! = 0: MRz! = 0
    Px! = 0: Py! = 0: Pz! = 0
    FOR N% = 0 TO NoSeed%% - 1
        TotMass! = TotMass! + 1
        MRx! = MRx! + SodiumPos!(N%, 0)
        MRy! = MRy! + SodiumPos!(N%, 1)
        MRz! = MRz! + SodiumPos!(N%, 2)
        Px! = SodiumVel!(N%, 0) + Px!
        Py! = SodiumVel!(N%, 1) + Py!
        Pz! = SodiumVel!(N%, 2) + Pz!
        TotMass! = TotMass! + 1
        MRx! = MRx! + ChlorinePos!(N%, 0)
        MRy! = MRy! + ChlorinePos!(N%, 1)
        MRz! = MRz! + ChlorinePos!(N%, 2)
        Px! = ChlorineVel!(N%, 0) + Px!
        Py! = ChlorineVel!(N%, 1) + Py!
        Pz! = ChlorineVel!(N%, 2) + Pz!
    NEXT N%
    FOR N% = 0 TO NoSeed%% - 1
        SodiumPos!(N%, 0) = SodiumPos!(N%, 0) - (MRx! / TotMass!)
        SodiumPos!(N%, 1) = SodiumPos!(N%, 1) - (MRy! / TotMass!)
        SodiumPos!(N%, 2) = SodiumPos!(N%, 2) - (MRz! / TotMass!)
        SodiumVel!(N%, 0) = SodiumVel!(N%, 0) - (Px! / TotMass!)
        SodiumVel!(N%, 1) = SodiumVel!(N%, 1) - (Py! / TotMass!)
        SodiumVel!(N%, 2) = SodiumVel!(N%, 2) - (Pz! / TotMass!)
        ChlorinePos!(N%, 0) = ChlorinePos!(N%, 0) - (MRx! / TotMass!)
        ChlorinePos!(N%, 1) = ChlorinePos!(N%, 1) - (MRy! / TotMass!)
        ChlorinePos!(N%, 2) = ChlorinePos!(N%, 2) - (MRz! / TotMass!)
        ChlorineVel!(N%, 0) = ChlorineVel!(N%, 0) - (Px! / TotMass!)
        ChlorineVel!(N%, 1) = ChlorineVel!(N%, 1) - (Py! / TotMass!)
        ChlorineVel!(N%, 2) = ChlorineVel!(N%, 2) - (Pz! / TotMass!)
    NEXT N%
END SUB
Reply
#2
You sure post interesting progs, @magdha! Keep it up.
Reply
#3
(12-17-2025, 04:05 PM)NakedApe Wrote: You sure post interesting progs, @magdha! Keep it up.
Oh thanks.  It is my pleasure.  But I'm about to run out of my old programs (the ones that are good enough to appear here).
Reply


Forum Jump:


Users browsing this thread: 2 Guest(s)