622 lines
29 KiB
Markdown
622 lines
29 KiB
Markdown
|
|
```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
|
|
``` |