mdtools/libmdCode/simulation_module.F90

!! Fortran interface to C entry plug.

module simulation
  use definitions, ONLY :dp
#ifdef IS_MPI
  use mpiSimulation
#endif

  implicit none
  PRIVATE

#define __FORTRAN90
#include "fSimulation.h"

  type (simtype), public :: thisSim

  logical :: setSim = .false.

  integer,public :: natoms

  public :: getBox
  public :: getRcut
  public :: getRlist
  public :: getNlocal
  public :: setSimulation
  public :: isEnsemble
  public :: isPBC
  public :: getStringLen
  public :: returnMixingRules
  public :: doStress

!  public :: setRcut
  interface getBox
     module procedure getBox_3d
     module procedure getBox_dim
  end interface


contains

  subroutine setSimulation(setThisSim,error)
    type (simtype) :: setThisSim
    integer :: error
    integer :: alloc_stat

    error = 0
    setSim = .true.

! copy C struct into fortran type
    thisSim = setThisSim
  end subroutine setSimulation

  function getNparticles() result(nparticles)
    integer :: nparticles
    nparticles = thisSim%nLRparticles
  end function getNparticles


  subroutine change_box_size(new_box_size)
    real(kind=dp), dimension(3) :: new_box_size

    thisSim%box = new_box_size

  end subroutine change_box_size


  function getBox_3d() result(thisBox)
    real( kind = dp ), dimension(3) :: thisBox
    thisBox = thisSim%box
  end function getBox_3d

  function getBox_dim(dim) result(thisBox)
    integer, intent(in) :: dim
    real( kind = dp ) :: thisBox

    thisBox = thisSim%box(dim)
  end function getBox_dim
  
  
  subroutine getRcut(thisrcut,rcut2,rcut6,status)
    real( kind = dp ), intent(out) :: thisrcut
    real( kind = dp ), intent(out), optional :: rcut2
    real( kind = dp ), intent(out), optional :: rcut6
    integer, optional :: status

    if (present(status)) status = 0

    if (.not.setSim ) then
       if (present(status)) status = -1
       return
    end if
    
    thisrcut = thisSim%rcut
    if(present(rcut2)) rcut2 = thisSim%rcutsq
    if(present(rcut6)) rcut6 = thisSim%rcut6

  end subroutine getRcut
  
  
  subroutine getRlist(thisrlist,rlist2,status)
    real( kind = dp ), intent(out) :: thisrlist
    real( kind = dp ), intent(out), optional :: rlist2

    integer, optional :: status

    if (present(status)) status = 0

    if (.not.setSim ) then
       if (present(status)) status = -1
       return
    end if
    
    thisrlist = thisSim%rlist
    if(present(rlist2)) rlist2 = thisSim%rlistsq


  end subroutine getRlist
  
 
 pure function getNlocal() result(nlocal)
    integer :: nlocal
    nlocal = thisSim%nLRparticles
  end function getNlocal

  function doStress() result(do_stress)
    logical :: do_stress
    do_stress = thisSim%do_stress
  end function doStress

  function isEnsemble(this_ensemble) result(is_this_ensemble)
    character(len = *) :: this_ensemble
    logical :: is_this_ensemble
    is_this_ensemble = .false.
    if (this_ensemble == thisSim%ensemble) is_this_ensemble = .true.
  end function isEnsemble
  
  function returnEnsemble() result(thisEnsemble)
    character (len = len(thisSim%ensemble)) :: thisEnsemble
    thisEnsemble = thisSim%ensemble
  end function returnEnsemble

  function returnMixingRules() result(thisMixingRule)
    character (len = len(thisSim%ensemble)) :: thisMixingRule
    thisMixingRule = thisSim%MixingRule
  end function returnMixingRules

  function isPBC() result(PBCset)
    logical :: PBCset
    PBCset = .false.
    if (thisSim%use_pbc) PBCset = .true.
  end function isPBC

  pure function getStringLen() result (thislen)
    integer :: thislen    
    thislen = string_len
  end function getStringLen

