Esope source files

   1 : C NORMNO    SOURCE    MAGN      10/05/18    21:16:29     6675           
   2 :       SUBROUTINE NORMNO(MELEME,MELEMS,MCHPOI,IRET)
   3 : C************************************************************************
   4 : C
   5 : C
   6 : C
   7 : C************************************************************************
   8 :       IMPLICIT INTEGER(I-N)
   9 :       IMPLICIT REAL*8 (A-H,O-Z)
  10 : C
  11 : -INC SMELEME
  12 :       POINTEUR MELEMS.MELEME
  13 : -INC SMLENTI
  14 : -INC SMLREEL
  15 : -INC SMCOORD
  16 : -INC SIZFFB
  17 : -INC SMCHPOI
  18 : -INC CCGEOME
  19 : -INC CCOPTIO
  20 : -INC CCREEL
  21 : C
  22 :       CHARACTER*8 NOM0
  23 : C***
  24 : C
  25 :       IRET=0
  26 : 
  27 :       IAXI=0
  28 :       IF(IFOMOD.EQ.0)IAXI=2
  29 :       DEUPI=1.D0
  30 :       IF(IAXI.NE.0)DEUPI=2.D0*XPI
  31 : 
  32 :       SEGACT MELEMS
  33 :       NAT=2
  34 :       NSOUPO=1
  35 :       SEGINI MCHPOI
  36 :       NC=IDIM
  37 :       SEGINI MSOUPO
  38 :       IPCHP(1)=MSOUPO
  39 : C     write(6,*)' MSOUPO=',MSOUPO,'MCHPOI=',MCHPOI
  40 : C  nature indeterminee  (2 discret)
  41 :       JATTRI(1)=0
  42 :       NOCOMP(1)='UX'
  43 :       NOCOMP(2)='UY'
  44 :       IF(IDIM.EQ.3)NOCOMP(3)='UZ'
  45 :       IGEOC=MELEMS
  46 : C     write(6,*)' MELEMS=',MELEMS
  47 :       N=MELEMS.NUM(/2)
  48 :       SEGINI MPOVAL
  49 :       IPOVAL=MPOVAL
  50 :       JG=N
  51 :       SEGINI MLREEL
  52 : 
  52 :       CALL KRIPAD(MELEMS,MLENTI)
  53 :       SEGDES MELEMS
  54 :       SEGACT MELEME
  55 : 
  56 :       DO 1 L=1,MAX(1,LISOUS(/1))
  57 :       IPT1=MELEME
  58 :       IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  59 :       SEGACT IPT1
  60 :       NOM0=NOMS(IPT1.ITYPEL)//'    '
  61 : C     write(6,*)' NOM0 ,IDIM',NOM0,IDIM
  61 :       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
  62 :       SEGACT IZFFM*MOD
  63 :       IZHR=KZHR(1)
  64 :       SEGACT IZHR*MOD
  65 :       NES=GR(/1)
  66 :       NPG=GR(/3)
  67 :       NBNN =IPT1.NUM(/1)
  68 :       NBELEM=IPT1.NUM(/2)
  69 : 
  70 :       DO 2 K=1,NBELEM
  71 : 
  72 :       DO 20 I=1,NBNN
  73 :       J=IPT1.NUM(I,K)
  74 :             DO 10 N=1,IDIM
  75 :                XYZ(N,I) = XCOOR((J-1)*(IDIM+1)+N)
  76 :   10        CONTINUE
  77 :   20     CONTINUE
  78 : 
  78 :       CALL CALJBR(FN,GR,PG,XYZ,HR,PGSQ,RPG,
  79 :      &        NES,IDIM,NBNN,NPG,IAXI,AIRE,AJ,SGN)
  80 : 
  81 :       DO 22 I=1,NBNN
  82 :       AX=0.D0
  83 :       AY=0.D0
  84 :       AZ=0.D0
  85 : 
  86 :       DO 17 LG=1,NPG
  87 :       AX=AX+FN(I,LG)*AJ(1,IDIM,LG)*PGSQ(LG)*DEUPI*RPG(LG)
  88 :       AY=AY+FN(I,LG)*AJ(2,IDIM,LG)*PGSQ(LG)*DEUPI*RPG(LG)
  89 :       IF(IDIM.EQ.3)THEN
  90 :       AZ=AZ+FN(I,LG)*AJ(3,IDIM,LG)*PGSQ(LG)*DEUPI*RPG(LG)
  91 :       ENDIF
  92 :  17   CONTINUE
  93 : 
  94 :       IU=LECT(IPT1.NUM(I,K))
  95 :       VPOCHA(IU,1)=VPOCHA(IU,1)+AX
  96 :       VPOCHA(IU,2)=VPOCHA(IU,2)+AY
  97 :       IF(IDIM.EQ.3)THEN
  98 :       VPOCHA(IU,3)=VPOCHA(IU,3)+AZ
  99 :       ENDIF
 100 :  22   CONTINUE
 101 : 
 102 :  2    CONTINUE
 103 :       SEGDES IPT1
 104 :       SEGSUP IZFFM,IZHR
 105 :  1    CONTINUE
 106 :       SEGDES MELEME
 107 :       N=VPOCHA(/1)
 108 : 
 109 :       IF(IDIM.EQ.2)THEN
 110 :       DO 31 I=1,N
 111 :       AN=(VPOCHA(I,1)*VPOCHA(I,1) + VPOCHA(I,2)*VPOCHA(I,2))**0.5D0
 112 :       VPOCHA(I,1)=VPOCHA(I,1)/AN
 113 :       VPOCHA(I,2)=VPOCHA(I,2)/AN
 114 : C     write(6,*)' ux uy ',VPOCHA(I,1),VPOCHA(I,2)
 115 :  31   CONTINUE
 116 : 
 117 :       ELSE
 118 :       DO 33 I=1,N
 119 :       AN=(VPOCHA(I,1)*VPOCHA(I,1) + VPOCHA(I,2)*VPOCHA(I,2)
 120 :      &  + VPOCHA(I,3)*VPOCHA(I,3) )**0.5D0
 121 :       VPOCHA(I,1)=VPOCHA(I,1)/AN
 122 :       VPOCHA(I,2)=VPOCHA(I,2)/AN
 123 :       VPOCHA(I,3)=VPOCHA(I,3)/AN
 124 :  33   CONTINUE
 125 :       ENDIF
 126 : 
 127 :       SEGDES MCHPOI,MSOUPO,MPOVAL
 128 :       SEGSUP MLENTI,MLREEL
 129 :       IRET=1
 130 : 
 131 :       RETURN
 132 :  1002 FORMAT(10(1X,1PE11.4))
 133 :  1001 FORMAT(20(1X,I5))
 134 :       END
 135 :  
 136 :  
 137 :  
 138 :  
 139 :  
 140 :  
 141 :