OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25norm.F File Reference
#include "implicit_f.inc"
#include "i25edge_c.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"
#include "vectorize.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Macros

#define TO1D(i, j, k, s1, s2)
#define RZERO   0.
#define RUN   1.
#define RDIX   10.
#define REP30   1.0E30
#define REM30   1.0E-30

Functions/Subroutines

subroutine i25tagn (ni25, nin, nrtm, nsn, nsnr, jtask, iad_frnor, fr_nor, irtlm, msegtyp, i_stok_glo, i_stok_rtlm, cand_opt_e, stfns, actnor, irect, tagnod, iad_elem, fr_elem, admsr, knor2msr, nor2msr, flagremn, kremnor, remnor, iedge, nedge, ledge, nrtm_free, free_irect_id, i_stok_e2s, candm_e2s, cands_e2s, mvoisin, e2s_actnor, nadmsr, stfm, number_edge_type1, number_edge_type1_0, edge_type1, edge_type1_0)
subroutine i25normp (ni25, nrtm, nrtm0, irect, x, nod_normal, nmn, msr, jtask, stifm, stfe, actnor, msegtyp, tagnod, mvoisin, evoisin, iad_fredg, fr_edg, wnod_normal, buffers, iedge, nedge, ledge, lbound, nadmsr, admsr, iad_frnor, fr_nor, vtx_bisector, flag, nb_free_bound, free_bound, tage, free_irect_id, nrtm_free, fskyt, iadnor, ishift, addcsrect, procnor, sol_edge, fskyn25)
subroutine i25assnp (jtask, nadmsr, nod_normal, admsr, adskyt, iadnor, actnor, fskyt)

Macro Definition Documentation

◆ RDIX

#define RDIX   10.

◆ REM30

#define REM30   1.0E-30

◆ REP30

#define REP30   1.0E30

◆ RUN

#define RUN   1.

◆ RZERO

#define RZERO   0.

◆ TO1D

#define TO1D ( i,
j,
k,
s1,
s2 )
Value:
1i+(j-1)*s1+(k-1)*s1*s2

Function/Subroutine Documentation

◆ i25assnp()

subroutine i25assnp ( integer jtask,
integer nadmsr,
real*4, dimension(3,nadmsr) nod_normal,
integer, dimension(4,*) admsr,
integer, dimension(nadmsr+1) adskyt,
integer, dimension(4,*) iadnor,
integer, dimension(*) actnor,
real*4, dimension(3,*) fskyt )

Definition at line 1123 of file i25norm.F.

1125C-----------------------------------------------
1126C I m p l i c i t T y p e s
1127C-----------------------------------------------
1128#include "implicit_f.inc"
1129C-----------------------------------------------
1130C C o m m o n B l o c k s
1131C-----------------------------------------------
1132#include "task_c.inc"
1133C-----------------------------------------------
1134C D u m m y A r g u m e n t s
1135C-----------------------------------------------
1136 INTEGER JTASK, NADMSR,
1137 . ADMSR(4,*), ADSKYT(NADMSR+1), IADNOR(4,*), ACTNOR(*)
1138C REAL
1139 real*4
1140 . nod_normal(3,nadmsr)
1141 real*4 fskyt(3,*)
1142C-----------------------------------------------
1143C L o c a l V a r i a b l e s
1144C-----------------------------------------------
1145 INTEGER I, C1, C2, CC
1146 INTEGER NADMSRFT, NADMSRLT
1147 real*4
1148 . aaa
1149C------------------------------------
1150C Normal nodes for edge to edge solids
1151C------------------------------------
1152
1153 nadmsrft= 1+(jtask-1)*nadmsr/ nthread
1154 nadmsrlt= jtask*nadmsr/nthread
1155C
1156 nod_normal(1:3,nadmsrft:nadmsrlt)=rzero
1157 DO i = nadmsrft,nadmsrlt
1158
1159 IF(actnor(i)==0)cycle
1160
1161 c1 = adskyt(i)
1162 c2 = adskyt(i+1)-1
1163 DO cc = c1, c2
1164 nod_normal(1:3,i) = nod_normal(1:3,i) + fskyt(1:3,cc)
1165 END DO
1166
1167 aaa=run/max(rem30,sqrt(nod_normal(1,i)*nod_normal(1,i)+
1168 . nod_normal(2,i)*nod_normal(2,i)+
1169 . nod_normal(3,i)*nod_normal(3,i)))
1170 nod_normal(1,i)=nod_normal(1,i)*aaa
1171 nod_normal(2,i)=nod_normal(2,i)*aaa
1172 nod_normal(3,i)=nod_normal(3,i)*aaa
1173
1174 END DO
1175C
1176 RETURN
max
#define max(a, b)
Definition macros.h:21

◆ i25normp()

subroutine i25normp ( integer ni25,
integer nrtm,
integer nrtm0,
integer, dimension(4,nrtm) irect,
x,
real*4, dimension(3,4,nrtm) nod_normal,
integer nmn,
integer, dimension(*) msr,
integer jtask,
stifm,
stfe,
integer, dimension(*) actnor,
integer, dimension(*) msegtyp,
integer, dimension(*) tagnod,
integer, dimension(4,*) mvoisin,
integer, dimension(4,*) evoisin,
integer, dimension(ninter25,*) iad_fredg,
integer, dimension(*) fr_edg,
real*4, dimension(3,4,nrtm) wnod_normal,
type(mpi_comm_nor_struct) buffers,
integer iedge,
integer nedge,
integer, dimension(nledge,*) ledge,
integer, dimension(*) lbound,
integer nadmsr,
integer, dimension(4,*) admsr,
integer, dimension(ninter25,*) iad_frnor,
integer, dimension(*) fr_nor,
real*4, dimension(3,2,nadmsr) vtx_bisector,
integer flag,
integer nb_free_bound,
integer, dimension(4,4*nrtm) free_bound,
integer, dimension(*) tage,
integer, dimension(nrtm) free_irect_id,
integer nrtm_free,
real*4, dimension(3,*) fskyt,
integer, dimension(4,*) iadnor,
integer ishift,
integer, dimension(*) addcsrect,
integer, dimension(*) procnor,
integer sol_edge,
real*4, dimension(3,*) fskyn25 )

Definition at line 437 of file i25norm.F.