end module simulation
Revision:	309
Committed:	Mon Mar 10 23:19:23 2003 UTC (22 years, 9 months ago) by gezelter
File size:	3646 byte(s)
Log Message:	Massive rewrite underway. This way be dragons.
#	User	Rev	Content
1	chuckv	290	!! Fortran interface to C entry plug.
2
3	mmeineke	270	module simulation
4			use definitions, ONLY :dp
5			#ifdef IS_MPI
6			use mpiSimulation
7			#endif
8
9			implicit none
10			PRIVATE
11
12	mmeineke	285	#define __FORTRAN90
13	gezelter	309	#include "fSimulation.h"
14	mmeineke	270
15			type (simtype), public :: thisSim
16
17	chuckv	290	logical :: setSim = .false.
18	mmeineke	270
19	gezelter	309	integer,public :: natoms
20	mmeineke	270
21			public :: getBox
22			public :: getRcut
23			public :: getRlist
24			public :: getNlocal
25			public :: setSimulation
26	mmeineke	285	public :: isEnsemble
27			public :: isPBC
28			public :: getStringLen
29			public :: returnMixingRules
30	gezelter	309	public :: doStress
31	mmeineke	285
32	mmeineke	270	! public :: setRcut
33			interface getBox
34			module procedure getBox_3d
35			module procedure getBox_dim
36			end interface
37
38
39
40
41			contains
42
43	chuckv	290	subroutine setSimulation(setThisSim,error)
44			type (simtype) :: setThisSim
45			integer :: error
46	mmeineke	270	integer :: alloc_stat
47	chuckv	290
48			error = 0
49	mmeineke	270	setSim = .true.
50
51	chuckv	290	! copy C struct into fortran type
52			thisSim = setThisSim
53	mmeineke	270	end subroutine setSimulation
54
55			function getNparticles() result(nparticles)
56			integer :: nparticles
57			nparticles = thisSim%nLRparticles
58			end function getNparticles
59
60
61			subroutine change_box_size(new_box_size)
62			real(kind=dp), dimension(3) :: new_box_size
63
64			thisSim%box = new_box_size
65
66			end subroutine change_box_size
67
68
69			function getBox_3d() result(thisBox)
70			real( kind = dp ), dimension(3) :: thisBox
71			thisBox = thisSim%box
72			end function getBox_3d
73
74			function getBox_dim(dim) result(thisBox)
75			integer, intent(in) :: dim
76			real( kind = dp ) :: thisBox
77
78			thisBox = thisSim%box(dim)
79			end function getBox_dim
80
81
82
83			subroutine getRcut(thisrcut,rcut2,rcut6,status)
84			real( kind = dp ), intent(out) :: thisrcut
85			real( kind = dp ), intent(out), optional :: rcut2
86			real( kind = dp ), intent(out), optional :: rcut6
87			integer, optional :: status
88
89			if (present(status)) status = 0
90
91			if (.not.setSim ) then
92			if (present(status)) status = -1
93			return
94			end if
95
96			thisrcut = thisSim%rcut
97			if(present(rcut2)) rcut2 = thisSim%rcutsq
98			if(present(rcut6)) rcut6 = thisSim%rcut6
99
100			end subroutine getRcut
101
102
103
104
105			subroutine getRlist(thisrlist,rlist2,status)
106			real( kind = dp ), intent(out) :: thisrlist
107			real( kind = dp ), intent(out), optional :: rlist2
108
109			integer, optional :: status
110
111			if (present(status)) status = 0
112
113			if (.not.setSim ) then
114			if (present(status)) status = -1
115			return
116			end if
117
118			thisrlist = thisSim%rlist
119			if(present(rlist2)) rlist2 = thisSim%rlistsq
120
121
122			end subroutine getRlist
123
124	gezelter	309
125	mmeineke	270	pure function getNlocal() result(nlocal)
126			integer :: nlocal
127			nlocal = thisSim%nLRparticles
128			end function getNlocal
129
130	gezelter	309	function doStress() result(do_stress)
131			logical :: do_stress
132			do_stress = thisSim%do_stress
133			end function doStress
134	mmeineke	270
135	mmeineke	285	function isEnsemble(this_ensemble) result(is_this_ensemble)
136			character(len = *) :: this_ensemble
137	gezelter	309	logical :: is_this_ensemble
138	mmeineke	285	is_this_ensemble = .false.
139			if (this_ensemble == thisSim%ensemble) is_this_ensemble = .true.
140			end function isEnsemble
141	gezelter	309
142	mmeineke	285	function returnEnsemble() result(thisEnsemble)
143			character (len = len(thisSim%ensemble)) :: thisEnsemble
144			thisEnsemble = thisSim%ensemble
145			end function returnEnsemble
146
147			function returnMixingRules() result(thisMixingRule)
148			character (len = len(thisSim%ensemble)) :: thisMixingRule
149			thisMixingRule = thisSim%MixingRule
150			end function returnMixingRules
151
152			function isPBC() result(PBCset)
153			logical :: PBCset
154			PBCset = .false.
155			if (thisSim%use_pbc) PBCset = .true.
156			end function isPBC
157
158			pure function getStringLen() result (thislen)
159			integer :: thislen
160			thislen = string_len
161	gezelter	309	end function getStringLen
162	mmeineke	285
163	mmeineke	270	end module simulation