Télécharger pramel.eso

Retour à la liste

Numérotation des lignes :

  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
  37. IF (ICLE.EQ.2) CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP, NUMINI,
  38. # ICLE,IVOI(1),ISUP,QUAL,KON(1,1),NCTIN,NBNN)
  39. SEGSUP KON
  40. IF (ICLE.EQ.2) SEGSUP IVOI
  41. IF (ICLE.EQ.2) RETURN
  42. IF (ICLE.EQ.6) QUAL=QUAL/0.75
  43. IF (ICLE.EQ.10) GOTO 12
  44. ICLE=10
  45. GOTO 11
  46. 12 CONTINUE
  47. SEGINI KON
  48. CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP,NUMINI,ICLE,IVOI(1),ISUP,
  49. # QUAL,KON(1,1),NCTIN,NBNN)
  50. SEGSUP KON
  51. ICLE=2
  52. ITENT=ITENT+1
  53. IF (ITENT.EQ.10) SEGSUP IVOI
  54. IF (ITENT.EQ.10) RETURN
  55. QUAL=QUAL*0.75
  56. IF (IIMPI.EQ.1) WRITE (IOIMP,1000) QUAL
  57. 1000 FORMAT (' NOUVELLE QUALITE TENTEE ',G12.5)
  58. GOTO 11
  59. END
  60.  
  61.  

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