446C-----------------------------------------------
447C M o d u l e s
448C-----------------------------------------------
449 USE mpi_commod
450#ifdef WITH_ASSERT
451 USE debug_mod
452#endif
453C-----------------------------------------------
454C I m p l i c i t T y p e s
455C-----------------------------------------------
456#include "implicit_f.inc"
457C-----------------------------------------------
458C G l o b a l P a r a m e t e r s
459C-----------------------------------------------
460#include "mvsiz_p.inc"
461C-----------------------------------------------
462C C o m m o n B l o c k s
463C-----------------------------------------------
464#include "com01_c.inc"
465#include "com04_c.inc"
466#include "param_c.inc"
467#include "task_c.inc"
468C-----------------------------------------------
469C D u m m y A r g u m e n t s
470C-----------------------------------------------
471 INTEGER NI25, NRTM, NRTM0, NMN, JTASK, IEDGE, NEDGE, FLAG, NADMSR,ISHIFT,SOL_EDGE,
472 . IRECT(4,NRTM), MSR(*),
473 . ACTNOR(*), MSEGTYP(*), TAGNOD(*),
474 . MVOISIN(4,*), EVOISIN(4,*), IAD_FREDG(NINTER25,*), FR_EDG(*),
475 . LEDGE(NLEDGE,*), LBOUND(*), ADMSR(4,*), IAD_FRNOR(NINTER25,*), FR_NOR(*),
476 . IADNOR(4,*),ADDCSRECT(*), PROCNOR(*)
477 INTEGER :: FREE_IRECT_ID(NRTM),NRTM_FREE
478C REAL
479 my_real
480 . x(3,numnod), stifm(*),stfe(nedge)
481 real*4 nod_normal(3,4,nrtm), wnod_normal(3,4,nrtm), vtx_bisector(3,2,nadmsr)
482 real*4 fskyt(3,*),fskyn25(3,*)
483 INTEGER :: NB_FREE_BOUND,FREE_BOUND(4,4*NRTM)
484 INTEGER :: TAGE(*)
485
486 TYPE(MPI_COMM_NOR_STRUCT) :: BUFFERS
487C-----------------------------------------------
488C L o c a l V a r i a b l e s
489C-----------------------------------------------
490 INTEGER I, J, N, LLT, IRM, IAD, ISH
491 INTEGER IX1, IX2, IX3, IX4,
492 . I1, I2, I3, I4, JRM, JEDG, IEDG, IS1,IS2
493 INTEGER NRTMFT, NRTMLT, NADMSRFT, NADMSRLT
494 INTEGER SIZE
495 real*4
496 . x0, y0, z0,
497 . x1, x2, x3, x4,
498 . y1, y2, y3, y4,
499 . z1, z2, z3, z4,
500 . x01, x02, x03, x04,
501 . y01, y02, y03, y04,
502 . z01, z02, z03, z04,
503 . xn1(mvsiz),yn1(mvsiz),zn1(mvsiz),
504 . xn2(mvsiz),yn2(mvsiz),zn2(mvsiz),
505 . xn3(mvsiz),yn3(mvsiz),zn3(mvsiz),
506 . xn4(mvsiz),yn4(mvsiz),zn4(mvsiz),
507 . aaa, nx, ny, nz,
508 . vx, vy, vz, x12, y12, z12
509
510 LOGICAL :: LIMIT_CASE,IS_QUAD(MVSIZ)
511C REAL*4 :: RZERO, RUN, REM30, REP30, RDIX
512C PARAMETER ( RZERO = 0. )
513C PARAMETER ( RUN = 1. )
514C PARAMETER ( RDIX = 10. )
515C PARAMETER ( REP30 = RDIX**30 )
516C PARAMETER ( REM30 = RUN/REP30 )
517#define RZERO 0.
518#define RUN 1.
519#define RDIX 10.
520#define REP30 1.0E30
521#define REM30 1.0E-30
522
523
524
525
526C-----------------------------------------------
527C debug
528
529
530
531C RZERO = 0.
532C RUN = 1.
533C RDIX = 10.
534C REP30 = RDIX**30
535C REM30 = RUN/REP30
536C
537 IF(flag == 1) THEN
538
539 nrtmft= 1+(jtask-1)*nrtm0/ nthread
540 nrtmlt= jtask*nrtm0/nthread
541
542 DO n=nrtmft,nrtmlt,mvsiz
543C
544 llt=min(nrtmlt-n+1,mvsiz)
545C
546 tage(n:llt+n-1)=0
547Cnofusion is important
548#include "vectorize.inc"
549CDIR$ NOFUSION
550 DO i=1,llt
551C
552 irm=i+n-1
553
554 ix1=irect(1,irm)
555 ix2=irect(2,irm)
556 ix3=irect(3,irm)
557 ix4=irect(4,irm)
558 IF(ix3/=ix4)THEN
559 is_quad(i) = .true.
560 ELSE
561 is_quad(i) = .false.
562 ENDIF
563
564C
565 IF(tagnod(ix1)==0.AND.
566 . tagnod(ix2)==0.AND.
567 . tagnod(ix3)==0.AND.
568 . tagnod(ix4)==0) THEN
569 tage(irm)=1
570 cycle
571 END IF
572
573C
574 IF(stifm(irm) > zero) THEN
575C
576 x1=x(1,ix1)
577 y1=x(2,ix1)
578 z1=x(3,ix1)
579 x2=x(1,ix2)
580 y2=x(2,ix2)
581 z2=x(3,ix2)
582 x3=x(1,ix3)
583 y3=x(2,ix3)
584 z3=x(3,ix3)
585 x4=x(1,ix4)
586 y4=x(2,ix4)
587 z4=x(3,ix4)
588C
589 IF(ix3/=ix4)THEN
590 x0 = (x1+x2+x3+x4)/4.0
591 y0 = (y1+y2+y3+y4)/4.0
592 z0 = (z1+z2+z3+z4)/4.0
593 ELSE
594 x0 = x3
595 y0 = y3
596 z0 = z3
597 ENDIF
598C
599 x01 = x1 - x0
600 y01 = y1 - y0
601 z01 = z1 - z0
602 x02 = x2 - x0
603 y02 = y2 - y0
604 z02 = z2 - z0
605 x03 = x3 - x0
606 y03 = y3 - y0
607 z03 = z3 - z0
608 x04 = x4 - x0
609 y04 = y4 - y0
610 z04 = z4 - z0
611C
612 xn1(i) = y01*z02 - z01*y02
613 yn1(i) = z01*x02 - x01*z02
614 zn1(i) = x01*y02 - y01*x02
615 xn2(i) = y02*z03 - z02*y03
616 yn2(i) = z02*x03 - x02*z03
617 zn2(i) = x02*y03 - y02*x03
618 xn3(i) = y03*z04 - z03*y04
619 yn3(i) = z03*x04 - x03*z04
620 zn3(i) = x03*y04 - y03*x04
621 xn4(i) = y04*z01 - z04*y01
622 yn4(i) = z04*x01 - x04*z01
623 zn4(i) = x04*y01 - y04*x01
624C
625C
626 aaa=run/max(rem30,sqrt(xn1(i)*xn1(i)+yn1(i)*yn1(i)+zn1(i)*zn1(i)))
627 xn1(i) = xn1(i)*aaa
628 yn1(i) = yn1(i)*aaa
629 zn1(i) = zn1(i)*aaa
630C
631 aaa=run/max(rem30,sqrt(xn2(i)*xn2(i)+yn2(i)*yn2(i)+zn2(i)*zn2(i)))
632 xn2(i) = xn2(i)*aaa
633 yn2(i) = yn2(i)*aaa
634 zn2(i) = zn2(i)*aaa
635C
636 aaa=run/max(rem30,sqrt(xn3(i)*xn3(i)+yn3(i)*yn3(i)+zn3(i)*zn3(i)))
637 xn3(i) = xn3(i)*aaa
638 yn3(i) = yn3(i)*aaa
639 zn3(i) = zn3(i)*aaa
640C
641 aaa=run/max(rem30,sqrt(xn4(i)*xn4(i)+yn4(i)*yn4(i)+zn4(i)*zn4(i)))
642 xn4(i) = xn4(i)*aaa
643 yn4(i) = yn4(i)*aaa
644 zn4(i) = zn4(i)*aaa
645C
646 ELSE ! IF(STIFM(IRM)/=ZERO)THEN
647 xn1(i) = rzero
648 yn1(i) = rzero
649 zn1(i) = rzero
650C
651 xn2(i) = rzero
652 yn2(i) = rzero
653 zn2(i) = rzero
654C
655 xn3(i) = rzero
656 yn3(i) = rzero
657 zn3(i) = rzero
658C
659 xn4(i) = rzero
660 yn4(i) = rzero
661 zn4(i) = rzero
662 END IF
663 END DO
664C
665#include "vectorize.inc"
666 DO i=1,llt
667C
668 irm=i+n-1
669 IF(tage(irm)==1) cycle
670
671C
672 IF(is_quad(i))THEN
673C
674 nod_normal(1,1,irm)=xn1(i)
675 nod_normal(2,1,irm)=yn1(i)
676 nod_normal(3,1,irm)=zn1(i)
677C
678 nod_normal(1,2,irm)=xn2(i)
679 nod_normal(2,2,irm)=yn2(i)
680 nod_normal(3,2,irm)=zn2(i)
681C
682 nod_normal(1,3,irm)=xn3(i)
683 nod_normal(2,3,irm)=yn3(i)
684 nod_normal(3,3,irm)=zn3(i)
685C
686 nod_normal(1,4,irm)=xn4(i)
687 nod_normal(2,4,irm)=yn4(i)
688 nod_normal(3,4,irm)=zn4(i)
689C
690 ELSE
691C
692 nod_normal(1,1,irm)=xn1(i)
693 nod_normal(2,1,irm)=yn1(i)
694 nod_normal(3,1,irm)=zn1(i)
695C
696 nod_normal(1,2,irm)=xn1(i)
697 nod_normal(2,2,irm)=yn1(i)
698 nod_normal(3,2,irm)=zn1(i)
699C
700 nod_normal(1,4,irm)=xn1(i)
701 nod_normal(2,4,irm)=yn1(i)
702 nod_normal(3,4,irm)=zn1(i)
703C
704 END IF
705 END DO
706C
707#include "vectorize.inc"
708 DO i=1,llt
709C
710C
711 irm=i+n-1
712 IF(tage(irm)==1) cycle
713C
714 ish=msegtyp(irm)
715 IF(ish > 0) THEN
716 IF(ish > nrtm)ish=ish-nrtm
717C
718 IF(is_quad(i))THEN
719C
720 nod_normal(1,1,ish)=-xn1(i)
721 nod_normal(2,1,ish)=-yn1(i)
722 nod_normal(3,1,ish)=-zn1(i)
723C
724 nod_normal(1,4,ish)=-xn2(i)
725 nod_normal(2,4,ish)=-yn2(i)
726 nod_normal(3,4,ish)=-zn2(i)
727C
728 nod_normal(1,3,ish)=-xn3(i)
729 nod_normal(2,3,ish)=-yn3(i)
730 nod_normal(3,3,ish)=-zn3(i)
731C
732 nod_normal(1,2,ish)=-xn4(i)
733 nod_normal(2,2,ish)=-yn4(i)
734 nod_normal(3,2,ish)=-zn4(i)
735C
736 ELSE
737C
738 nod_normal(1,1,ish)=-xn1(i)
739 nod_normal(2,1,ish)=-yn1(i)
740 nod_normal(3,1,ish)=-zn1(i)
741C
742 nod_normal(1,4,ish)=-xn1(i)
743 nod_normal(2,4,ish)=-yn1(i)
744 nod_normal(3,4,ish)=-zn1(i)
745C
746 nod_normal(1,2,ish)=-xn1(i)
747 nod_normal(2,2,ish)=-yn1(i)
748 nod_normal(3,2,ish)=-zn1(i)
749C
750 END IF
751 END IF
752 END DO
753
754 IF(sol_edge /= 0) THEN
755
756 DO i=1,llt
757C
758C
759 irm=i+n-1
760 IF(tage(irm)==1) cycle
761C
762 i1=admsr(1,irm)
763 i2=admsr(2,irm)
764 i3=admsr(3,irm)
765 i4=admsr(4,irm)
766C
767 IF(is_quad(i))THEN
768 iad = iadnor(1,irm)
769 fskyt(1,iad) = xn4(i)+xn1(i)
770 fskyt(2,iad) = yn4(i)+yn1(i)
771 fskyt(3,iad) = zn4(i)+zn1(i)
772c
773 iad = iadnor(2,irm)
774 fskyt(1,iad) = xn1(i)+xn2(i)
775 fskyt(2,iad) = yn1(i)+yn2(i)
776 fskyt(3,iad) = zn1(i)+zn2(i)
777c
778 iad = iadnor(3,irm)
779 fskyt(1,iad) = xn2(i)+xn3(i)
780 fskyt(2,iad) = yn2(i)+yn3(i)
781 fskyt(3,iad) = zn2(i)+zn3(i)
782c
783 iad = iadnor(4,irm)
784 fskyt(1,iad) = xn3(i)+xn4(i)
785 fskyt(2,iad) = yn3(i)+yn4(i)
786 fskyt(3,iad) = zn3(i)+zn4(i)
787 ELSE
788 iad = iadnor(1,irm)
789 fskyt(1,iad) = xn1(i)
790 fskyt(2,iad) = yn1(i)
791 fskyt(3,iad) = zn1(i)
792c
793 iad = iadnor(2,irm)
794 fskyt(1,iad) = xn1(i)
795 fskyt(2,iad) = yn1(i)
796 fskyt(3,iad) = zn1(i)
797c
798 iad = iadnor(3,irm)
799 fskyt(1,iad) = xn1(i)
800 fskyt(2,iad) = yn1(i)
801 fskyt(3,iad) = zn1(i)
802c
803 END IF
804 END DO
805 ENDIF
806
807 END DO
808C
809 CALL my_barrier
810C
811 nrtmft= 1+(jtask-1)*nrtm/ nthread
812 nrtmlt= jtask*nrtm/nthread
813
814 nadmsrft= 1+(jtask-1)*nadmsr/ nthread
815 nadmsrlt= jtask*nadmsr/nthread
816
817 lbound(nadmsrft:nadmsrlt)=0
818C
819 CALL my_barrier
820C
821!$OMP SINGLE
822 nb_free_bound = 0
823 limit_case = .false.
824 DO i=1,nrtm_free
825 irm = free_irect_id(i)
826 IF(stifm(irm) <= zero)cycle
827 DO iedg=1,4
828 IF(mvoisin(iedg,irm)==0)THEN
829 IF(.NOT.(irect(3,irm)==irect(4,irm).AND.iedg==3))THEN
830 nb_free_bound = nb_free_bound + 1
831 free_bound(1,nb_free_bound) = irm
832 free_bound(2,nb_free_bound) = iedg
833 !ADMSR( 1 2 3 4)
834! IS /= semgment sup and inf
835 is1=admsr(iedg,irm)
836 is2=admsr(mod(iedg,4)+1,irm)
837
838 vx=nod_normal(1,iedg,irm)
839 vy=nod_normal(2,iedg,irm)
840 vz=nod_normal(3,iedg,irm)
841
842 IF(vx == 0 .AND. vy == 0 .AND. vz == 0) THEN
843C Free bound, but nod_normal not computed (no candidate for this free bound)
844 free_bound(3,nb_free_bound) = 3
845 free_bound(4,nb_free_bound) = 3
846 ELSE
847 lbound(is1) = lbound(is1) + 1
848 lbound(is2) = lbound(is2) + 1
849 free_bound(3,nb_free_bound) = lbound(is1)
850 free_bound(4,nb_free_bound) = lbound(is2)
851 ENDIF
852
853 IF(lbound(is1) > 2 .OR. lbound(is2) > 2) THEN
854C When a node belongs to many free boundaries
855C ex: two segments linked only by a corner
856C The node at the corner belongs to two free boundaries
857C A special treatment is done, VTX_BISECTOR has to set to 0
858 limit_case = .true.
859 ENDIF
860 ENDIF
861 ENDIF
862 ENDDO
863 ENDDO
864 IF(limit_case) THEN
865 DO i=1,nb_free_bound
866 irm = free_bound(1,i)
867 iedg = free_bound(2,i)
868 is1=admsr(iedg,irm)
869 IF(lbound(is1) > 2) THEN
870 free_bound(3,i) = 3
871 vtx_bisector(1,1,is1) = rzero
872 vtx_bisector(2,1,is1) = rzero
873 vtx_bisector(3,1,is1) = rzero
874 vtx_bisector(1,2,is1) = rzero
875 vtx_bisector(2,2,is1) = rzero
876 vtx_bisector(3,2,is1) = rzero
877 ENDIF
878 !ADMSR( 2 3 4 1)
879 is2=admsr(mod(iedg,4)+1,irm)
880 IF(lbound(is2) > 2) THEN
881 free_bound(4,i) = 3
882 vtx_bisector(1,1,is2) = rzero
883 vtx_bisector(2,1,is2) = rzero
884 vtx_bisector(3,1,is2) = rzero
885 vtx_bisector(1,2,is2) = rzero
886 vtx_bisector(2,2,is2) = rzero
887 vtx_bisector(3,2,is2) = rzero
888 ENDIF
889 ENDDO
890 ENDIF
891!$OMP END SINGLE
892
893
894C
895 CALL my_barrier
896
897
898 nrtmft= 1+(jtask-1)*nb_free_bound/nthread
899 nrtmlt= jtask*nb_free_bound/nthread
900#include "vectorize.inc"
901 DO i=nrtmft,nrtmlt
902 irm = free_bound(1,i)
903 iedg = free_bound(2,i)
904 nx=nod_normal(1,iedg,irm)
905 ny=nod_normal(2,iedg,irm)
906 nz=nod_normal(3,iedg,irm)
907C
908 i1=irect(iedg,irm)
909 i2=irect(mod(iedg,4)+1,irm)
910
911 x12=x(1,i2)-x(1,i1)
912 y12=x(2,i2)-x(2,i1)
913 z12=x(3,i2)-x(3,i1)
914
915 vx=y12*nz-z12*ny
916 vy=z12*nx-x12*nz
917 vz=x12*ny-y12*nx
918
919 aaa=run/max(rem30,sqrt(vx*vx+vy*vy+vz*vz))
920 vx=vx*aaa
921 vy=vy*aaa
922 vz=vz*aaa
923
924 nod_normal(1,iedg,irm)=vx
925 nod_normal(2,iedg,irm)=vy
926 nod_normal(3,iedg,irm)=vz
927
928 ENDDO
929
930 CALL my_barrier
931
932#include "vectorize.inc"
933 DO i=nrtmft,nrtmlt
934 irm = free_bound(1,i)
935 iedg = free_bound(2,i)
936 i1 = free_bound(3,i)
937 i2 = free_bound(4,i)
938
939 vx=nod_normal(1,iedg,irm)
940 vy=nod_normal(2,iedg,irm)
941 vz=nod_normal(3,iedg,irm)
942C
943 is1=admsr(iedg,irm)
944 IF(i1 <= 2 ) THEN
945 vtx_bisector(1,i1,is1)=vx
946 vtx_bisector(2,i1,is1)=vy
947 vtx_bisector(3,i1,is1)=vz
948 END IF
949
950 is2=admsr(mod(iedg,4)+1,irm)
951 IF(i2 <= 2) THEN
952 vtx_bisector(1,i2,is2)=vx
953 vtx_bisector(2,i2,is2)=vy
954 vtx_bisector(3,i2,is2)=vz
955 END IF
956 ENDDO
957
958 CALL my_barrier
959
960C
961 IF(nspmd > 1)THEN
962 IF(jtask==1)THEN
963 SIZE = 3
964 CALL spmd_exch_nor(
965 1 ni25,iad_fredg,fr_edg , nod_normal,wnod_normal,SIZE ,nadmsr,
966 2 buffers%RECV_RQ ,buffers%SEND_RQ,buffers%IRINDEX,buffers%ISINDEX,buffers%IAD_RECV,
967 3 buffers%NBIRECV,buffers%NBISEND,buffers%RECV_BUF ,buffers%SEND_BUF ,vtx_bisector,
968 4 lbound,iad_frnor,fr_nor,1,fskyn25 ,ishift,addcsrect, procnor,sol_edge)
969 END IF
970 END IF
971 CALL my_barrier
972C
973 ELSE IF(flag == 2) THEN
974C
975C
976C
977
978 nrtmft= 1+(jtask-1)*nrtm/ nthread
979 nrtmlt= jtask*nrtm/nthread
980 DO n=nrtmft,nrtmlt,mvsiz
981C
982 llt=min(nrtmlt-n+1,mvsiz)
983C
984#include "vectorize.inc"
985 DO i=1,llt
986C
987 irm=i+n-1
988C
989
990 IF(actnor(irm)==3) THEN
991 wnod_normal(1:3,1:4,irm) = rzero
992C CYCLE
993 ENDIF
994
995 IF(actnor(irm)==0) THEN
996Cno need to calculate the bisectors on this irm
997C WNOD_NORMAL(1:3,1:4,IRM) = RZERO
998 cycle
999 ENDIF
1000
1001C
1002 IF(stifm(irm) <= 0) THEN
1003 wnod_normal(1:3,1:4,irm) = rzero
1004 ELSE
1005 DO j=1,4
1006 jrm =mvoisin(j,irm)
1007 jedg=evoisin(j,irm)
1008 IF(jrm > 0 )THEN
1009C IF(ACTNOR(JRM) > 0) THEN
1010 wnod_normal(1,j,irm) = nod_normal(1,jedg,jrm)
1011 wnod_normal(2,j,irm) = nod_normal(2,jedg,jrm)
1012 wnod_normal(3,j,irm) = nod_normal(3,jedg,jrm)
1013C ELSE
1014C WNOD_NORMAL(1,J,IRM) = RZERO
1015C WNOD_NORMAL(2,J,IRM) = RZERO
1016C WNOD_NORMAL(3,J,IRM) = RZERO
1017C ENDIF
1018 ELSEIF(jrm<=0)THEN
1019 wnod_normal(1,j,irm) = rzero
1020 wnod_normal(2,j,irm) = rzero
1021 wnod_normal(3,j,irm) = rzero
1022 END IF
1023 END DO !J
1024 ENDIF ! STIFM = 0
1025 END DO !I
1026 END DO ! N
1027C
1028 CALL my_barrier
1029 IF(nspmd > 1)THEN
1030 IF(jtask==1)THEN
1031 SIZE = 3
1032 CALL spmd_exch_nor(
1033 1 ni25,iad_fredg,fr_edg , nod_normal,wnod_normal,SIZE , nadmsr,
1034 2 buffers%RECV_RQ ,buffers%SEND_RQ,buffers%IRINDEX,buffers%ISINDEX,buffers%IAD_RECV,
1035 3 buffers%NBIRECV,buffers%NBISEND,buffers%RECV_BUF ,buffers%SEND_BUF ,vtx_bisector,
1036 4 lbound,iad_frnor,fr_nor,2,fskyn25 ,ishift,addcsrect, procnor,sol_edge)
1037 WHERE (lbound(1:nadmsr) > 1)
1038 lbound(1:nadmsr) = 1
1039 END WHERE
1040 END IF
1041 END IF
1042C
1043 CALL my_barrier
1044C
1045 DO irm=nrtmft,nrtmlt
1046C
1047C IF(ACTNOR(IRM)==0 .OR. STIFM(IRM)<=ZERO) CYCLE
1048
1049! Nod Normal should be received even if IRM
1050C is deleted
1051C ISPMD may still send the edge during for contact detection
1052C (i.e. ISPMD is PMAIN)
1053
1054 IF(actnor(irm)==0) cycle
1055
1056 IF(stifm(irm) <= zero) THEN
1057 nod_normal(1:3,1:4,irm) = rzero
1058 ENDIF
1059
1060 DO j=1,4
1061 jrm =mvoisin(j,irm)
1062C DEBUG_E2E(INT_CHECKSUM(IDS,4,1) == D_EM,JRM)
1063 IF(jrm<0 .AND. stifm(irm) <= 0 ) THEN
1064 nod_normal(1,j,irm) = wnod_normal(1,j,irm)
1065 nod_normal(2,j,irm) = wnod_normal(2,j,irm)
1066 nod_normal(3,j,irm) = wnod_normal(3,j,irm)
1067C If the local segment is broken
1068C The (secondary) edge can still be sended by ISPMD to the processor that have
1069C the main segment.
1070C In that case, the ordering of (JEDG) should be the one on the side that is not
1071C broken
1072 ELSE ! JRM >= 0 .OR. STIFM /= 0
1073 IF( jrm /= 0) THEN
1074 nx=nod_normal(1,j,irm)+wnod_normal(1,j,irm)
1075 ny=nod_normal(2,j,irm)+wnod_normal(2,j,irm)
1076 nz=nod_normal(3,j,irm)+wnod_normal(3,j,irm)
1077 aaa=run/max(rem30,sqrt(nx*nx+ny*ny+nz*nz))
1078 nod_normal(1,j,irm)=nx*aaa
1079 nod_normal(2,j,irm)=ny*aaa
1080 nod_normal(3,j,irm)=nz*aaa
1081 ENDIF
1082 ENDIF
1083 END DO
1084 END DO
1085 ENDIF ! FLAG
1086
1087C debug print
1088CCCC #ifdef D_ES
1089CCCC !$OMP SINGLE
1090CCCC DO NEDG=1,NEDGE
1091CCCC IRM = LEDGE(LEDGE_LEFT_SEG ,NEDG)
1092CCCC IEDG = LEDGE(LEDGE_LEFT_ID ,NEDG)
1093CCCC JRM = LEDGE(LEDGE_RIGHT_SEG,NEDG)
1094CCCC JEDG = LEDGE(LEDGE_RIGHT_ID ,NEDG)
1095CCCC IF(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_ES ) THEN
1096CCCC WRITE(6,*) "LEDGE(1:4)=",IRM,IEDG,JRM,JEDG
1097CCCC IF(IRM > 0) THEN
1098CCCC WRITE(6,"(2I10,A,3Z20)") IEDG,IRM,"(A) F[XYZ]=",
1099CCCC . NOD_NORMAL(1,IEDG,IRM),
1100CCCC . NOD_NORMAL(2,IEDG,IRM),
1101CCCC . NOD_NORMAL(3,IEDG,IRM)
1102CCCC ELSEIF(IRM < 0) THEN
1103CCCC WRITE(6,"(2I10,A,3Z20)") IEDG,IRM,"(B) F[XYZ]=",
1104CCCC . NOD_NORMAL(1,IEDG,ABS(IRM)),
1105CCCC . NOD_NORMAL(2,IEDG,ABS(IRM)),
1106CCCC . NOD_NORMAL(3,IEDG,ABS(IRM))
1107CCCC ENDIF
1108CCCC ENDIF
1109CCCC ENDDO
1110CCCC !$OMP END SINGLE
1111CCCC #endif
1112 CALL my_barrier
1113
1114 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
debug_mod
Definition debug_mod.F:47
mpi_commod
Definition mpi_comm_mod.F:37
spmd_exch_nor
subroutine spmd_exch_nor(ni25, iad_fredg, fr_edg, nod_normal, wnod_normal, size, nadmsr, req_r, req_s, irindex, isindex, iad_recv, nbirecv, nbisend, rbuf, sbuf, vtx_bisector, lbound, iad_frnor, fr_nor, iflag, fskyn, ishift, addcsrect, procnor, sol_edge)
Definition spmd_exch_nor.F:38
my_barrier
subroutine my_barrier
Definition machine.F:31
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29

