C NORMNO SOURCE CB215821 20/11/25 13:35:07 10792 SUBROUTINE NORMNO(MELEME,MELEMS,MCHPOI,IRET) C************************************************************************ C C C C************************************************************************ IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC SMELEME POINTEUR MELEMS.MELEME -INC SMLENTI -INC SMLREEL -INC SMCOORD -INC SIZFFB -INC SMCHPOI -INC CCGEOME -INC PPARAM -INC CCOPTIO -INC CCREEL C CHARACTER*8 NOM0 C*** C IRET=0 IAXI=0 IF(IFOMOD.EQ.0)IAXI=2 DEUPI=1.D0 IF(IAXI.NE.0)DEUPI=2.D0*XPI SEGACT MELEMS NAT=2 NSOUPO=1 SEGINI MCHPOI NC=IDIM SEGINI MSOUPO IPCHP(1)=MSOUPO C write(6,*)' MSOUPO=',MSOUPO,'MCHPOI=',MCHPOI C nature indeterminee (2 discret) JATTRI(1)=0 NOCOMP(1)='UX' NOCOMP(2)='UY' IF(IDIM.EQ.3)NOCOMP(3)='UZ' IGEOC=MELEMS C write(6,*)' MELEMS=',MELEMS N=MELEMS.NUM(/2) SEGINI MPOVAL IPOVAL=MPOVAL JG=N SEGINI MLREEL CALL KRIPAD(MELEMS,MLENTI) SEGDES MELEMS SEGACT MELEME DO 1 L=1,MAX(1,LISOUS(/1)) IPT1=MELEME IF(LISOUS(/1).NE.0)IPT1=LISOUS(L) SEGACT IPT1 NOM0=NOMS(IPT1.ITYPEL)//' ' C write(6,*)' NOM0 ,IDIM',NOM0,IDIM CALL KALPBG(NOM0,'FONFORM ',IZFFM) SEGACT IZFFM*MOD IZHR=KZHR(1) SEGACT IZHR*MOD NES=GR(/1) NPG=GR(/3) NBNN =IPT1.NUM(/1) NBELEM=IPT1.NUM(/2) DO 2 K=1,NBELEM DO 20 I=1,NBNN J=IPT1.NUM(I,K) DO 10 N=1,IDIM XYZ(N,I) = XCOOR((J-1)*(IDIM+1)+N) 10 CONTINUE 20 CONTINUE CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG, & NES,IDIM,NBNN,NPG,IAXI,AIRE,AJ,SGN) DO 22 I=1,NBNN AX=0.D0 AY=0.D0 AZ=0.D0 DO 17 LG=1,NPG AX=AX+FN(I,LG)*AJ(1,IDIM,LG)*PGSQ(LG)*DEUPI*RPG(LG) AY=AY+FN(I,LG)*AJ(2,IDIM,LG)*PGSQ(LG)*DEUPI*RPG(LG) IF(IDIM.EQ.3)THEN AZ=AZ+FN(I,LG)*AJ(3,IDIM,LG)*PGSQ(LG)*DEUPI*RPG(LG) ENDIF 17 CONTINUE IU=LECT(IPT1.NUM(I,K)) VPOCHA(IU,1)=VPOCHA(IU,1)+AX VPOCHA(IU,2)=VPOCHA(IU,2)+AY IF(IDIM.EQ.3)THEN VPOCHA(IU,3)=VPOCHA(IU,3)+AZ ENDIF 22 CONTINUE 2 CONTINUE SEGDES IPT1 SEGSUP IZFFM,IZHR 1 CONTINUE SEGDES MELEME N=VPOCHA(/1) IF(IDIM.EQ.2)THEN DO 31 I=1,N AN=(VPOCHA(I,1)*VPOCHA(I,1) + VPOCHA(I,2)*VPOCHA(I,2))**0.5D0 if (abs(an).lt.xpetit) an=1.d0 VPOCHA(I,1)=VPOCHA(I,1)/AN VPOCHA(I,2)=VPOCHA(I,2)/AN C write(6,*)' ux uy ',VPOCHA(I,1),VPOCHA(I,2) 31 CONTINUE ELSE DO 33 I=1,N AN=(VPOCHA(I,1)*VPOCHA(I,1) + VPOCHA(I,2)*VPOCHA(I,2) & + VPOCHA(I,3)*VPOCHA(I,3) )**0.5D0 if (abs(an).lt.xpetit) an=1.d0 VPOCHA(I,1)=VPOCHA(I,1)/AN VPOCHA(I,2)=VPOCHA(I,2)/AN VPOCHA(I,3)=VPOCHA(I,3)/AN 33 CONTINUE ENDIF SEGDES MCHPOI,MSOUPO,MPOVAL SEGSUP MLENTI,MLREEL IRET=1 RETURN 1002 FORMAT(10(1X,1PE11.4)) 1001 FORMAT(20(1X,I5)) END