1 : C PRAMEL SOURCE CHAT 05/01/13 02:21:20 5004 2 : C CE SOUS PROGRAMME FABRIQUE LE TABLEAU DES CONNECTIONS PAR NOEUD 3 : C POUR ENVOYER A AMELIO 4 : SUBROUTINE PRAMEL(XPROJ,MELEME,NUMELG,NUMNP,NUMINI,ICLE,QUAL, 5 : # NCTIN,NBNN) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : -INC SMELEME 9 : -INC CCOPTIO 10 : SEGMENT IVOI(IRANGE) 11 : SEGMENT /XPROJ/(X(3,1)) 12 : SEGMENT KON(ISUP,IRANGE) 13 : IF (QUAL.LT.0) RETURN 14 : IRANGE=NUMNP-NCTIN+1 15 : SEGINI IVOI 16 : ITENT=0 17 : 11 CONTINUE 18 : ISUP=0 19 : DO 100 I=1,IRANGE 20 : 100 IVOI(I)=0 21 : DO 1 J=1,NBNN 22 : DO 1 I=1,NUMELG 23 : IF (NUM(J,I).EQ.0) GOTO 1 24 : IC=NUM(J,I)-NCTIN+1 25 : IF (IC.LT.1) GOTO 1 26 : IVOI(IC)=IVOI(IC)+1 27 : 1 CONTINUE 28 : IF (IIMPI.EQ.2) WRITE (IOIMP,2001) ((NUM(I,J),I=1,NBNN),J=1, 29 : # NUMELG) 30 : 2001 FORMAT(' LISTE DE L''OBJET APRES SA CREATION',/,(20I4)) 31 : IF (IIMPI.EQ.1) WRITE(IOIMP,2002) QUAL,NUMINI,NUMNP 32 : 2002 FORMAT(' QUAL ',G12.5,' NUMINI ',I5,' NUMNP ',I5) 33 : DO 3 J=1,IRANGE 34 : IF (IVOI(J).GT.ISUP) ISUP=IVOI(J) 35 : 3 CONTINUE 36 : SEGINI KON 36 : IF (ICLE.EQ.2) CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP, NUMINI, 37 : # ICLE,IVOI(1),ISUP,QUAL,KON(1,1),NCTIN,NBNN) 38 : SEGSUP KON 39 : IF (ICLE.EQ.2) SEGSUP IVOI 40 : IF (ICLE.EQ.2) RETURN 41 : IF (ICLE.EQ.6) QUAL=QUAL/0.75 42 : IF (ICLE.EQ.10) GOTO 12 43 : ICLE=10 44 : GOTO 11 45 : 12 CONTINUE 46 : SEGINI KON 46 : CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP,NUMINI,ICLE,IVOI(1),ISUP, 47 : # QUAL,KON(1,1),NCTIN,NBNN) 48 : SEGSUP KON 49 : ICLE=2 50 : ITENT=ITENT+1 51 : IF (ITENT.EQ.10) SEGSUP IVOI 52 : IF (ITENT.EQ.10) RETURN 53 : QUAL=QUAL*0.75 54 : IF (IIMPI.EQ.1) WRITE (IOIMP,1000) QUAL 55 : 1000 FORMAT (' NOUVELLE QUALITE TENTEE ',G12.5) 56 : GOTO 11 57 : END 58 :
© Cast3M 2003 - All rights reserved.
Disclaimer