◆ i25tagn()

subroutine i25tagn ( integer ni25,
integer nin,
integer nrtm,
integer nsn,
integer nsnr,
integer jtask,
integer, dimension(ninter25,nspmd+1) iad_frnor,
integer, dimension(*) fr_nor,
integer, dimension(4,*) irtlm,
integer, dimension(*) msegtyp,
integer i_stok_glo,
integer i_stok_rtlm,
integer, dimension(*) cand_opt_e,
stfns,
integer, dimension(*) actnor,
integer, dimension(4,*) irect,
integer, dimension(*) tagnod,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(4,*) admsr,
integer, dimension(*) knor2msr,
integer, dimension(*) nor2msr,
integer flagremn,
integer, dimension(*) kremnor,
integer, dimension(*) remnor,
integer, intent(in) iedge,
integer, intent(in) nedge,
integer, dimension(nledge,nedge) ledge,
integer nrtm_free,
integer, dimension(nrtm) free_irect_id,
integer i_stok_e2s,
integer, dimension(*) candm_e2s,
integer, dimension(*) cands_e2s,
integer, dimension(4,*) mvoisin,
integer, dimension(*) e2s_actnor,
integer nadmsr,
dimension(nrtm), intent(in) stfm,
integer, intent(in) number_edge_type1,
integer, intent(in) number_edge_type1_0,
integer, dimension(number_edge_type1), intent(in) edge_type1,
integer, dimension(number_edge_type1_0), intent(in) edge_type1_0 )
Parameters
[in]number_edge_type1number of solid edge
[in]number_edge_type1_0number of solid + S edge
[in]edge_type1solid edge list
[in]edge_type1_0solid + S edge list

