PROGRAM Cooling
! Copyright 2007 Matthew Norton
!
!    This program is free software; you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation; either version 2 of the License, or
!    (at your option) any later version.
!
!    This program is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with this program; if not, write to the Free Software
!    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
!
! NOTE: This is in FORTRAN 90 and you will need a FORTRAN 90 complier to run this code
!---------------------------------------------------------------------------
!  This program models the two dimensional process by which a laser is 
! shown on moving atom of cesium and shows how the movement of the atom
! is affected by the adsorption and then re-emission of those photons
!
! Programmed by:
!     Matthew Norton
!
!----------------------------------------------------------------------------

IMPLICIT NONE

REAL*8 :: XMom=0.0, YMom=0.0, Xpos=0.0, YPos=0.0, PhMo, Time=0, dT=0.0
REAL*8 :: RandR=0.0, RandTheta=0.0, RefX, RefY
INTEGER :: I=0, NumPho=0, ErrorStat=0, NumInt=0, Times(8)
REAL*8, PARAMETER :: H = 6.626E-34
REAL*8, PARAMETER :: Lambda = 852E-9
REAL*8, PARAMETER :: MassCs = 2.207E-25
OPEN (UNIT = 10, FILE = "Cool.txt", STATUS = "REPLACE", IOSTAT = ErrorStat)
IF (ErrorStat /= 0) THEN
    PRINT *, "*** ERROR IN OPENING FILE ***", ErrorStat
    STOP
END IF
PhMo = H / Lambda
XMom = MassCs * 200.0
NumPho = 11500000
PRINT *, "How many interations do you want to perform?"
READ *, NumInt
Dt = 1.0 / NumPho
CALL Seed()
DO I = 1, NumInt
Main: DO
        XMom = XMom - PhMo
        IF (XMom < 0.0) THEN
            EXIT Main
        END IF
        XPos = XPos + (XMom / MassCs) * Dt
        Time = Time + Dt
        CALL SetRandomNumbers()
        XMom = XMom - (PhMo * RefX)
        YMom = YMom - (PhMo * RefY)
        YPos = YPos + (YMom / MassCs) * Dt

END DO Main 
WRITE (10,*) XPos, YPos
XPos = 0.0
YPos = 0.0
XMom = MassCs * 200.0
YMom = 0.0
END DO
CLOSE(10)
PRINT *, "Program complete"

! ----------------------------------------------------------------------
CONTAINS
! ----------------------------------------------------------------------

SUBROUTINE Seed
INTEGER :: Now(8)
CALL date_and_time(values=Now)
CALL random_seed(put=Now(5:8))
END SUBROUTINE

! ----------------------------------------------------------------------

SUBROUTINE SetRandomNumbers()
REAL*8, PARAMETER :: Pi = 3.141592653589793238462643383279
CALL RANDOM_NUMBER(RandR)
CALL RANDOM_NUMBER(RandTheta)
RandTheta = Randtheta * 2.0 * Pi
RefX = RandR * COS(RandTheta)
RefY = RandR * SIN(RandTheta)

END SUBROUTINE
END PROGRAM