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 :: getRrf
  public :: getRt
  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

  function getRrf() result(rrf)
    real( kind = dp ) :: rrf
    rrf = thisSim%rrf
  end function getRrf
  
  function getRt() result(rt)
    real( kind = dp ) :: rt
    rt = thisSim%rt
  end function getRt
   
  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:	312
Committed:	Tue Mar 11 17:46:18 2003 UTC (21 years, 5 months ago) by gezelter
File size:	3890 byte(s)
Log Message:	Bunch o' stuff, particularly the vector_class.F90 module
#	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	gezelter	312	public :: getRrf
25			public :: getRt
26	mmeineke	270	public :: getNlocal
27			public :: setSimulation
28	mmeineke	285	public :: isEnsemble
29			public :: isPBC
30			public :: getStringLen
31			public :: returnMixingRules
32	gezelter	309	public :: doStress
33	mmeineke	285
34	mmeineke	270	! public :: setRcut
35			interface getBox
36			module procedure getBox_3d
37			module procedure getBox_dim
38			end interface
39
40			contains
41
42	chuckv	290	subroutine setSimulation(setThisSim,error)
43			type (simtype) :: setThisSim
44			integer :: error
45	mmeineke	270	integer :: alloc_stat
46	chuckv	290
47			error = 0
48	mmeineke	270	setSim = .true.
49	gezelter	312	! copy C struct into fortran type
50	chuckv	290	thisSim = setThisSim
51	mmeineke	270	end subroutine setSimulation
52
53			function getNparticles() result(nparticles)
54			integer :: nparticles
55			nparticles = thisSim%nLRparticles
56			end function getNparticles
57
58			subroutine change_box_size(new_box_size)
59			real(kind=dp), dimension(3) :: new_box_size
60			thisSim%box = new_box_size
61			end subroutine change_box_size
62
63			function getBox_3d() result(thisBox)
64			real( kind = dp ), dimension(3) :: thisBox
65			thisBox = thisSim%box
66			end function getBox_3d
67
68			function getBox_dim(dim) result(thisBox)
69			integer, intent(in) :: dim
70			real( kind = dp ) :: thisBox
71	gezelter	312
72	mmeineke	270	thisBox = thisSim%box(dim)
73			end function getBox_dim
74	gezelter	312
75	mmeineke	270	subroutine getRcut(thisrcut,rcut2,rcut6,status)
76			real( kind = dp ), intent(out) :: thisrcut
77			real( kind = dp ), intent(out), optional :: rcut2
78			real( kind = dp ), intent(out), optional :: rcut6
79			integer, optional :: status
80
81			if (present(status)) status = 0
82
83			if (.not.setSim ) then
84			if (present(status)) status = -1
85			return
86			end if
87
88			thisrcut = thisSim%rcut
89			if(present(rcut2)) rcut2 = thisSim%rcutsq
90			if(present(rcut6)) rcut6 = thisSim%rcut6
91			end subroutine getRcut
92
93			subroutine getRlist(thisrlist,rlist2,status)
94			real( kind = dp ), intent(out) :: thisrlist
95			real( kind = dp ), intent(out), optional :: rlist2
96
97			integer, optional :: status
98
99			if (present(status)) status = 0
100
101			if (.not.setSim ) then
102			if (present(status)) status = -1
103			return
104			end if
105
106			thisrlist = thisSim%rlist
107			if(present(rlist2)) rlist2 = thisSim%rlistsq
108	gezelter	312	end subroutine getRlist
109	mmeineke	270
110	gezelter	312	function getRrf() result(rrf)
111			real( kind = dp ) :: rrf
112			rrf = thisSim%rrf
113			end function getRrf
114	mmeineke	270
115	gezelter	312	function getRt() result(rt)
116			real( kind = dp ) :: rt
117			rt = thisSim%rt
118			end function getRt
119
120			pure function getNlocal() result(nlocal)
121	mmeineke	270	integer :: nlocal
122			nlocal = thisSim%nLRparticles
123			end function getNlocal
124	gezelter	312
125	gezelter	309	function doStress() result(do_stress)
126			logical :: do_stress
127			do_stress = thisSim%do_stress
128			end function doStress
129	gezelter	312
130	mmeineke	285	function isEnsemble(this_ensemble) result(is_this_ensemble)
131			character(len = *) :: this_ensemble
132	gezelter	309	logical :: is_this_ensemble
133	mmeineke	285	is_this_ensemble = .false.
134			if (this_ensemble == thisSim%ensemble) is_this_ensemble = .true.
135			end function isEnsemble
136	gezelter	309
137	mmeineke	285	function returnEnsemble() result(thisEnsemble)
138			character (len = len(thisSim%ensemble)) :: thisEnsemble
139			thisEnsemble = thisSim%ensemble
140			end function returnEnsemble
141	gezelter	312
142	mmeineke	285	function returnMixingRules() result(thisMixingRule)
143			character (len = len(thisSim%ensemble)) :: thisMixingRule
144			thisMixingRule = thisSim%MixingRule
145			end function returnMixingRules
146	gezelter	312
147	mmeineke	285	function isPBC() result(PBCset)
148			logical :: PBCset
149			PBCset = .false.
150			if (thisSim%use_pbc) PBCset = .true.
151			end function isPBC
152	gezelter	312
153	mmeineke	285	pure function getStringLen() result (thislen)
154			integer :: thislen
155			thislen = string_len
156	gezelter	309	end function getStringLen
157	gezelter	312
158	mmeineke	270	end module simulation