Sources Esope | Cast3M

normno
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