Definition at line 34 of file i25norm.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE intbufdef_mod
46 USE tri7box
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C G l o b a l P a r a m e t e r s
53C-----------------------------------------------
54#include "i25edge_c.inc"
55
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "param_c.inc"
60#include "com01_c.inc"
61#include "com04_c.inc"
62#include "task_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER NI25, NIN, NRTM, NSN, NSNR, JTASK, FLAGREMN,NADMSR,
67 . IAD_FRNOR(NINTER25,NSPMD+1) ,FR_NOR(*),
68 . IRTLM(4,*), MSEGTYP(*), I_STOK_GLO, I_STOK_RTLM, CAND_OPT_E(*),
69 . ACTNOR(*), IRECT(4,*), TAGNOD(*), E2S_ACTNOR(*),
70 . IAD_ELEM(2,*), FR_ELEM(*), KNOR2MSR(*), NOR2MSR(*), ADMSR(4,*),
71 . KREMNOR(*), REMNOR(*), I_STOK_E2S, CANDM_E2S(*), CANDS_E2S(*), MVOISIN(4,*)
72 INTEGER, INTENT(IN) :: IEDGE,NEDGE
73 INTEGER :: LEDGE(NLEDGE,NEDGE)
74 INTEGER :: FREE_IRECT_ID(NRTM),NRTM_FREE
75 INTEGER, INTENT(in) :: NUMBER_EDGE_TYPE1 !< number of solid edge
76 INTEGER, INTENT(in) :: NUMBER_EDGE_TYPE1_0 !< number of solid + S edge
77 INTEGER, DIMENSION(NUMBER_EDGE_TYPE1), INTENT(in) :: EDGE_TYPE1 !< solid edge list
78 INTEGER, DIMENSION(NUMBER_EDGE_TYPE1_0), INTENT(in) :: EDGE_TYPE1_0 !< solid + S edge list
79C REAL
80 my_real
81 . stfns(*)
82 my_real, INTENT(IN):: stfm(nrtm)
83
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER I, J, K, N, NOR, NOD, L, ISH, FIRST, LAST, NL, LVOIS
88 INTEGER NRTMFT, NRTMLT, NSNF, NSNL, NSNRF, NSNRL, NODFT, NODLT,
89 . M, NOR1, NOR2, NADMSRFT, NADMSRLT,
90 . NRTMFT_FREE, NRTMLT_FREE, NEDGFT, NEDGLT, SOL_EDGE, SH_EDGE
91 INTEGER IRM,JRM,IEDG,JEDG
92 INTEGER, DIMENSION(:), ALLOCATABLE :: TAGMSR
93C-----------------------------------------------
94C
95 nodft= 1+(jtask-1)*numnod/ nthread
96 nodlt= jtask*numnod/nthread
97 tagnod(nodft:nodlt)=0
98C
99 nrtmft= 1+(jtask-1)*nrtm/ nthread
100 nrtmlt= jtask*nrtm/nthread
101 actnor(nrtmft:nrtmlt)=0
102C
103 IF(iedge /= 0) THEN
104 sol_edge =iedge/10 ! solids
105 IF(sol_edge/=0) THEN
106 nadmsrft= 1+(jtask-1)*nadmsr/ nthread
107 nadmsrlt= jtask*nadmsr/nthread
108 e2s_actnor(nadmsrft:nadmsrlt)=0
109 ENDIF
110 ENDIF
111C
112 CALL my_barrier()
113C
114 nsnf = 1 + nsn*(jtask-1) / nthread
115 nsnl = nsn*jtask / nthread
116
117 IF(flagremn == 2 ) THEN
118c
119 ALLOCATE(tagmsr(nrtm))
120 tagmsr(1:nrtm) = 0
121c
122 DO n=nsnf,nsnl
123 nor1 = kremnor(n)+1
124 nor2 = kremnor(n+1)
125 DO m=nor1,nor2
126 tagmsr(remnor(m)) = 1
127 ENDDO
128c
129 IF(irtlm(1,n) > 0)THEN
130 IF(stfns(n)/=zero.AND.irtlm(4,n) == ispmd+1)THEN
131 l = irtlm(3,n)
132
133 actnor(l)=1
134
135 DO j=1,4
136 nor=admsr(j,l)
137C
138C consider l and all neighboring segments (see sliding)
139 DO nl=knor2msr(nor)+1,knor2msr(nor+1)
140 lvois= nor2msr(nl)
141 IF(tagmsr(lvois)==0.AND.stfm(lvois) > zero) THEN
142 actnor(lvois)=1
143
144 DO k=1,4
145 nod=irect(k,lvois)
146 tagnod(nod)=1
147 END DO
148 ENDIF
149 END DO
150 END DO
151 END IF
152 END IF
153 DO m=nor1,nor2
154 tagmsr(remnor(m)) = 0
155 ENDDO
156 END DO
157 ELSE ! FLAGREMN
158 DO n=nsnf,nsnl
159 IF(irtlm(1,n) > 0)THEN
160 IF(stfns(n)/=zero.AND.irtlm(4,n) == ispmd+1)THEN
161C IRTLM(4,N) is INTERCEP
162 l = irtlm(3,n)
163 actnor(l)=1
164 DO j=1,4
165 nor=admsr(j,l)
166C consider l and all neighboring segments (see sliding)
167 DO nl=knor2msr(nor)+1,knor2msr(nor+1)
168 lvois= nor2msr(nl)
169 IF(stfm(lvois) > zero) THEN
170 actnor(lvois)=1
171 DO k=1,4
172 nod=irect(k,lvois)
173 tagnod(nod)=1
174 END DO
175 ENDIF
176 END DO
177 END DO
178 END IF
179 END IF
180 ENDDO
181 ENDIF
182
183C
184 nsnrf = 1 + nsnr*(jtask-1) / nthread
185 nsnrl = nsnr*jtask / nthread
186
187 IF(flagremn == 2 ) THEN
188
189 DO n=nsnrf,nsnrl
190 nor1 = kremnor_fi(nin)%P(n) +1
191 nor2 = kremnor_fi(nin)%P(n+1)
192 DO m=nor1,nor2
193 tagmsr(remnor_fi(nin)%P(m)) = 1
194 ENDDO
195 IF(irtlm_fi(nin)%P(1,n) > 0)THEN
196 IF(stifi(nin)%P(n)/=zero.AND.irtlm_fi(nin)%P(4,n) == ispmd+1)THEN
197 l = irtlm_fi(nin)%P(3,n)
198
199 actnor(l)=1
200
201 DO j=1,4
202 nor=admsr(j,l)
203C
204C consider l and all neighboring segments (see sliding)
205 DO nl=knor2msr(nor)+1,knor2msr(nor+1)
206 lvois= nor2msr(nl)
207 IF(tagmsr(lvois)==0.AND.stfm(lvois) > zero) THEN
208 actnor(lvois)=1
209
210 DO k=1,4
211 nod=irect(k,lvois)
212 tagnod(nod)=1
213 END DO
214 ENDIF
215
216 END DO
217 END DO
218
219 END IF
220 END IF
221 DO m=nor1,nor2
222 tagmsr(remnor_fi(nin)%P(m)) = 0
223 ENDDO
224 END DO
225 ELSE ! FLAGREMN
226
227 DO n=nsnrf,nsnrl
228 IF(irtlm_fi(nin)%P(1,n) > 0)THEN
229 IF(stifi(nin)%P(n)/=zero.AND.irtlm_fi(nin)%P(4,n) == ispmd+1)THEN
230 l = irtlm_fi(nin)%P(3,n)
231C
232 actnor(l)=1
233
234 DO j=1,4
235 nor=admsr(j,l)
236C
237C consider l and all neighboring segments (see sliding)
238 DO nl=knor2msr(nor)+1,knor2msr(nor+1)
239 lvois= nor2msr(nl)
240 IF(stfm(lvois) > zero) THEN
241
242 actnor(lvois)=1
243
244 DO k=1,4
245 nod=irect(k,lvois)
246 tagnod(nod)=1
247 END DO
248 ENDIF
249
250 END DO
251 END DO
252
253 END IF
254 END IF
255 END DO
256 ENDIF
257C
258C calculation of optimized candidates
259 first = i_stok_rtlm + 1 + (i_stok_glo-i_stok_rtlm)*(jtask-1) / nthread
260 last = i_stok_rtlm + (i_stok_glo-i_stok_rtlm)*jtask / nthread
261 DO i=first,last
262
263 irm = cand_opt_e(i)
264 actnor(irm)=1
265 tagnod(irect(1,irm)) = 1
266 tagnod(irect(2,irm)) = 1
267 tagnod(irect(3,irm)) = 1
268 tagnod(irect(4,irm)) = 1
269
270 ish=msegtyp(irm)
271 IF(ish > 0) THEN
272 IF(ish > nrtm)ish=ish-nrtm
273 actnor(ish)=1
274 END IF
275 END DO
276C
277C force calculation along free edges needed for vtx_bisector
278 nrtmft_free= 1+(jtask-1)*nrtm_free/nthread
279 nrtmlt_free= jtask*nrtm_free/nthread
280 DO i=nrtmft_free,nrtmlt_free
281 irm = free_irect_id(i)
282 actnor(irm) = 1
283 ish=iabs(msegtyp(irm))
284 IF(ish > 0) THEN
285 IF(ish > nrtm)ish=ish-nrtm
286 actnor(ish)=1
287 END IF
288 DO iedg=1,4
289 IF(mvoisin(iedg,irm)==0)THEN
290 IF(.NOT.(irect(3,irm)==irect(4,irm).AND.iedg==3))THEN
291 tagnod(irect(iedg ,irm)) = 1
292 tagnod(irect(mod(iedg,4)+1,irm)) = 1
293 END IF
294 END IF
295 END DO
296 END DO
297C
298 IF(iedge /= 0) THEN
299
300 sol_edge =iedge/10 ! solids
301 sh_edge =iedge-10*sol_edge ! shells
302C
303 IF(sol_edge/=0)THEN
304C
305C Primary edges <=> only candidates retained for this cycle (optcd_e2s)
306 first = 1 + i_stok_e2s*(jtask-1) / nthread
307 last = i_stok_e2s*jtask / nthread
308 DO i=first,last
309 IF(cands_e2s(i) < 0)THEN ! after optcd_e2s
310 irm=candm_e2s(i)
311 actnor(irm)=1
312 tagnod(irect(1,irm)) = 1
313 tagnod(irect(2,irm)) = 1
314 tagnod(irect(3,irm)) = 1
315 tagnod(irect(4,irm)) = 1
316 END IF
317 END DO
318C
319C All secondary edges includes
320 nedgft = 1 + (jtask-1)*number_edge_type1_0 / nthread
321 nedglt = jtask*number_edge_type1_0 / nthread
322 IF(jtask==nthread) nedglt =number_edge_type1_0
323#include "vectorize.inc"
324 DO j = nedgft,nedglt
325 i = edge_type1_0(j)
326C
327 IF(sh_edge==1 .AND. ledge(ledge_type,i) /= 1 .AND. ledge(ledge_right_seg,i) /= 0) cycle
328 ! Not a secondary edge
329C
330 irm =ledge(ledge_left_seg ,i)
331 iedg=ledge(ledge_left_id ,i)
332 jrm =ledge(ledge_right_seg,i)
333 jedg=ledge(ledge_right_id ,i)
334 IF(irm >0 ) THEN
335 actnor(irm) = 1
336 tagnod(irect(1,irm)) = 1
337 tagnod(irect(2,irm)) = 1
338 tagnod(irect(3,irm)) = 1
339 tagnod(irect(4,irm)) = 1
340 ENDIF
341 IF(jrm >0 ) THEN
342 actnor(jrm) = 1
343 tagnod(irect(1,jrm)) = 1
344 tagnod(irect(2,jrm)) = 1
345 tagnod(irect(3,jrm)) = 1
346 tagnod(irect(4,jrm)) = 1
347 ENDIF
348 ENDDO
349 ENDIF
350 ENDIF
351C
352 IF(iedge /= 0) THEN
353
354 sol_edge =iedge/10 ! solids
355C
356 IF(sol_edge/=0)THEN
357C
358C Primary edges <=> only candidates retained for this cycle (optcd_e2s)
359 first = 1 + i_stok_e2s*(jtask-1) / nthread
360 last = i_stok_e2s*jtask / nthread
361 DO i=first,last
362 IF(cands_e2s(i) < 0)THEN ! after optcd_e2s
363c IF( LEDGE(LEDGE_TYPE,ABS(CANDS_E2S(I)))/=1)CYCLE
364 irm=candm_e2s(i)
365 IF(tagnod(irect(1,irm))==1)e2s_actnor(admsr(1,irm)) = 1
366 IF(tagnod(irect(2,irm))==1)e2s_actnor(admsr(2,irm)) = 1
367 IF(tagnod(irect(3,irm))==1)e2s_actnor(admsr(3,irm)) = 1
368 IF(tagnod(irect(4,irm))==1)e2s_actnor(admsr(4,irm)) = 1
369 END IF
370 END DO
371
372C All secondary edges includes
373 nedgft = 1 + (jtask-1)*number_edge_type1 / nthread
374 nedglt = jtask*number_edge_type1 / nthread
375 IF(jtask==nthread) nedglt =number_edge_type1
376#include "vectorize.inc"
377 DO j = nedgft,nedglt
378 i = edge_type1(j)
379C
380 irm =ledge(ledge_left_seg ,i)
381 iedg=ledge(ledge_left_id ,i)
382 jrm =ledge(ledge_right_seg,i)
383 jedg=ledge(ledge_right_id ,i)
384 IF(irm >0 ) THEN
385 IF(tagnod(irect(1,irm))==1)e2s_actnor(admsr(iedg,irm)) = 1
386 IF(tagnod(irect(mod(iedg,4)+1,irm))==1)e2s_actnor(admsr(mod(iedg,4)+1,irm)) = 1
387 ENDIF
388 ENDDO
389 ENDIF
390 ENDIF
391
392C
393C force calculation of normals vs boundary nodes
394 CALL my_barrier()
395
396 IF(nspmd > 1 .AND. jtask == 1)THEN
397 DO i=iad_elem(1,1),iad_elem(1,nspmd+1)-1
398 nod=fr_elem(i)
399 tagnod(nod)=2 + tagnod(nod)
400 END DO
401 DO i = 1,nrtm
402 DO j = 1,4
403 IF(tagnod(irect(j,i))>=2) THEN
404 IF(actnor(i) == 0) THEN
405 actnor(i) = 3
406 ELSEIF(actnor(i) == 1) THEN
407C ACTNOR(I) = 4
408C ACTNOR values
409C Free edge
410C YES NO
411C Boundary YES 4 3
412C NO 1 0
413C
414 ENDIF
415 ENDIF
416 ENDDO
417 END DO
418 END IF
419C
420 CALL my_barrier()
421
422 IF(flagremn == 2) DEALLOCATE(tagmsr)
423C
424 RETURN
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
tri7box::stifi
type(real_pointer), dimension(:), allocatable stifi
Definition tri7box.F:449
tri7box::kremnor_fi
type(int_pointer), dimension(:), allocatable kremnor_fi
Definition tri7box.F:549
tri7box::remnor_fi
type(int_pointer), dimension(:), allocatable remnor_fi
Definition tri7box.F:548
nl
character *2 function nl()
Definition message.F:2360