PageRenderTime 105ms CodeModel.GetById 20ms app.highlight 79ms RepoModel.GetById 1ms app.codeStats 0ms

/TwoRegions/src/TwoRegionsExample.f90

http://github.com/xyan075/examples
FORTRAN Modern | 653 lines | 381 code | 73 blank | 199 comment | 52 complexity | 87e102af144003d52e3411b1d058acde MD5 | raw file
  1!> \file
  2!> \author Chris Bradley
  3!> \brief This is an example program which sets up a field in two regions using openCMISS calls.
  4!>
  5!> \section LICENSE
  6!>
  7!> Version: MPL 1.1/GPL 2.0/LGPL 2.1
  8!>
  9!> The contents of this file are subject to the Mozilla Public License
 10!> Version 1.1 (the "License"); you may not use this file except in
 11!> compliance with the License. You may obtain a copy of the License at
 12!> http://www.mozilla.org/MPL/
 13!>
 14!> Software distributed under the License is distributed on an "AS IS"
 15!> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
 16!> License for the specific language governing rights and limitations
 17!> under the License.
 18!>
 19!> The Original Code is OpenCMISS
 20!>
 21!> The Initial Developer of the Original Code is University of Auckland,
 22!> Auckland, New Zealand and University of Oxford, Oxford, United
 23!> Kingdom. Portions created by the University of Auckland and University
 24!> of Oxford are Copyright (C) 2007 by the University of Auckland and
 25!> the University of Oxford. All Rights Reserved.
 26!>
 27!> Contributor(s):
 28!>
 29!> Alternatively, the contents of this file may be used under the terms of
 30!> either the GNU General Public License Version 2 or later (the "GPL"), or
 31!> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
 32!> in which case the provisions of the GPL or the LGPL are applicable instead
 33!> of those above. If you wish to allow use of your version of this file only
 34!> under the terms of either the GPL or the LGPL, and not to allow others to
 35!> use your version of this file under the terms of the MPL, indicate your
 36!> decision by deleting the provisions above and replace them with the notice
 37!> and other provisions required by the GPL or the LGPL. If you do not delete
 38!> the provisions above, a recipient may use your version of this file under
 39!> the terms of any one of the MPL, the GPL or the LGPL.
 40!>
 41
 42!> \example TwoRegions/src/TwoRegionsExample.f90
 43!! Example program which sets up a field in two regions using OpenCMISS calls.
 44!! \par Latest Builds:
 45!! \li <a href='http://autotest.bioeng.auckland.ac.nz/opencmiss-build/logs_x86_64-linux/TwoRegions/build-intel'>Linux Intel Build</a>
 46!! \li <a href='http://autotest.bioeng.auckland.ac.nz/opencmiss-build/logs_x86_64-linux/TwoRegions/build-gnu'>Linux GNU Build</a>
 47!<
 48
 49!> Main program
 50PROGRAM TWOREGIONSEXAMPLE
 51
 52  USE OPENCMISS
 53  USE MPI
 54  
 55#ifdef WIN32
 56  USE IFQWIN
 57#endif
 58
 59  IMPLICIT NONE
 60
 61  !Test program parameters
 62
 63  REAL(CMISSDP), PARAMETER :: HEIGHT=1.0_CMISSDP
 64  REAL(CMISSDP), PARAMETER :: WIDTH=2.0_CMISSDP
 65  REAL(CMISSDP), PARAMETER :: LENGTH=3.0_CMISSDP
 66
 67  INTEGER(CMISSIntg), PARAMETER :: CoordinateSystem1UserNumber=1
 68  INTEGER(CMISSIntg), PARAMETER :: CoordinateSystem2UserNumber=2
 69  INTEGER(CMISSIntg), PARAMETER :: Region1UserNumber=3
 70  INTEGER(CMISSIntg), PARAMETER :: Region2UserNumber=4
 71  INTEGER(CMISSIntg), PARAMETER :: Basis1UserNumber=5
 72  INTEGER(CMISSIntg), PARAMETER :: Basis2UserNumber=6
 73  INTEGER(CMISSIntg), PARAMETER :: InterfaceBasisUserNumber=7
 74  INTEGER(CMISSIntg), PARAMETER :: GeneratedMesh1UserNumber=8
 75  INTEGER(CMISSIntg), PARAMETER :: GeneratedMesh2UserNumber=9
 76  INTEGER(CMISSIntg), PARAMETER :: InterfaceGeneratedMeshUserNumber=10
 77  INTEGER(CMISSIntg), PARAMETER :: Mesh1UserNumber=11
 78  INTEGER(CMISSIntg), PARAMETER :: Mesh2UserNumber=12
 79  INTEGER(CMISSIntg), PARAMETER :: InterfaceMeshUserNumber=13
 80  INTEGER(CMISSIntg), PARAMETER :: Decomposition1UserNumber=14
 81  INTEGER(CMISSIntg), PARAMETER :: Decomposition2UserNumber=15
 82  INTEGER(CMISSIntg), PARAMETER :: InterfaceDecompositionUserNumber=16
 83  INTEGER(CMISSIntg), PARAMETER :: GeometricField1UserNumber=17
 84  INTEGER(CMISSIntg), PARAMETER :: GeometricField2UserNumber=18
 85  INTEGER(CMISSIntg), PARAMETER :: InterfaceGeometricFieldUserNumber=19
 86  INTEGER(CMISSIntg), PARAMETER :: EquationsSet1UserNumber=20
 87  INTEGER(CMISSIntg), PARAMETER :: EquationsSet2UserNumber=21
 88  INTEGER(CMISSIntg), PARAMETER :: DependentField1UserNumber=22
 89  INTEGER(CMISSIntg), PARAMETER :: DependentField2UserNumber=23
 90  INTEGER(CMISSIntg), PARAMETER :: InterfaceUserNumber=24
 91  INTEGER(CMISSIntg), PARAMETER :: InterfaceConditionUserNumber=25
 92  INTEGER(CMISSIntg), PARAMETER :: LagrangeFieldUserNumber=26
 93  INTEGER(CMISSIntg), PARAMETER :: CoupledProblemUserNumber=27
 94  INTEGER(CMISSIntg), PARAMETER :: EquationsSetField1UserNumber=40
 95  INTEGER(CMISSIntg), PARAMETER :: EquationsSetField2UserNumber=41
 96  !Program types
 97  
 98  !Program variables
 99
