C XDIAMM SOURCE CHAT 05/01/13 04:13:22 5004 SUBROUTINE XDIAMM(MELEME,DIAM) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCREEL -INC SMELEME -INC SMCOORD -INC PPARAM -INC CCOPTIO * PARAMETER (XPETI2=XPETIT**2) XPETI2 = xpetit * DIAM2=XGRAND**2 DIAM2 = xgrand SEGACT MELEME NBSOUS=LISOUS(/1) IF(NBSOUS.EQ.0)NBSOUS=1 DO 1 L=1,NBSOUS IF(NBSOUS.EQ.1)THEN IPT1=MELEME ELSE IPT1=LISOUS(L) SEGACT IPT1 ENDIF NP =IPT1.NUM(/1) NEL=IPT1.NUM(/2) IF(NP.EQ.1) THEN C On ne veut pas d'objet de type %m1:8 MOTERR(1:8)='POI1 ' CALL ERREUR(39) RETURN ENDIF DO 10 K=1,NEL C CALCUL DU DIAMETRE MIN DO 321 I=1,NP-1 IPI=IPT1.NUM(I,K) DO 322 J=I+1,NP IPJ=IPT1.NUM(J,K) XM2=0.D0 DO 323 N=1,IDIM XM2=XM2+(XCOOR((IPI-1)*(IDIM+1)+N) $ -XCOOR((IPJ-1)*(IDIM+1)+N))**2 323 CONTINUE DIAM2=MIN(DIAM2,XM2) 322 CONTINUE 321 CONTINUE C * IF(DIAM2.LT.XPETI2) WRITE(6,*) * $ 'xdiamm.eso : un element est peut-etre degenere' 10 CONTINUE IF(NBSOUS.NE.1)SEGDES IPT1 1 CONTINUE SEGDES MELEME DIAM=SQRT(DIAM2) RETURN END