```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 ```