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 1125 of file i25norm.F.

1127C-----------------------------------------------
1128C I m p l i c i t T y p e s
1129C-----------------------------------------------
1130#include "implicit_f.inc"
1131C-----------------------------------------------
1132C C o m m o n B l o c k s
1133C-----------------------------------------------
1134#include "task_c.inc"
1135C-----------------------------------------------
1136C D u m m y A r g u m e n t s
1137C-----------------------------------------------
1138 INTEGER JTASK, NADMSR,
1139 . ADMSR(4,*), ADSKYT(NADMSR+1), IADNOR(4,*), ACTNOR(*)
1140C REAL
1141 real*4
1142 . nod_normal(3,nadmsr)
1143 real*4 fskyt(3,*)
1144C-----------------------------------------------
1145C L o c a l V a r i a b l e s
1146C-----------------------------------------------
1147 INTEGER I ,J, C1, C2, CC
1148 INTEGER NADMSRFT, NADMSRLT, NRTMFT, NRTMLT
1149 real*4
1150 . aaa
1151C------------------------------------
1152C Normal nodes for edge to edge solids
1153C------------------------------------
1154
1155 nadmsrft= 1+(jtask-1)*nadmsr/ nthread
1156 nadmsrlt= jtask*nadmsr/nthread
1157C
1158 nod_normal(1:3,nadmsrft:nadmsrlt)=rzero
1159 DO i = nadmsrft,nadmsrlt
1160
1161 IF(actnor(i)==0)cycle
1162
1163 c1 = adskyt(i)
1164 c2 = adskyt(i+1)-1
1165 DO cc = c1, c2
1166 nod_normal(1:3,i) = nod_normal(1:3,i) + fskyt(1:3,cc)
1167 END DO
1168
1169 aaa=run/max(rem30,sqrt(nod_normal(1,i)*nod_normal(1,i)+
1170 . nod_normal(2,i)*nod_normal(2,i)+
1171 . nod_normal(3,i)*nod_normal(3,i)))
1172 nod_normal(1,i)=nod_normal(1,i)*aaa
1173 nod_normal(2,i)=nod_normal(2,i)*aaa
1174 nod_normal(3,i)=nod_normal(3,i)*aaa
1175
1176 END DO
1177C
1178 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, NM, IRM, N1, N2, N3, N4, IAD, LENR, LENS, CC, ISH
491 INTEGER IX1, IX2, IX3, IX4,
492 . I1, I2, I3, I4, JRM, JEDG, IEDG, NEDG, IS1,IS2
493 INTEGER NRTMFT, NRTMLT, NEDGFT, NEDGLT, NADMSRFT, NADMSRLT
494 INTEGER SIZE
495 my_real s1,s2
496 real*4
497 . x0, y0, z0,
498 . x1, x2, x3, x4,
499 . y1, y2, y3, y4,
500 . z1, z2, z3, z4,
501 . x01, x02, x03, x04,
502 . y01, y02, y03, y04,
503 . z01, z02, z03, z04,
504 . xn1(mvsiz),yn1(mvsiz),zn1(mvsiz),
505 . xn2(mvsiz),yn2(mvsiz),zn2(mvsiz),
506 . xn3(mvsiz),yn3(mvsiz),zn3(mvsiz),
507 . xn4(mvsiz),yn4(mvsiz),zn4(mvsiz),
508 . xs(mvsiz), ys(mvsiz), zs(mvsiz),
509 . aaa, nx, ny, nz,
510 . vx, vy, vz, x12, y12, z12
511 real*4 :: x0s,y0s,z0s,x01s,y01s,z01s,x02s,y02s,z02s
512 LOGICAL :: LIMIT_CASE,IS_QUAD(MVSIZ)
513C REAL*4 :: RZERO, RUN, REM30, REP30, RDIX
514C PARAMETER ( RZERO = 0. )
515C PARAMETER ( RUN = 1. )
516C PARAMETER ( RDIX = 10. )
517C PARAMETER ( REP30 = RDIX**30 )
518C PARAMETER ( REM30 = RUN/REP30 )
519#define RZERO 0.
520#define RUN 1.
521#define RDIX 10.
522#define REP30 1.0E30
523#define REM30 1.0E-30
524
525
526
527
528C-----------------------------------------------
529C debug
530 INTEGER IE,JE,I1E,I2E
531 INTEGER :: IDS(4)
532
533C RZERO = 0.
534C RUN = 1.
535C RDIX = 10.
536C REP30 = RDIX**30
537C REM30 = RUN/REP30
538C
539 IF(flag == 1) THEN
540
541 nrtmft= 1+(jtask-1)*nrtm0/ nthread
542 nrtmlt= jtask*nrtm0/nthread
543
544 DO n=nrtmft,nrtmlt,mvsiz
545C
546 llt=min(nrtmlt-n+1,mvsiz)
547C
548 tage(n:llt+n-1)=0
549CLe nofusion est important
550#include "vectorize.inc"
551CDIR$ NOFUSION
552 DO i=1,llt
553C
554 irm=i+n-1
555
556 ix1=irect(1,irm)
557 ix2=irect(2,irm)
558 ix3=irect(3,irm)
559 ix4=irect(4,irm)
560 IF(ix3/=ix4)THEN
561 is_quad(i) = .true.
562 ELSE
563 is_quad(i) = .false.
564 ENDIF
565
566C
567 IF(tagnod(ix1)==0.AND.
568 . tagnod(ix2)==0.AND.
569 . tagnod(ix3)==0.AND.
570 . tagnod(ix4)==0) THEN
571 tage(irm)=1
572 cycle
573 END IF
574
575C
576 IF(stifm(irm) > zero) THEN
577C
578 x1=x(1,ix1)
579 y1=x(2,ix1)
580 z1=x(3,ix1)
581 x2=x(1,ix2)
582 y2=x(2,ix2)
583 z2=x(3,ix2)
584 x3=x(1,ix3)
585 y3=x(2,ix3)
586 z3=x(3,ix3)
587 x4=x(1,ix4)
588 y4=x(2,ix4)
589 z4=x(3,ix4)
590C
591 IF(ix3/=ix4)THEN
592 x0 = (x1+x2+x3+x4)/4.0
593 y0 = (y1+y2+y3+y4)/4.0
594 z0 = (z1+z2+z3+z4)/4.0
595 ELSE
596 x0 = x3
597 y0 = y3
598 z0 = z3
599 ENDIF
600C
601 x01 = x1 - x0
602 y01 = y1 - y0
603 z01 = z1 - z0
604 x02 = x2 - x0
605 y02 = y2 - y0
606 z02 = z2 - z0
607 x03 = x3 - x0
608 y03 = y3 - y0
609 z03 = z3 - z0
610 x04 = x4 - x0
611 y04 = y4 - y0
612 z04 = z4 - z0
613C
614 xn1(i) = y01*z02 - z01*y02
615 yn1(i) = z01*x02 - x01*z02
616 zn1(i) = x01*y02 - y01*x02
617 xn2(i) = y02*z03 - z02*y03
618 yn2(i) = z02*x03 - x02*z03
619 zn2(i) = x02*y03 - y02*x03
620 xn3(i) = y03*z04 - z03*y04
621 yn3(i) = z03*x04 - x03*z04
622 zn3(i) = x03*y04 - y03*x04
623 xn4(i) = y04*z01 - z04*y01
624 yn4(i) = z04*x01 - x04*z01
625 zn4(i) = x04*y01 - y04*x01
626C
627C
628 aaa=run/max(rem30,sqrt(xn1(i)*xn1(i)+yn1(i)*yn1(i)+zn1(i)*zn1(i)))
629 xn1(i) = xn1(i)*aaa
630 yn1(i) = yn1(i)*aaa
631 zn1(i) = zn1(i)*aaa
632C
633 aaa=run/max(rem30,sqrt(xn2(i)*xn2(i)+yn2(i)*yn2(i)+zn2(i)*zn2(i)))
634 xn2(i) = xn2(i)*aaa
635 yn2(i) = yn2(i)*aaa
636 zn2(i) = zn2(i)*aaa
637C
638 aaa=run/max(rem30,sqrt(xn3(i)*xn3(i)+yn3(i)*yn3(i)+zn3(i)*zn3(i)))
639 xn3(i) = xn3(i)*aaa
640 yn3(i) = yn3(i)*aaa
641 zn3(i) = zn3(i)*aaa
642C
643 aaa=run/max(rem30,sqrt(xn4(i)*xn4(i)+yn4(i)*yn4(i)+zn4(i)*zn4(i)))
644 xn4(i) = xn4(i)*aaa
645 yn4(i) = yn4(i)*aaa
646 zn4(i) = zn4(i)*aaa
647C
648 ELSE ! IF(STIFM(IRM)/=ZERO)THEN
649 xn1(i) = rzero
650 yn1(i) = rzero
651 zn1(i) = rzero
652C
653 xn2(i) = rzero
654 yn2(i) = rzero
655 zn2(i) = rzero
656C
657 xn3(i) = rzero
658 yn3(i) = rzero
659 zn3(i) = rzero
660C
661 xn4(i) = rzero
662 yn4(i) = rzero
663 zn4(i) = rzero
664 END IF
665 END DO
666C
667#include "vectorize.inc"
668 DO i=1,llt
669C
670 irm=i+n-1
671 IF(tage(irm)==1) cycle
672
673C
674 IF(is_quad(i))THEN
675C
676 nod_normal(1,1,irm)=xn1(i)
677 nod_normal(2,1,irm)=yn1(i)
678 nod_normal(3,1,irm)=zn1(i)
679C
680 nod_normal(1,2,irm)=xn2(i)
681 nod_normal(2,2,irm)=yn2(i)
682 nod_normal(3,2,irm)=zn2(i)
683C
684 nod_normal(1,3,irm)=xn3(i)
685 nod_normal(2,3,irm)=yn3(i)
686 nod_normal(3,3,irm)=zn3(i)
687C
688 nod_normal(1,4,irm)=xn4(i)
689 nod_normal(2,4,irm)=yn4(i)
690 nod_normal(3,4,irm)=zn4(i)
691C
692 ELSE
693C
694 nod_normal(1,1,irm)=xn1(i)
695 nod_normal(2,1,irm)=yn1(i)
696 nod_normal(3,1,irm)=zn1(i)
697C
698 nod_normal(1,2,irm)=xn1(i)
699 nod_normal(2,2,irm)=yn1(i)
700 nod_normal(3,2,irm)=zn1(i)
701C
702 nod_normal(1,4,irm)=xn1(i)
703 nod_normal(2,4,irm)=yn1(i)
704 nod_normal(3,4,irm)=zn1(i)
705C
706 END IF
707 END DO
708C
709#include "vectorize.inc"
710 DO i=1,llt
711C
712C
713 irm=i+n-1
714 IF(tage(irm)==1) cycle
715C
716 ish=msegtyp(irm)
717 IF(ish > 0) THEN
718 IF(ish > nrtm)ish=ish-nrtm
719C
720 IF(is_quad(i))THEN
721C
722 nod_normal(1,1,ish)=-xn1(i)
723 nod_normal(2,1,ish)=-yn1(i)
724 nod_normal(3,1,ish)=-zn1(i)
725C
726 nod_normal(1,4,ish)=-xn2(i)
727 nod_normal(2,4,ish)=-yn2(i)
728 nod_normal(3,4,ish)=-zn2(i)
729C
730 nod_normal(1,3,ish)=-xn3(i)
731 nod_normal(2,3,ish)=-yn3(i)
732 nod_normal(3,3,ish)=-zn3(i)
733C
734 nod_normal(1,2,ish)=-xn4(i)
735 nod_normal(2,2,ish)=-yn4(i)
736 nod_normal(3,2,ish)=-zn4(i)
737C
738 ELSE
739C
740 nod_normal(1,1,ish)=-xn1(i)
741 nod_normal(2,1,ish)=-yn1(i)
742 nod_normal(3,1,ish)=-zn1(i)
743C
744 nod_normal(1,4,ish)=-xn1(i)
745 nod_normal(2,4,ish)=-yn1(i)
746 nod_normal(3,4,ish)=-zn1(i)
747C
748 nod_normal(1,2,ish)=-xn1(i)
749 nod_normal(2,2,ish)=-yn1(i)
750 nod_normal(3,2,ish)=-zn1(i)
751C
752 END IF
753 END IF
754 END DO
755
756 IF(sol_edge /= 0) THEN
757
758 DO i=1,llt
759C
760C
761 irm=i+n-1
762 IF(tage(irm)==1) cycle
763C
764 i1=admsr(1,irm)
765 i2=admsr(2,irm)
766 i3=admsr(3,irm)
767 i4=admsr(4,irm)
768C
769 IF(is_quad(i))THEN
770 iad = iadnor(1,irm)
771 fskyt(1,iad) = xn4(i)+xn1(i)
772 fskyt(2,iad) = yn4(i)+yn1(i)
773 fskyt(3,iad) = zn4(i)+zn1(i)
774c
775 iad = iadnor(2,irm)
776 fskyt(1,iad) = xn1(i)+xn2(i)
777 fskyt(2,iad) = yn1(i)+yn2(i)
778 fskyt(3,iad) = zn1(i)+zn2(i)
779c
780 iad = iadnor(3,irm)
781 fskyt(1,iad) = xn2(i)+xn3(i)
782 fskyt(2,iad) = yn2(i)+yn3(i)
783 fskyt(3,iad) = zn2(i)+zn3(i)
784c
785 iad = iadnor(4,irm)
786 fskyt(1,iad) = xn3(i)+xn4(i)
787 fskyt(2,iad) = yn3(i)+yn4(i)
788 fskyt(3,iad) = zn3(i)+zn4(i)
789 ELSE
790 iad = iadnor(1,irm)
791 fskyt(1,iad) = xn1(i)
792 fskyt(2,iad) = yn1(i)
793 fskyt(3,iad) = zn1(i)
794c
795 iad = iadnor(2,irm)
796 fskyt(1,iad) = xn1(i)
797 fskyt(2,iad) = yn1(i)
798 fskyt(3,iad) = zn1(i)
799c
800 iad = iadnor(3,irm)
801 fskyt(1,iad) = xn1(i)
802 fskyt(2,iad) = yn1(i)
803 fskyt(3,iad) = zn1(i)
804c
805 END IF
806 END DO
807 ENDIF
808
809 END DO
810C
811 CALL my_barrier
812C
813 nrtmft= 1+(jtask-1)*nrtm/ nthread
814 nrtmlt= jtask*nrtm/nthread
815
816 nadmsrft= 1+(jtask-1)*nadmsr/ nthread
817 nadmsrlt= jtask*nadmsr/nthread
818
819 lbound(nadmsrft:nadmsrlt)=0
820C
821 CALL my_barrier
822C
823!$OMP SINGLE
824 nb_free_bound = 0
825 limit_case = .false.
826 DO i=1,nrtm_free
827 irm = free_irect_id(i)
828 IF(stifm(irm) <= zero)cycle
829 DO iedg=1,4
830 IF(mvoisin(iedg,irm)==0)THEN
831 IF(.NOT.(irect(3,irm)==irect(4,irm).AND.iedg==3))THEN
832 nb_free_bound = nb_free_bound + 1
833 free_bound(1,nb_free_bound) = irm
834 free_bound(2,nb_free_bound) = iedg
835 !ADMSR( 1 2 3 4)
836! IS /= semgment sup and inf
837 is1=admsr(iedg,irm)
838 is2=admsr(mod(iedg,4)+1,irm)
839
840 vx=nod_normal(1,iedg,irm)
841 vy=nod_normal(2,iedg,irm)
842 vz=nod_normal(3,iedg,irm)
843
844 IF(vx == 0 .AND. vy == 0 .AND. vz == 0) THEN
845C Free bound, but nod_normal not computed (no candidate for this free bound)
846 free_bound(3,nb_free_bound) = 3
847 free_bound(4,nb_free_bound) = 3
848 ELSE
849 lbound(is1) = lbound(is1) + 1
850 lbound(is2) = lbound(is2) + 1
851 free_bound(3,nb_free_bound) = lbound(is1)
852 free_bound(4,nb_free_bound) = lbound(is2)
853 ENDIF
854
855 IF(lbound(is1) > 2 .OR. lbound(is2) > 2) THEN
856C When a node belongs to many free boundaries
857C ex: two segments linked only by a corner
858C The node at the corner belongs to two free boundaries
859C A special treatment is done, VTX_BISECTOR has to set to 0
860 limit_case = .true.
861 ENDIF
862 ENDIF
863 ENDIF
864 ENDDO
865 ENDDO
866 IF(limit_case) THEN
867 DO i=1,nb_free_bound
868 irm = free_bound(1,i)
869 iedg = free_bound(2,i)
870 is1=admsr(iedg,irm)
871 IF(lbound(is1) > 2) THEN
872 free_bound(3,i) = 3
873 vtx_bisector(1,1,is1) = rzero
874 vtx_bisector(2,1,is1) = rzero
875 vtx_bisector(3,1,is1) = rzero
876 vtx_bisector(1,2,is1) = rzero
877 vtx_bisector(2,2,is1) = rzero
878 vtx_bisector(3,2,is1) = rzero
879 ENDIF
880 !ADMSR( 2 3 4 1)
881 is2=admsr(mod(iedg,4)+1,irm)
882 IF(lbound(is2) > 2) THEN
883 free_bound(4,i) = 3
884 vtx_bisector(1,1,is2) = rzero
885 vtx_bisector(2,1,is2) = rzero
886 vtx_bisector(3,1,is2) = rzero
887 vtx_bisector(1,2,is2) = rzero
888 vtx_bisector(2,2,is2) = rzero
889 vtx_bisector(3,2,is2) = rzero
890 ENDIF
891 ENDDO
892 ENDIF
893!$OMP END SINGLE
894
895
896C
897 CALL my_barrier
898
899
900 nrtmft= 1+(jtask-1)*nb_free_bound/nthread
901 nrtmlt= jtask*nb_free_bound/nthread
902#include "vectorize.inc"
903 DO i=nrtmft,nrtmlt
904 irm = free_bound(1,i)
905 iedg = free_bound(2,i)
906 nx=nod_normal(1,iedg,irm)
907 ny=nod_normal(2,iedg,irm)
908 nz=nod_normal(3,iedg,irm)
909C
910 i1=irect(iedg,irm)
911 i2=irect(mod(iedg,4)+1,irm)
912
913 x12=x(1,i2)-x(1,i1)
914 y12=x(2,i2)-x(2,i1)
915 z12=x(3,i2)-x(3,i1)
916
917 vx=y12*nz-z12*ny
918 vy=z12*nx-x12*nz
919 vz=x12*ny-y12*nx
920
921 aaa=run/max(rem30,sqrt(vx*vx+vy*vy+vz*vz))
922 vx=vx*aaa
923 vy=vy*aaa
924 vz=vz*aaa
925
926 nod_normal(1,iedg,irm)=vx
927 nod_normal(2,iedg,irm)=vy
928 nod_normal(3,iedg,irm)=vz
929
930 ENDDO
931
932 CALL my_barrier
933
934#include "vectorize.inc"
935 DO i=nrtmft,nrtmlt
936 irm = free_bound(1,i)
937 iedg = free_bound(2,i)
938 i1 = free_bound(3,i)
939 i2 = free_bound(4,i)
940
941 vx=nod_normal(1,iedg,irm)
942 vy=nod_normal(2,iedg,irm)
943 vz=nod_normal(3,iedg,irm)
944C
945 is1=admsr(iedg,irm)
946 IF(i1 <= 2 ) THEN
947 vtx_bisector(1,i1,is1)=vx
948 vtx_bisector(2,i1,is1)=vy
949 vtx_bisector(3,i1,is1)=vz
950 END IF
951
952 is2=admsr(mod(iedg,4)+1,irm)
953 IF(i2 <= 2) THEN
954 vtx_bisector(1,i2,is2)=vx
955 vtx_bisector(2,i2,is2)=vy
956 vtx_bisector(3,i2,is2)=vz
957 END IF
958 ENDDO
959
960 CALL my_barrier
961
962C
963 IF(nspmd > 1)THEN
964 IF(jtask==1)THEN
965 SIZE = 3
966 CALL spmd_exch_nor(
967 1 ni25,iad_fredg,fr_edg , nod_normal,wnod_normal,SIZE ,nadmsr,
968 2 buffers%RECV_RQ ,buffers%SEND_RQ,buffers%IRINDEX,buffers%ISINDEX,buffers%IAD_RECV,
969 3 buffers%NBIRECV,buffers%NBISEND,buffers%RECV_BUF ,buffers%SEND_BUF ,vtx_bisector,
970 4 lbound,iad_frnor,fr_nor,1,fskyn25 ,ishift,addcsrect, procnor,sol_edge)
971 END IF
972 END IF
973 CALL my_barrier
974C
975 ELSE IF(flag == 2) THEN
976C
977C
978C
979
980 nrtmft= 1+(jtask-1)*nrtm/ nthread
981 nrtmlt= jtask*nrtm/nthread
982 DO n=nrtmft,nrtmlt,mvsiz
983C
984 llt=min(nrtmlt-n+1,mvsiz)
985C
986#include "vectorize.inc"
987 DO i=1,llt
988C
989 irm=i+n-1
990C
991
992 IF(actnor(irm)==3) THEN
993 wnod_normal(1:3,1:4,irm) = rzero
994C CYCLE
995 ENDIF
996
997 IF(actnor(irm)==0) THEN
998CC pas besoin de calculer les bis. sur ce irm
999C WNOD_NORMAL(1:3,1:4,IRM) = RZERO
1000 cycle
1001 ENDIF
1002
1003C
1004 IF(stifm(irm) <= 0) THEN
1005 wnod_normal(1:3,1:4,irm) = rzero
1006 ELSE
1007 DO j=1,4
1008 jrm =mvoisin(j,irm)
1009 jedg=evoisin(j,irm)
1010 IF(jrm > 0 )THEN
1011C IF(ACTNOR(JRM) > 0) THEN
1012 wnod_normal(1,j,irm) = nod_normal(1,jedg,jrm)
1013 wnod_normal(2,j,irm) = nod_normal(2,jedg,jrm)
1014 wnod_normal(3,j,irm) = nod_normal(3,jedg,jrm)
1015C ELSE
1016C WNOD_NORMAL(1,J,IRM) = RZERO
1017C WNOD_NORMAL(2,J,IRM) = RZERO
1018C WNOD_NORMAL(3,J,IRM) = RZERO
1019C ENDIF
1020 ELSEIF(jrm<=0)THEN
1021 wnod_normal(1,j,irm) = rzero
1022 wnod_normal(2,j,irm) = rzero
1023 wnod_normal(3,j,irm) = rzero
1024 END IF
1025 END DO !J
1026 ENDIF ! STIFM = 0
1027 END DO !I
1028 END DO ! N
1029C
1030 CALL my_barrier
1031 IF(nspmd > 1)THEN
1032 IF(jtask==1)THEN
1033 SIZE = 3
1034 CALL spmd_exch_nor(
1035 1 ni25,iad_fredg,fr_edg , nod_normal,wnod_normal,SIZE , nadmsr,
1036 2 buffers%RECV_RQ ,buffers%SEND_RQ,buffers%IRINDEX,buffers%ISINDEX,buffers%IAD_RECV,
1037 3 buffers%NBIRECV,buffers%NBISEND,buffers%RECV_BUF ,buffers%SEND_BUF ,vtx_bisector,
1038 4 lbound,iad_frnor,fr_nor,2,fskyn25 ,ishift,addcsrect, procnor,sol_edge)
1039 WHERE (lbound(1:nadmsr) > 1)
1040 lbound(1:nadmsr) = 1
1041 END WHERE
1042 END IF
1043 END IF
1044C
1045 CALL my_barrier
1046C
1047 DO irm=nrtmft,nrtmlt
1048C
1049C IF(ACTNOR(IRM)==0 .OR. STIFM(IRM)<=ZERO) CYCLE
1050
1051! Nod Normal should be received even if IRM
1052C is deleted
1053C ISPMD may still send the edge during for contact detection
1054C (i.e. ISPMD is PMAIN)
1055
1056 IF(actnor(irm)==0) cycle
1057
1058 IF(stifm(irm) <= zero) THEN
1059 nod_normal(1:3,1:4,irm) = rzero
1060 ENDIF
1061
1062 DO j=1,4
1063 jrm =mvoisin(j,irm)
1064C DEBUG_E2E(INT_CHECKSUM(IDS,4,1) == D_EM,JRM)
1065 IF(jrm<0 .AND. stifm(irm) <= 0 ) THEN
1066 nod_normal(1,j,irm) = wnod_normal(1,j,irm)
1067 nod_normal(2,j,irm) = wnod_normal(2,j,irm)
1068 nod_normal(3,j,irm) = wnod_normal(3,j,irm)
1069C If the local segment is broken
1070C The (secondary) edge can still be sended by ISPMD to the processor that have
1071C the main segment.
1072C In that case, the ordering of (JEDG) should be the one on the side that is not
1073C broken
1074 ELSE ! JRM >= 0 .OR. STIFM /= 0
1075 IF( jrm /= 0) THEN
1076 nx=nod_normal(1,j,irm)+wnod_normal(1,j,irm)
1077 ny=nod_normal(2,j,irm)+wnod_normal(2,j,irm)
1078 nz=nod_normal(3,j,irm)+wnod_normal(3,j,irm)
1079 aaa=run/max(rem30,sqrt(nx*nx+ny*ny+nz*nz))
1080 nod_normal(1,j,irm)=nx*aaa
1081 nod_normal(2,j,irm)=ny*aaa
1082 nod_normal(3,j,irm)=nz*aaa
1083 ENDIF
1084 ENDIF
1085 END DO
1086 END DO
1087 ENDIF ! FLAG
1088
1089C debug print
1090CCCC #ifdef D_ES
1091CCCC !$OMP SINGLE
1092CCCC DO NEDG=1,NEDGE
1093CCCC IRM = LEDGE(LEDGE_LEFT_SEG ,NEDG)
1094CCCC IEDG = LEDGE(LEDGE_LEFT_ID ,NEDG)
1095CCCC JRM = LEDGE(LEDGE_RIGHT_SEG,NEDG)
1096CCCC JEDG = LEDGE(LEDGE_RIGHT_ID ,NEDG)
1097CCCC IF(LEDGE(LEDGE_GLOBAL_ID,NEDG) == D_ES ) THEN
1098CCCC WRITE(6,*) "LEDGE(1:4)=",IRM,IEDG,JRM,JEDG
1099CCCC IF(IRM > 0) THEN
1100CCCC WRITE(6,"(2I10,A,3Z20)") IEDG,IRM,"(A) F[XYZ]=",
1101CCCC . NOD_NORMAL(1,IEDG,IRM),
1102CCCC . NOD_NORMAL(2,IEDG,IRM),
1103CCCC . NOD_NORMAL(3,IEDG,IRM)
1104CCCC ELSEIF(IRM < 0) THEN
1105CCCC WRITE(6,"(2I10,A,3Z20)") IEDG,IRM,"(B) F[XYZ]=",
1106CCCC . NOD_NORMAL(1,IEDG,ABS(IRM)),
1107CCCC . NOD_NORMAL(2,IEDG,ABS(IRM)),
1108CCCC . NOD_NORMAL(3,IEDG,ABS(IRM))
1109CCCC ENDIF
1110CCCC ENDIF
1111CCCC ENDDO
1112CCCC !$OMP END SINGLE
1113CCCC #endif
1114 CALL my_barrier
1115
1116 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:45
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, NORV
88 INTEGER NRTMFT, NRTMLT, NSNF, NSNL, NSNRF, NSNRL, NODFT, NODLT,
89 . I1, I2, I3, I4, 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 considerer L ET tous les segments voisins (cf glissement)
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 considerer L ET tous les segments voisins (cf glissement)
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 considerer L ET tous les segments voisins (cf glissement)
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 considerer L ET tous les segments voisins (cf glissement)
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 Calcul des candidats optimises
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 le calcul le long des free edges necessaire a 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 le calcul des normales vs noeuds frontieres
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:2354