PageRenderTime 59ms CodeModel.GetById 11ms app.highlight 43ms RepoModel.GetById 1ms app.codeStats 0ms

/DataProjection/1DRectangularCartesian/src/1DRectangularCartesianExample.f90

http://github.com/xyan075/examples
FORTRAN Modern | 306 lines | 182 code | 55 blank | 69 comment | 0 complexity | 41f5f9a18a4ed665832274fef9a29a24 MD5 | raw file
  1!> \file
  2!> \author Tim Wu
  3!> \brief This is an example program to solve 3D data points projecting onto 1D cartesian elements 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): Code based on the examples by Kumar Mithraratne and Prasad Babarenda Gamage
 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!> Main program
 42PROGRAM DataProjection1DRectangularCartesian
 43
 44  USE MPI
 45  USE OPENCMISS
 46
 47#ifdef WIN32
 48  USE IFQWIN
 49#endif
 50
 51  IMPLICIT NONE
 52
 53  !Program parameters
 54  INTEGER(CMISSIntg),PARAMETER :: BasisUserNumber=1  
 55  INTEGER(CMISSIntg),PARAMETER :: CoordinateSystemDimension=3
 56  INTEGER(CMISSIntg),PARAMETER :: CoordinateSystemUserNumber=1
 57  INTEGER(CMISSIntg),PARAMETER :: DecompositionUserNumber=1
 58  INTEGER(CMISSIntg),PARAMETER :: FieldUserNumber=1  
 59  INTEGER(CMISSIntg),PARAMETER :: MeshUserNumber=1
 60  INTEGER(CMISSIntg),PARAMETER :: RegionUserNumber=1
 61
 62  REAL(CMISSDP), PARAMETER :: CoordinateSystemOrigin(3)=(/0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP/)
 63  !Program types
 64
 65  !Program variables   
 66  INTEGER(CMISSIntg) :: MeshComponentNumber=1
 67  INTEGER(CMISSIntg) :: MeshDimensions=1
 68  INTEGER(CMISSIntg) :: MeshNumberOfElements
 69  INTEGER(CMISSIntg) :: MeshNumberOfComponents=1
 70  INTEGER(CMISSIntg) :: NumberOfDomains=2
 71  INTEGER(CMISSIntg) :: NumberOfNodes
 72  INTEGER(CMISSIntg) :: NumberOfXi=1
 73  INTEGER(CMISSIntg) :: BasisInterpolation(1)=(/CMISS_BASIS_CUBIC_HERMITE_INTERPOLATION/)
 74  INTEGER(CMISSIntg) :: WorldCoordinateSystemUserNumber
 75  INTEGER(CMISSIntg) :: WorldRegionUserNumber
 76  
 77  INTEGER(CMISSIntg) :: FieldNumberOfVariables=1
 78  INTEGER(CMISSIntg) :: FieldNumberOfComponents=3
 79  
 80
 81  INTEGER(CMISSIntg) :: np,el,xi,ver_idx,der_idx,node_idx,comp_idx
 82    
 83  REAL(CMISSDP), DIMENSION(5,3) :: DataPointValues !(number_of_data_points,dimension)
 84  INTEGER(CMISSIntg), DIMENSION(5,2) :: ElementUserNodes  
 85  REAL(CMISSDP), DIMENSION(2,6,3) :: FieldValues
 86  
 87  !Test variables
 88  REAL(CMISSDP) :: AbsoluteToleranceSet=1.0E-10_CMISSDP !default is 1.0E-8
 89  REAL(CMISSDP) :: RelativeToleranceSet=1.0E-6_CMISSDP !default is 1.0E-8
 90  INTEGER(CMISSIntg) :: MaximumNumberOfIterationsSet=30 !default is 25
 91  REAL(CMISSDP) :: MaximumIterationUpdateSet=0.4_CMISSDP !default is 0.5
 92  INTEGER(CMISSIntg) :: NumberOfClosestElementsSet=3 !default is 2/4/8 for 1/2/3 dimensional projection 
 93  INTEGER(CMISSIntg) :: ProjectionTypeSet=CMISS_DATA_PROJECTION_ALL_ELEMENTS_PROJECTION_TYPE !same as default
 94  REAL(CMISSDP) :: StartingXiSet(1)=[0.4_CMISSDP] !default is 0.5
 95  REAL(CMISSDP) :: AbsoluteToleranceGet
 96  REAL(CMISSDP) :: RelativeToleranceGet
 97  INTEGER(CMISSIntg) :: MaximumNumberOfIterationsGet
 98  REAL(CMISSDP) :: MaximumIterationUpdateGet
 99  INTEGER(CMISSIntg) :: NumberOfClosestElementsGet
