70 LOGICAL :: surfaceelonproc
71 INTEGER :: testnumsurfel
72 INTEGER,
POINTER,
DIMENSION(:,:) :: nodeflag2d
79 TYPE user_type_surfndlist
80 TYPE(link_type
) :: link
82 END TYPE user_type_surfndlist
84 TYPE user_data_type_surfndlist
86 END TYPE user_data_type_surfndlist
89 TYPE user_ptr_type_surfndlist
90 TYPE(user_type_surfndlist
),
POINTER :: p
91 END TYPE user_ptr_type_surfndlist
93 TYPE(user_ptr_type_surfndlist
) :: user_surfndlist
94 TYPE(list_type
) :: surfndlist
96 TYPE(link_ptr_type
) :: link
98 TYPE(surfmesh_tri3_ptr
),
POINTER :: ptrtri3
99 TYPE(surfmesh_tri6_ptr
),
POINTER :: ptrtri6
100 TYPE(surfmesh_hex8_ptr
),
POINTER :: ptrhex8
102 INTEGER,
POINTER,
DIMENSION(:) :: bcsurfflagzero,bcsurfflagone,bcsurfflagtwo
105 CHARACTER(*),
PARAMETER :: surwin =
"sfrac"
107 REAL*8,
POINTER,
DIMENSION(:,:) :: meshcoor
109 INTEGER,
POINTER,
DIMENSION(:) :: elflag_list
110 INTEGER,
POINTER,
DIMENSION(:) :: faceoncell
114 INTEGER :: inb, ibu, ini
122 write_attr = com_get_function_handle(
'OUT.write_attribute')
123 set_option = com_get_function_handle(
'OUT.set_option')
127 print*,
'Overlay processor', iprocs - 1
128 WRITE(456,*) iprocs - 1
141 CALL com_new_window( surwin)
434 IF(meshtype2d.EQ.3)
THEN
440 ptrtri3 => surfmesh_tri3_ov1_head
442 do while(
associated(ptrtri3))
445 glbndnum = ptrtri3%ElemData(
i)
446 IF( nodeflag(glbndnum).GT.0)
THEN
447 numnpnew = numnpnew + 1
448 nodeflag(glbndnum) = -nodeflag(glbndnum)
451 ptrtri3 => ptrtri3%next
457 ptrtri3 => surfmesh_tri3_ov1_head
458 do while(
associated(ptrtri3))
460 glbndnum = ptrtri3%ElemData(
i)
461 DO k = 1,maxnumberofprocstosharenode
462 IF(procndlist(glbndnum,
k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)
THEN
463 print*,
'Dectected surface sliver for pressure'
464 numnpnew = numnpnew + 1
465 nodeflag(glbndnum) = -nodeflag(glbndnum)
469 ptrtri3 => ptrtri3%next
474 nodeflag(:)= abs( nodeflag(:))
476 ALLOCATE(nodeflag2d(1:2,1:numnpnew))
481 ptrtri3 => surfmesh_tri3_ov1_head
483 do while(
associated(ptrtri3))
486 glbndnum = ptrtri3%ElemData(
i)
487 IF( nodeflag(glbndnum).GT.0)
THEN
488 numnpnew = numnpnew + 1
491 nodeflag2d(1,numnpnew) = glbndnum
492 nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
493 nodeflag(ptrtri3%ElemData(
i)) = - numnpnew
496 ptrtri3 => ptrtri3%next
498 ptrtri3 => surfmesh_tri3_ov1_head
499 do while(
associated(ptrtri3))
501 glbndnum = ptrtri3%ElemData(
i)
502 DO k = 1,maxnumberofprocstosharenode
503 IF(procndlist(glbndnum,
k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)
THEN
504 print*,
'Dectected surface sliver for pressure'
505 numnpnew = numnpnew + 1
507 nodeflag2d(1,numnpnew) = glbndnum
508 nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
509 nodeflag(ptrtri3%ElemData(
i)) = - numnpnew
513 ptrtri3 => ptrtri3%next
517 CALL com_new_attribute( surwin//
'.nc',
'n', com_double, 3,
'm')
518 CALL com_set_size( surwin//
'.nc', ini, numnpnew )
519 CALL com_resize_array(surwin//
'.nc', ini, meshcoor, 3)
522 meshcoor(1:3,
i) = coor(1:3,nodeflag2d(1,
i))
531 testnumsurfel = numeltet2d(4,iprocs)
534 CALL com_set_size( surwin//
'.:t3', ini, testnumsurfel)
535 CALL com_resize_array( surwin//
'.:t3', ini, elconntable, 3)
543 WRITE(456,*) numeltet2d(4,iprocs)
546 ptrtri3 => surfmesh_tri3_ov1_head
547 do while(
associated(ptrtri3))
548 surfaceelonproc = .false.
555 IF(epart(ptrtri3%ElemData(4)).EQ.iprocs) surfaceelonproc = .true.
556 IF(surfaceelonproc)
THEN
562 testnumsurfel = testnumsurfel + 1
563 elconntable(1:3,testnumsurfel) = abs(nodeflag(ptrtri3%ElemData(1:3)))
565 WRITE(456,*) elflag(ptrtri3%ElemData(4)),ptrtri3%ElemData(5)
569 ptrtri3 => ptrtri3%next
572 IF(testnumsurfel.NE.numeltet2d(4,iprocs))
THEN
573 print*,
'ERROR, number of triangles from link list in Mesh2d'
574 print*,
' different then that in read_patran'
575 print*,testnumsurfel,numeltet2d(4,iprocs)
583 CALL com_call_function(
set_option, 2,
'mode',
'w')
587 CALL com_call_function(
set_option, 2,
'mode',
'a')
594 CALL com_call_function(
set_option, 2,
'rankwidth',
'0')
598 sur_all = com_get_attribute_handle( surwin//
'.all')
599 CALL com_call_function(
write_attr, 4,
'Rocin/A_SurfMesh_Ov.hdf', sur_all,&
600 "solid_surf",
"00.000000")
608 ptrtri3 => surfmesh_tri3_ov1_head
610 DO WHILE(
ASSOCIATED(ptrtri3))
612 glbndnum = ptrtri3%ElemData(
i)
613 IF( nodeflag(glbndnum).LT.0)
THEN
614 numnpnew = numnpnew + 1
615 nodeflag(ptrtri3%ElemData(
i)) = nodeflag2d(2,numnpnew)
618 ptrtri3 => ptrtri3%next
623 IF(
ASSOCIATED(nodeflag2d))
DEALLOCATE(nodeflag2d)
634 CALL com_delete_window( surwin)
637 CALL com_new_window( surwin)
644 IF(meshtype2d.EQ.3)
THEN
650 ptrtri3 => surfmesh_tri3_ov2_head
652 DO WHILE(
ASSOCIATED(ptrtri3))
655 glbndnum = ptrtri3%ElemData(
i)
657 IF( nodeflag(glbndnum).GT.0)
THEN
658 numnpnew = numnpnew + 1
659 nodeflag(glbndnum) = -nodeflag(glbndnum)
662 ptrtri3 => ptrtri3%next
665 print*,
'NumNpNew',numnpnew
670 ptrtri3 => surfmesh_tri3_ov2_head
671 do while(
associated(ptrtri3))
673 glbndnum = ptrtri3%ElemData(
i)
674 DO k = 1,maxnumberofprocstosharenode
675 IF(procndlist(glbndnum,
k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)
THEN
676 print*,
'Dectected surface sliver for pressure'
677 numnpnew = numnpnew + 1
678 nodeflag(glbndnum) = -nodeflag(glbndnum)
682 ptrtri3 => ptrtri3%next
688 nodeflag(:)= abs( nodeflag(:))
689 ALLOCATE(nodeflag2d(1:2,1:numnpnew))
694 ptrtri3 => surfmesh_tri3_ov2_head
696 DO WHILE(
ASSOCIATED(ptrtri3))
699 glbndnum = ptrtri3%ElemData(
i)
700 IF( nodeflag(glbndnum).GT.0)
THEN
701 numnpnew = numnpnew + 1
704 nodeflag2d(1,numnpnew) = glbndnum
705 nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
706 nodeflag(ptrtri3%ElemData(
i)) = - numnpnew
709 ptrtri3 => ptrtri3%next
711 ptrtri3 => surfmesh_tri3_ov2_head
712 do while(
associated(ptrtri3))
714 glbndnum = ptrtri3%ElemData(
i)
715 DO k = 1,maxnumberofprocstosharenode
716 IF(procndlist(glbndnum,
k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)
THEN
717 print*,
'Dectected surface sliver for pressure'
718 numnpnew = numnpnew + 1
720 nodeflag2d(1,numnpnew) = glbndnum
721 nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
722 nodeflag(ptrtri3%ElemData(
i)) = - numnpnew
726 ptrtri3 => ptrtri3%next
731 CALL com_new_attribute( surwin//
'.nc',
'n', com_double, 3,
'm')
732 CALL com_set_size( surwin//
'.nc', ini, numnpnew )
733 CALL com_resize_array(surwin//
'.nc', ini, meshcoor, 3)
736 print*,coor(1:3,nodeflag2d(1,
i))
737 meshcoor(1:3,
i) = coor(1:3,nodeflag2d(1,
i))
742 testnumsurfel = numeltet2d(5,iprocs)
744 CALL com_set_size( surwin//
'.:t3', ini, testnumsurfel)
745 CALL com_resize_array( surwin//
'.:t3', ini, elconntable, 3)
747 WRITE(456,*) numeltet2d(5,iprocs)
750 ptrtri3 => surfmesh_tri3_ov2_head
752 DO WHILE(
ASSOCIATED(ptrtri3))
753 surfaceelonproc = .false.
754 IF(epart(ptrtri3%ElemData(4)).EQ.iprocs) surfaceelonproc = .true.
755 IF(surfaceelonproc)
THEN
756 testnumsurfel = testnumsurfel + 1
757 elconntable(1:3,testnumsurfel) = abs(nodeflag(ptrtri3%ElemData(1:3)))
758 WRITE(456,*) elflag(ptrtri3%ElemData(4)),ptrtri3%ElemData(5)
762 ptrtri3 => ptrtri3%next
765 IF(testnumsurfel.NE.numeltet2d(5,iprocs))
THEN
766 print*,
'ERROR, number of triangles from link list in Mesh2d'
767 print*,
' different then that in read_patran'
768 print*,testnumsurfel,numeltet2d(5,iprocs)
774 CALL com_call_function(
set_option, 2,
'mode',
'w')
778 CALL com_call_function(
set_option, 2,
'mode',
'a')
785 CALL com_call_function(
set_option, 2,
'rankwidth',
'0')
789 sur_all = com_get_attribute_handle( surwin//
'.all')
792 CALL com_call_function(
write_attr, 4,
'Rocin/B_SurfMesh_Ov.hdf', sur_all,&
793 "solid_surf",
"00.000000")
799 CALL com_delete_window( surwin)
802 IF(
ASSOCIATED(nodeflag2d))
DEALLOCATE(nodeflag2d)
void set_option(const char *option_name, const char *option_val)
Set an option for Rocout, such as controlling the output format.
static void write_attr(std::ostream &os, const COM::Attribute *attr, int i)
subroutine mesh2doverlay(nprocs, iProcs, ichr4)