gyz/obsidian_backup
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
obsidian_backup/书籍/力学书籍/OpenFast/FASTKinetics/auto/meshmap.md

622 lines
29 KiB
Markdown
Raw Normal View History

vault backup: 2026-01-23 15:42:30
2026-01-23 15:42:35 +08:00
```fortran
!----------------------------------------------------------------------------------------------------------------------------------
!bjj: maybe the MeshMapCreate routine shouldn't actually allocate arrays; allocate them in
! the "IF (RemapFlag)" sections so that if people add nodes during the simulation, the structures get reallocated to correct
! size? MeshMapCreate should maybe be MeshMapping_Init() and only check that fields are compatible, etc.
!----------------------------------------------------------------------------------------------------------------------------------
!> This subroutine takes two meshes, determines the sizes required for the mapping data structure, and then
!! allocates the mappings (different for loads and motions/scalars).
SUBROUTINE MeshMapCreate( Src, Dest, MeshMap, ErrStat, ErrMsg )
! note that MeshMap%MapSrcToAugmt is allocated in Create_Augmented_Ln2_Src_Mesh() along with the Augmented_Ln2_Src Mesh
TYPE(MeshType), INTENT(IN) :: Src !< source mesh
TYPE(MeshType), INTENT(IN) :: Dest !< destination mesh
TYPE(MeshMapType), INTENT(INOUT) :: MeshMap !< mapping data structure
INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation
CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None
! local variables:
INTEGER(IntKi) :: PointsInMap, PointsInTmpMap
INTEGER(IntKi) :: ElementNodes
LOGICAL :: MapCreated
INTEGER(IntKi) :: ErrStat2
CHARACTER(ErrMsgLen) :: ErrMsg2
CHARACTER(*), PARAMETER :: RoutineName = 'MeshMapCreate'
ErrStat = ErrID_None
ErrMsg = ''
MapCreated = .FALSE.
IF ( .NOT. Dest%Committed .OR. .NOT. Src%Committed ) THEN
ErrStat = ErrID_Fatal
ErrMsg = " Both meshes must be committed before they can be mapped."
RETURN
END IF
ElementNodes = 1
PointsInTmpMap = 0
!................................................
! Allocate the mapping for Motions and Scalars (if both meshes have some):
!................................................
IF ( HasMotionFields(Src) .AND. HasMotionFields(Dest) ) THEN
IF ( Src%ElemTable(ELEMENT_LINE2)%nelem > 0 ) THEN !Line2-to-Point and Line2-to-Line2 motion mapping
ElementNodes = 2
END IF
! for motion fields, every destination node is mapped to a source element or node
PointsInMap = Dest%Nnodes
PointsInTmpMap = MAX(PointsInTmpMap,PointsInMap)
IF ( PointsInMap < 1 ) THEN
CALL SetErrStat( ErrID_Fatal, 'MeshMap%MapMotions not allocated because no nodes were found to map.', ErrStat, ErrMsg, RoutineName)
ELSE
! Allocate the mapping structure:
ALLOCATE( MeshMap%MapMotions(PointsInMap), STAT=ErrStat2 )
IF ( ErrStat2 /= 0 ) THEN
CALL SetErrStat( ErrID_Fatal, 'Error trying to allocate MeshMap%MapMotions.', ErrStat, ErrMsg, RoutineName)
ELSE
MapCreated = .TRUE.
! set up the initial mappings so that we don't necessarially have to do this multiple times on the first time step (if calculating Jacobians)
IF ( Dest%ElemTable(ELEMENT_LINE2)%nelem > 0 ) THEN ! point-to-Line2 or Line2-to-Line2
IF ( Src%ElemTable(ELEMENT_LINE2)%nelem > 0 ) THEN ! Line2-to-Line2
CALL CreateMotionMap_L2_to_L2( Src, Dest, MeshMap, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
ELSEIF ( Src%ElemTable(ELEMENT_POINT)%nelem > 0 ) THEN ! point-to-Line2
CALL CreateMotionMap_P_to_L2( Src, Dest, MeshMap, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
END IF
ELSEIF ( Dest%ElemTable(ELEMENT_POINT)%nelem > 0 ) THEN ! point-to-point or Line2-to-point
IF ( Src%ElemTable(ELEMENT_POINT)%nelem > 0 ) THEN ! point-to-point
CALL CreateMotionMap_P_to_P( Src, Dest, MeshMap, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
ELSEIF ( Src%ElemTable(ELEMENT_LINE2)%nelem > 0 ) THEN ! Line2-to-point
CALL CreateMotionMap_L2_to_P(Src, Dest, MeshMap, ErrStat2, ErrMsg2)
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
END IF
END IF ! create initial mapping based on mesh element type
END IF ! MapMotions created
END IF ! Dest has nodes to map
END IF !HasMotionFields
!................................................
! Allocate the mapping for Loads:
!................................................
IF ( HasLoadFields(Src) .AND. HasLoadFields(Dest) ) THEN
! check that the appropriate combinations of source/destination force/moments exist:
IF ( Src%FieldMask(MASKID_Force) ) THEN
IF (.NOT. Dest%FieldMask(MASKID_Force) ) THEN
CALL SetErrStat( ErrID_Fatal, 'Destination mesh does not contain force but source mesh does.', ErrStat, ErrMsg, RoutineName)
END IF
IF (.NOT. Dest%FieldMask(MASKID_Moment) ) THEN
CALL SetErrStat( ErrID_Fatal, 'Destination mesh must contain moment when source mesh contains force.', ErrStat, ErrMsg, RoutineName)
END IF
END IF
IF ( Src%FieldMask(MASKID_Moment) ) THEN
IF (.NOT. Dest%FieldMask(MASKID_Moment) ) THEN
CALL SetErrStat( ErrID_Fatal, 'Destination mesh does not contain moment but source mesh does.', ErrStat, ErrMsg, RoutineName)
END IF
END IF
! get size of mapping:
PointsInMap = Src%Nnodes
IF ( PointsInMap < 1 ) THEN
CALL SetErrStat( ErrID_Fatal, 'MeshMap%MapLoads not allocated because no nodes were found to map.', ErrStat, ErrMsg, RoutineName)
ELSE
! Allocate the mapping structure:
ALLOCATE( MeshMap%MapLoads(PointsInMap), STAT=ErrStat2 )
IF ( ErrStat2 /= 0 ) THEN
CALL SetErrStat( ErrID_Fatal, 'Error trying to allocate MeshMap%MapLoads.', ErrStat, ErrMsg, RoutineName)
ELSE
MapCreated = .TRUE.
! set up the initial mappings so that we don't necessarially have to do this multiple times on the first time step (if calculating Jacobians)
IF ( Dest%ElemTable(ELEMENT_LINE2)%nelem > 0 ) THEN ! point-to-Line2 or Line2-to-Line2
ElementNodes = 2
IF ( Src%ElemTable(ELEMENT_LINE2)%nelem > 0 ) THEN ! Line2-to-Line2
CALL CreateLoadMap_L2_to_L2( Src, Dest, MeshMap, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
ELSEIF ( Src%ElemTable(ELEMENT_POINT)%nelem > 0 ) THEN ! point-to-Line2
CALL CreateLoadMap_P_to_L2( Src, Dest, MeshMap, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
END IF
ELSEIF ( Dest%ElemTable(ELEMENT_POINT)%nelem > 0 ) THEN ! point-to-point or Line2-to-point
IF ( Src%ElemTable(ELEMENT_POINT)%nelem > 0 ) THEN ! point-to-point
CALL CreateLoadMap_P_to_P( Src, Dest, MeshMap, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
ELSEIF ( Src%ElemTable(ELEMENT_LINE2)%nelem > 0 ) THEN ! Line2-to-point
CALL CreateLoadMap_L2_to_P(Src, Dest, MeshMap, ErrStat2, ErrMsg2)
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
END IF
END IF ! create initial mapping based on mesh element type
END IF ! MapLoads allocated
END IF ! Src has nodes to transfer
END IF ! HasLoadFields
IF ( .NOT. MapCreated ) THEN
CALL SetErrStat( ErrID_Fatal, 'Neither MapMotions or MapLoads was allocated. Meshes may not have compatible fields for mapping.', ErrStat, ErrMsg, RoutineName)
RETURN
END IF
!................................................
! Allocate the DisplacedPosition field:
!................................................
IF (.NOT. ALLOCATED (MeshMap%DisplacedPosition)) THEN
CALL AllocAry( MeshMap%DisplacedPosition, 3, PointsInTmpMap, ElementNodes, 'MeshMap%DisplacedPosition', ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, RoutineName)
END IF
END SUBROUTINE MeshMapCreate
```
```fortran
!> This routine creates the mapping of motions between two meshes
SUBROUTINE CreateMotionMap_L2_to_L2( Src, Dest, MeshMap, ErrStat, ErrMsg )
TYPE(MeshType), INTENT(IN ) :: Src !< The source mesh
TYPE(MeshType), INTENT(IN ) :: Dest !< The destination mesh
TYPE(MeshMapType), INTENT(INOUT) :: MeshMap !< structure that contains data necessary to map these two meshes
INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation
CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None
! Local variables:
INTEGER(IntKi) :: ErrStat2
CHARACTER(ErrMsgLen) :: ErrMsg2
ErrStat = ErrID_None
ErrMsg = ""
CALL CreateMapping_ProjectToLine2(Dest,Src, MeshMap%MapMotions, ELEMENT_LINE2, ErrStat2, ErrMsg2)
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CreateMotionMap_L2_to_L2')
IF (ErrStat >= AbortErrLev) RETURN
END SUBROUTINE CreateMotionMap_L2_to_L2
```
```fortran
!> This routine projects Mesh1 onto a Line2 mesh (Mesh2) to find the element mappings between the two meshes.
SUBROUTINE CreateMapping_ProjectToLine2(Mesh1, Mesh2, NodeMap, Mesh1_TYPE, ErrStat, ErrMsg)
TYPE(MeshType), INTENT(IN ) :: Mesh1 !< The mesh in the outer mapping loop (Dest for Motions/Scalars; Src for Loads)
TYPE(MeshType), INTENT(IN ) :: Mesh2 !< The mesh in the inner mapping loop (Src for Motions/Scalars; Dest for Loads)
TYPE(MapType), INTENT(INOUT) :: NodeMap(:) !< The mapping from Src to Dest
INTEGER(IntKi), INTENT(IN ) :: Mesh1_TYPE !< Type of Mesh1 elements to map
INTEGER(IntKi), PARAMETER :: Mesh2_TYPE = ELEMENT_LINE2 !< Type of Mesh2 elements on map (MUST BE ELEMENT_LINE2)
INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation
CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None
! local variables
! INTEGER(IntKi) :: ErrStat2 ! Error status of the operation
! CHARACTER(ErrMsgLen) :: ErrMsg2 ! Error message if ErrStat2 /= ErrID_None
#ifdef DEBUG_MESHMAPPING
CHARACTER(200) :: DebugFileName ! File name for debugging file
#endif
CHARACTER(*), PARAMETER :: RoutineName = 'CreateMapping_ProjectToLine2'
REAL(ReKi) :: denom
REAL(ReKi) :: dist
REAL(ReKi) :: min_dist
REAL(ReKi) :: elem_position
REAL(SiKi) :: elem_position_SiKi
REAL(ReKi) :: Mesh1_xyz(3)
REAL(ReKi) :: n1_n2_vector(3) ! vector going from node 1 to node 2 in Line2 element
REAL(ReKi) :: n1_Point_vector(3) ! vector going from node 1 in Line 2 element to Destination Point
REAL(ReKi) :: tmp(3) ! temporary vector for cross product calculation
INTEGER(IntKi) :: iElem, iNode, i ! do-loop counter for elements on Mesh1, associated node(S)
INTEGER(IntKi) :: jElem ! do-loop counter for elements on Mesh2, associated node
INTEGER(IntKi) :: n1, n2 ! nodes associated with an element
LOGICAL :: found
LOGICAL :: on_element
REAL(ReKi) :: closest_elem_position
INTEGER(IntKi) :: closest_elem
REAL(ReKi) :: closest_elem_diff
REAL(ReKi) :: closest_elem_distance
#ifdef DEBUG_MESHMAPPING
INTEGER(IntKi) :: Un ! unit number for debugging
INTEGER(IntKi) :: ErrStat2
CHARACTER(ErrMsgLen) :: ErrMsg2
#endif
! initialization
ErrStat = ErrID_None
ErrMsg = ""
! Map the source nodes to destination nodes:
do n1=1,size(NodeMap)
NodeMap(n1)%OtherMesh_Element = NODE_NOT_MAPPED ! initialize this so we know if we've mapped this node already (done only because we may have different elements)
end do !n1
do iElem = 1, Mesh1%ElemTable(Mesh1_TYPE)%nelem ! number of Mesh1_TYPE elements on Mesh1
do iNode = 1, SIZE( Mesh1%ElemTable(Mesh1_TYPE)%Elements(iElem)%ElemNodes )
i = Mesh1%ElemTable(Mesh1_TYPE)%Elements(iElem)%ElemNodes(iNode) ! the nodes on element iElem
IF ( NodeMap(i)%OtherMesh_Element > 0 ) CYCLE ! we already mapped this node; let's move on to the next iNode (or iElem)
! destination point
Mesh1_xyz = Mesh1%Position(:, i)
found = .false.
min_dist = HUGE(min_dist)
! some values for finding mapping if there are some numerical issues
closest_elem_diff = HUGE(min_dist)
closest_elem = 0
do jElem = 1, Mesh2%ElemTable(Mesh2_TYPE)%nelem ! ELEMENT_LINE2 = Mesh2_TYPE
! write(*,*) 'i,jElem = ', i,jElem, 'found = ', found
! grab node numbers associated with the jElem_th element
n1 = Mesh2%ElemTable(Mesh2_TYPE)%Elements(jElem)%ElemNodes(1)
n2 = Mesh2%ElemTable(Mesh2_TYPE)%Elements(jElem)%ElemNodes(2)
! Calculate vectors used in projection operation
n1_n2_vector = Mesh2%Position(:,n2) - Mesh2%Position(:,n1)
n1_Point_vector = Mesh1_xyz - Mesh2%Position(:,n1)
denom = DOT_PRODUCT( n1_n2_vector, n1_n2_vector )
IF ( EqualRealNos( denom, 0.0_ReKi ) ) THEN
CALL SetErrStat( ErrID_Fatal, 'Division by zero because Line2 element nodes are in same position.', ErrStat, ErrMsg, RoutineName)
RETURN
END IF
! project point onto line defined by n1 and n2
elem_position = DOT_PRODUCT(n1_n2_vector,n1_Point_vector) / denom
! note: i forumlated it this way because Fortran doesn't necessarially do shortcutting and I don't want to call EqualRealNos if we don't need it:
if ( elem_position .ge. 0.0_ReKi .and. elem_position .le. 1.0_ReKi ) then !we're ON the element (between the two nodes)
on_element = .true.
else
elem_position_SiKi = REAL( elem_position, SiKi )
if (EqualRealNos( elem_position_SiKi, 1.0_SiKi )) then !we're ON the element (at a node)
on_element = .true.
elem_position = 1.0_ReKi
elseif (EqualRealNos( elem_position_SiKi, 0.0_SiKi )) then !we're ON the element (at a node)
on_element = .true.
elem_position = 0.0_ReKi
else !we're not on the element
on_element = .false.
if (.not. found) then ! see if we have are very close to the end of an element (numerical roundoff?)
if ( elem_position_SiKi < 0.0_SiKi ) then
if ( -elem_position_SiKi < closest_elem_diff ) then
closest_elem_diff = -elem_position_SiKi
closest_elem = jElem
closest_elem_position = 0.0_ReKi
closest_elem_distance = sqrt(denom) * closest_elem_diff ! distance from end of element, in meters
end if
else
if ( elem_position_SiKi-1.0_SiKi < closest_elem_diff ) then
closest_elem_diff = elem_position_SiKi-1.0_SiKi
closest_elem = jElem
closest_elem_position = 1.0_ReKi
closest_elem_distance = sqrt(denom) * closest_elem_diff ! distance from end of element, in meters
end if
end if
end if
end if
end if
if (on_element) then
! calculate distance between point and line (note: this is actually the distance squared);
! will only store information once we have determined the closest element
tmp = cross_product( n1_n2_vector, n1_Point_vector )
dist = DOT_PRODUCT(tmp,tmp) / denom
if (dist .lt. min_dist) then
found = .true.
min_dist = dist
NodeMap(i)%OtherMesh_Element = jElem
NodeMap(i)%shape_fn(1) = 1.0_ReKi - elem_position
NodeMap(i)%shape_fn(2) = elem_position
!NodeMap(i)%couple_arm = n1_Point_vector
end if !the point is closest to this line2 element
endif
end do !jElem
! if failed to find an element that the Point projected into, throw an error
if (.not. found) then
if ( closest_elem_distance <= 7.5e-3 ) then ! if it is within 7.5mm of the end of an element, we'll accept it
NodeMap(i)%OtherMesh_Element = closest_elem
NodeMap(i)%shape_fn(1) = 1.0_ReKi - closest_elem_position
NodeMap(i)%shape_fn(2) = closest_elem_position
CALL SetErrStat( ErrID_Info, 'Found close value for node '//trim(num2Lstr(i))//'. ('//trim(num2lstr(closest_elem_distance))//' m)', ErrStat, ErrMsg, RoutineName)
end if
if (NodeMap(i)%OtherMesh_Element .lt. 1 ) then
CALL SetErrStat( ErrID_Fatal, 'Node '//trim(num2Lstr(i))//' does not project onto any line2 element.' &
//' Closest distance is '//trim(num2lstr(closest_elem_distance))//' m.', ErrStat, ErrMsg, RoutineName)
#ifdef DEBUG_MESHMAPPING
! output some mesh information for debugging
CALL GetNewUnit(Un,ErrStat2,ErrMsg2)
DebugFileName='FAST_Meshes.'//trim(num2Lstr(Un))//'.dbg'
CALL OpenFOutFile(Un,DebugFileName,ErrStat2,ErrMsg2)
IF (ErrStat2 >= AbortErrLev) RETURN
CALL SetErrStat( ErrID_Info, 'See '//trim(DebugFileName)//' for mesh debug information.', ErrStat, ErrMsg, RoutineName)
WRITE( Un, '(A,I5,A,I5,A,ES15.5,A)' ) 'Element ', closest_elem, ' is closest to node ', i, &
'. It has a relative position of ', closest_elem_diff, '.'
WRITE( Un, '(A)') '************************************************** Mesh1 ***************************************************'
WRITE( Un, '(A)') 'Mesh1 is the destination mesh for transfer of motions/scalars; it is the source mesh for transfer of loads.'
WRITE( Un, '(A)') '************************************************************************************************************'
CALL MeshPrintInfo ( Un, Mesh1 )
WRITE( Un, '(A)') '************************************************** Mesh2 ***************************************************'
WRITE( Un, '(A)') 'Mesh2 is the source mesh for transfer of motions/scalars; it is the destination mesh for transfer of loads.'
WRITE( Un, '(A)') '************************************************************************************************************'
CALL MeshPrintInfo ( Un, Mesh2 )
! CLOSE(Un) ! by not closing this, I can ensure unique file names.
#endif
RETURN
endif
end if !not found on projection to element
end do !iNode
end do !iElem
END SUBROUTINE CreateMapping_ProjectToLine2
```
```fortran
SUBROUTINE CreateMotionMap_P_to_L2( Src, Dest, MeshMap, ErrStat, ErrMsg )
TYPE(MeshType), INTENT(IN ) :: Src ! The source mesh
TYPE(MeshType), INTENT(IN ) :: Dest ! The destination mesh
TYPE(MeshMapType), INTENT(INOUT) :: MeshMap
INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation
CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None
! Local variables:
INTEGER(IntKi) :: i
INTEGER(IntKi) :: ErrStat2
CHARACTER(ErrMsgLen) :: ErrMsg2
ErrStat = ErrID_None
ErrMsg = ""
! Each destination node (on a LINE2 mesh) needs a source
! in following call, Dest is mesh to looped over, finding a corresponding point for each point in Src
CALL CreateMapping_NearestNeighbor( Dest, Src, MeshMap%MapMotions, ELEMENT_LINE2, ELEMENT_POINT, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CreateMotionMap_P_to_L2')
IF (ErrStat >= AbortErrLev) RETURN
! bjj: for consistant definition of couple_arm (i.e. p_ODR-p_OSR), let's multiply by -1
do i=1,SIZE(MeshMap%MapMotions)
MeshMap%MapMotions(i)%couple_arm = -1._ReKi*MeshMap%MapMotions(i)%couple_arm
end do
END SUBROUTINE CreateMotionMap_P_to_L2
```
```fortran
!> This routine creates the node-to-node (nearest neighbor). We map FROM Mesh1 to Mesh2
SUBROUTINE CreateMapping_NearestNeighbor( Mesh1, Mesh2, NodeMap, Mesh1_TYPE, Mesh2_TYPE, ErrStat, ErrMsg )
!.......................................................................................
TYPE(MeshType), INTENT(IN ) :: Mesh1 !< The mesh in the outer mapping loop (Dest for Motions/Scalars; Src for Loads)
TYPE(MeshType), INTENT(IN ) :: Mesh2 !< The mesh in the inner mapping loop (Src for Motions/Scalars; Dest for Loads)
TYPE(MapType), INTENT(INOUT) :: NodeMap(:) !< The mapping from Src to Dest
INTEGER(IntKi), INTENT(IN ) :: Mesh1_TYPE !< Type of Mesh1 elements to map
INTEGER(IntKi), INTENT(IN ) :: Mesh2_TYPE !< Type of Mesh2 elements on map
INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation
CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None
! local variables
REAL(ReKi) :: dist
REAL(ReKi) :: min_dist
REAL(ReKi) :: Mesh1_xyz(3)
REAL(ReKi) :: Mesh2_xyz(3)
INTEGER(IntKi) :: point_with_min_dist
INTEGER(IntKi) :: iElem, iNode, i ! do-loop counter for elements on Mesh1, associated node(S)
INTEGER(IntKi) :: jElem, jNode, j ! do-loop counter for elements on Mesh2, associated node
LOGICAL :: UseMesh2Node(Mesh2%NNodes) ! determines if the node on the second mesh is part of the mapping (i.e., contained in an element of the appropriate type)
! initialization
ErrStat = ErrID_None
ErrMsg = ""
! Determine which nodes on mesh2 are going to be in the mapping
UseMesh2Node = .FALSE.
do jElem = 1, Mesh2%ElemTable(Mesh2_TYPE)%nelem ! number of point elements on Mesh2
do jNode = 1, SIZE( Mesh2%ElemTable(Mesh2_TYPE)%Elements(jElem)%ElemNodes )
UseMesh2Node( Mesh2%ElemTable(Mesh2_TYPE)%Elements(jElem)%ElemNodes(jNode) ) = .TRUE.
end do
end do
! Map the source nodes to destination nodes:
do i=1,size(NodeMap)
NodeMap(i)%OtherMesh_Element = NODE_NOT_MAPPED ! initialize this so we know if we've mapped this node already (done only because we may have different elements)
end do !n1
do iElem = 1, Mesh1%ElemTable(Mesh1_TYPE)%nelem ! number of Mesh1_TYPE elements on Mesh1 = number of points on Mesh1
do iNode = 1, SIZE( Mesh1%ElemTable(Mesh1_TYPE)%Elements(iElem)%ElemNodes )
i = Mesh1%ElemTable(Mesh1_TYPE)%Elements(iElem)%ElemNodes(iNode) ! the nodes on element iElem
IF ( NodeMap(i)%OtherMesh_Element > 0 ) CYCLE ! we already mapped this node; let's move on
! Find the nearest neighbor node for this particular node
! initialize minimum distance marker at some huge number
min_dist = HUGE(min_dist)
point_with_min_dist = 0
Mesh1_xyz = Mesh1%Position(:, i)
do j = 1, Mesh2%NNodes
IF ( .NOT. UseMesh2Node(j) ) CYCLE !This node isn't part of the elements we're mapping
! destination point
Mesh2_xyz = Mesh2%Position(:, j)
! calculate distance between source and desination; will only store information once we have determined
! the closest point
dist = sqrt( (Mesh1_xyz(1) - Mesh2_xyz(1))**2 &
+ (Mesh1_xyz(2) - Mesh2_xyz(2))**2 &
+ (Mesh1_xyz(3) - Mesh2_xyz(3))**2 )
if (dist .lt. min_dist) then
min_dist = dist
point_with_min_dist = j
!if (EqualRealNos(dist), 0.0_ReKi)) EXIT !we have an exact match so let's just stop looking
endif
end do !j
if (point_with_min_dist .lt. 1 ) then
CALL SetErrStat( ErrID_Fatal, 'Failed to find destination point associated with source point.', ErrStat, ErrMsg, 'CreateMapping_NearestNeighbor')
RETURN
endif
NodeMap(i)%OtherMesh_Element = point_with_min_dist !bjj: For consistency, I really wish we had used element numbers here instead....
NodeMap(i)%distance = min_dist
NodeMap(i)%couple_arm = Mesh2%Position(:, point_with_min_dist) - Mesh1_xyz
!bjj: this is the negative of the case where it's Mesh2=src, so we'll have to multiply by -1 outside this routine if that's the case
end do !iNode
end do !iElem
END SUBROUTINE CreateMapping_NearestNeighbor
```
```fortran
SUBROUTINE CreateMotionMap_P_to_P( Src, Dest, MeshMap, ErrStat, ErrMsg )
TYPE(MeshType), INTENT(IN ) :: Src ! The source mesh
TYPE(MeshType), INTENT(IN ) :: Dest ! The destination mesh
TYPE(MeshMapType), INTENT(INOUT) :: MeshMap
INTEGER(IntKi), INTENT( OUT) :: ErrStat ! Error status of the operation
CHARACTER(*), INTENT( OUT) :: ErrMsg ! Error message if ErrStat /= ErrID_None
! Local variables:
INTEGER(IntKi) :: i
INTEGER(IntKi) :: ErrStat2
CHARACTER(ErrMsgLen) :: ErrMsg2
ErrStat = ErrID_None
ErrMsg = ""
! in following call, Dest is mesh to looped over, finding a corresponding point for each point in Src
CALL CreateMapping_NearestNeighbor( Dest, Src, MeshMap%MapMotions, ELEMENT_POINT, ELEMENT_POINT, ErrStat2, ErrMsg2 )
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CreateMotionMap_P_to_P')
IF (ErrStat >= AbortErrLev) RETURN
! bjj: for consistant definition of couple_arm (i.e. p_ODR-p_OSR), let's multiply by -1
do i=1,SIZE(MeshMap%MapMotions)
MeshMap%MapMotions(i)%couple_arm = -1.0_ReKi*MeshMap%MapMotions(i)%couple_arm
end do
END SUBROUTINE CreateMotionMap_P_to_P
```
```fortran
SUBROUTINE CreateMotionMap_L2_to_P( Src, Dest, MeshMap, ErrStat, ErrMsg )
TYPE(MeshType), INTENT(IN ) :: Src !< The source mesh
TYPE(MeshType), INTENT(IN ) :: Dest !< The destination mesh
TYPE(MeshMapType), INTENT(INOUT) :: MeshMap !< mapping data structure
INTEGER(IntKi), INTENT( OUT) :: ErrStat !< Error status of the operation
CHARACTER(*), INTENT( OUT) :: ErrMsg !< Error message if ErrStat /= ErrID_None
! Local variables:
INTEGER(IntKi) :: ErrStat2
CHARACTER(ErrMsgLen) :: ErrMsg2
ErrStat = ErrID_None
ErrMsg = ""
CALL CreateMapping_ProjectToLine2(Dest,Src, MeshMap%MapMotions, ELEMENT_POINT, ErrStat2, ErrMsg2)
CALL SetErrStat( ErrStat2, ErrMsg2, ErrStat, ErrMsg, 'CreateMotionMap_L2_to_P')
!IF (ErrStat >= AbortErrLev) RETURN
END SUBROUTINE CreateMotionMap_L2_to_P
```
Reference in New Issue Copy Permalink