100  INTEGER(CMISSIntg) :: NUMBER_GLOBAL_X_ELEMENTS,NUMBER_GLOBAL_Y_ELEMENTS,NUMBER_GLOBAL_Z_ELEMENTS
101  INTEGER(CMISSIntg) :: NUMBER_OF_DOMAINS
102  
103  INTEGER(CMISSIntg) :: MPI_IERROR
104
105  LOGICAL :: EXPORT_FIELD
106  
107  INTEGER(CMISSIntg) :: EquationsSet1Index,EquationsSet2Index
108  INTEGER(CMISSIntg) :: FirstNodeNumber,LastNodeNumber
109  INTEGER(CMISSIntg) :: FirstNodeDomain,LastNodeDomain
110  INTEGER(CMISSIntg) :: InterfaceConditionIndex
111  INTEGER(CMISSIntg) :: Mesh1Index,Mesh2Index
112  INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber
113
114  !CMISS variables
115
116  TYPE(CMISSBasisType) :: Basis1,Basis2,InterfaceBasis
117  TYPE(CMISSBoundaryConditionsType) :: BoundaryConditions
118  TYPE(CMISSCoordinateSystemType) :: CoordinateSystem1,CoordinateSystem2,WorldCoordinateSystem
119  TYPE(CMISSDecompositionType) :: Decomposition1,Decomposition2,InterfaceDecomposition
120  TYPE(CMISSEquationsType) :: Equations1,Equations2
121  TYPE(CMISSEquationsSetType) :: EquationsSet1,EquationsSet2
122  TYPE(CMISSFieldType) :: GeometricField1,GeometricField2,InterfaceGeometricField,DependentField1, &
123    & DependentField2,LagrangeField,EquationsSetField1,EquationsSetField2
124  TYPE(CMISSFieldsType) :: Fields1,Fields2,InterfaceFields
125  TYPE(CMISSGeneratedMeshType) :: GeneratedMesh1,GeneratedMesh2,InterfaceGeneratedMesh
126  TYPE(CMISSInterfaceType) :: Interface
127  TYPE(CMISSInterfaceConditionType) :: InterfaceCondition
128  TYPE(CMISSInterfaceEquationsType) :: InterfaceEquations
129  TYPE(CMISSInterfaceMeshConnectivityType) :: InterfaceMeshConnectivity
130  TYPE(CMISSMeshType) :: Mesh1,Mesh2,InterfaceMesh
131  TYPE(CMISSProblemType) :: CoupledProblem
132  TYPE(CMISSRegionType) :: Region1,Region2,WorldRegion
133  TYPE(CMISSSolverType) :: CoupledSolver
134  TYPE(CMISSSolverEquationsType) :: CoupledSolverEquations
135  
136#ifdef WIN32
137  !Quickwin type
138  LOGICAL :: QUICKWIN_STATUS=.FALSE.
139  TYPE(WINDOWCONFIG) :: QUICKWIN_WINDOW_CONFIG
140#endif
141  
142  !Generic CMISS variables
143  
144  INTEGER(CMISSIntg) :: Err
145  
146#ifdef WIN32
147  !Initialise QuickWin
148  QUICKWIN_WINDOW_CONFIG%TITLE="General Output" !Window title
149  QUICKWIN_WINDOW_CONFIG%NUMTEXTROWS=-1 !Max possible number of rows
150  QUICKWIN_WINDOW_CONFIG%MODE=QWIN$SCROLLDOWN
151  !Set the window parameters
152  QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
153  !If attempt fails set with system estimated values
154  IF(.NOT.QUICKWIN_STATUS) QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
155#endif
156
157  !Intialise OpenCMISS
158  CALL CMISSInitialise(WorldCoordinateSystem,WorldRegion,Err)
159
160  !Set error handling mode
161  CALL CMISSErrorHandlingModeSet(CMISS_ERRORS_TRAP_ERROR,Err)
162 
163  !Set diganostics for testing
164  !CALL CMISSDiagnosticsSetOn(CMISS_FROM_DIAG_TYPE,(/1,2,3,4,5/),"Diagnostics",(/"FIELD_MAPPINGS_CALCULATE", &
165  !  & "SOLVER_MAPPING_CALCULATE"/),Err)
166  
167  !Get the computational nodes information
168  CALL CMISSComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err)
169  CALL CMISSComputationalNodeNumberGet(ComputationalNodeNumber,Err)
170  
171  NUMBER_GLOBAL_X_ELEMENTS=2
172  NUMBER_GLOBAL_Y_ELEMENTS=2
173  NUMBER_GLOBAL_Z_ELEMENTS=0
174  NUMBER_OF_DOMAINS=NumberOfComputationalNodes
175    
176  !Broadcast the number of elements in the X & Y directions and the number of partitions to the other computational nodes
177  CALL MPI_BCAST(NUMBER_GLOBAL_X_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
178  CALL MPI_BCAST(NUMBER_GLOBAL_Y_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
179  CALL MPI_BCAST(NUMBER_GLOBAL_Z_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
180  CALL MPI_BCAST(NUMBER_OF_DOMAINS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
181
182  !Start the creation of a new RC coordinate system for the first region
183  PRINT *, ' == >> CREATING COORDINATE SYSTEM(1) << == '
184  CALL CMISSCoordinateSystem_Initialise(CoordinateSystem1,Err)
185  CALL CMISSCoordinateSystem_CreateStart(CoordinateSystem1UserNumber,CoordinateSystem1,Err)
186  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
187    !Set the coordinate system to be 2D
188    CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem1,2,Err)
189  ELSE
190    !Set the coordinate system to be 3D
191    CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem1,3,Err)
192  ENDIF
193  !Finish the creation of the coordinate system
194  CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystem1,Err)
195
196  !Start the creation of a new RC coordinate system for the second region
197  PRINT *, ' == >> CREATING COORDINATE SYSTEM(2) << == '
198  CALL CMISSCoordinateSystem_Initialise(CoordinateSystem2,Err)
199  CALL CMISSCoordinateSystem_CreateStart(CoordinateSystem2UserNumber,CoordinateSystem2,Err)
200  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
201    !Set the coordinate system to be 2D
202    CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem2,2,Err)
203  ELSE
204    !Set the coordinate system to be 3D
205    CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem2,3,Err)
206  ENDIF
207  !Finish the creation of the coordinate system
208  CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystem2,Err)
209  
210  !Start the creation of the first region
211  PRINT *, ' == >> CREATING REGION(1) << == '
212  CALL CMISSRegion_Initialise(Region1,Err)
213  CALL CMISSRegion_CreateStart(Region1UserNumber,WorldRegion,Region1,Err)
214  !Set the regions coordinate system to the RC coordinate system that we have created
215  CALL CMISSRegion_CoordinateSystemSet(Region1,CoordinateSystem1,Err)
216  !Finish the creation of the first region
217  CALL CMISSRegion_CreateFinish(Region1,Err)
218
219  !Start the creation of the second region
220  PRINT *, ' == >> CREATING REGION(2) << == '
221  CALL CMISSRegion_Initialise(Region2,Err)
222  CALL CMISSRegion_CreateStart(Region2UserNumber,WorldRegion,Region2,Err)
223  !Set the regions coordinate system to the RC coordinate system that we have created
224  CALL CMISSRegion_CoordinateSystemSet(Region2,CoordinateSystem2,Err)
225  !Finish the creation of the second region
226  CALL CMISSRegion_CreateFinish(Region2,Err)
227
228  !Start the creation of a bI/tri-linear-Lagrange basis
229  PRINT *, ' == >> CREATING BASIS(1) << == '
230  CALL CMISSBasis_Initialise(Basis1,Err)
231  CALL CMISSBasis_CreateStart(Basis1UserNumber,Basis1,Err)
232  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
233    !Set the basis to be a bilinear Lagrange basis
234    CALL CMISSBasis_NumberOfXiSet(Basis1,2,Err)
235  ELSE
236    !Set the basis to be a trilinear Lagrange basis
237    CALL CMISSBasis_NumberOfXiSet(Basis1,3,Err)
238  ENDIF
239  !Finish the creation of the basis
240  CALL CMISSBasis_CreateFinish(Basis1,Err)
241   
242  !Start the creation of a bI/tri-quadratic-Lagrange basis
243  PRINT *, ' == >> CREATING BASIS(2) << == '
244  CALL CMISSBasis_Initialise(Basis2,Err)
245  CALL CMISSBasis_CreateStart(Basis2UserNumber,Basis2,Err)
246  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
247    !Set the basis to be a bilinear Lagrange basis
248    CALL CMISSBasis_NumberOfXiSet(Basis2,2,Err)
249    CALL CMISSBasis_InterpolationXiSet(Basis2,(/CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION, &
250      & CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION/),Err)
251  ELSE
252    !Set the basis to be a trilinear Lagrange basis
253    CALL CMISSBasis_NumberOfXiSet(Basis2,3,Err)
254    CALL CMISSBasis_InterpolationXiSet(Basis2,(/CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION, &
255      & CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION,CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION/),Err)
256  ENDIF
257  !Finish the creation of the basis
258  CALL CMISSBasis_CreateFinish(Basis2,Err)
259  
260  !Start the creation of a generated mesh in the first region
261  PRINT *, ' == >> CREATING GENERATED MESH(1) << == '
262  CALL CMISSGeneratedMesh_Initialise(GeneratedMesh1,Err)
263  CALL CMISSGeneratedMesh_CreateStart(GeneratedMesh1UserNumber,Region1,GeneratedMesh1,Err)
264  !Set up a regular x*y*z mesh
265  CALL CMISSGeneratedMesh_TypeSet(GeneratedMesh1,CMISS_GENERATED_MESH_REGULAR_MESH_TYPE,Err)
266  !Set the default basis
267  CALL CMISSGeneratedMesh_BasisSet(GeneratedMesh1,Basis1,Err)   
268  !Define the mesh on the first region
269  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
270    CALL CMISSGeneratedMesh_ExtentSet(GeneratedMesh1,(/WIDTH,HEIGHT/),Err)
271    CALL CMISSGeneratedMesh_NumberOfElementsSet(GeneratedMesh1,(/NUMBER_GLOBAL_X_ELEMENTS, &
272      & NUMBER_GLOBAL_Y_ELEMENTS/),Err)
273  ELSE
274    CALL CMISSGeneratedMesh_ExtentSet(GeneratedMesh1,(/WIDTH,HEIGHT,LENGTH/),Err)
275    CALL CMISSGeneratedMesh_NumberOfElementsSet(GeneratedMesh1,(/NUMBER_GLOBAL_X_ELEMENTS, &
276      & NUMBER_GLOBAL_Y_ELEMENTS,NUMBER_GLOBAL_Z_ELEMENTS/),Err)
277  ENDIF    
278  !Finish the creation of a generated mesh in the first region
279  CALL CMISSMesh_Initialise(Mesh1,Err)
280  CALL CMISSGeneratedMesh_CreateFinish(GeneratedMesh1,Mesh1UserNumber,Mesh1,Err)
281
282  !Start the creation of a generated mesh in the second region
283  PRINT *, ' == >> CREATING GENERATED MESH(2) << == '
284  CALL CMISSGeneratedMesh_Initialise(GeneratedMesh2,Err)
285  CALL CMISSGeneratedMesh_CreateStart(GeneratedMesh2UserNumber,Region2,GeneratedMesh2,Err)
286  !Set up a regular x*y*z mesh
287  CALL CMISSGeneratedMesh_TypeSet(GeneratedMesh2,CMISS_GENERATED_MESH_REGULAR_MESH_TYPE,Err)
288  !Set the default basis
289  CALL CMISSGeneratedMesh_BasisSet(GeneratedMesh2,Basis2,Err)   
290  !Define the mesh on the second region
291  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
292    CALL CMISSGeneratedMesh_OriginSet(GeneratedMesh2,(/WIDTH,0.0_CMISSDP/),Err)
293    CALL CMISSGeneratedMesh_ExtentSet(GeneratedMesh2,(/WIDTH,HEIGHT/),Err)
294    CALL CMISSGeneratedMesh_NumberOfElementsSet(GeneratedMesh2,(/NUMBER_GLOBAL_X_ELEMENTS, &
295      & NUMBER_GLOBAL_Y_ELEMENTS/),Err)
296  ELSE
297    CALL CMISSGeneratedMesh_OriginSet(GeneratedMesh2,(/WIDTH,0.0_CMISSDP,0.0_CMISSDP/),Err)
298    CALL CMISSGeneratedMesh_ExtentSet(GeneratedMesh2,(/WIDTH,HEIGHT,LENGTH/),Err)
299    CALL CMISSGeneratedMesh_NumberOfElementsSet(GeneratedMesh2,(/NUMBER_GLOBAL_X_ELEMENTS, &
300      & NUMBER_GLOBAL_Y_ELEMENTS,NUMBER_GLOBAL_Z_ELEMENTS/),Err)
301  ENDIF    
302  !Finish the creation of a generated mesh in the second region
303  CALL CMISSMesh_Initialise(Mesh2,Err)
304  CALL CMISSGeneratedMesh_CreateFinish(GeneratedMesh2,Mesh2UserNumber,Mesh2,Err)
305
306  !Create an interface between the two meshes
307  PRINT *, ' == >> CREATING INTERFACE << == '
308  CALL CMISSInterface_Initialise(Interface,Err)
309  CALL CMISSInterface_CreateStart(InterfaceUserNumber,WorldRegion,Interface,Err)
310  !Add in the two meshes
311  CALL CMISSInterface_MeshAdd(Interface,Mesh1,Mesh1Index,Err)
312  CALL CMISSInterface_MeshAdd(Interface,Mesh2,Mesh2Index,Err)
313  !Finish creating the interface
314  CALL CMISSInterface_CreateFinish(INTERFACE,Err)
315
316  !Start the creation of a (bi)-linear-Lagrange basis
317  PRINT *, ' == >> CREATING INTERFACE BASIS << == '
318  CALL CMISSBasis_Initialise(InterfaceBasis,Err)
319  CALL CMISSBasis_CreateStart(InterfaceBasisUserNumber,InterfaceBasis,Err)
320  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
321    !Set the basis to be a linear Lagrange basis
322    CALL CMISSBasis_NumberOfXiSet(InterfaceBasis,1,Err)
323    CALL CMISSBasis_InterpolationXiSet(InterfaceBasis,(/CMISS_BASIS_LINEAR_LAGRANGE_INTERPOLATION/),Err)
324  ELSE
325    !Set the basis to be a bilinear Lagrange basis
326    CALL CMISSBasis_NumberOfXiSet(InterfaceBasis,2,Err)
327    CALL CMISSBasis_InterpolationXiSet(InterfaceBasis,(/CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION, &
328      & CMISS_BASIS_QUADRATIC_LAGRANGE_INTERPOLATION/),Err)
329  ENDIF
330  !Finish the creation of the basis
331  CALL CMISSBasis_CreateFinish(InterfaceBasis,Err)
332  
333  !Start the creation of a generated mesh for the interface
334  PRINT *, ' == >> CREATING INTERFACE GENERATED MESH << == '
335  CALL CMISSGeneratedMesh_Initialise(InterfaceGeneratedMesh,Err)
336  CALL CMISSGeneratedMesh_CreateStart(InterfaceGeneratedMeshUserNumber,Interface,InterfaceGeneratedMesh,Err)
337  !Set up a regular x*y*z mesh
338  CALL CMISSGeneratedMesh_TypeSet(InterfaceGeneratedMesh,CMISS_GENERATED_MESH_REGULAR_MESH_TYPE,Err)
339  !Set the default basis
340  CALL CMISSGeneratedMesh_BasisSet(InterfaceGeneratedMesh,InterfaceBasis,Err)   
341  !Define the mesh on the interface
342  CALL CMISSGeneratedMesh_OriginSet(InterfaceGeneratedMesh,(/WIDTH,0.0_CMISSDP,0.0_CMISSDP/),Err)
343  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
344    CALL CMISSGeneratedMesh_ExtentSet(InterfaceGeneratedMesh,(/WIDTH,HEIGHT,0.0_CMISSDP/),Err)
345    CALL CMISSGeneratedMesh_NumberOfElementsSet(InterfaceGeneratedMesh,(/NUMBER_GLOBAL_Y_ELEMENTS/),Err)
346  ELSE
347    CALL CMISSGeneratedMesh_ExtentSet(InterfaceGeneratedMesh,(/WIDTH,HEIGHT,LENGTH/),Err)
348    CALL CMISSGeneratedMesh_NumberOfElementsSet(InterfaceGeneratedMesh,(/NUMBER_GLOBAL_Y_ELEMENTS, &
349      & NUMBER_GLOBAL_Z_ELEMENTS/),Err)
350  ENDIF    
351  !Finish the creation of a generated mesh in interface
352  CALL CMISSMesh_Initialise(InterfaceMesh,Err)
353  CALL CMISSGeneratedMesh_CreateFinish(InterfaceGeneratedMesh,InterfaceMeshUserNumber,InterfaceMesh,Err)
354
355  !Couple the interface meshes
356!  CALL CMISSInterfaceMeshConnectivity_CreateStart(Interface,InterfaceMeshConnectivity,Err)
357! <<>> CALL COMMAND TO ADD MESHES CONNECTIVITY INFORMATION <<>> Dave + Sebo april 7.
358!      CMISSInterfaceMeshConnectivityMeshAdd()
359!      CMISSInterfaceMeshConnectivityElementsAdd()
360!      CMISSInterfaceMeshConnectivityXiPoint()
361!  CALL CMISSInterfaceMeshConnectivity_CreateFinish(InterfaceMeshConnectivity,Err)
362
363
364
365
366
367
368
369  !Create a decomposition for mesh1
370  PRINT *, ' == >> CREATING MESH(1) DECOMPOSITION << == '
371  CALL CMISSDecomposition_Initialise(Decomposition1,Err)
372  CALL CMISSDecomposition_CreateStart(Decomposition1UserNumber,Mesh1,Decomposition1,Err)
373  !Set the decomposition to be a general decomposition with the specified number of domains
374  CALL CMISSDecomposition_TypeSet(Decomposition1,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
375  CALL CMISSDecomposition_NumberOfDomainsSet(Decomposition1,NUMBER_OF_DOMAINS,Err)
376  !Finish the decomposition
377  CALL CMISSDecomposition_CreateFinish(Decomposition1,Err)
378
379  !Create a decomposition for mesh2
380  PRINT *, ' == >> CREATING MESH(2) DECOMPOSITION << == '
381  CALL CMISSDecomposition_Initialise(Decomposition2,Err)
382  CALL CMISSDecomposition_CreateStart(Decomposition2UserNumber,Mesh2,Decomposition2,Err)
383  !Set the decomposition to be a general decomposition with the specified number of domains
384  CALL CMISSDecomposition_TypeSet(Decomposition2,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
385  CALL CMISSDecomposition_NumberOfDomainsSet(Decomposition2,NUMBER_OF_DOMAINS,Err)
386  !Finish the decomposition
387  CALL CMISSDecomposition_CreateFinish(Decomposition2,Err)
388  
389  !Create a decomposition for the interface mesh
390  PRINT *, ' == >> CREATING INTERFACE DECOMPOSITION << == '
391  CALL CMISSDecomposition_Initialise(InterfaceDecomposition,Err)
392  CALL CMISSDecomposition_CreateStart(InterfaceDecompositionUserNumber,InterfaceMesh,InterfaceDecomposition,Err)
393  !Set the decomposition to be a general decomposition with the specified number of domains
394  CALL CMISSDecomposition_TypeSet(InterfaceDecomposition,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
395  CALL CMISSDecomposition_NumberOfDomainsSet(InterfaceDecomposition,NUMBER_OF_DOMAINS,Err)
396  !Finish the decomposition
397  CALL CMISSDecomposition_CreateFinish(InterfaceDecomposition,Err)
398
399  !Start to create a default (geometric) field on the first region
400  PRINT *, ' == >> CREATING MESH(1) GEOMETRIC FIELD << == '
401  CALL CMISSField_Initialise(GeometricField1,Err)
402  CALL CMISSField_CreateStart(GeometricField1UserNumber,Region1,GeometricField1,Err)
403  !Set the decomposition to use
404  CALL CMISSField_MeshDecompositionSet(GeometricField1,Decomposition1,Err)
405  !Set the domain to be used by the field components.
406  CALL CMISSField_ComponentMeshComponentSet(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
407  CALL CMISSField_ComponentMeshComponentSet(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,2,1,Err)
408  IF(NUMBER_GLOBAL_Z_ELEMENTS/=0) THEN
409    CALL CMISSField_ComponentMeshComponentSet(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,3,1,Err)
410  ENDIF
411  !Finish creating the first field
412  CALL CMISSField_CreateFinish(GeometricField1,Err)
413
414  !Start to create a default (geometric) field on the second region
415  PRINT *, ' == >> CREATING MESH(2) GEOMETRIC FIELD << == '
416  CALL CMISSField_Initialise(GeometricField2,Err)
417  CALL CMISSField_CreateStart(GeometricField2UserNumber,Region2,GeometricField2,Err)
418  !Set the decomposition to use
419  CALL CMISSField_MeshDecompositionSet(GeometricField2,Decomposition2,Err)
420  !Set the domain to be used by the field components.
421  CALL CMISSField_ComponentMeshComponentSet(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
422  CALL CMISSField_ComponentMeshComponentSet(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,2,1,Err)
423  IF(NUMBER_GLOBAL_Z_ELEMENTS/=0) THEN
424    CALL CMISSField_ComponentMeshComponentSet(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,3,1,Err)
425  ENDIF
426  !Finish creating the second field
427  CALL CMISSField_CreateFinish(GeometricField2,Err)
428
429  !Update the geometric field parameters for the first field
430  CALL CMISSGeneratedMesh_GeometricParametersCalculate(GeneratedMesh1,GeometricField1,Err)
431  !Update the geometric field parameters for the second field
432  CALL CMISSGeneratedMesh_GeometricParametersCalculate(GeneratedMesh2,GeometricField2,Err)
433
434 !Create the equations set for the first region
435  PRINT *, ' == >> CREATING EQUATION SET(1) << == '
436  CALL CMISSField_Initialise(EquationsSetField1,Err)
437  CALL CMISSEquationsSet_Initialise(EquationsSet1,Err)
438  CALL CMISSEquationsSet_CreateStart(EquationsSet1UserNumber,Region1,GeometricField1,CMISS_EQUATIONS_SET_CLASSICAL_FIELD_CLASS, &
439    & CMISS_EQUATIONS_SET_LAPLACE_EQUATION_TYPE,CMISS_EQUATIONS_SET_STANDARD_LAPLACE_SUBTYPE,EquationsSetField1UserNumber,&
440    & EquationsSetField1,EquationsSet1,Err)
441  !Set the equations set to be a standard Laplace problem
442  !Finish creating the equations set
443  CALL CMISSEquationsSet_CreateFinish(EquationsSet1,Err)
444
445  !Create the equations set for the second region
446  PRINT *, ' == >> CREATING EQUATION SET(2) << == '
447  CALL CMISSField_Initialise(EquationsSetField2,Err)
448  CALL CMISSEquationsSet_Initialise(EquationsSet2,Err)
449  CALL CMISSEquationsSet_CreateStart(EquationsSet2UserNumber,Region2,GeometricField2,CMISS_EQUATIONS_SET_CLASSICAL_FIELD_CLASS, &
450    & CMISS_EQUATIONS_SET_LAPLACE_EQUATION_TYPE,CMISS_EQUATIONS_SET_STANDARD_LAPLACE_SUBTYPE,EquationsSetField2UserNumber,&
451    & EquationsSetField2,EquationsSet2,Err)
452  !Finish creating the equations set
453  CALL CMISSEquationsSet_CreateFinish(EquationsSet2,Err)
454
455  !Create the equations set dependent field variables for the first equations set
456  PRINT *, ' == >> CREATING DEPENDENT FIELD(1) << == '
457  CALL CMISSField_Initialise(DependentField1,Err)
458  CALL CMISSEquationsSet_DependentCreateStart(EquationsSet1,DependentField1UserNumber,DependentField1,Err)
459  !Finish the equations set dependent field variables
460  CALL CMISSEquationsSet_DependentCreateFinish(EquationsSet1,Err)
461
462  !Create the equations set dependent field variables for the second equations set
463  PRINT *, ' == >> CREATING DEPENDENT FIELD(2) << == '
464  CALL CMISSField_Initialise(DependentField2,Err)
465  CALL CMISSEquationsSet_DependentCreateStart(EquationsSet2,DependentField2UserNumber,DependentField2,Err)
466  !Finish the equations set dependent field variables
467  CALL CMISSEquationsSet_DependentCreateFinish(EquationsSet2,Err)
468
469  !Create the equations set equations for the first equations set
470  PRINT *, ' == >> CREATING EQUATIONS(1) << == '
471  CALL CMISSEquations_Initialise(Equations1,Err)
472  CALL CMISSEquationsSet_EquationsCreateStart(EquationsSet1,Equations1,Err)
473  !Set the equations matrices sparsity type
474  CALL CMISSEquations_SparsityTypeSet(Equations1,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
475  !Set the equations set output
476  !CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_NO_OUTPUT,Err)
477  CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_TIMING_OUTPUT,Err)
478  !CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_MATRIX_OUTPUT,Err)
479  !CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT,Err)
480  !Finish the equations set equations
481  CALL CMISSEquationsSet_EquationsCreateFinish(EquationsSet1,Err)
482
483  !Create the equations set equations for the second equations set
484  PRINT *, ' == >> CREATING EQUATIONS(2) << == '
485  CALL CMISSEquations_Initialise(Equations2,Err)
486  CALL CMISSEquationsSet_EquationsCreateStart(EquationsSet2,Equations2,Err)
487  !Set the equations matrices sparsity type
488  CALL CMISSEquations_SparsityTypeSet(Equations2,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
489  !Set the equations set output
490  !CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_NO_OUTPUT,Err)
491  CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_TIMING_OUTPUT,Err)
492  !CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_MATRIX_OUTPUT,Err)
493  !CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT,Err)
494  !Finish the equations set equations
495  CALL CMISSEquationsSet_EquationsCreateFinish(EquationsSet2,Err)
496
497  !Start to create a default (geometric) field on the Interface
498  PRINT *, ' == >> CREATING INTERFACE GEOMETRIC FIELD << == '
499  CALL CMISSField_Initialise(InterfaceGeometricField,Err)
500  CALL CMISSField_CreateStart(InterfaceGeometricFieldUserNumber,Interface,InterfaceGeometricField,Err)
501  !Set the decomposition to use
502  CALL CMISSField_MeshDecompositionSet(InterfaceGeometricField,InterfaceDecomposition,Err)
503  !Set the domain to be used by the field components.
504  CALL CMISSField_ComponentMeshComponentSet(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
505  CALL CMISSField_ComponentMeshComponentSet(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,2,1,Err)
506  IF(NUMBER_GLOBAL_Z_ELEMENTS/=0) THEN
507    CALL CMISSField_ComponentMeshComponentSet(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,3,1,Err)
508  ENDIF
509  !Finish creating the first field
510  CALL CMISSField_CreateFinish(InterfaceGeometricField,Err)
511
512  !Update the geometric field parameters for the interface field
513  CALL CMISSGeneratedMesh_GeometricParametersCalculate(InterfaceGeneratedMesh,InterfaceGeometricField,Err)
514  
515! <<  ACCESS LATER  >>>
516  
517  !Create an interface condition between the two meshes
518  CALL CMISSInterfaceCondition_Initialise(InterfaceCondition,Err)
519  CALL CMISSInterfaceCondition_CreateStart(InterfaceConditionUserNumber,Interface,InterfaceGeometricField, &
520    & InterfaceCondition,Err)
521  !Specify the method for the interface condition
522  CALL CMISSInterfaceCondition_MethodSet(InterfaceCondition,CMISS_INTERFACE_CONDITION_LAGRANGE_MULTIPLIERS_METHOD,Err)
523  !Specify the type of interface condition operator
524  CALL CMISSInterfaceCondition_OperatorSet(InterfaceCondition,CMISS_INTERFACE_CONDITION_FIELD_CONTINUITY_OPERATOR,Err)
525  !Add in the dependent variables
526  CALL CMISSInterfaceCondition_DependentVariableAdd(InterfaceCondition,Mesh1Index,DependentField1, &
527    & CMISS_FIELD_U_VARIABLE_TYPE,Err)
528  CALL CMISSInterfaceCondition_DependentVariableAdd(InterfaceCondition,Mesh2Index,DependentField2, &
529    & CMISS_FIELD_U_VARIABLE_TYPE,Err)
530  !Finish creating the interface condition
531  CALL CMISSInterfaceCondition_CreateFinish(InterfaceCondition,Err)
532
533  !Create the Lagrange multipliers field
534  PRINT *, ' == >> CREATING INTERFACE LAGRANGE FIELD << == '
535  CALL CMISSField_Initialise(LagrangeField,Err)
536  CALL CMISSInterfaceCondition_LagrangeFieldCreateStart(InterfaceCondition,LagrangeFieldUserNumber, &
537    & LagrangeField,Err)
538  !Finish the Lagrange multipliers field
539  CALL CMISSInterfaceCondition_LagrangeFieldCreateFinish(InterfaceCondition,Err)
540
541  !Create the interface condition equations
542  PRINT *, ' == >> CREATING INTERFACE EQUATIONS << == '
543  CALL CMISSInterfaceEquations_Initialise(InterfaceEquations,Err)
544  CALL CMISSInterfaceCondition_EquationsCreateStart(InterfaceCondition,InterfaceEquations,Err)
545  !Set the interface equations sparsity
546  CALL CMISSInterfaceEquations_SparsitySet(InterfaceEquations,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
547  !Set the interface equations output
548  CALL CMISSInterfaceEquations_OutputTypeSet(InterfaceEquations,CMISS_EQUATIONS_TIMING_OUTPUT,Err)
549  !Finish creating the interface equations
550  CALL CMISSInterfaceCondition_EquationsCreateFinish(InterfaceCondition,Err)
551  
552  !Start the creation of a coupled problem.
553  CALL CMISSProblem_Initialise(CoupledProblem,Err)
554  CALL CMISSProblem_CreateStart(CoupledProblemUserNumber,CoupledProblem,Err)
555  !Set the problem to be a standard Laplace problem
556  CALL CMISSProblem_SpecificationSet(CoupledProblem,CMISS_PROBLEM_CLASSICAL_FIELD_CLASS, &
557    & CMISS_PROBLEM_LAPLACE_EQUATION_TYPE,CMISS_PROBLEM_STANDARD_LAPLACE_SUBTYPE,Err)
558  !Finish the creation of a problem.
559  CALL CMISSProblem_CreateFinish(CoupledProblem,Err)
560
561  !Start the creation of the problem control loop for the coupled problem
562  CALL CMISSProblem_ControlLoopCreateStart(CoupledProblem,Err)
563  !Finish creating the problem control loop
564  CALL CMISSProblem_ControlLoopCreateFinish(CoupledProblem,Err)
565 
566  !Start the creation of the problem solver for the coupled problem
567  CALL CMISSSolver_Initialise(CoupledSolver,Err)
568  CALL CMISSProblem_SolversCreateStart(CoupledProblem,Err)
569  CALL CMISSProblem_SolverGet(CoupledProblem,CMISS_CONTROL_LOOP_NODE,1,CoupledSolver,Err)
570  !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_NO_OUTPUT,Err)
571  !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_PROGRESS_OUTPUT,Err)
572  !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_TIMING_OUTPUT,Err)
573  !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_SOLVER_OUTPUT,Err)
574  CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_MATRIX_OUTPUT,Err)
575  !Finish the creation of the problem solver
576  CALL CMISSProblem_SolversCreateFinish(CoupledProblem,Err)
577
578  !Start the creation of the problem solver equations for the coupled problem
579  CALL CMISSSolver_Initialise(CoupledSolver,Err)
580  CALL CMISSSolverEquations_Initialise(CoupledSolverEquations,Err)
581  CALL CMISSProblem_SolverEquationsCreateStart(CoupledProblem,Err)
582  !Get the solve equations
583  CALL CMISSProblem_SolverGet(CoupledProblem,CMISS_CONTROL_LOOP_NODE,1,CoupledSolver,Err)
584  CALL CMISSSolver_SolverEquationsGet(CoupledSolver,CoupledSolverEquations,Err)
585  !Set the solver equations sparsity
586  CALL CMISSSolverEquations_SparsityTypeSet(CoupledSolverEquations,CMISS_SOLVER_SPARSE_MATRICES,Err)
587  !CALL CMISSSolverEquations_SparsityTypeSet(CoupledSolverEquations,CMISS_SOLVER_FULL_MATRICES,Err)  
588  !Add in the first equations set
589  CALL CMISSSolverEquations_EquationsSetAdd(CoupledSolverEquations,EquationsSet1,EquationsSet1Index,Err)
590  !Add in the second equations set
591  CALL CMISSSolverEquations_EquationsSetAdd(CoupledSolverEquations,EquationsSet2,EquationsSet2Index,Err)
592  !Add in the interface condition
593  CALL CMISSSolverEquations_InterfaceConditionAdd(CoupledSolverEquations,InterfaceCondition, &
594    & InterfaceConditionIndex,Err)
595  !Finish the creation of the problem solver equations
596  CALL CMISSProblem_SolverEquationsCreateFinish(CoupledProblem,Err)
597
598  !Start the creation of the equations set boundary conditions for both equations sets
599  PRINT *, ' == >> CREATING BOUNDARY CONDITIONS << == '
600  CALL CMISSBoundaryConditions_Initialise(BoundaryConditions,Err)
601  CALL CMISSSolverEquations_BoundaryConditionsCreateStart(CoupledSolverEquations,BoundaryConditions,Err)
602  !Set the first node to 0.0
603  FirstNodeNumber=1
604  CALL CMISSDecomposition_NodeDomainGet(Decomposition1,FirstNodeNumber,1,FirstNodeDomain,Err)
605  IF(FirstNodeDomain==ComputationalNodeNumber) THEN
606    CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField1,CMISS_FIELD_U_VARIABLE_TYPE,1,1,FirstNodeNumber,1, &
607      & CMISS_BOUNDARY_CONDITION_FIXED,0.0_CMISSDP,Err)
608  ENDIF
609
610  !Set the last node to 1.0
611  IF(NUMBER_GLOBAL_Z_ELEMENTS==0) THEN
612    LastNodeNumber=(NUMBER_GLOBAL_X_ELEMENTS+1)*(NUMBER_GLOBAL_Y_ELEMENTS+1)
613  ELSE
614    LastNodeNumber=(NUMBER_GLOBAL_X_ELEMENTS+1)*(NUMBER_GLOBAL_Y_ELEMENTS+1)*(NUMBER_GLOBAL_Z_ELEMENTS+1)
615  ENDIF
616  CALL CMISSDecomposition_NodeDomainGet(Decomposition2,LastNodeNumber,1,LastNodeDomain,Err)
617  IF(LastNodeDomain==ComputationalNodeNumber) THEN
618    CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField2,CMISS_FIELD_U_VARIABLE_TYPE,1,1,LastNodeNumber,1, &
619      & CMISS_BOUNDARY_CONDITION_FIXED,1.0_CMISSDP,Err)
620  ENDIF
621  !Finish the creation of the equations set boundary conditions
622  CALL CMISSSolverEquations_BoundaryConditionsCreateFinish(CoupledSolverEquations,Err)
623
624  !Solve the problem
625  CALL CMISSProblem_Solve(CoupledProblem,Err)
626
627  EXPORT_FIELD=.TRUE.
628  IF(EXPORT_FIELD) THEN
629    CALL CMISSFields_Initialise(Fields1,Err)
630    CALL CMISSFields_Create(Region1,Fields1,Err)
631    CALL CMISSFields_NodesExport(Fields1,"TwoRegion_1","FORTRAN",Err)
632    CALL CMISSFields_ElementsExport(Fields1,"TwoRegion_1","FORTRAN",Err)
633    CALL CMISSFields_Finalise(Fields1,Err)
634    CALL CMISSFields_Initialise(Fields2,Err)
635    CALL CMISSFields_Create(Region2,Fields2,Err)
636    CALL CMISSFields_NodesExport(Fields2,"TwoRegion_2","FORTRAN",Err)
637    CALL CMISSFields_ElementsExport(Fields2,"TwoRegion_2","FORTRAN",Err)
638    CALL CMISSFields_Finalise(Fields2,Err)
639    CALL CMISSFields_Initialise(InterfaceFields,Err)
640    CALL CMISSFields_Create(Interface,InterfaceFields,Err)
641    CALL CMISSFields_NodesExport(InterfaceFields,"TwoRegion_Interface","FORTRAN",Err)
642    CALL CMISSFields_ElementsExport(InterfaceFields,"TwoRegion_Interface","FORTRAN",Err)
643    CALL CMISSFields_Finalise(InterfaceFields,Err)
644  ENDIF
645    
646  !Finialise CMISS
647  !CALL CMISSFinalise(Err)
648
649  WRITE(*,'(A)') "Program successfully completed."
650
651  STOP
652 
653END PROGRAM TWOREGIONSEXAMPLE