PageRenderTime 52ms CodeModel.GetById 11ms RepoModel.GetById 0ms app.codeStats 0ms

/InterfaceExamples/InputCoupledStokes/src/InputCoupledStokesExample.f90

http://github.com/xyan075/examples
FORTRAN Modern | 1366 lines | 865 code | 162 blank | 339 comment | 68 complexity | 672b61fc9974c31b892d000d56f21b13 MD5 | raw file
    

  1. !> \file
    2. 

  2. !> \author Chris Bradley
    3. 

  3. !> \brief This is an example program which solves a weakly coupled Stokes equation in two regions using OpenCMISS calls.
    4. 

  4. !>
    5. 

  5. !> \section LICENSE
    6. 

  6. !>
    7. 

  7. !> Version: MPL 1.1/GPL 2.0/LGPL 2.1
    8. 

  8. !>
    9. 

  9. !> The contents of this file are subject to the Mozilla Public License
    10. 

  10. !> Version 1.1 (the "License"); you may not use this file except in
    11. 

  11. !> compliance with the License. You may obtain a copy of the License at
    12. 

  12. !> http://www.mozilla.org/MPL/
    13. 

  13. !>
    14. 

  14. !> Software distributed under the License is distributed on an "AS IS"
    15. 

  15. !> basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See the
    16. 

  16. !> License for the specific language governing rights and limitations
    17. 

  17. !> under the License.
    18. 

  18. !>
    19. 

  19. !> The Original Code is OpenCMISS
    20. 

  20. !>
    21. 

  21. !> The Initial Developer of the Original Code is University of Auckland,
    22. 

  22. !> Auckland, New Zealand and University of Oxford, Oxford, United
    23. 

  23. !> Kingdom. Portions created by the University of Auckland and University
    24. 

  24. !> of Oxford are Copyright (C) 2007 by the University of Auckland and
    25. 

  25. !> the University of Oxford. All Rights Reserved.
    26. 

  26. !>
    27. 

  27. !> Contributor(s):
    28. 

  28. !>
    29. 

  29. !> Alternatively, the contents of this file may be used under the terms of
    30. 

  30. !> either the GNU General Public License Version 2 or later (the "GPL"), or
    31. 

  31. !> the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
    32. 

  32. !> in which case the provisions of the GPL or the LGPL are applicable instead
    33. 

  33. !> of those above. If you wish to allow use of your version of this file only
    34. 

  34. !> under the terms of either the GPL or the LGPL, and not to allow others to
    35. 

  35. !> use your version of this file under the terms of the MPL, indicate your
    36. 

  36. !> decision by deleting the provisions above and replace them with the notice
    37. 

  37. !> and other provisions required by the GPL or the LGPL. If you do not delete
    38. 

  38. !> the provisions above, a recipient may use your version of this file under
    39. 

  39. !> the terms of any one of the MPL, the GPL or the LGPL.
    40. 

  40. !>
    41. 

  41. 

  42. !> \example InterfaceExamples/CoupledStokes/src/CoupledStoesExample.f90
    43. 

  43. !! Example program which sets up a field in two regions using OpenCMISS calls.
    44. 

  44. !! \par Latest Builds:
    45. 

  45. !! \li <a href='http://autotest.bioeng.auckland.ac.nz/opencmiss-build/logs_x86_64-linux/InterfaceExamples/CoupledStokes/build-intel'>Linux Intel Build</a>
    46. 

  46. !! \li <a href='http://autotest.bioeng.auckland.ac.nz/opencmiss-build/logs_x86_64-linux/InterfaceExamples/CoupledStokes/build-gnu'>Linux GNU Build</a>
    47. 

  47. !<
    48. 

  48. 

  49. !> Main program
    50. 

  50. PROGRAM COUPLEDSTOKES
    51. 

  51. 

  52.   USE OPENCMISS
    53. 

  53.   USE FLUID_MECHANICS_IO_ROUTINES
    54. 

  54.   
    55. 

  55. #ifdef WIN32
    56. 

  56.   USE IFQWIN
    57. 

  57. #endif
    58. 

  58. 

  59.   IMPLICIT NONE
    60. 

  60. 

  61.   !Test program parameters
    62. 

  62. 

  63.   INTEGER(CMISSIntg), PARAMETER :: CoordinateSystem1UserNumber=1
    64. 

  64.   INTEGER(CMISSIntg), PARAMETER :: CoordinateSystem2UserNumber=2
    65. 

  65.   INTEGER(CMISSIntg), PARAMETER :: Region1UserNumber=3
    66. 

  66.   INTEGER(CMISSIntg), PARAMETER :: Region2UserNumber=4
    67. 

  67.   INTEGER(CMISSIntg), PARAMETER :: Basis1UserNumber=5
    68. 

  68.   INTEGER(CMISSIntg), PARAMETER :: Basis2UserNumber=6
    69. 

  69.   INTEGER(CMISSIntg), PARAMETER :: InterfaceBasisUserNumber=7
    70. 

  70.   INTEGER(CMISSIntg), PARAMETER :: InterfaceGeneratedMeshUserNumber=10
    71. 

  71.   INTEGER(CMISSIntg), PARAMETER :: Mesh1UserNumber=11
    72. 

  72.   INTEGER(CMISSIntg), PARAMETER :: Mesh2UserNumber=12
    73. 

  73.   INTEGER(CMISSIntg), PARAMETER :: InterfaceMeshUserNumber=13
    74. 

  74.   INTEGER(CMISSIntg), PARAMETER :: Decomposition1UserNumber=14
    75. 

  75.   INTEGER(CMISSIntg), PARAMETER :: Decomposition2UserNumber=15
    76. 

  76.   INTEGER(CMISSIntg), PARAMETER :: InterfaceDecompositionUserNumber=16
    77. 

  77.   INTEGER(CMISSIntg), PARAMETER :: GeometricField1UserNumber=17
    78. 

  78.   INTEGER(CMISSIntg), PARAMETER :: GeometricField2UserNumber=18
    79. 

  79.   INTEGER(CMISSIntg), PARAMETER :: InterfaceGeometricFieldUserNumber=19
    80. 

  80.   INTEGER(CMISSIntg), PARAMETER :: EquationsSet1UserNumber=20
    81. 

  81.   INTEGER(CMISSIntg), PARAMETER :: EquationsSet2UserNumber=21
    82. 

  82.   INTEGER(CMISSIntg), PARAMETER :: DependentField1UserNumber=22
    83. 

  83.   INTEGER(CMISSIntg), PARAMETER :: DependentField2UserNumber=23
    84. 

  84.   INTEGER(CMISSIntg), PARAMETER :: InterfaceUserNumber=24
    85. 

  85.   INTEGER(CMISSIntg), PARAMETER :: InterfaceConditionUserNumber=25
    86. 

  86.   INTEGER(CMISSIntg), PARAMETER :: LagrangeFieldUserNumber=26
    87. 

  87.   INTEGER(CMISSIntg), PARAMETER :: CoupledProblemUserNumber=27
    88. 

  88.   INTEGER(CMISSIntg), PARAMETER :: InterfaceMappingBasisUserNumber=28
    89. 

  89.   INTEGER(CMISSIntg), PARAMETER :: EquationsSetField1UserNumber=40
    90. 

  90.   INTEGER(CMISSIntg), PARAMETER :: EquationsSetField2UserNumber=41
    91. 

  91. 

  92.   INTEGER(CMISSIntg), PARAMETER :: MaterialsComponentUserNumber1=1 !MU
    93. 

  93.   INTEGER(CMISSIntg), PARAMETER :: MaterialsComponentUserNumber2=2 !RHO
    94. 

  94.  
    95. 

  95.   !Program types
    96. 

  96. 

  97.   TYPE(EXPORT_CONTAINER):: CM1,CM2,CM3
    98. 

  98.   TYPE(COUPLING_PARAMETERS):: CMX
    99. 

  99.   TYPE(BOUNDARY_PARAMETERS):: BC
    100. 

  100.   
    101. 

  101.   !Program variables
    102. 

  102.   INTEGER(CMISSIntg) :: EquationsSet1Index,EquationsSet2Index
    103. 

  103.   INTEGER(CMISSIntg) :: BoundaryNodeDomain
    104. 

  104.   INTEGER(CMISSIntg) :: InterfaceConditionIndex
    105. 

  105.   INTEGER(CMISSIntg) :: Mesh1Index,Mesh2Index
    106. 

  106.   INTEGER(CMISSIntg) :: NumberOfComputationalNodes,ComputationalNodeNumber,ic_idx
    107. 

  107.   REAL(CMISSDP) :: VALUE
    108. 

  108. 

  109.   INTEGER(CMISSIntg) :: NUMBER_OF_DIMENSIONS1,NUMBER_OF_DIMENSIONS2,NUMBER_OF_DIMENSIONS_INTERFACE
    110. 

  110.   
    111. 

  111.   INTEGER(CMISSIntg) :: BASIS_TYPE1,BASIS_TYPE2,BASIS_TYPE_INTERFACE
    112. 

  112.   INTEGER(CMISSIntg) :: BASIS_NUMBER_SPACE1,BASIS_NUMBER_SPACE2,BASIS_NUMBER_SPACE_INTERFACE
    113. 

  113.   INTEGER(CMISSIntg) :: BASIS_NUMBER_VELOCITY1,BASIS_NUMBER_VELOCITY2
    114. 

  114.   INTEGER(CMISSIntg) :: BASIS_NUMBER_PRESSURE1,BASIS_NUMBER_PRESSURE2
    115. 

  115.   INTEGER(CMISSIntg) :: BASIS_XI_GAUSS_SPACE1,BASIS_XI_GAUSS_SPACE2,BASIS_XI_GAUSS_INTERFACE
    116. 

  116.   INTEGER(CMISSIntg) :: BASIS_XI_GAUSS_VELOCITY1,BASIS_XI_GAUSS_VELOCITY2
    117. 

  117.   INTEGER(CMISSIntg) :: BASIS_XI_GAUSS_PRESSURE1,BASIS_XI_GAUSS_PRESSURE2
    118. 

  118.   INTEGER(CMISSIntg) :: BASIS_XI_INTERPOLATION_SPACE1,BASIS_XI_INTERPOLATION_SPACE2,BASIS_XI_INTERPOLATION_INTERFACE
    119. 

  119.   INTEGER(CMISSIntg) :: BASIS_XI_INTERPOLATION_VELOCITY1,BASIS_XI_INTERPOLATION_VELOCITY2
    120. 

  120.   INTEGER(CMISSIntg) :: BASIS_XI_INTERPOLATION_PRESSURE1,BASIS_XI_INTERPOLATION_PRESSURE2
    121. 

  121.   INTEGER(CMISSIntg) :: MESH_NUMBER_OF_COMPONENTS1,MESH_NUMBER_OF_COMPONENTS2,MESH_NUMBER_OF_COMPONENTS_INTERFACE
    122. 

  122.   INTEGER(CMISSIntg) :: MESH_COMPONENT_NUMBER_SPACE1,MESH_COMPONENT_NUMBER_SPACE2,MESH_COMPONENT_NUMBER_INTERFACE
    123. 

  123.   INTEGER(CMISSIntg) :: MESH_COMPONENT_NUMBER_VELOCITY1,MESH_COMPONENT_NUMBER_VELOCITY2
    124. 

  124.   INTEGER(CMISSIntg) :: MESH_COMPONENT_NUMBER_PRESSURE1,MESH_COMPONENT_NUMBER_PRESSURE2
    125. 

  125.   INTEGER(CMISSIntg) :: NUMBER_OF_NODES_SPACE1,NUMBER_OF_NODES_SPACE2,NUMBER_OF_NODES_INTERFACE
    126. 

  126.   INTEGER(CMISSIntg) :: NUMBER_OF_NODES_VELOCITY1,NUMBER_OF_NODES_VELOCITY2
    127. 

  127.   INTEGER(CMISSIntg) :: NUMBER_OF_NODES_PRESSURE1,NUMBER_OF_NODES_PRESSURE2
    128. 

  128.   INTEGER(CMISSIntg) :: NUMBER_OF_ELEMENT_NODES_SPACE1,NUMBER_OF_ELEMENT_NODES_SPACE2,NUMBER_OF_ELEMENT_NODES_INTERFACE
    129. 

  129.   INTEGER(CMISSIntg) :: NUMBER_OF_ELEMENT_NODES_VELOCITY1,NUMBER_OF_ELEMENT_NODES_VELOCITY2
    130. 

  130.   INTEGER(CMISSIntg) :: NUMBER_OF_ELEMENT_NODES_PRESSURE1,NUMBER_OF_ELEMENT_NODES_PRESSURE2
    131. 

  131.   INTEGER(CMISSIntg) :: TOTAL_NUMBER_OF_NODES1,TOTAL_NUMBER_OF_NODES2,TOTAL_NUMBER_OF_NODES_INTERFACE
    132. 

  132.   INTEGER(CMISSIntg) :: TOTAL_NUMBER_OF_ELEMENTS1,TOTAL_NUMBER_OF_ELEMENTS2,TOTAL_NUMBER_OF_ELEMENTS_INTERFACE
    133. 

  133.   INTEGER(CMISSIntg) :: ELEMENT_NUMBER,COMPONENT_NUMBER,NODE_NUMBER,NODE_COUNTER,CONDITION
    134. 

  134.   INTEGER(CMISSIntg) :: NUMBER_OF_FIXED_WALL_NODES1,NUMBER_OF_FIXED_WALL_NODES2
    135. 

  135.   INTEGER(CMISSIntg) :: NUMBER_OF_INLET_WALL_NODES1,NUMBER_OF_INLET_WALL_NODES2
    136. 

  136. 

  137.   INTEGER, ALLOCATABLE, DIMENSION(:):: FIXED_WALL_NODES1
    138. 

  138.   INTEGER, ALLOCATABLE, DIMENSION(:):: INLET_WALL_NODES1
    139. 

  139.   REAL(CMISSDP) :: BOUNDARY_CONDITIONS1(3)
    140. 

  140.   LOGICAL :: FIXED_WALL_NODES1_FLAG=.TRUE.
    141. 

  141.   LOGICAL :: INLET_WALL_NODES1_FLAG=.TRUE.
    142. 

  142. 

  143.   INTEGER, ALLOCATABLE, DIMENSION(:):: FIXED_WALL_NODES2
    144. 

  144.   INTEGER, ALLOCATABLE, DIMENSION(:):: INLET_WALL_NODES2
    145. 

  145.   REAL(CMISSDP) :: BOUNDARY_CONDITIONS2(3)
    146. 

  146.   LOGICAL :: FIXED_WALL_NODES2_FLAG=.TRUE.
    147. 

  147.   LOGICAL :: INLET_WALL_NODES2_FLAG=.TRUE.
    148. 

  148. 

  149. 

  150.   REAL(CMISSDP) :: RHO_PARAM=1.0_CMISSDP
    151. 

  151.   REAL(CMISSDP) :: MU_PARAM=1.0_CMISSDP
    152. 

  152. 

  153.   !CMISS variables
    154. 

  154. 

  155.   TYPE(CMISSBasisType) :: BasisSpace1,BasisSpace2
    156. 

  156.   TYPE(CMISSBasisType) :: BasisVelocity1,BasisVelocity2
    157. 

  157.   TYPE(CMISSBasisType) :: BasisPressure1,BasisPressure2
    158. 

  158.   TYPE(CMISSBasisType) :: InterfaceBasis,InterfaceMappingBasis
    159. 

  159.   TYPE(CMISSBoundaryConditionsType) :: BoundaryConditions
    160. 

  160.   TYPE(CMISSCoordinateSystemType) :: CoordinateSystem1,CoordinateSystem2,WorldCoordinateSystem
    161. 

  161.   TYPE(CMISSDecompositionType) :: Decomposition1,Decomposition2,InterfaceDecomposition
    162. 

  162.   TYPE(CMISSEquationsType) :: Equations1,Equations2
    163. 

  163.   TYPE(CMISSEquationsSetType) :: EquationsSet1,EquationsSet2
    164. 

  164.   TYPE(CMISSFieldType) :: GeometricField1,GeometricField2
    165. 

  165.   TYPE(CMISSFieldType) :: InterfaceGeometricField,LagrangeField
    166. 

  166.   TYPE(CMISSFieldType) :: DependentField1,DependentField2
    167. 

  167.   TYPE(CMISSFieldType) :: EquationsSetField1,EquationsSetField2
    168. 

  168.   TYPE(CMISSFieldType) :: MaterialsField1,MaterialsField2
    169. 

  169. 

  170.   TYPE(CMISSFieldsType) :: Fields1,Fields2,InterfaceFields
    171. 

  171.   TYPE(CMISSInterfaceType) :: Interface
    172. 

  172.   TYPE(CMISSInterfaceConditionType) :: InterfaceCondition
    173. 

  173.   TYPE(CMISSInterfaceEquationsType) :: InterfaceEquations
    174. 

  174.   TYPE(CMISSInterfaceMeshConnectivityType) :: InterfaceMeshConnectivity
    175. 

  175.   !Nodes
    176. 

  176.   TYPE(CMISSNodesType) :: Nodes1
    177. 

  177.   TYPE(CMISSNodesType) :: Nodes2
    178. 

  178.   TYPE(CMISSNodesType) :: InterfaceNodes
    179. 

  179.   !Elements
    180. 

  180.   TYPE(CMISSMeshElementsType) :: MeshElementsSpace1,MeshElementsVelocity1,MeshElementsPressure1
    181. 

  181.   TYPE(CMISSMeshElementsType) :: MeshElementsSpace2,MeshElementsVelocity2,MeshElementsPressure2
    182. 

  182.   TYPE(CMISSMeshElementsType) :: InterfaceMeshElements
    183. 

  183.   TYPE(CMISSMeshType) :: Mesh1,Mesh2,InterfaceMesh
    184. 

  184.   TYPE(CMISSProblemType) :: CoupledProblem
    185. 

  185.   TYPE(CMISSRegionType) :: Region1,Region2,WorldRegion
    186. 

  186.   TYPE(CMISSSolverType) :: CoupledSolver
    187. 

  187.   TYPE(CMISSSolverEquationsType) :: CoupledSolverEquations
    188. 

  188.   
    189. 

  189. #ifdef WIN32
    190. 

  190.   !Quickwin type
    191. 

  191.   LOGICAL :: QUICKWIN_STATUS=.FALSE.
    192. 

  192.   TYPE(WINDOWCONFIG) :: QUICKWIN_WINDOW_CONFIG
    193. 

  193. #endif
    194. 

  194.   
    195. 

  195.   !Generic CMISS variables
    196. 

  196.   
    197. 

  197.   INTEGER(CMISSIntg) :: Err
    198. 

  198.   
    199. 

  199. #ifdef WIN32
    200. 

  200.   !Initialise QuickWin
    201. 

  201.   QUICKWIN_WINDOW_CONFIG%TITLE="General Output" !Window title
    202. 

  202.   QUICKWIN_WINDOW_CONFIG%NUMTEXTROWS=-1 !Max possible number of rows
    203. 

  203.   QUICKWIN_WINDOW_CONFIG%MODE=QWIN$SCROLLDOWN
    204. 

  204.   !Set the window parameters
    205. 

  205.   QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
    206. 

  206.   !If attempt fails set with system estimated values
    207. 

  207.   IF(.NOT.QUICKWIN_STATUS) QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
    208. 

  208. #endif
    209. 

  209. 

  210.   !
    211. 

  211.   !================================================================================================================================
    212. 

  212.   !
    213. 

  213. 

  214.   !INITIALISE OPENCMISS
    215. 

  215. 

  216. 

  217.   !Intialise OpenCMISS
    218. 

  218.   CALL CMISSInitialise(WorldCoordinateSystem,WorldRegion,Err)
    219. 

  219. 

  220.   !Set error handling mode
    221. 

  221.   CALL CMISSErrorHandlingModeSet(CMISS_ERRORS_TRAP_ERROR,Err)
    222. 

  222.  
    223. 

  223.   !Set diganostics for testing
    224. 

  224.   !CALL CMISSDiagnosticsSetOn(CMISS_FROM_DIAG_TYPE,[1,2,3,4,5],"Diagnostics",["SOLVER_MAPPING_CALCULATE         ", &
    225. 

  225.   !  & "SOLVER_MATRIX_STRUCTURE_CALCULATE"],Err)
    226. 

  226.   
    227. 

  227.   !
    228. 

  228.   !================================================================================================================================
    229. 

  229.   !
    230. 

  230. 

  231.   !CHECK COMPUTATIONAL NODE
    232. 

  232. 

  233.   !Get the computational nodes information
    234. 

  234.   CALL CMISSComputationalNumberOfNodesGet(NumberOfComputationalNodes,Err)
    235. 

  235.   CALL CMISSComputationalNodeNumberGet(ComputationalNodeNumber,Err)
    236. 

  236. 

  237.   !
    238. 

  238.   !================================================================================================================================
    239. 

  239.   !
    240. 

  240. 

  241.   !PROBLEM CONTROL PANEL
    242. 

  242. 

  243.   !Import cmHeart mesh information
    244. 

  244.   CALL FLUID_MECHANICS_IO_READ_CMHEART(CM1,CM2,CM3,CMX,BC,Err)
    245. 

  245. 

  246.   !Information for mesh 1
    247. 

  247.   BASIS_NUMBER_SPACE1=CM1%ID_M
    248. 

  248.   BASIS_NUMBER_VELOCITY1=CM1%ID_V
    249. 

  249.   BASIS_NUMBER_PRESSURE1=CM1%ID_P
    250. 

  250.   NUMBER_OF_DIMENSIONS1=CM1%D
    251. 

  251.   BASIS_TYPE1=CM1%IT_T
    252. 

  252.   BASIS_XI_INTERPOLATION_SPACE1=CM1%IT_M
    253. 

  253.   BASIS_XI_INTERPOLATION_VELOCITY1=CM1%IT_V
    254. 

  254.   BASIS_XI_INTERPOLATION_PRESSURE1=CM1%IT_P
    255. 

  255.   NUMBER_OF_NODES_SPACE1=CM1%N_M
    256. 

  256.   NUMBER_OF_NODES_VELOCITY1=CM1%N_V
    257. 

  257.   NUMBER_OF_NODES_PRESSURE1=CM1%N_P
    258. 

  258.   TOTAL_NUMBER_OF_NODES1=CM1%N_T
    259. 

  259.   TOTAL_NUMBER_OF_ELEMENTS1=CM1%E_T
    260. 

  260.   NUMBER_OF_ELEMENT_NODES_SPACE1=CM1%EN_M
    261. 

  261.   NUMBER_OF_ELEMENT_NODES_VELOCITY1=CM1%EN_V
    262. 

  262.   NUMBER_OF_ELEMENT_NODES_PRESSURE1=CM1%EN_P
    263. 

  263.   !Information for mesh 2
    264. 

  264.   BASIS_NUMBER_SPACE2=CM2%ID_M+10
    265. 

  265.   BASIS_NUMBER_VELOCITY2=CM2%ID_V+10
    266. 

  266.   BASIS_NUMBER_PRESSURE2=CM2%ID_P+10
    267. 

  267.   NUMBER_OF_DIMENSIONS2=CM2%D
    268. 

  268.   BASIS_TYPE2=CM2%IT_T
    269. 

  269.   BASIS_XI_INTERPOLATION_SPACE2=CM2%IT_M
    270. 

  270.   BASIS_XI_INTERPOLATION_VELOCITY2=CM2%IT_V
    271. 

  271.   BASIS_XI_INTERPOLATION_PRESSURE2=CM2%IT_P
    272. 

  272.   NUMBER_OF_NODES_SPACE2=CM2%N_M
    273. 

  273.   NUMBER_OF_NODES_VELOCITY2=CM2%N_V
    274. 

  274.   NUMBER_OF_NODES_PRESSURE2=CM2%N_P
    275. 

  275.   TOTAL_NUMBER_OF_NODES2=CM2%N_T
    276. 

  276.   TOTAL_NUMBER_OF_ELEMENTS2=CM2%E_T
    277. 

  277.   NUMBER_OF_ELEMENT_NODES_SPACE2=CM2%EN_M
    278. 

  278.   NUMBER_OF_ELEMENT_NODES_VELOCITY2=CM2%EN_V
    279. 

  279.   NUMBER_OF_ELEMENT_NODES_PRESSURE2=CM2%EN_P
    280. 

  280.   !Set interpolation parameters
    281. 

  281.   BASIS_XI_GAUSS_SPACE1=3
    282. 

  282.   BASIS_XI_GAUSS_VELOCITY1=3
    283. 

  283.   BASIS_XI_GAUSS_PRESSURE1=3
    284. 

  284.   BASIS_XI_GAUSS_SPACE2=3
    285. 

  285.   BASIS_XI_GAUSS_VELOCITY2=3
    286. 

  286.   BASIS_XI_GAUSS_PRESSURE2=3
    287. 

  287.   BASIS_NUMBER_SPACE_INTERFACE=CM3%ID_M
    288. 

  288.   NUMBER_OF_DIMENSIONS_INTERFACE=CM3%D
    289. 

  289.   BASIS_TYPE_INTERFACE=CM3%IT_T
    290. 

  290.   BASIS_XI_INTERPOLATION_INTERFACE=CM3%IT_M
    291. 

  291.   BASIS_XI_INTERPOLATION_VELOCITY2=CM2%IT_V
    292. 

  292.   BASIS_XI_INTERPOLATION_PRESSURE2=CM2%IT_P
    293. 

  293.   NUMBER_OF_NODES_INTERFACE=CM3%N_M
    294. 

  294.   NUMBER_OF_NODES_VELOCITY2=CM2%N_V
    295. 

  295.   NUMBER_OF_NODES_PRESSURE2=CM2%N_P
    296. 

  296.   TOTAL_NUMBER_OF_NODES_INTERFACE=CM3%N_T
    297. 

  297.   TOTAL_NUMBER_OF_ELEMENTS_INTERFACE=CM3%E_T
    298. 

  298.   NUMBER_OF_ELEMENT_NODES_INTERFACE=CM3%EN_M
    299. 

  299.   NUMBER_OF_ELEMENT_NODES_VELOCITY2=CM2%EN_V
    300. 

  300.   NUMBER_OF_ELEMENT_NODES_PRESSURE2=CM2%EN_P
    301. 

  301.   !Set interpolation parameters
    302. 

  302.   BASIS_XI_GAUSS_INTERFACE=3
    303. 

  303.   BASIS_XI_GAUSS_VELOCITY1=3
    304. 

  304.   BASIS_XI_GAUSS_PRESSURE1=3
    305. 

  305.   BASIS_XI_GAUSS_INTERFACE=3
    306. 

  306.   BASIS_XI_GAUSS_VELOCITY2=3
    307. 

  307.   BASIS_XI_GAUSS_PRESSURE2=3
    308. 

  308. 

  309.   IF(FIXED_WALL_NODES1_FLAG) THEN
    310. 

  310.     NUMBER_OF_FIXED_WALL_NODES1=80
    311. 

  311.     ALLOCATE(FIXED_WALL_NODES1(NUMBER_OF_FIXED_WALL_NODES1))
    312. 

  312.     FIXED_WALL_NODES1=(/1,2,3,4,5,7,9,10,11,12,13,14,17,20,24,28,29,30,31,32,33,34,35,37,39, & 
    313. 

  313.     & 41,44,46,47,48,50,51,52,53,54,57,60,64,65,66,67,68,70,72,74,76,77,78,79,80,83,86, & 
    314. 

  314.     & 89,90,91,92,93,94,95,97,99,101,102,103,104,105,106,107,108,111,114,115,116,117,118, & 
    315. 

  315.     & 120,122,123,124,125/)
    316. 

  316.   ENDIF
    317. 

  317.   IF(INLET_WALL_NODES1_FLAG) THEN
    318. 

  318.     NUMBER_OF_INLET_WALL_NODES1=9
    319. 

  319.     ALLOCATE(INLET_WALL_NODES1(NUMBER_OF_INLET_WALL_NODES1))
    320. 

  320.     INLET_WALL_NODES1=(/67,74,76,79,87,88,102,103,113/)
    321. 

  321.     !Set initial boundary conditions
    322. 

  322.     BOUNDARY_CONDITIONS1(1)=1.0_CMISSDP
    323. 

  323.     BOUNDARY_CONDITIONS1(2)=0.0_CMISSDP
    324. 

  324.     BOUNDARY_CONDITIONS1(3)=0.0_CMISSDP
    325. 

  325.   ENDIF
    326. 

  326.   IF(FIXED_WALL_NODES2_FLAG) THEN
    327. 

  327.     NUMBER_OF_FIXED_WALL_NODES2=80
    328. 

  328.     ALLOCATE(FIXED_WALL_NODES2(NUMBER_OF_FIXED_WALL_NODES2))
    329. 

  329.     FIXED_WALL_NODES2=(/1,2,3,4,5,7,9,10,11,12,13,14,17,20,24,28,29,30,31,32,33,34,35,37,39, & 
    330. 

  330.     & 41,44,46,47,48,50,51,52,53,54,57,60,64,65,66,67,68,70,72,74,76,77,78,79,80,83,86, & 
    331. 

  331.     & 89,90,91,92,93,94,95,97,99,101,102,103,104,105,106,107,108,111,114,115,116,117,118, & 
    332. 

  332.     & 120,122,123,124,125/)
    333. 

  333.   ENDIF
    334. 

  334.   IF(INLET_WALL_NODES2_FLAG) THEN
    335. 

  335.     NUMBER_OF_INLET_WALL_NODES2=9
    336. 

  336.     ALLOCATE(INLET_WALL_NODES2(NUMBER_OF_INLET_WALL_NODES1))
    337. 

  337.     INLET_WALL_NODES2=(/67,74,76,79,87,88,102,103,113/)
    338. 

  338.     !Set initial boundary conditions
    339. 

  339.     BOUNDARY_CONDITIONS2(1)=1.0_CMISSDP
    340. 

  340.     BOUNDARY_CONDITIONS2(2)=0.0_CMISSDP
    341. 

  341.     BOUNDARY_CONDITIONS2(3)=0.0_CMISSDP
    342. 

  342.   ENDIF
    343. 

  343. 

  344. 

  345. 

  346.   !
    347. 

  347.   !================================================================================================================================
    348. 

  348.   !
    349. 

  349. 

  350.   !COORDINATE SYSTEM
    351. 

  351. 

  352.   
    353. 

  353.   !Start the creation of a new RC coordinate system for the first region
    354. 

  354.   PRINT *, ' == >> CREATING COORDINATE SYSTEM(1) << == '
    355. 

  355.   CALL CMISSCoordinateSystem_Initialise(CoordinateSystem1,Err)
    356. 

  356.   CALL CMISSCoordinateSystem_CreateStart(CoordinateSystem1UserNumber,CoordinateSystem1,Err)
    357. 

  357.   !Set the coordinate system dimension
    358. 

  358.   CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem1,NUMBER_OF_DIMENSIONS1,Err)
    359. 

  359.   !Finish the creation of the coordinate system
    360. 

  360.   CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystem1,Err)
    361. 

  361. 

  362.   !Start the creation of a new RC coordinate system for the second region
    363. 

  363.   PRINT *, ' == >> CREATING COORDINATE SYSTEM(2) << == '
    364. 

  364.   CALL CMISSCoordinateSystem_Initialise(CoordinateSystem2,Err)
    365. 

  365.   CALL CMISSCoordinateSystem_CreateStart(CoordinateSystem2UserNumber,CoordinateSystem2,Err)
    366. 

  366.   !Set the coordinate system dimension
    367. 

  367.   CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystem2,NUMBER_OF_DIMENSIONS2,Err)
    368. 

  368.   !Finish the creation of the coordinate system
    369. 

  369.   CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystem2,Err)
    370. 

  370. 

  371.   !
    372. 

  372.   !================================================================================================================================
    373. 

  373.   !
    374. 

  374. 

  375.   !REGION
    376. 

  376.   
    377. 

  377.   !Start the creation of the first region
    378. 

  378.   PRINT *, ' == >> CREATING REGION(1) << == '
    379. 

  379.   CALL CMISSRegion_Initialise(Region1,Err)
    380. 

  380.   CALL CMISSRegion_CreateStart(Region1UserNumber,WorldRegion,Region1,Err)
    381. 

  381.   CALL CMISSRegion_LabelSet(Region1,"Region1",Err)
    382. 

  382.   !Set the regions coordinate system as defined above
    383. 

  383.   CALL CMISSRegion_CoordinateSystemSet(Region1,CoordinateSystem1,Err)
    384. 

  384.   !Finish the creation of the region
    385. 

  385.   CALL CMISSRegion_CreateFinish(Region1,Err)
    386. 

  386. 

  387.   !Start the creation of the second region
    388. 

  388.   PRINT *, ' == >> CREATING REGION(2) << == '
    389. 

  389.   CALL CMISSRegion_Initialise(Region2,Err)
    390. 

  390.   CALL CMISSRegion_CreateStart(Region2UserNumber,WorldRegion,Region2,Err)
    391. 

  391.   CALL CMISSRegion_LabelSet(Region2,"Region2",Err)
    392. 

  392.   !Set the regions coordinate system as defined above
    393. 

  393.   CALL CMISSRegion_CoordinateSystemSet(Region2,CoordinateSystem2,Err)
    394. 

  394.   !Finish the creation of the region
    395. 

  395.   CALL CMISSRegion_CreateFinish(Region2,Err)
    396. 

  396. 

  397.   !
    398. 

  398.   !================================================================================================================================
    399. 

  399.   !
    400. 

  400. 

  401.   !BASES
    402. 

  402. 

  403. 

  404.   !Start the creation of a bI/tri-linear-Lagrange basis
    405. 

  405.   PRINT *, ' == >> CREATING BASIS(1) << == '
    406. 

  406.   !Start the creation of new bases
    407. 

  407.   MESH_NUMBER_OF_COMPONENTS1=1
    408. 

  408.   CALL CMISSBasis_Initialise(BasisSpace1,Err)
    409. 

  409.   CALL CMISSBasis_CreateStart(BASIS_NUMBER_SPACE1,BasisSpace1,Err)
    410. 

  410.   !Set the basis type (Lagrange/Simplex)
    411. 

  411.   CALL CMISSBasis_TypeSet(BasisSpace1,BASIS_TYPE1,Err)
    412. 

  412.   !Set the basis xi number
    413. 

  413.   CALL CMISSBasis_NumberOfXiSet(BasisSpace1,NUMBER_OF_DIMENSIONS1,Err)
    414. 

  414.   !Set the basis xi interpolation and number of Gauss points
    415. 

  415.   IF(NUMBER_OF_DIMENSIONS1==2.AND.NUMBER_OF_DIMENSIONS2==2) THEN
    416. 

  416.     CALL CMISSBasis_InterpolationXiSet(BasisSpace1,(/BASIS_XI_INTERPOLATION_SPACE1,BASIS_XI_INTERPOLATION_SPACE1/),Err)
    417. 

  417.     IF(BASIS_TYPE1/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    418. 

  418.       CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisSpace1,(/BASIS_XI_GAUSS_SPACE1,BASIS_XI_GAUSS_SPACE1/),Err)
    419. 

  419.     ELSE
    420. 

  420.       CALL CMISSBasis_QuadratureOrderSet(BasisSpace1,BASIS_XI_GAUSS_SPACE1+1,Err)
    421. 

  421.     ENDIF
    422. 

  422.   ELSE IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    423. 

  423.     CALL CMISSBasis_InterpolationXiSet(BasisSpace1,(/BASIS_XI_INTERPOLATION_SPACE1,BASIS_XI_INTERPOLATION_SPACE1, & 
    424. 

  424.       & BASIS_XI_INTERPOLATION_SPACE1/),Err)                         
    425. 

  425.     IF(BASIS_TYPE1/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    426. 

  426.       CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisSpace1,(/BASIS_XI_GAUSS_SPACE1,BASIS_XI_GAUSS_SPACE1, &
    427. 

  427.         & BASIS_XI_GAUSS_SPACE1/),Err)
    428. 

  428.     ELSE
    429. 

  429.       CALL CMISSBasis_QuadratureOrderSet(BasisSpace1,BASIS_XI_GAUSS_SPACE1+1,Err)
    430. 

  430.     ENDIF
    431. 

  431.   ELSE
    432. 

  432.     CALL HANDLE_ERROR("Dimension coupling error.")
    433. 

  433.   ENDIF
    434. 

  434.   !Finish the creation of the basis
    435. 

  435.   CALL CMISSBasis_CreateFinish(BasisSpace1,Err)
    436. 

  436.   !Start the creation of another basis
    437. 

  437.   IF(BASIS_XI_INTERPOLATION_VELOCITY1==BASIS_XI_INTERPOLATION_SPACE1) THEN
    438. 

  438.     BasisVelocity1=BasisSpace1
    439. 

  439.   ELSE
    440. 

  440.     MESH_NUMBER_OF_COMPONENTS1=MESH_NUMBER_OF_COMPONENTS1+1
    441. 

  441.     !Initialise a new velocity basis
    442. 

  442.     CALL CMISSBasis_Initialise(BasisVelocity1,Err)
    443. 

  443.     !Start the creation of a basis
    444. 

  444.     CALL CMISSBasis_CreateStart(BASIS_NUMBER_VELOCITY1,BasisVelocity1,Err)
    445. 

  445.     !Set the basis type (Lagrange/Simplex)
    446. 

  446.     CALL CMISSBasis_TypeSet(BasisVelocity1,BASIS_TYPE1,Err)
    447. 

  447.     !Set the basis xi number
    448. 

  448.     CALL CMISSBasis_NumberOfXiSet(BasisVelocity1,NUMBER_OF_DIMENSIONS1,Err)
    449. 

  449.     !Set the basis xi interpolation and number of Gauss points
    450. 

  450.     IF(NUMBER_OF_DIMENSIONS1==2.AND.NUMBER_OF_DIMENSIONS2==2) THEN
    451. 

  451.       CALL CMISSBasis_InterpolationXiSet(BasisVelocity1,(/BASIS_XI_INTERPOLATION_VELOCITY1,BASIS_XI_INTERPOLATION_VELOCITY1/),Err)
    452. 

  452.       IF(BASIS_TYPE1/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    453. 

  453.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisVelocity1,(/BASIS_XI_GAUSS_VELOCITY1,BASIS_XI_GAUSS_VELOCITY1/),Err)
    454. 

  454.       ELSE
    455. 

  455.         CALL CMISSBasis_QuadratureOrderSet(BasisVelocity1,BASIS_XI_GAUSS_VELOCITY1+1,Err)
    456. 

  456.       ENDIF
    457. 

  457.     ELSE IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    458. 

  458.       CALL CMISSBasis_InterpolationXiSet(BasisVelocity1,(/BASIS_XI_INTERPOLATION_VELOCITY1,BASIS_XI_INTERPOLATION_VELOCITY1, & 
    459. 

  459.         & BASIS_XI_INTERPOLATION_VELOCITY1/),Err)                         
    460. 

  460.       IF(BASIS_TYPE1/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    461. 

  461.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisVelocity1,(/BASIS_XI_GAUSS_VELOCITY1,BASIS_XI_GAUSS_VELOCITY1, &
    462. 

  462.           & BASIS_XI_GAUSS_VELOCITY1/),Err)
    463. 

  463.       ELSE
    464. 

  464.         CALL CMISSBasis_QuadratureOrderSet(BasisVelocity1,BASIS_XI_GAUSS_VELOCITY1+1,Err)
    465. 

  465.       ENDIF
    466. 

  466.     ELSE
    467. 

  467.       CALL HANDLE_ERROR("Dimension coupling error.")
    468. 

  468.     ENDIF
    469. 

  469.     !Finish the creation of the basis
    470. 

  470.     CALL CMISSBasis_CreateFinish(BasisVelocity1,Err)
    471. 

  471.   ENDIF
    472. 

  472.   !Start the creation of another basis
    473. 

  473.   IF(BASIS_XI_INTERPOLATION_PRESSURE1==BASIS_XI_INTERPOLATION_SPACE1) THEN
    474. 

  474.     BasisPressure1=BasisSpace1
    475. 

  475.   ELSE IF(BASIS_XI_INTERPOLATION_PRESSURE1==BASIS_XI_INTERPOLATION_VELOCITY1) THEN
    476. 

  476.     BasisPressure1=BasisVelocity1
    477. 

  477.   ELSE
    478. 

  478.     MESH_NUMBER_OF_COMPONENTS1=MESH_NUMBER_OF_COMPONENTS1+1
    479. 

  479.     !Initialise a new pressure basis
    480. 

  480.     CALL CMISSBasis_Initialise(BasisPressure1,Err)
    481. 

  481.     !Start the creation of a basis
    482. 

  482.     CALL CMISSBasis_CreateStart(BASIS_NUMBER_PRESSURE1,BasisPressure1,Err)
    483. 

  483.     !Set the basis type (Lagrange/Simplex)
    484. 

  484.     CALL CMISSBasis_TypeSet(BasisPressure1,BASIS_TYPE1,Err)
    485. 

  485.     !Set the basis xi number
    486. 

  486.     CALL CMISSBasis_NumberOfXiSet(BasisPressure1,NUMBER_OF_DIMENSIONS1,Err)
    487. 

  487.     !Set the basis xi interpolation and number of Gauss points
    488. 

  488.     IF(NUMBER_OF_DIMENSIONS1==2.AND.NUMBER_OF_DIMENSIONS2==2) THEN
    489. 

  489.       CALL CMISSBasis_InterpolationXiSet(BasisPressure1,(/BASIS_XI_INTERPOLATION_PRESSURE1,BASIS_XI_INTERPOLATION_PRESSURE1/),Err)
    490. 

  490.       IF(BASIS_TYPE1/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    491. 

  491.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisPressure1,(/BASIS_XI_GAUSS_PRESSURE1,BASIS_XI_GAUSS_PRESSURE1/),Err)
    492. 

  492.       ELSE
    493. 

  493.         CALL CMISSBasis_QuadratureOrderSet(BasisPressure1,BASIS_XI_GAUSS_PRESSURE1+1,Err)
    494. 

  494.       ENDIF
    495. 

  495.     ELSE IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    496. 

  496.       CALL CMISSBasis_InterpolationXiSet(BasisPressure1,(/BASIS_XI_INTERPOLATION_PRESSURE1,BASIS_XI_INTERPOLATION_PRESSURE1, & 
    497. 

  497.         & BASIS_XI_INTERPOLATION_PRESSURE1/),Err)                         
    498. 

  498.       IF(BASIS_TYPE1/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    499. 

  499.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisPressure1,(/BASIS_XI_GAUSS_PRESSURE1,BASIS_XI_GAUSS_PRESSURE1, &
    500. 

  500.           & BASIS_XI_GAUSS_PRESSURE1/),Err)
    501. 

  501.       ELSE
    502. 

  502.         CALL CMISSBasis_QuadratureOrderSet(BasisPressure1,BASIS_XI_GAUSS_PRESSURE1+1,Err)
    503. 

  503.       ENDIF
    504. 

  504.     ELSE
    505. 

  505.       CALL HANDLE_ERROR("Dimension coupling error.")
    506. 

  506.     ENDIF
    507. 

  507.     !Finish the creation of the basis
    508. 

  508.     CALL CMISSBasis_CreateFinish(BasisPressure1,Err)
    509. 

  509.   ENDIF
    510. 

  510. 

  511. 

  512.   !Start the creation of a bI/tri-XXX-Lagrange basis
    513. 

  513.   PRINT *, ' == >> CREATING BASIS(2) << == '
    514. 

  514.   !Start the creation of new bases
    515. 

  515.   MESH_NUMBER_OF_COMPONENTS2=1
    516. 

  516.   CALL CMISSBasis_Initialise(BasisSpace2,Err)
    517. 

  517.   CALL CMISSBasis_CreateStart(BASIS_NUMBER_SPACE2,BasisSpace2,Err)
    518. 

  518.   !Set the basis type (Lagrange/Simplex)
    519. 

  519.   CALL CMISSBasis_TypeSet(BasisSpace2,BASIS_TYPE2,Err)
    520. 

  520.   !Set the basis xi number
    521. 

  521.   CALL CMISSBasis_NumberOfXiSet(BasisSpace2,NUMBER_OF_DIMENSIONS2,Err)
    522. 

  522.   !Set the basis xi interpolation and number of Gauss points
    523. 

  523.   IF(NUMBER_OF_DIMENSIONS1==2.AND.NUMBER_OF_DIMENSIONS2==2) THEN
    524. 

  524.     CALL CMISSBasis_InterpolationXiSet(BasisSpace2,(/BASIS_XI_INTERPOLATION_SPACE2,BASIS_XI_INTERPOLATION_SPACE2/),Err)
    525. 

  525.     IF(BASIS_TYPE2/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    526. 

  526.       CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisSpace2,(/BASIS_XI_GAUSS_SPACE2,BASIS_XI_GAUSS_SPACE2/),Err)
    527. 

  527.     ELSE
    528. 

  528.       CALL CMISSBasis_QuadratureOrderSet(BasisSpace2,BASIS_XI_GAUSS_SPACE2+1,Err)
    529. 

  529.     ENDIF
    530. 

  530.   ELSE IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    531. 

  531.     CALL CMISSBasis_InterpolationXiSet(BasisSpace2,(/BASIS_XI_INTERPOLATION_SPACE2,BASIS_XI_INTERPOLATION_SPACE2, & 
    532. 

  532.       & BASIS_XI_INTERPOLATION_SPACE2/),Err)                         
    533. 

  533.     IF(BASIS_TYPE2/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    534. 

  534.       CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisSpace2,(/BASIS_XI_GAUSS_SPACE2,BASIS_XI_GAUSS_SPACE2, &
    535. 

  535.         & BASIS_XI_GAUSS_SPACE2/),Err)
    536. 

  536.     ELSE
    537. 

  537.       CALL CMISSBasis_QuadratureOrderSet(BasisSpace2,BASIS_XI_GAUSS_SPACE2+1,Err)
    538. 

  538.     ENDIF
    539. 

  539.   ELSE
    540. 

  540.     CALL HANDLE_ERROR("Dimension coupling error.")
    541. 

  541.   ENDIF
    542. 

  542.   !Finish the creation of the basis
    543. 

  543.   CALL CMISSBasis_CreateFinish(BasisSpace2,Err)
    544. 

  544.   !Start the creation of another basis
    545. 

  545.   IF(BASIS_XI_INTERPOLATION_VELOCITY2==BASIS_XI_INTERPOLATION_SPACE2) THEN
    546. 

  546.     BasisVelocity2=BasisSpace2
    547. 

  547.   ELSE
    548. 

  548.     MESH_NUMBER_OF_COMPONENTS2=MESH_NUMBER_OF_COMPONENTS2+1
    549. 

  549.     !Initialise a new velocity basis
    550. 

  550.     CALL CMISSBasis_Initialise(BasisVelocity2,Err)
    551. 

  551.     !Start the creation of a basis
    552. 

  552.     CALL CMISSBasis_CreateStart(BASIS_NUMBER_VELOCITY2,BasisVelocity2,Err)
    553. 

  553.     !Set the basis type (Lagrange/Simplex)
    554. 

  554.     CALL CMISSBasis_TypeSet(BasisVelocity2,BASIS_TYPE2,Err)
    555. 

  555.     !Set the basis xi number
    556. 

  556.     CALL CMISSBasis_NumberOfXiSet(BasisVelocity2,NUMBER_OF_DIMENSIONS2,Err)
    557. 

  557.     !Set the basis xi interpolation and number of Gauss points
    558. 

  558.     IF(NUMBER_OF_DIMENSIONS1==2.AND.NUMBER_OF_DIMENSIONS2==2) THEN
    559. 

  559.       CALL CMISSBasis_InterpolationXiSet(BasisVelocity2,(/BASIS_XI_INTERPOLATION_VELOCITY2,BASIS_XI_INTERPOLATION_VELOCITY2/),Err)
    560. 

  560.       IF(BASIS_TYPE2/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    561. 

  561.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisVelocity2,(/BASIS_XI_GAUSS_VELOCITY2,BASIS_XI_GAUSS_VELOCITY2/),Err)
    562. 

  562.       ELSE
    563. 

  563.         CALL CMISSBasis_QuadratureOrderSet(BasisVelocity2,BASIS_XI_GAUSS_VELOCITY2+1,Err)
    564. 

  564.       ENDIF
    565. 

  565.     ELSE IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    566. 

  566.       CALL CMISSBasis_InterpolationXiSet(BasisVelocity2,(/BASIS_XI_INTERPOLATION_VELOCITY2,BASIS_XI_INTERPOLATION_VELOCITY2, & 
    567. 

  567.         & BASIS_XI_INTERPOLATION_VELOCITY2/),Err)                         
    568. 

  568.       IF(BASIS_TYPE2/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    569. 

  569.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisVelocity2,(/BASIS_XI_GAUSS_VELOCITY2,BASIS_XI_GAUSS_VELOCITY2, &
    570. 

  570.           & BASIS_XI_GAUSS_VELOCITY2/),Err)
    571. 

  571.       ELSE
    572. 

  572.         CALL CMISSBasis_QuadratureOrderSet(BasisVelocity2,BASIS_XI_GAUSS_VELOCITY2+1,Err)
    573. 

  573.       ENDIF
    574. 

  574.     ELSE
    575. 

  575.       CALL HANDLE_ERROR("Dimension coupling error.")
    576. 

  576.     ENDIF
    577. 

  577.     !Finish the creation of the basis
    578. 

  578.     CALL CMISSBasis_CreateFinish(BasisVelocity2,Err)
    579. 

  579.   ENDIF
    580. 

  580.   !Start the creation of another basis
    581. 

  581.   IF(BASIS_XI_INTERPOLATION_PRESSURE2==BASIS_XI_INTERPOLATION_SPACE2) THEN
    582. 

  582.     BasisPressure2=BasisSpace2
    583. 

  583.   ELSE IF(BASIS_XI_INTERPOLATION_PRESSURE2==BASIS_XI_INTERPOLATION_VELOCITY2) THEN
    584. 

  584.     BasisPressure2=BasisVelocity2
    585. 

  585.   ELSE
    586. 

  586.     MESH_NUMBER_OF_COMPONENTS2=MESH_NUMBER_OF_COMPONENTS2+1
    587. 

  587.     !Initialise a new pressure basis
    588. 

  588.     CALL CMISSBasis_Initialise(BasisPressure2,Err)
    589. 

  589.     !Start the creation of a basis
    590. 

  590.     CALL CMISSBasis_CreateStart(BASIS_NUMBER_PRESSURE2,BasisPressure2,Err)
    591. 

  591.     !Set the basis type (Lagrange/Simplex)
    592. 

  592.     CALL CMISSBasis_TypeSet(BasisPressure2,BASIS_TYPE2,Err)
    593. 

  593.     !Set the basis xi number
    594. 

  594.     CALL CMISSBasis_NumberOfXiSet(BasisPressure2,NUMBER_OF_DIMENSIONS2,Err)
    595. 

  595.     !Set the basis xi interpolation and number of Gauss points
    596. 

  596.     IF(NUMBER_OF_DIMENSIONS1==2.AND.NUMBER_OF_DIMENSIONS2==2) THEN
    597. 

  597.       CALL CMISSBasis_InterpolationXiSet(BasisPressure2,(/BASIS_XI_INTERPOLATION_PRESSURE2,BASIS_XI_INTERPOLATION_PRESSURE2/),Err)
    598. 

  598.       IF(BASIS_TYPE2/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    599. 

  599.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisPressure2,(/BASIS_XI_GAUSS_PRESSURE2,BASIS_XI_GAUSS_PRESSURE2/),Err)
    600. 

  600.       ELSE
    601. 

  601.         CALL CMISSBasis_QuadratureOrderSet(BasisPressure2,BASIS_XI_GAUSS_PRESSURE2+1,Err)
    602. 

  602.       ENDIF
    603. 

  603.     ELSE IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    604. 

  604.       CALL CMISSBasis_InterpolationXiSet(BasisPressure2,(/BASIS_XI_INTERPOLATION_PRESSURE2,BASIS_XI_INTERPOLATION_PRESSURE2, & 
    605. 

  605.         & BASIS_XI_INTERPOLATION_PRESSURE2/),Err)                         
    606. 

  606.       IF(BASIS_TYPE2/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    607. 

  607.         CALL CMISSBasis_QuadratureNumberOfGaussXiSet(BasisPressure2,(/BASIS_XI_GAUSS_PRESSURE2,BASIS_XI_GAUSS_PRESSURE2, &
    608. 

  608.           & BASIS_XI_GAUSS_PRESSURE2/),Err)
    609. 

  609.       ELSE
    610. 

  610.         CALL CMISSBasis_QuadratureOrderSet(BasisPressure2,BASIS_XI_GAUSS_PRESSURE2+1,Err)
    611. 

  611.       ENDIF
    612. 

  612.     ELSE
    613. 

  613.       CALL HANDLE_ERROR("Dimension coupling error.")
    614. 

  614.     ENDIF
    615. 

  615.     !Finish the creation of the basis
    616. 

  616.     CALL CMISSBasis_CreateFinish(BasisPressure2,Err)
    617. 

  617.   ENDIF
    618. 

  618. 

  619. 

  620.   !
    621. 

  621.   !================================================================================================================================
    622. 

  622.   !
    623. 

  623. 

  624.   !MESH
    625. 

  625. 

  626.   
    627. 

  627.   !Start the creation of a generated mesh in the first region
    628. 

  628.   PRINT *, ' == >> CREATING MESH(1) FROM INPUT DATA << == '
    629. 

  629.  !Start the creation of mesh nodes
    630. 

  630.   CALL CMISSNodes_Initialise(Nodes1,Err)
    631. 

  631.   CALL CMISSMesh_Initialise(Mesh1,Err)
    632. 

  632.   CALL CMISSNodes_CreateStart(Region1,TOTAL_NUMBER_OF_NODES1,Nodes1,Err)
    633. 

  633.   CALL CMISSNodes_CreateFinish(Nodes1,Err)
    634. 

  634.   !Start the creation of the mesh
    635. 

  635.   CALL CMISSMesh_CreateStart(Mesh1UserNumber,Region1,NUMBER_OF_DIMENSIONS1,Mesh1,Err)
    636. 

  636.   !Set number of mesh elements
    637. 

  637.   CALL CMISSMesh_NumberOfElementsSet(Mesh1,TOTAL_NUMBER_OF_ELEMENTS1,Err)
    638. 

  638.   !Set number of mesh components
    639. 

  639.   CALL CMISSMesh_NumberOfComponentsSet(Mesh1,MESH_NUMBER_OF_COMPONENTS1,Err)
    640. 

  640.   !Specify spatial mesh component
    641. 

  641.   CALL CMISSMeshElements_Initialise(MeshElementsSpace1,Err)
    642. 

  642.   CALL CMISSMeshElements_Initialise(MeshElementsVelocity1,Err)
    643. 

  643.   CALL CMISSMeshElements_Initialise(MeshElementsPressure1,Err)
    644. 

  644.   MESH_COMPONENT_NUMBER_SPACE1=1
    645. 

  645.   MESH_COMPONENT_NUMBER_VELOCITY1=1
    646. 

  646.   MESH_COMPONENT_NUMBER_PRESSURE1=1
    647. 

  647.   CALL CMISSMeshElements_CreateStart(Mesh1,MESH_COMPONENT_NUMBER_SPACE1,BasisSpace1,MeshElementsSpace1,Err)
    648. 

  648.   DO ELEMENT_NUMBER=1,TOTAL_NUMBER_OF_ELEMENTS1
    649. 

  649.     CALL CMISSMeshElements_NodesSet(MeshElementsSpace1,ELEMENT_NUMBER,CM1%M(ELEMENT_NUMBER,1:NUMBER_OF_ELEMENT_NODES_SPACE1),Err)
    650. 

  650.   ENDDO
    651. 

  651.   CALL CMISSMeshElements_CreateFinish(MeshElementsSpace1,Err)
    652. 

  652.   !Specify velocity mesh component
    653. 

  653.   IF(BASIS_XI_INTERPOLATION_VELOCITY1==BASIS_XI_INTERPOLATION_SPACE1) THEN
    654. 

  654.     MeshElementsVelocity1=MeshElementsSpace1
    655. 

  655.   ELSE
    656. 

  656.     MESH_COMPONENT_NUMBER_VELOCITY1=MESH_COMPONENT_NUMBER_SPACE1+1
    657. 

  657.     CALL CMISSMeshElements_CreateStart(Mesh1,MESH_COMPONENT_NUMBER_VELOCITY1,BasisVelocity1,MeshElementsVelocity1,Err)
    658. 

  658.     DO ELEMENT_NUMBER=1,TOTAL_NUMBER_OF_ELEMENTS1
    659. 

  659.       CALL CMISSMeshElements_NodesSet(MeshElementsVelocity1,ELEMENT_NUMBER,CM1%V(ELEMENT_NUMBER, & 
    660. 

  660.         & 1:NUMBER_OF_ELEMENT_NODES_VELOCITY1),Err)
    661. 

  661.     ENDDO
    662. 

  662.     CALL CMISSMeshElements_CreateFinish(MeshElementsVelocity1,Err)
    663. 

  663.   ENDIF
    664. 

  664.   !Specify pressure mesh component
    665. 

  665.   IF(BASIS_XI_INTERPOLATION_PRESSURE1==BASIS_XI_INTERPOLATION_SPACE1) THEN
    666. 

  666.     MeshElementsPressure1=MeshElementsSpace1
    667. 

  667.     MESH_COMPONENT_NUMBER_PRESSURE1=MESH_COMPONENT_NUMBER_SPACE1
    668. 

  668.   ELSE IF(BASIS_XI_INTERPOLATION_PRESSURE1==BASIS_XI_INTERPOLATION_VELOCITY1) THEN
    669. 

  669.     MeshElementsPressure1=MeshElementsVelocity1
    670. 

  670.     MESH_COMPONENT_NUMBER_PRESSURE1=MESH_COMPONENT_NUMBER_VELOCITY1
    671. 

  671.   ELSE
    672. 

  672.     MESH_COMPONENT_NUMBER_PRESSURE1=MESH_COMPONENT_NUMBER_VELOCITY1+1
    673. 

  673.     CALL CMISSMeshElements_CreateStart(Mesh1,MESH_COMPONENT_NUMBER_PRESSURE1,BasisPressure1,MeshElementsPressure1,Err)
    674. 

  674.     DO ELEMENT_NUMBER=1,TOTAL_NUMBER_OF_ELEMENTS1
    675. 

  675.       CALL CMISSMeshElements_NodesSet(MeshElementsPressure1,ELEMENT_NUMBER,CM1%P(ELEMENT_NUMBER, & 
    676. 

  676.         & 1:NUMBER_OF_ELEMENT_NODES_PRESSURE1),Err)
    677. 

  677.     ENDDO
    678. 

  678.     CALL CMISSMeshElements_CreateFinish(MeshElementsPressure1,Err)
    679. 

  679.   ENDIF
    680. 

  680.   !Finish the creation of the mesh
    681. 

  681.   CALL CMISSMesh_CreateFinish(Mesh1,Err)
    682. 

  682. 

  683.   !Start the creation of a generated mesh in the second region
    684. 

  684.   PRINT *, ' == >> CREATING MESH(2) FROM INPUT DATA << == '
    685. 

  685.   !Start the creation of mesh nodes
    686. 

  686.   CALL CMISSNodes_Initialise(Nodes2,Err)
    687. 

  687.   CALL CMISSMesh_Initialise(Mesh2,Err)
    688. 

  688.   CALL CMISSNodes_CreateStart(Region2,TOTAL_NUMBER_OF_NODES2,Nodes2,Err)
    689. 

  689.   CALL CMISSNodes_CreateFinish(Nodes2,Err)
    690. 

  690.   !Start the creation of the mesh
    691. 

  691.   CALL CMISSMesh_CreateStart(Mesh2UserNumber,Region2,NUMBER_OF_DIMENSIONS2,Mesh2,Err)
    692. 

  692.   !Set number of mesh elements
    693. 

  693.   CALL CMISSMesh_NumberOfElementsSet(Mesh2,TOTAL_NUMBER_OF_ELEMENTS2,Err)
    694. 

  694.   !Set number of mesh components
    695. 

  695.   CALL CMISSMesh_NumberOfComponentsSet(Mesh2,MESH_NUMBER_OF_COMPONENTS2,Err)
    696. 

  696.   !Specify spatial mesh component
    697. 

  697.   CALL CMISSMeshElements_Initialise(MeshElementsSpace2,Err)
    698. 

  698.   CALL CMISSMeshElements_Initialise(MeshElementsVelocity2,Err)
    699. 

  699.   CALL CMISSMeshElements_Initialise(MeshElementsPressure2,Err)
    700. 

  700.   MESH_COMPONENT_NUMBER_SPACE2=1
    701. 

  701.   MESH_COMPONENT_NUMBER_VELOCITY2=1
    702. 

  702.   MESH_COMPONENT_NUMBER_PRESSURE2=1
    703. 

  703.   CALL CMISSMeshElements_CreateStart(Mesh2,MESH_COMPONENT_NUMBER_SPACE2,BasisSpace2,MeshElementsSpace2,Err)
    704. 

  704.   DO ELEMENT_NUMBER=1,TOTAL_NUMBER_OF_ELEMENTS2
    705. 

  705.     CALL CMISSMeshElements_NodesSet(MeshElementsSpace2,ELEMENT_NUMBER,CM2%M(ELEMENT_NUMBER,1:NUMBER_OF_ELEMENT_NODES_SPACE2),Err)
    706. 

  706.   ENDDO
    707. 

  707.   CALL CMISSMeshElements_CreateFinish(MeshElementsSpace2,Err)
    708. 

  708.   !Specify velocity mesh component
    709. 

  709.   IF(BASIS_XI_INTERPOLATION_VELOCITY2==BASIS_XI_INTERPOLATION_SPACE2) THEN
    710. 

  710.     MeshElementsVelocity2=MeshElementsSpace2
    711. 

  711.   ELSE
    712. 

  712.     MESH_COMPONENT_NUMBER_VELOCITY2=MESH_COMPONENT_NUMBER_SPACE2+1
    713. 

  713.     CALL CMISSMeshElements_CreateStart(Mesh2,MESH_COMPONENT_NUMBER_VELOCITY2,BasisVelocity2,MeshElementsVelocity2,Err)
    714. 

  714.     DO ELEMENT_NUMBER=1,TOTAL_NUMBER_OF_ELEMENTS2
    715. 

  715.       CALL CMISSMeshElements_NodesSet(MeshElementsVelocity2,ELEMENT_NUMBER,CM2%V(ELEMENT_NUMBER, & 
    716. 

  716.         & 1:NUMBER_OF_ELEMENT_NODES_VELOCITY2),Err)
    717. 

  717.     ENDDO
    718. 

  718.     CALL CMISSMeshElements_CreateFinish(MeshElementsVelocity2,Err)
    719. 

  719.   ENDIF
    720. 

  720.   !Specify pressure mesh component
    721. 

  721.   IF(BASIS_XI_INTERPOLATION_PRESSURE2==BASIS_XI_INTERPOLATION_SPACE2) THEN
    722. 

  722.     MeshElementsPressure2=MeshElementsSpace2
    723. 

  723.     MESH_COMPONENT_NUMBER_PRESSURE2=MESH_COMPONENT_NUMBER_SPACE2
    724. 

  724.   ELSE IF(BASIS_XI_INTERPOLATION_PRESSURE2==BASIS_XI_INTERPOLATION_VELOCITY2) THEN
    725. 

  725.     MeshElementsPressure2=MeshElementsVelocity2
    726. 

  726.     MESH_COMPONENT_NUMBER_PRESSURE2=MESH_COMPONENT_NUMBER_VELOCITY2
    727. 

  727.   ELSE
    728. 

  728.     MESH_COMPONENT_NUMBER_PRESSURE2=MESH_COMPONENT_NUMBER_VELOCITY2+1
    729. 

  729.     CALL CMISSMeshElements_CreateStart(Mesh2,MESH_COMPONENT_NUMBER_PRESSURE2,BasisPressure2,MeshElementsPressure2,Err)
    730. 

  730.     DO ELEMENT_NUMBER=1,TOTAL_NUMBER_OF_ELEMENTS2
    731. 

  731.       CALL CMISSMeshElements_NodesSet(MeshElementsPressure2,ELEMENT_NUMBER,CM2%P(ELEMENT_NUMBER, & 
    732. 

  732.         & 1:NUMBER_OF_ELEMENT_NODES_PRESSURE2),Err)
    733. 

  733.     ENDDO
    734. 

  734.     CALL CMISSMeshElements_CreateFinish(MeshElementsPressure2,Err)
    735. 

  735.   ENDIF
    736. 

  736.   !Finish the creation of the mesh
    737. 

  737.   CALL CMISSMesh_CreateFinish(Mesh2,Err)
    738. 

  738. 

  739. 

  740.   !
    741. 

  741.   !================================================================================================================================
    742. 

  742.   !
    743. 

  743. 

  744.   !INTERFACE DEFINITION
    745. 

  745. 

  746.   !Create an interface between the two meshes
    747. 

  747.   PRINT *, ' == >> CREATING INTERFACE << == '
    748. 

  748.   CALL CMISSInterface_Initialise(Interface,Err)
    749. 

  749.   CALL CMISSInterface_CreateStart(InterfaceUserNumber,WorldRegion,Interface,Err)
    750. 

  750.   CALL CMISSInterface_LabelSet(Interface,"Interface",Err)
    751. 

  751.   !Add in the two meshes
    752. 

  752.   CALL CMISSInterface_MeshAdd(Interface,Mesh1,Mesh1Index,Err)
    753. 

  753.   CALL CMISSInterface_MeshAdd(Interface,Mesh2,Mesh2Index,Err)
    754. 

  754.   !Finish creating the interface
    755. 

  755.   CALL CMISSInterface_CreateFinish(Interface,Err)
    756. 

  756. 

  757.   !Start the creation of a (bi)-linear-Lagrange basis
    758. 

  758.   PRINT *, ' == >> CREATING INTERFACE BASIS << == '
    759. 

  759.   CALL CMISSBasis_Initialise(InterfaceBasis,Err)
    760. 

  760.   CALL CMISSBasis_CreateStart(InterfaceBasisUserNumber,InterfaceBasis,Err)
    761. 

  761.   CALL CMISSBasis_TypeSet(InterfaceBasis,BASIS_TYPE_INTERFACE,Err)
    762. 

  762.   CALL CMISSBasis_NumberOfXiSet(InterfaceBasis,NUMBER_OF_DIMENSIONS_INTERFACE,Err)
    763. 

  763.   !Set the basis xi interpolation and number of Gauss points
    764. 

  764.   IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3.AND.NUMBER_OF_DIMENSIONS_INTERFACE==2) THEN
    765. 

  765.     CALL CMISSBasis_InterpolationXiSet(InterfaceBasis,(/BASIS_XI_INTERPOLATION_INTERFACE,BASIS_XI_INTERPOLATION_INTERFACE/),Err)
    766. 

  766.     IF(BASIS_TYPE_INTERFACE/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    767. 

  767.       CALL CMISSBasis_QuadratureNumberOfGaussXiSet(InterfaceBasis,(/BASIS_XI_GAUSS_INTERFACE,BASIS_XI_GAUSS_INTERFACE/),Err)
    768. 

  768.     ELSE
    769. 

  769.       CALL CMISSBasis_QuadratureOrderSet(InterfaceBasis,BASIS_XI_GAUSS_INTERFACE+1,Err)
    770. 

  770.     ENDIF
    771. 

  771.   ENDIF
    772. 

  772.   !Finish the creation of the basis
    773. 

  773.   CALL CMISSBasis_CreateFinish(InterfaceBasis,Err)
    774. 

  774. 

  775. 

  776.   !
    777. 

  777.   !================================================================================================================================
    778. 

  778.   !
    779. 

  779. 

  780.   !INTERFACE MAPPING
    781. 

  781. 

  782.   !Start the creation of a (bi)-linear-Lagrange basis
    783. 

  783.   PRINT *, ' == >> CREATING INTERFACE MAPPING BASIS << == '
    784. 

  784.   CALL CMISSBasis_Initialise(InterfaceMappingBasis,Err)
    785. 

  785.   CALL CMISSBasis_CreateStart(InterfaceMappingBasisUserNumber,InterfaceMappingBasis,Err)
    786. 

  786.   CALL CMISSBasis_TypeSet(InterfaceMappingBasis,BASIS_TYPE_INTERFACE,Err)
    787. 

  787.   CALL CMISSBasis_NumberOfXiSet(InterfaceMappingBasis,NUMBER_OF_DIMENSIONS_INTERFACE,Err)
    788. 

  788.   IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3.AND.NUMBER_OF_DIMENSIONS_INTERFACE==2) THEN
    789. 

  789.     CALL CMISSBasis_InterpolationXiSet(InterfaceMappingBasis,(/BASIS_XI_INTERPOLATION_INTERFACE, &
    790. 

  790.       & BASIS_XI_INTERPOLATION_INTERFACE/),Err)
    791. 

  791.     IF(BASIS_TYPE_INTERFACE/=CMISS_BASIS_SIMPLEX_TYPE) THEN
    792. 

  792.       CALL CMISSBasis_QuadratureNumberOfGaussXiSet(InterfaceMappingBasis,(/BASIS_XI_GAUSS_INTERFACE,BASIS_XI_GAUSS_INTERFACE/),Err)
    793. 

  793.     ELSE
    794. 

  794.       CALL CMISSBasis_QuadratureOrderSet(InterfaceMappingBasis,BASIS_XI_GAUSS_INTERFACE+1,Err)
    795. 

  795.     ENDIF
    796. 

  796.   ENDIF
    797. 

  797.   !Finish the creation of the basis
    798. 

  798.   CALL CMISSBasis_CreateFinish(InterfaceMappingBasis,Err)
    799. 

  799. 

  800.   !
    801. 

  801.   !================================================================================================================================
    802. 

  802.   !
    803. 

  803. 

  804.   !INTERFACE MESH
    805. 

  805.   
    806. 

  806.   !Start the creation of a generated mesh for the interface
    807. 

  807.   PRINT *, ' == >> CREATING INTERFACE MESH FROM INPUT DATA << == '
    808. 

  808.   !Start the creation of mesh nodes
    809. 

  809.   CALL CMISSNodes_Initialise(InterfaceNodes,Err)
    810. 

  810.   CALL CMISSMesh_Initialise(InterfaceMesh,Err)
    811. 

  811.   CALL CMISSNodes_CreateStart(Interface,TOTAL_NUMBER_OF_NODES_INTERFACE,InterfaceNodes,Err)
    812. 

  812.   CALL CMISSNodes_CreateFinish(InterfaceNodes,Err)
    813. 

  813.   !Start the creation of the mesh
    814. 

  814.   CALL CMISSMesh_CreateStart(InterfaceMeshUserNumber,Interface,NUMBER_OF_DIMENSIONS_INTERFACE,InterfaceMesh,Err)
    815. 

  815.   !Set number of mesh elements
    816. 

  816.   CALL CMISSMesh_NumberOfElementsSet(InterfaceMesh,TOTAL_NUMBER_OF_ELEMENTS_INTERFACE,Err)
    817. 

  817.   MESH_NUMBER_OF_COMPONENTS_INTERFACE=1
    818. 

  818.   !Set number of mesh components
    819. 

  819.   CALL CMISSMesh_NumberOfComponentsSet(InterfaceMesh,MESH_NUMBER_OF_COMPONENTS_INTERFACE,Err)
    820. 

  820.   !Specify spatial mesh component
    821. 

  821.   CALL CMISSMeshElements_Initialise(InterfaceMeshElements,Err)
    822. 

  822.   MESH_COMPONENT_NUMBER_INTERFACE=1
    823. 

  823.   CALL CMISSMeshElements_CreateStart(InterfaceMesh,MESH_COMPONENT_NUMBER_INTERFACE,InterfaceBasis,InterfaceMeshElements,Err)
    824. 

  824.   DO ELEMENT_NUMBER=1,TOTAL_NUMBER_OF_ELEMENTS_INTERFACE
    825. 

  825.     CALL CMISSMeshElements_NodesSet(InterfaceMeshElements,ELEMENT_NUMBER,CM3%M(ELEMENT_NUMBER, &
    826. 

  826.       & 1:NUMBER_OF_ELEMENT_NODES_INTERFACE),Err)
    827. 

  827.   ENDDO
    828. 

  828.   CALL CMISSMeshElements_CreateFinish(InterfaceMeshElements,Err)
    829. 

  829.   !Finish the creation of the mesh
    830. 

  830.   CALL CMISSMesh_CreateFinish(InterfaceMesh,Err)
    831. 

  831. 

  832. 

  833.   !
    834. 

  834.   !================================================================================================================================
    835. 

  835.   !
    836. 

  836. 

  837.   !INTERFACE CONNECTIVITY
    838. 

  838. 

  839.   !Couple the interface meshes
    840. 

  840.   PRINT *, ' == >> CREATING INTERFACE MESHES CONNECTIVITY << == '
    841. 

  841.   CALL CMISSInterfaceMeshConnectivity_Initialise(InterfaceMeshConnectivity,Err)
    842. 

  842.   CALL CMISSInterfaceMeshConnectivity_CreateStart(Interface,InterfaceMesh,InterfaceMeshConnectivity,Err)
    843. 

  843.   CALL CMISSInterfaceMeshConnectivity_SetBasis(InterfaceMeshConnectivity,InterfaceMappingBasis,Err)
    844. 

  844. 

  845.   DO ic_idx=1,CMX%NUMBER_OF_COUPLINGS
    846. 

  846.     !Map the interface element to the elements in mesh 1
    847. 

  847.     CALL CMISSInterfaceMeshConnectivity_ElementNumberSet(InterfaceMeshConnectivity,CMX%INTERFACE_ELEMENT_NUMBER(ic_idx), &
    848. 

  848.       & CMX%MESH1_ID,CMX%MESH1_ELEMENT_NUMBER(ic_idx),Err)
    849. 

  849.     !Map the interface element to the elements in mesh 2
    850. 

  850.     CALL CMISSInterfaceMeshConnectivity_ElementNumberSet(InterfaceMeshConnectivity,CMX%INTERFACE_ELEMENT_NUMBER(ic_idx), &
    851. 

  851.       & CMX%MESH2_ID,CMX%MESH2_ELEMENT_NUMBER(ic_idx),Err)
    852. 

  852.   ENDDO !ic_idx
    853. 

  853. 

  854.   DO ic_idx=1,CMX%NUMBER_OF_COUPLINGS
    855. 

  855.     !Define xi mapping in mesh 1
    856. 

  856.     CALL CMISSInterfaceMeshConnectivity_ElementXiSet(InterfaceMeshConnectivity,CMX%INTERFACE_ELEMENT_NUMBER(ic_idx), & 
    857. 

  857.       & CMX%MESH1_ID,CMX%MESH1_ELEMENT_NUMBER(ic_idx),CMX%INTERFACE_ELEMENT_LOCAL_NODE(ic_idx),1, &
    858. 

  858.       & CMX%MESH1_ELEMENT_XI(ic_idx,1:3),Err)
    859. 

  859.     !Define xi mapping in mesh 2
    860. 

  860.     CALL CMISSInterfaceMeshConnectivity_ElementXiSet(InterfaceMeshConnectivity,CMX%INTERFACE_ELEMENT_NUMBER(ic_idx), & 
    861. 

  861.       & CMX%MESH2_ID,CMX%MESH2_ELEMENT_NUMBER(ic_idx),CMX%INTERFACE_ELEMENT_LOCAL_NODE(ic_idx),1, &
    862. 

  862.       & CMX%MESH2_ELEMENT_XI(ic_idx,1:3),Err)
    863. 

  863.   ENDDO !ic_idx
    864. 

  864. 

  865. 

  866.   CALL CMISSInterfaceMeshConnectivity_CreateFinish(InterfaceMeshConnectivity,Err)
    867. 

  867. 

  868. 

  869.   !
    870. 

  870.   !================================================================================================================================
    871. 

  871.   !
    872. 

  872. 

  873.   !GEOMETRIC FIELD & DECOMPOSITION
    874. 

  874. 

  875.   !Create a decomposition for mesh1
    876. 

  876.   PRINT *, ' == >> CREATING MESH(1) DECOMPOSITION << == '
    877. 

  877.   CALL CMISSDecomposition_Initialise(Decomposition1,Err)
    878. 

  878.   CALL CMISSDecomposition_CreateStart(Decomposition1UserNumber,Mesh1,Decomposition1,Err)
    879. 

  879.   !Set the decomposition to be a general decomposition with the specified number of domains
    880. 

  880.   CALL CMISSDecomposition_TypeSet(Decomposition1,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
    881. 

  881.   CALL CMISSDecomposition_NumberOfDomainsSet(Decomposition1,NumberOfComputationalNodes,Err)
    882. 

  882.   !Finish the decomposition
    883. 

  883.   CALL CMISSDecomposition_CreateFinish(Decomposition1,Err)
    884. 

  884. 

  885.   !Create a decomposition for mesh2
    886. 

  886.   PRINT *, ' == >> CREATING MESH(2) DECOMPOSITION << == '
    887. 

  887.   CALL CMISSDecomposition_Initialise(Decomposition2,Err)
    888. 

  888.   CALL CMISSDecomposition_CreateStart(Decomposition2UserNumber,Mesh2,Decomposition2,Err)
    889. 

  889.   !Set the decomposition to be a general decomposition with the specified number of domains
    890. 

  890.   CALL CMISSDecomposition_TypeSet(Decomposition2,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
    891. 

  891.   CALL CMISSDecomposition_NumberOfDomainsSet(Decomposition2,NumberOfComputationalNodes,Err)
    892. 

  892.   !Finish the decomposition
    893. 

  893.   CALL CMISSDecomposition_CreateFinish(Decomposition2,Err)
    894. 

  894.   
    895. 

  895.   !Create a decomposition for the interface mesh
    896. 

  896.   PRINT *, ' == >> CREATING INTERFACE DECOMPOSITION << == '
    897. 

  897.   CALL CMISSDecomposition_Initialise(InterfaceDecomposition,Err)
    898. 

  898.   CALL CMISSDecomposition_CreateStart(InterfaceDecompositionUserNumber,InterfaceMesh,InterfaceDecomposition,Err)
    899. 

  899.   !Set the decomposition to be a general decomposition with the specified number of domains
    900. 

  900.   CALL CMISSDecomposition_TypeSet(InterfaceDecomposition,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
    901. 

  901.   CALL CMISSDecomposition_NumberOfDomainsSet(InterfaceDecomposition,NumberOfComputationalNodes,Err)
    902. 

  902.   !Finish the decomposition
    903. 

  903.   CALL CMISSDecomposition_CreateFinish(InterfaceDecomposition,Err)
    904. 

  904. 

  905.   !Start to create a default (geometric) field on the first region
    906. 

  906.   PRINT *, ' == >> CREATING MESH(1) GEOMETRIC FIELD << == '
    907. 

  907.   CALL CMISSField_Initialise(GeometricField1,Err)
    908. 

  908.   CALL CMISSField_CreateStart(GeometricField1UserNumber,Region1,GeometricField1,Err)
    909. 

  909.   !Set the decomposition to use
    910. 

  910.   CALL CMISSField_MeshDecompositionSet(GeometricField1,Decomposition1,Err)
    911. 

  911.   !Set the domain to be used by the field components.
    912. 

  912.   CALL CMISSField_ComponentMeshComponentSet(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
    913. 

  913.   CALL CMISSField_ComponentMeshComponentSet(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,2,1,Err)
    914. 

  914.   IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    915. 

  915.     CALL CMISSField_ComponentMeshComponentSet(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,3,1,Err)
    916. 

  916.   ENDIF
    917. 

  917.   !Finish creating the first field
    918. 

  918.   CALL CMISSField_CreateFinish(GeometricField1,Err)
    919. 

  919. 

  920.   !Start to create a default (geometric) field on the second region
    921. 

  921.   PRINT *, ' == >> CREATING MESH(2) GEOMETRIC FIELD << == '
    922. 

  922.   CALL CMISSField_Initialise(GeometricField2,Err)
    923. 

  923.   CALL CMISSField_CreateStart(GeometricField2UserNumber,Region2,GeometricField2,Err)
    924. 

  924.   !Set the decomposition to use
    925. 

  925.   CALL CMISSField_MeshDecompositionSet(GeometricField2,Decomposition2,Err)
    926. 

  926.   !Set the domain to be used by the field components.
    927. 

  927.   CALL CMISSField_ComponentMeshComponentSet(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
    928. 

  928.   CALL CMISSField_ComponentMeshComponentSet(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,2,1,Err)
    929. 

  929.   IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3) THEN
    930. 

  930.     CALL CMISSField_ComponentMeshComponentSet(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,3,1,Err)
    931. 

  931.   ENDIF
    932. 

  932.   !Finish creating the second field
    933. 

  933.   CALL CMISSField_CreateFinish(GeometricField2,Err)
    934. 

  934. 

  935.   !Update the geometric field parameters for the first field
    936. 

  936.   DO NODE_NUMBER=1,NUMBER_OF_NODES_SPACE1
    937. 

  937.     DO COMPONENT_NUMBER=1,NUMBER_OF_DIMENSIONS1
    938. 

  938.       VALUE=CM1%N(NODE_NUMBER,COMPONENT_NUMBER)
    939. 

  939.       CALL CMISSField_ParameterSetUpdateNode(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1, & 
    940. 

  940.         & CMISS_NO_GLOBAL_DERIV,NODE_NUMBER,COMPONENT_NUMBER,VALUE,Err)
    941. 

  941.     ENDDO
    942. 

  942.   ENDDO
    943. 

  943.   CALL CMISSField_ParameterSetUpdateStart(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,Err)
    944. 

  944.   CALL CMISSField_ParameterSetUpdateFinish(GeometricField1,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,Err)
    945. 

  945. 

  946.   !Update the geometric field parameters for the second field
    947. 

  947.   DO NODE_NUMBER=1,NUMBER_OF_NODES_SPACE2
    948. 

  948.     DO COMPONENT_NUMBER=1,NUMBER_OF_DIMENSIONS2
    949. 

  949.       VALUE=CM2%N(NODE_NUMBER,COMPONENT_NUMBER)
    950. 

  950.       CALL CMISSField_ParameterSetUpdateNode(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1, & 
    951. 

  951.         & CMISS_NO_GLOBAL_DERIV,NODE_NUMBER,COMPONENT_NUMBER,VALUE,Err)
    952. 

  952.     ENDDO
    953. 

  953.   ENDDO
    954. 

  954.   CALL CMISSField_ParameterSetUpdateStart(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,Err)
    955. 

  955.   CALL CMISSField_ParameterSetUpdateFinish(GeometricField2,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,Err)
    956. 

  956. 

  957. 

  958.   !
    959. 

  959.   !================================================================================================================================
    960. 

  960.   !
    961. 

  961. 

  962.   !EQUATIONS SETS
    963. 

  963. 

  964.    !Create the equations set for the first region
    965. 

  965.   PRINT *, ' == >> CREATING EQUATION SET(1) << == '
    966. 

  966.   CALL CMISSField_Initialise(EquationsSetField1,Err)
    967. 

  967.   CALL CMISSEquationsSet_Initialise(EquationsSet1,Err)
    968. 

  968.   CALL CMISSEquationsSet_CreateStart(EquationsSet1UserNumber,Region1,GeometricField1,CMISS_EQUATIONS_SET_FLUID_MECHANICS_CLASS, &
    969. 

  969.     & CMISS_EQUATIONS_SET_STOKES_EQUATION_TYPE,CMISS_EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EquationsSetField1UserNumber,&
    970. 

  970.     & EquationsSetField1,EquationsSet1,Err)
    971. 

  971.   !Set the equations set to be a standard Stokes problem
    972. 

  972.   !Finish creating the equations set
    973. 

  973.   CALL CMISSEquationsSet_CreateFinish(EquationsSet1,Err)
    974. 

  974. 

  975.   !Create the equations set for the second region
    976. 

  976.   PRINT *, ' == >> CREATING EQUATION SET(2) << == '
    977. 

  977.   CALL CMISSField_Initialise(EquationsSetField2,Err)
    978. 

  978.   CALL CMISSEquationsSet_Initialise(EquationsSet2,Err)
    979. 

  979.   CALL CMISSEquationsSet_CreateStart(EquationsSet2UserNumber,Region2,GeometricField2,CMISS_EQUATIONS_SET_FLUID_MECHANICS_CLASS, &
    980. 

  980.     & CMISS_EQUATIONS_SET_STOKES_EQUATION_TYPE,CMISS_EQUATIONS_SET_STATIC_STOKES_SUBTYPE,EquationsSetField2UserNumber,&
    981. 

  981.     & EquationsSetField2,EquationsSet2,Err)
    982. 

  982.   !Finish creating the equations set
    983. 

  983.   CALL CMISSEquationsSet_CreateFinish(EquationsSet2,Err)
    984. 

  984. 

  985.   !
    986. 

  986.   !================================================================================================================================
    987. 

  987.   !
    988. 

  988. 

  989.   !DEPENDENT FIELDS
    990. 

  990. 

  991.   !Create the equations set dependent field variables for the first equations set
    992. 

  992.   PRINT *, ' == >> CREATING DEPENDENT FIELD(1) << == '
    993. 

  993.   CALL CMISSField_Initialise(DependentField1,Err)
    994. 

  994.   CALL CMISSEquationsSet_DependentCreateStart(EquationsSet1,DependentField1UserNumber,DependentField1,Err)
    995. 

  995.   !Finish the equations set dependent field variables
    996. 

  996.   CALL CMISSEquationsSet_DependentCreateFinish(EquationsSet1,Err)
    997. 

  997. 

  998.   !Create the equations set dependent field variables for the second equations set
    999. 

  999.   PRINT *, ' == >> CREATING DEPENDENT FIELD(2) << == '
    1000. 

  1000.   CALL CMISSField_Initialise(DependentField2,Err)
    1001. 

  1001.   CALL CMISSEquationsSet_DependentCreateStart(EquationsSet2,DependentField2UserNumber,DependentField2,Err)
    1002. 

  1002.   !Finish the equations set dependent field variables
    1003. 

  1003.   CALL CMISSEquationsSet_DependentCreateFinish(EquationsSet2,Err)
    1004. 

  1004. 

  1005. 

  1006.   !
    1007. 

  1007.   !================================================================================================================================
    1008. 

  1008.   !
    1009. 

  1009. 

  1010.   !MATERIALS FIELDS
    1011. 

  1011. 

  1012.   !Create the equations set materials field variables for Field 1
    1013. 

  1013.   CALL CMISSField_Initialise(MaterialsField1,Err)
    1014. 

  1014.   CALL CMISSEquationsSet_MaterialsCreateStart(EquationsSet1,MaterialsComponentUserNumber1, & 
    1015. 

  1015.     & MaterialsField1,Err)
    1016. 

  1016.   !Finish the equations set materials field variables
    1017. 

  1017.   CALL CMISSEquationsSet_MaterialsCreateFinish(EquationsSet1,Err)
    1018. 

  1018. 

  1019.   !Create the equations set materials field variables for Field 2
    1020. 

  1020.   CALL CMISSField_Initialise(MaterialsField2,Err)
    1021. 

  1021.   CALL CMISSEquationsSet_MaterialsCreateStart(EquationsSet2,MaterialsComponentUserNumber2, & 
    1022. 

  1022.     & MaterialsField2,Err)
    1023. 

  1023.   !Finish the equations set materials field variables
    1024. 

  1024.   CALL CMISSEquationsSet_MaterialsCreateFinish(EquationsSet2,Err)
    1025. 

  1025. 

  1026.   
    1027. 

  1027.   !Initialise same material parameters for each field
    1028. 

  1028.   CALL CMISSField_ComponentValuesInitialise(MaterialsField1,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE, & 
    1029. 

  1029.     & MaterialsComponentUserNumber1,MU_PARAM,Err)
    1030. 

  1030.   CALL CMISSField_ComponentValuesInitialise(MaterialsField1,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE, & 
    1031. 

  1031.     & MaterialsComponentUserNumber2,RHO_PARAM,Err)
    1032. 

  1032.   CALL CMISSField_ComponentValuesInitialise(MaterialsField2,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE, & 
    1033. 

  1033.     & MaterialsComponentUserNumber1,MU_PARAM,Err)
    1034. 

  1034.   CALL CMISSField_ComponentValuesInitialise(MaterialsField2,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE, & 
    1035. 

  1035.     & MaterialsComponentUserNumber2,RHO_PARAM,Err)
    1036. 

  1036. 

  1037. 

  1038.   !
    1039. 

  1039.   !================================================================================================================================
    1040. 

  1040.   !
    1041. 

  1041. 

  1042.   !EQUATIONS
    1043. 

  1043. 

  1044.   !Create the equations set equations for the first equations set
    1045. 

  1045.   PRINT *, ' == >> CREATING EQUATIONS(1) << == '
    1046. 

  1046.   CALL CMISSEquations_Initialise(Equations1,Err)
    1047. 

  1047.   CALL CMISSEquationsSet_EquationsCreateStart(EquationsSet1,Equations1,Err)
    1048. 

  1048.   !Set the equations matrices sparsity type
    1049. 

  1049.   CALL CMISSEquations_SparsityTypeSet(Equations1,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
    1050. 

  1050.   !Set the equations set output
    1051. 

  1051.   !CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_NO_OUTPUT,Err)
    1052. 

  1052.   !CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_TIMING_OUTPUT,Err)
    1053. 

  1053.   CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_MATRIX_OUTPUT,Err)
    1054. 

  1054.   !CALL CMISSEquations_OutputTypeSet(Equations1,CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT,Err)
    1055. 

  1055.   !Finish the equations set equations
    1056. 

  1056.   CALL CMISSEquationsSet_EquationsCreateFinish(EquationsSet1,Err)
    1057. 

  1057. 

  1058.   !Create the equations set equations for the second equations set
    1059. 

  1059.   PRINT *, ' == >> CREATING EQUATIONS(2) << == '
    1060. 

  1060.   CALL CMISSEquations_Initialise(Equations2,Err)
    1061. 

  1061.   CALL CMISSEquationsSet_EquationsCreateStart(EquationsSet2,Equations2,Err)
    1062. 

  1062.   !Set the equations matrices sparsity type
    1063. 

  1063.   CALL CMISSEquations_SparsityTypeSet(Equations2,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
    1064. 

  1064.   !Set the equations set output
    1065. 

  1065.   !CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_NO_OUTPUT,Err)
    1066. 

  1066.   CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_TIMING_OUTPUT,Err)
    1067. 

  1067.   !CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_MATRIX_OUTPUT,Err)
    1068. 

  1068.   !CALL CMISSEquations_OutputTypeSet(Equations2,CMISS_EQUATIONS_ELEMENT_MATRIX_OUTPUT,Err)
    1069. 

  1069.   !Finish the equations set equations
    1070. 

  1070.   CALL CMISSEquationsSet_EquationsCreateFinish(EquationsSet2,Err)
    1071. 

  1071. 

  1072. 

  1073.   !
    1074. 

  1074.   !================================================================================================================================
    1075. 

  1075.   !
    1076. 

  1076. 

  1077. 

  1078.   !INTERFACE GEOMETRIC FIELD
    1079. 

  1079. 

  1080.   !Start to create a default (geometric) field on the Interface
    1081. 

  1081.   PRINT *, ' == >> CREATING INTERFACE GEOMETRIC FIELD << == '
    1082. 

  1082.   CALL CMISSField_Initialise(InterfaceGeometricField,Err)
    1083. 

  1083.   CALL CMISSField_CreateStart(InterfaceGeometricFieldUserNumber,Interface,InterfaceGeometricField,Err)
    1084. 

  1084.   !Set the decomposition to use
    1085. 

  1085.   CALL CMISSField_MeshDecompositionSet(InterfaceGeometricField,InterfaceDecomposition,Err)
    1086. 

  1086.   !Set the domain to be used by the field components.
    1087. 

  1087.   CALL CMISSField_ComponentMeshComponentSet(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,1,1,Err)
    1088. 

  1088.   CALL CMISSField_ComponentMeshComponentSet(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,2,1,Err)
    1089. 

  1089.   IF(NUMBER_OF_DIMENSIONS1==3.AND.NUMBER_OF_DIMENSIONS2==3.AND.NUMBER_OF_DIMENSIONS_INTERFACE==2) THEN
    1090. 

  1090.     CALL CMISSField_ComponentMeshComponentSet(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,3,1,Err)
    1091. 

  1091.   ENDIF
    1092. 

  1092.   !Finish creating the first field
    1093. 

  1093.   CALL CMISSField_CreateFinish(InterfaceGeometricField,Err)
    1094. 

  1094. 

  1095.  !Update the geometric field parameters for the interface field
    1096. 

  1096.   DO NODE_NUMBER=1,NUMBER_OF_NODES_INTERFACE
    1097. 

  1097.     DO COMPONENT_NUMBER=1,NUMBER_OF_DIMENSIONS_INTERFACE+1
    1098. 

  1098.       VALUE=CM3%N(NODE_NUMBER,COMPONENT_NUMBER)
    1099. 

  1099.       CALL CMISSField_ParameterSetUpdateNode(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,1, & 
    1100. 

  1100.         & CMISS_NO_GLOBAL_DERIV,NODE_NUMBER,COMPONENT_NUMBER,VALUE,Err)
    1101. 

  1101.     ENDDO
    1102. 

  1102.   ENDDO
    1103. 

  1103.   CALL CMISSField_ParameterSetUpdateStart(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,Err)
    1104. 

  1104.   CALL CMISSField_ParameterSetUpdateFinish(InterfaceGeometricField,CMISS_FIELD_U_VARIABLE_TYPE,CMISS_FIELD_VALUES_SET_TYPE,Err)
    1105. 

  1105. 

  1106.   !Create an interface condition between the two meshes
    1107. 

  1107.   PRINT *, ' == >> CREATING INTERFACE CONDITIONS << == '
    1108. 

  1108.   CALL CMISSInterfaceCondition_Initialise(InterfaceCondition,Err)
    1109. 

  1109.   CALL CMISSInterfaceCondition_CreateStart(InterfaceConditionUserNumber,Interface,InterfaceGeometricField, &
    1110. 

  1110.     & InterfaceCondition,Err)
    1111. 

  1111.   !Specify the method for the interface condition
    1112. 

  1112.   CALL CMISSInterfaceCondition_MethodSet(InterfaceCondition,CMISS_INTERFACE_CONDITION_LAGRANGE_MULTIPLIERS_METHOD,Err)
    1113. 

  1113. 

  1114. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1115. 

  1115. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1116. 

  1116. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1117. 

  1117. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1118. 

  1118. 

  1119.   !Specify the type of interface condition operator
    1120. 

  1120.   CALL CMISSInterfaceCondition_OperatorSet(InterfaceCondition,CMISS_INTERFACE_CONDITION_FIELD_CONTINUITY_OPERATOR,Err)
    1121. 

  1121. 

  1122. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1123. 

  1123. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1124. 

  1124. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1125. 

  1125. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1126. 

  1126. 

  1127.   !Add in the dependent variables from the equations sets
    1128. 

  1128.   CALL CMISSInterfaceCondition_DependentVariableAdd(InterfaceCondition,Mesh1Index,EquationsSet1, &
    1129. 

  1129.     & CMISS_FIELD_U_VARIABLE_TYPE,Err)
    1130. 

  1130.   CALL CMISSInterfaceCondition_DependentVariableAdd(InterfaceCondition,Mesh2Index,EquationsSet2, &
    1131. 

  1131.     & CMISS_FIELD_U_VARIABLE_TYPE,Err)
    1132. 

  1132.   !Finish creating the interface condition
    1133. 

  1133.   CALL CMISSInterfaceCondition_CreateFinish(InterfaceCondition,Err)
    1134. 

  1134. 

  1135.   !Create the Lagrange multipliers field
    1136. 

  1136.   PRINT *, ' == >> CREATING INTERFACE LAGRANGE FIELD << == '
    1137. 

  1137.   CALL CMISSField_Initialise(LagrangeField,Err)
    1138. 

  1138.   CALL CMISSInterfaceCondition_LagrangeFieldCreateStart(InterfaceCondition,LagrangeFieldUserNumber,LagrangeField,Err)
    1139. 

  1139.   !Finish the Lagrange multipliers field
    1140. 

  1140.   CALL CMISSInterfaceCondition_LagrangeFieldCreateFinish(InterfaceCondition,Err)
    1141. 

  1141. 

  1142.   !Create the interface condition equations
    1143. 

  1143.   PRINT *, ' == >> CREATING INTERFACE EQUATIONS << == '
    1144. 

  1144.   CALL CMISSInterfaceEquations_Initialise(InterfaceEquations,Err)
    1145. 

  1145.   CALL CMISSInterfaceCondition_EquationsCreateStart(InterfaceCondition,InterfaceEquations,Err)
    1146. 

  1146.   !Set the interface equations sparsity
    1147. 

  1147.   CALL CMISSInterfaceEquations_SparsitySet(InterfaceEquations,CMISS_EQUATIONS_SPARSE_MATRICES,Err)
    1148. 

  1148.   !Set the interface equations output
    1149. 

  1149.   CALL CMISSInterfaceEquations_OutputTypeSet(InterfaceEquations,CMISS_EQUATIONS_MATRIX_OUTPUT,Err)
    1150. 

  1150.   !Finish creating the interface equations
    1151. 

  1151.   CALL CMISSInterfaceCondition_EquationsCreateFinish(InterfaceCondition,Err)
    1152. 

  1152. 

  1153.   !
    1154. 

  1154.   !================================================================================================================================
    1155. 

  1155.   !
    1156. 

  1156. 

  1157.   !PROBLEMS
    1158. 

  1158.   
    1159. 

  1159.   !Start the creation of a coupled problem.
    1160. 

  1160.   PRINT *, ' == >> CREATING PROBLEM << == '
    1161. 

  1161.   CALL CMISSProblem_Initialise(CoupledProblem,Err)
    1162. 

  1162.   CALL CMISSProblem_CreateStart(CoupledProblemUserNumber,CoupledProblem,Err)
    1163. 

  1163.   !Set the problem to be a standard Stokes problem
    1164. 

  1164.   CALL CMISSProblem_SpecificationSet(CoupledProblem,CMISS_PROBLEM_FLUID_MECHANICS_CLASS, &
    1165. 

  1165.     & CMISS_PROBLEM_STOKES_EQUATION_TYPE,CMISS_PROBLEM_STATIC_STOKES_SUBTYPE,Err)
    1166. 

  1166.   !Finish the creation of a problem.
    1167. 

  1167.   CALL CMISSProblem_CreateFinish(CoupledProblem,Err)
    1168. 

  1168. 

  1169.   !
    1170. 

  1170.   !================================================================================================================================
    1171. 

  1171.   !
    1172. 

  1172. 

  1173.   !SOLVERS
    1174. 

  1174. 

  1175.   !Start the creation of the problem control loop for the coupled problem
    1176. 

  1176.   PRINT *, ' == >> CREATING PROBLEM CONTROL LOOP << == '
    1177. 

  1177.   CALL CMISSProblem_ControlLoopCreateStart(CoupledProblem,Err)
    1178. 

  1178.   !Finish creating the problem control loop
    1179. 

  1179.   CALL CMISSProblem_ControlLoopCreateFinish(CoupledProblem,Err)
    1180. 

  1180.  
    1181. 

  1181.   !Start the creation of the problem solver for the coupled problem
    1182. 

  1182.   PRINT *, ' == >> CREATING PROBLEM SOLVERS << == '
    1183. 

  1183.   CALL CMISSSolver_Initialise(CoupledSolver,Err)
    1184. 

  1184.   CALL CMISSProblem_SolversCreateStart(CoupledProblem,Err)
    1185. 

  1185.   CALL CMISSProblem_SolverGet(CoupledProblem,CMISS_CONTROL_LOOP_NODE,1,CoupledSolver,Err)
    1186. 

  1186.   !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_NO_OUTPUT,Err)
    1187. 

  1187.   !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_PROGRESS_OUTPUT,Err)
    1188. 

  1188.   !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_TIMING_OUTPUT,Err)
    1189. 

  1189.   !CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_SOLVER_OUTPUT,Err)
    1190. 

  1190.   CALL CMISSSolver_OutputTypeSet(CoupledSolver,CMISS_SOLVER_MATRIX_OUTPUT,Err)
    1191. 

  1191.   CALL CMISSSolver_LinearTypeSet(CoupledSolver,CMISS_SOLVER_LINEAR_DIRECT_SOLVE_TYPE,Err)
    1192. 

  1192.   CALL CMISSSolver_LibraryTypeSet(CoupledSolver,CMISS_SOLVER_MUMPS_LIBRARY,Err)
    1193. 

  1193.   !Finish the creation of the problem solver
    1194. 

  1194.   CALL CMISSProblem_SolversCreateFinish(CoupledProblem,Err)
    1195. 

  1195. 

  1196. 

  1197.   !
    1198. 

  1198.   !================================================================================================================================
    1199. 

  1199.   !
    1200. 

  1200. 

  1201.   !SOLVER EQUATIONS
    1202. 

  1202. 

  1203.   !Start the creation of the problem solver equations for the coupled problem
    1204. 

  1204.   PRINT *, ' == >> CREATING PROBLEM SOLVER EQUATIONS << == '
    1205. 

  1205.   CALL CMISSSolver_Initialise(CoupledSolver,Err)
    1206. 

  1206.   CALL CMISSSolverEquations_Initialise(CoupledSolverEquations,Err)
    1207. 

  1207.   CALL CMISSProblem_SolverEquationsCreateStart(CoupledProblem,Err)
    1208. 

  1208.   !Get the solve equations
    1209. 

  1209.   CALL CMISSProblem_SolverGet(CoupledProblem,CMISS_CONTROL_LOOP_NODE,1,CoupledSolver,Err)
    1210. 

  1210.   CALL CMISSSolver_SolverEquationsGet(CoupledSolver,CoupledSolverEquations,Err)
    1211. 

  1211.   !Set the solver equations sparsity
    1212. 

  1212.   CALL CMISSSolverEquations_SparsityTypeSet(CoupledSolverEquations,CMISS_SOLVER_SPARSE_MATRICES,Err)
    1213. 

  1213.   !CALL CMISSSolverEquations_SparsityTypeSet(CoupledSolverEquations,CMISS_SOLVER_FULL_MATRICES,Err)  
    1214. 

  1214.   !Add in the first equations set
    1215. 

  1215.   CALL CMISSSolverEquations_EquationsSetAdd(CoupledSolverEquations,EquationsSet1,EquationsSet1Index,Err)
    1216. 

  1216.   !Add in the second equations set
    1217. 

  1217.   CALL CMISSSolverEquations_EquationsSetAdd(CoupledSolverEquations,EquationsSet2,EquationsSet2Index,Err)
    1218. 

  1218. 

  1219. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1220. 

  1220. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1221. 

  1221. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1222. 

  1222. 

  1223.   !Add in the interface condition
    1224. 

  1224. ! ! !   CALL CMISSSolverEquations_InterfaceConditionAdd(CoupledSolverEquations,InterfaceCondition,InterfaceConditionIndex,Err)
    1225. 

  1225. 

  1226. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1227. 

  1227. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1228. 

  1228. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1229. 

  1229. 

  1230.   !Finish the creation of the problem solver equations
    1231. 

  1231.   CALL CMISSProblem_SolverEquationsCreateFinish(CoupledProblem,Err)
    1232. 

  1232. 

  1233.   !
    1234. 

  1234.   !================================================================================================================================
    1235. 

  1235.   !
    1236. 

  1236. 

  1237. 

  1238.   !BOUNDARY CONDITIONS
    1239. 

  1239. 

  1240.   !Start the creation of the equations set boundary conditions for the first equations set
    1241. 

  1241.   PRINT *, ' == >> CREATING BOUNDARY CONDITIONS << == '
    1242. 

  1242.   CALL CMISSBoundaryConditions_Initialise(BoundaryConditions,Err)
    1243. 

  1243.   CALL CMISSSolverEquations_BoundaryConditionsCreateStart(CoupledSolverEquations,BoundaryConditions,Err)
    1244. 

  1244. 

  1245.   IF(FIXED_WALL_NODES1_FLAG) THEN
    1246. 

  1246.     DO NODE_COUNTER=1,NUMBER_OF_FIXED_WALL_NODES1
    1247. 

  1247.       NODE_NUMBER=FIXED_WALL_NODES1(NODE_COUNTER)
    1248. 

  1248.       CONDITION=CMISS_BOUNDARY_CONDITION_FIXED_WALL
    1249. 

  1249.       CALL CMISSDecomposition_NodeDomainGet(Decomposition1,NODE_NUMBER,1,BoundaryNodeDomain,Err)
    1250. 

  1250.       IF(BoundaryNodeDomain==ComputationalNodeNumber) THEN
    1251. 

  1251.         DO COMPONENT_NUMBER=1,NUMBER_OF_DIMENSIONS1
    1252. 

  1252.           VALUE=0.0_CMISSDP
    1253. 

  1253.           CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField1,CMISS_FIELD_U_VARIABLE_TYPE, &
    1254. 

  1254.             & CMISS_NO_GLOBAL_DERIV,1,&
    1255. 

  1255.             & NODE_NUMBER,COMPONENT_NUMBER,CONDITION,VALUE,Err)
    1256. 

  1256.         ENDDO
    1257. 

  1257.       ENDIF
    1258. 

  1258.     ENDDO
    1259. 

  1259.   ENDIF
    1260. 

  1260.   !Set velocity boundary conditions
    1261. 

  1261.   IF(INLET_WALL_NODES1_FLAG) THEN
    1262. 

  1262.     DO NODE_COUNTER=1,NUMBER_OF_INLET_WALL_NODES1
    1263. 

  1263.       NODE_NUMBER=INLET_WALL_NODES1(NODE_COUNTER)
    1264. 

  1264.       CONDITION=CMISS_BOUNDARY_CONDITION_FIXED_INLET
    1265. 

  1265.       CALL CMISSDecomposition_NodeDomainGet(Decomposition1,NODE_NUMBER,1,BoundaryNodeDomain,Err)
    1266. 

  1266.       IF(BoundaryNodeDomain==ComputationalNodeNumber) THEN
    1267. 

  1267.         DO COMPONENT_NUMBER=1,NUMBER_OF_DIMENSIONS1
    1268. 

  1268.           VALUE=BOUNDARY_CONDITIONS1(COMPONENT_NUMBER)
    1269. 

  1269.           CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField1,CMISS_FIELD_U_VARIABLE_TYPE, &
    1270. 

  1270.             & CMISS_NO_GLOBAL_DERIV,1,&
    1271. 

  1271.             & NODE_NUMBER,COMPONENT_NUMBER,CONDITION,VALUE,Err)
    1272. 

  1272.         ENDDO
    1273. 

  1273.       ENDIF
    1274. 

  1274.     ENDDO
    1275. 

  1275.   ENDIF
    1276. 

  1276.   
    1277. 

  1277.   !Set boundary conditions for second dependent field
    1278. 

  1278.   IF(FIXED_WALL_NODES2_FLAG) THEN
    1279. 

  1279.     DO NODE_COUNTER=1,NUMBER_OF_FIXED_WALL_NODES2
    1280. 

  1280.       NODE_NUMBER=FIXED_WALL_NODES2(NODE_COUNTER)
    1281. 

  1281.       CONDITION=CMISS_BOUNDARY_CONDITION_FIXED_WALL
    1282. 

  1282.       CALL CMISSDecomposition_NodeDomainGet(Decomposition2,NODE_NUMBER,1,BoundaryNodeDomain,Err)
    1283. 

  1283.       IF(BoundaryNodeDomain==ComputationalNodeNumber) THEN
    1284. 

  1284.         DO COMPONENT_NUMBER=1,NUMBER_OF_DIMENSIONS2
    1285. 

  1285.           VALUE=0.0_CMISSDP
    1286. 

  1286.           CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField2,CMISS_FIELD_U_VARIABLE_TYPE,1, &
    1287. 

  1287.             & CMISS_NO_GLOBAL_DERIV,&
    1288. 

  1288.             & NODE_NUMBER,COMPONENT_NUMBER,CONDITION,VALUE,Err)
    1289. 

  1289.         ENDDO
    1290. 

  1290.       ENDIF
    1291. 

  1291.     ENDDO
    1292. 

  1292.   ENDIF
    1293. 

  1293.   !Set velocity boundary conditions
    1294. 

  1294.   IF(INLET_WALL_NODES2_FLAG) THEN
    1295. 

  1295.     DO NODE_COUNTER=1,NUMBER_OF_INLET_WALL_NODES2
    1296. 

  1296.       NODE_NUMBER=INLET_WALL_NODES2(NODE_COUNTER)
    1297. 

  1297.       CONDITION=CMISS_BOUNDARY_CONDITION_FIXED_INLET
    1298. 

  1298.       CALL CMISSDecomposition_NodeDomainGet(Decomposition2,NODE_NUMBER,1,BoundaryNodeDomain,Err)
    1299. 

  1299.       IF(BoundaryNodeDomain==ComputationalNodeNumber) THEN
    1300. 

  1300.         DO COMPONENT_NUMBER=1,NUMBER_OF_DIMENSIONS2
    1301. 

  1301.           VALUE=BOUNDARY_CONDITIONS2(COMPONENT_NUMBER)
    1302. 

  1302.           CALL CMISSBoundaryConditions_SetNode(BoundaryConditions,DependentField2,CMISS_FIELD_U_VARIABLE_TYPE,1, &
    1303. 

  1303.             & CMISS_NO_GLOBAL_DERIV,&
    1304. 

  1304.             & NODE_NUMBER,COMPONENT_NUMBER,CONDITION,VALUE,Err)
    1305. 

  1305.         ENDDO
    1306. 

  1306.       ENDIF
    1307. 

  1307.     ENDDO
    1308. 

  1308.   ENDIF
    1309. 

  1309.   CALL CMISSSolverEquations_BoundaryConditionsCreateFinish(CoupledSolverEquations,Err)
    1310. 

  1310. 

  1311.   !
    1312. 

  1312.   !================================================================================================================================
    1313. 

  1313.   !
    1314. 

  1314. 

  1315.   !RUN SOLVERS
    1316. 

  1316. 

  1317. 

  1318. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1319. 

  1319. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1320. 

  1320. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1321. 

  1321. 

  1322. ! ! !   !Solve the problem
    1323. 

  1323. ! ! !   PRINT *, ' == >> SOLVING PROBLEM << == '
    1324. 

  1324. ! ! !   CALL CMISSProblem_Solve(CoupledProblem,Err)
    1325. 

  1325. 

  1326. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1327. 

  1327. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1328. 

  1328. ! ! ! THIS NEEDS TO BE CHANGES!!!
    1329. 

  1329. 

  1330.   !Export the fields
    1331. 

  1331.   PRINT *, ' == >> EXPORTING FIELDS << == '
    1332. 

  1332.   CALL CMISSFields_Initialise(Fields1,Err)
    1333. 

  1333.   CALL CMISSFields_Create(Region1,Fields1,Err)
    1334. 

  1334.   CALL CMISSFields_NodesExport(Fields1,"CoupledStokes_1","FORTRAN",Err)
    1335. 

  1335.   CALL CMISSFields_ElementsExport(Fields1,"CoupledStokes_1","FORTRAN",Err)
    1336. 

  1336.   CALL CMISSFields_Finalise(Fields1,Err)
    1337. 

  1337.   CALL CMISSFields_Initialise(Fields2,Err)
    1338. 

  1338.   CALL CMISSFields_Create(Region2,Fields2,Err)
    1339. 

  1339.   CALL CMISSFields_NodesExport(Fields2,"CoupledStokes_2","FORTRAN",Err)
    1340. 

  1340.   CALL CMISSFields_ElementsExport(Fields2,"CoupledStokes_2","FORTRAN",Err)
    1341. 

  1341.   CALL CMISSFields_Finalise(Fields2,Err)
    1342. 

  1342.   CALL CMISSFields_Initialise(InterfaceFields,Err)
    1343. 

  1343.   CALL CMISSFields_Create(INTERFACE,InterfaceFields,Err)
    1344. 

  1344.   CALL CMISSFields_NodesExport(InterfaceFields,"CoupledStokes_Interface","FORTRAN",Err)
    1345. 

  1345.   CALL CMISSFields_ElementsExport(InterfaceFields,"CoupledStokes_Interface","FORTRAN",Err)
    1346. 

  1346.   CALL CMISSFields_Finalise(InterfaceFields,Err)
    1347. 

  1347.   
    1348. 

  1348.   !Finialise CMISS
    1349. 

  1349.   CALL CMISSFinalise(Err)
    1350. 

  1350. 

  1351.   WRITE(*,'(A)') "Program successfully completed."
    1352. 

  1352. 

  1353.   STOP
    1354. 

  1354.  
    1355. 

  1355. CONTAINS
    1356. 

  1356. 

  1357.   SUBROUTINE HANDLE_ERROR(ERROR_STRING)
    1358. 

  1358. 

  1359.     CHARACTER(LEN=*), INTENT(IN) :: ERROR_STRING
    1360. 

  1360. 

  1361.     WRITE(*,'(">>ERROR: ",A)') ERROR_STRING(1:LEN_TRIM(ERROR_STRING))
    1362. 

  1362.     STOP
    1363. 

  1363. 

  1364.   END SUBROUTINE HANDLE_ERROR
    1365. 

  1365.      
    1366. 

  1366. END PROGRAM COUPLEDSTOKES
    1367. 

  1367.