Esope source files

   1 : C XDIAMM    SOURCE    CHAT      05/01/13    04:13:22     5004           
   2 :       SUBROUTINE XDIAMM(MELEME,DIAM)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 : -INC CCREEL
   6 : -INC SMELEME
   7 : -INC SMCOORD
   8 : -INC CCOPTIO
   9 : *      PARAMETER (XPETI2=XPETIT**2)
  10 :       XPETI2 = xpetit
  11 : *      DIAM2=XGRAND**2
  12 :       DIAM2 = xgrand
  13 :       SEGACT MELEME
  14 :       NBSOUS=LISOUS(/1)
  15 :       IF(NBSOUS.EQ.0)NBSOUS=1
  16 :       DO 1 L=1,NBSOUS
  17 :          IF(NBSOUS.EQ.1)THEN
  18 :             IPT1=MELEME
  19 :          ELSE
  20 :             IPT1=LISOUS(L)
  21 :             SEGACT IPT1
  22 :          ENDIF
  23 :          NP =IPT1.NUM(/1)
  24 :          NEL=IPT1.NUM(/2)
  25 :          IF(NP.EQ.1) THEN
  26 : C           On ne veut pas d'objet de type %m1:8
  27 :             MOTERR(1:8)='POI1    '
  27 :             CALL ERREUR(39)
  28 :             RETURN
  29 :          ENDIF
  30 :          DO 10 K=1,NEL
  31 : 
  32 : C             CALCUL DU DIAMETRE MIN
  33 : 
  34 :             DO 321 I=1,NP-1
  35 :                IPI=IPT1.NUM(I,K)
  36 :                DO 322 J=I+1,NP
  37 :                   IPJ=IPT1.NUM(J,K)
  38 :                   XM2=0.D0
  39 :                   DO 323 N=1,IDIM
  40 :                      XM2=XM2+(XCOOR((IPI-1)*(IDIM+1)+N)
  41 :      $                       -XCOOR((IPJ-1)*(IDIM+1)+N))**2
  42 :  323              CONTINUE
  43 :                   DIAM2=MIN(DIAM2,XM2)
  44 :  322           CONTINUE
  45 :  321        CONTINUE
  46 : C
  47 : *            IF(DIAM2.LT.XPETI2) WRITE(6,*)
  48 : *     $           'xdiamm.eso : un element est peut-etre degenere'
  49 :  10      CONTINUE
  50 :          IF(NBSOUS.NE.1)SEGDES IPT1
  51 :  1    CONTINUE
  52 :       SEGDES MELEME
  53 :       DIAM=SQRT(DIAM2)
  54 :       RETURN
  55 :       END
  56 : 
  57 : 
  58 :  
  59 :  
  60 :