100  INTEGER(CMISSIntg) :: ProjectionTypeGet
101  REAL(CMISSDP), ALLOCATABLE :: StartingXiGet(:)
102#ifdef WIN32
103  !Quickwin type
104  LOGICAL :: QUICKWIN_STATUS=.FALSE.
105  TYPE(WINDOWCONFIG) :: QUICKWIN_WINDOW_CONFIG
106#endif
107
108  !Generic CMISS and MPI variables
109  INTEGER(CMISSIntg) :: Err
110  INTEGER(CMISSIntg) :: NUMBER_GLOBAL_X_ELEMENTS=1 !<number of elements on x axis
111  INTEGER(CMISSIntg) :: NUMBER_GLOBAL_Y_ELEMENTS=1 !<number of elements on y axis
112  INTEGER(CMISSIntg) :: NUMBER_GLOBAL_Z_ELEMENTS=1 !<number of elements on z axis  
113  INTEGER(CMISSIntg) :: NUMBER_OF_DOMAINS=1      
114  INTEGER(CMISSIntg) :: MPI_IERROR  
115  
116#ifdef WIN32
117  !Initialise QuickWin
118  QUICKWIN_WINDOW_CONFIG%TITLE="General Output" !Window title
119  QUICKWIN_WINDOW_CONFIG%NUMTEXTROWS=-1 !Max possible number of rows
120  QUICKWIN_WINDOW_CONFIG%MODE=QWIN$SCROLLDOWN
121  !Set the window parameters
122  QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
123  !If attempt fails set with system estimated values
124  IF(.NOT.QUICKWIN_STATUS) QUICKWIN_STATUS=SETWINDOWCONFIG(QUICKWIN_WINDOW_CONFIG)
125#endif
126    
127  !Intialise data points
128  DataPointValues(1,:)=[20.5_CMISSDP,1.8_CMISSDP,0.0_CMISSDP]
129  DataPointValues(2,:)=[33.2_CMISSDP,-4.8_CMISSDP,0.0_CMISSDP]  
130  DataPointValues(3,:)=[9.6_CMISSDP,10.0_CMISSDP,0.0_CMISSDP]  
131  DataPointValues(4,:)=[50.0_CMISSDP,-3.0_CMISSDP,6.0_CMISSDP]  
132  DataPointValues(5,:)=[44.0_CMISSDP,10.0_CMISSDP,18.6_CMISSDP]  
133  
134  ElementUserNodes(1,:)=[1,2]
135  ElementUserNodes(2,:)=[2,3]
136  ElementUserNodes(3,:)=[3,4]
137  ElementUserNodes(4,:)=[4,5]
138  ElementUserNodes(5,:)=[5,6]        
139  
140  FieldValues(1,1,:)=[0.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP] !no der, node 1
141  FieldValues(2,1,:)=[10.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP] !first der, node 1
142  
143  FieldValues(1,2,:)=[10.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP] !no der, node 2
144  FieldValues(2,2,:)=[10.0_CMISSDP,-10.0_CMISSDP,0.0_CMISSDP] !first der, node 2
145  
146  FieldValues(1,3,:)=[20.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP] !no der, node 3
147  FieldValues(2,3,:)=[10.0_CMISSDP,20.0_CMISSDP,0.0_CMISSDP] !first der, node 3
148  
149  FieldValues(1,4,:)=[30.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP] !no der, node 4
150  FieldValues(2,4,:)=[10.0_CMISSDP,10.0_CMISSDP,0.0_CMISSDP] !first der, node 4
151  
152  FieldValues(1,5,:)=[40.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP] !no der, node 5
153  FieldValues(2,5,:)=[10.0_CMISSDP,-15.0_CMISSDP,0.0_CMISSDP] !first der, node 5
154  
155  FieldValues(1,6,:)=[50.0_CMISSDP,0.0_CMISSDP,0.0_CMISSDP] !no der, node 6
156  FieldValues(2,6,:)=[10.0_CMISSDP,-5.0_CMISSDP,0.0_CMISSDP] !first der, node 6
157  
158  !Intialise cmiss
159  CALL CMISSInitialise(WorldCoordinateSystemUserNumber,WorldRegionUserNumber,Err)
160  !Broadcast the number of Elements in the X & Y directions and the number of partitions to the other computational nodes
161  CALL MPI_BCAST(NUMBER_GLOBAL_X_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
162  CALL MPI_BCAST(NUMBER_GLOBAL_Y_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
163  CALL MPI_BCAST(NUMBER_GLOBAL_Z_ELEMENTS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
164  CALL MPI_BCAST(NUMBER_OF_DOMAINS,1,MPI_INTEGER,0,MPI_COMM_WORLD,MPI_IERROR)
165
166  !=========================================================================================================================
167  !Create RC coordinate system
168  CALL CMISSCoordinateSystem_CreateStart(CoordinateSystemUserNumber,Err)
169  CALL CMISSCoordinateSystem_TypeSet(CoordinateSystemUserNumber,CMISS_COORDINATE_RECTANGULAR_CARTESIAN_TYPE,Err)
170  CALL CMISSCoordinateSystem_DimensionSet(CoordinateSystemUserNumber,CoordinateSystemDimension,Err)
171  CALL CMISSCoordinateSystem_OriginSet(CoordinateSystemUserNumber,CoordinateSystemOrigin,Err)
172  CALL CMISSCoordinateSystem_CreateFinish(CoordinateSystemUserNumber,Err) 
173
174  !=========================================================================================================================
175  !Create Region and set CS to newly created 3D RC CS
176  CALL CMISSRegion_CreateStart(RegionUserNumber,WorldRegionUserNumber,Err)
177  CALL CMISSRegion_CoordinateSystemSet(RegionUserNumber,CoordinateSystemUserNumber,Err)
178  CALL CMISSRegion_CreateFinish(RegionUserNumber,Err)
179    
180  !=========================================================================================================================
181  !Create Data Points and set the values
182  CALL CMISSDataPoints_CreateStart(RegionUserNumber,SIZE(DataPointValues,1),Err)
183  DO np=1,SIZE(DataPointValues,1)
184    CALL CMISSDataPoints_ValuesSet(RegionUserNumber,np,DataPointValues(np,:),Err)     
185  ENDDO
186  CALL CMISSDataPoints_CreateFinish(RegionUserNumber,Err)  
187  !=========================================================================================================================
188  !Define basis function - 1D cubic hermite
189  CALL CMISSBasis_CreateStart(BasisUserNumber,Err)
190  CALL CMISSBasis_TypeSet(BasisUserNumber,CMISS_BASIS_LAGRANGE_HERMITE_TP_TYPE,Err)
191  CALL CMISSBasis_NumberOfXiSet(BasisUserNumber,NumberOfXi,Err)
192  CALL CMISSBasis_InterpolationXiSet(BasisUserNumber,BasisInterpolation,Err)
193  CALL CMISSBasis_CreateFinish(BasisUserNumber,Err)  
194  !=========================================================================================================================
195  !Create a mesh
196  MeshNumberOfElements=SIZE(ElementUserNodes,1)
197  CALL CMISSMesh_CreateStart(MeshUserNumber,RegionUserNumber,MeshDimensions,Err)
198  CALL CMISSMesh_NumberOfComponentsSet(RegionUserNumber,MeshUserNumber,MeshNumberOfComponents,Err)
199  CALL CMISSMesh_NumberOfElementsSet(RegionUserNumber,MeshUserNumber,MeshNumberOfElements,Err)
200  !define nodes for the mesh
201  NumberOfNodes=SIZE(FieldValues,2)
202  CALL CMISSNodes_CreateStart(RegionUserNumber,NumberOfNodes,Err)
203  CALL CMISSNodes_CreateFinish(RegionUserNumber,Err)  
204  !define elements for the mesh
205  CALL CMISSMeshElements_CreateStart(RegionUserNumber,MeshUserNumber,MeshComponentNumber,BasisUserNumber,Err)
206  Do el=1,MeshNumberOfElements
207    CALL CMISSMeshElements_NodesSet(RegionUserNumber,MeshUserNumber,MeshComponentNumber,el,ElementUserNodes(el,:),Err)
208  ENDDO
209  CALL CMISSMeshElements_CreateFinish(RegionUserNumber,MeshUserNumber,MeshComponentNumber,Err)
210  CALL CMISSMesh_CreateFinish(RegionUserNumber,MeshUserNumber,Err)
211  !=========================================================================================================================
212  !Create a mesh decomposition 
213  CALL CMISSDecomposition_CreateStart(DecompositionUserNumber,RegionUserNumber,MeshUserNumber,Err)
214  CALL CMISSDecomposition_TypeSet(RegionUserNumber,MeshUserNumber,DecompositionUserNumber,CMISS_DECOMPOSITION_CALCULATED_TYPE,Err)
215  CALL CMISSDecomposition_NumberOfDomainsSet(RegionUserNumber,MeshUserNumber,DecompositionUserNumber,NumberOfDomains,Err)
216  CALL CMISSDecomposition_CreateFinish(RegionUserNumber,MeshUserNumber,DecompositionUserNumber,Err)
217  
218  !=========================================================================================================================
219  !Create a field to put the geometry
220  CALL CMISSField_CreateStart(FieldUserNumber,RegionUserNumber,Err)
221  CALL CMISSField_MeshDecompositionSet(RegionUserNumber,FieldUserNumber,MeshUserNumber,DecompositionUserNumber,Err)
222  CALL CMISSField_TypeSet(RegionUserNumber,FieldUserNumber,CMISS_FIELD_GEOMETRIC_TYPE,Err)
223  CALL CMISSField_NumberOfVariablesSet(RegionUserNumber,FieldUserNumber,FieldNumberOfVariables,Err)
224  CALL CMISSField_NumberOfComponentsSet(RegionUserNumber,FieldUserNumber,CMISS_FIELD_U_VARIABLE_TYPE,FieldNumberOfComponents,Err)
225  DO xi=1,NumberOfXi
226    CALL CMISSField_ComponentMeshComponentSet(RegionUserNumber,FieldUserNumber,CMISS_FIELD_U_VARIABLE_TYPE,xi,xi,Err)
227  ENDDO !xi    
228  CALL CMISSField_CreateFinish(RegionUserNumber,FieldUserNumber,Err)
229  !node 1
230  ver_idx=1 ! version number
231  DO der_idx=1,SIZE(FieldValues,1)
232    DO node_idx=1,SIZE(FieldValues,2)
233      DO comp_idx=1,SIZE(FieldValues,3)
234        CALL CMISSField_ParameterSetUpdateNode(RegionUserNumber,FieldUserNumber,CMISS_FIELD_U_VARIABLE_TYPE, &
235          & CMISS_FIELD_VALUES_SET_TYPE, &
236          & ver_idx,der_idx,node_idx,comp_idx,FieldValues(der_idx,node_idx,comp_idx),Err)
237      ENDDO
238    ENDDO
239  ENDDO
240  
241  !=========================================================================================================================
242  !Create a data projection
243  CALL CMISSDataProjection_CreateStart(RegionUserNumber,FieldUserNumber,RegionUserNumber,Err)
244  !=========================================================================================================================
245  !Test parameter set functions
246  CALL CMISSDataProjection_AbsoluteToleranceSet(RegionUserNumber,AbsoluteToleranceSet,Err) !test
247  CALL CMISSDataProjection_MaximumIterationUpdateSet(RegionUserNumber,MaximumIterationUpdateSet,Err) !test
248  CALL CMISSDataProjection_MaximumNumberOfIterationsSet(RegionUserNumber,MaximumNumberOfIterationsSet,Err) !test
249  CALL CMISSDataProjection_NumberOfClosestElementsSet(RegionUserNumber,NumberOfClosestElementsSet,Err) !test
250  CALL CMISSDataProjection_ProjectionTypeSet(RegionUserNumber,ProjectionTypeSet,Err)
251  CALL CMISSDataProjection_RelativeToleranceSet(RegionUserNumber,RelativeToleranceSet,Err) !test
252  CALL CMISSDataProjection_StartingXiSet(RegionUserNumber,StartingXiSet,Err) !test
253  !=========================================================================================================================
254  !Finish data projection  
255  CALL CMISSDataProjection_CreateFinish(RegionUserNumber,Err)
256  !=========================================================================================================================
257  !Test parameter get functions
258  CALL CMISSDataProjection_AbsoluteToleranceGet(RegionUserNumber,AbsoluteToleranceGet,Err) !test
259  CALL CMISSDataProjection_MaximumIterationUpdateGet(RegionUserNumber,MaximumIterationUpdateGet,Err) !test
260  CALL CMISSDataProjection_MaximumNumberOfIterationsGet(RegionUserNumber,MaximumNumberOfIterationsGet,Err) !test
261  CALL CMISSDataProjection_NumberOfClosestElementsGet(RegionUserNumber,NumberOfClosestElementsGet,Err) !test
262  CALL CMISSDataProjection_ProjectionTypeGet(RegionUserNumber,ProjectionTypeGet,Err) !test
263  CALL CMISSDataProjection_RelativeToleranceGet(RegionUserNumber,RelativeToleranceGet,Err) !test
264  CALL CMISSDataProjection_StartingXiGet(RegionUserNumber,StartingXiGet,Err) !test  
265  
266  !=========================================================================================================================
267  !Start data projection
268  CALL CMISSDataProjection_Evaluate(RegionUserNumber,Err)
269  
270  !=========================================================================================================================
271  !Destroy used types
272  CALL CMISSDataProjection_Destroy(RegionUserNumber,Err)
273  CALL CMISSDataPoints_Destroy(RegionUserNumber,Err)
274    
275  CALL CMISSRegion_Destroy(RegionUserNumber,Err)
276  CALL CMISSCoordinateSystem_Destroy(CoordinateSystemUserNumber,Err)  
277  
278  !=========================================================================================================================
279  !Finishing program
280  CALL CMISSFinalise(Err)
281  WRITE(*,'(A)') "Program successfully completed."
282  STOP  
283  
284END PROGRAM DataProjection1DRectangularCartesian
285  
286  
287  
288  
289  
290  
291  
292  
293  
294  
295  
296  
297  
298  
299  
300  
301  
302  
303  
304  
305  
306