Numérotation des lignes :

C PRAMEL    SOURCE    CHAT      05/01/13    02:21:20     5004C   CE SOUS PROGRAMME FABRIQUE LE TABLEAU DES CONNECTIONS PAR NOEUDC   POUR ENVOYER A AMELIO      SUBROUTINE PRAMEL(XPROJ,MELEME,NUMELG,NUMNP,NUMINI,ICLE,QUAL,     # NCTIN,NBNN)      IMPLICIT INTEGER(I-N)      IMPLICIT REAL*8 (A-H,O-Z)-INC SMELEME -INC PPARAM-INC CCOPTIO      SEGMENT IVOI(IRANGE)      SEGMENT /XPROJ/(X(3,1))      SEGMENT KON(ISUP,IRANGE)      IF (QUAL.LT.0) RETURN      IRANGE=NUMNP-NCTIN+1      SEGINI IVOI      ITENT=0  11  CONTINUE      ISUP=0      DO 100 I=1,IRANGE 100  IVOI(I)=0      DO  1 J=1,NBNN      DO 1 I=1,NUMELG      IF (NUM(J,I).EQ.0) GOTO 1      IC=NUM(J,I)-NCTIN+1      IF (IC.LT.1) GOTO 1      IVOI(IC)=IVOI(IC)+1   1  CONTINUE      IF (IIMPI.EQ.2) WRITE (IOIMP,2001) ((NUM(I,J),I=1,NBNN),J=1,     #   NUMELG) 2001 FORMAT(' LISTE DE L''OBJET APRES SA CREATION',/,(20I4))      IF (IIMPI.EQ.1) WRITE(IOIMP,2002) QUAL,NUMINI,NUMNP 2002 FORMAT(' QUAL ',G12.5,' NUMINI ',I5,' NUMNP ',I5)      DO 3 J=1,IRANGE      IF (IVOI(J).GT.ISUP) ISUP=IVOI(J)   3  CONTINUE      SEGINI KON      IF (ICLE.EQ.2) CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP, NUMINI,     #  ICLE,IVOI(1),ISUP,QUAL,KON(1,1),NCTIN,NBNN)      SEGSUP KON      IF (ICLE.EQ.2) SEGSUP IVOI      IF (ICLE.EQ.2) RETURN      IF (ICLE.EQ.6) QUAL=QUAL/0.75      IF (ICLE.EQ.10) GOTO 12      ICLE=10      GOTO 11  12  CONTINUE      SEGINI KON      CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP,NUMINI,ICLE,IVOI(1),ISUP,     #  QUAL,KON(1,1),NCTIN,NBNN)      SEGSUP KON      ICLE=2      ITENT=ITENT+1      IF (ITENT.EQ.10) SEGSUP IVOI      IF (ITENT.EQ.10) RETURN      QUAL=QUAL*0.75      IF (IIMPI.EQ.1) WRITE (IOIMP,1000) QUAL 1000 FORMAT (' NOUVELLE QUALITE TENTEE ',G12.5)      GOTO 11      END

© Cast3M 2003 - Tous droits réservés.
Mentions légales