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.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. SEGMENT IVOI(IRANGE)
  13. SEGMENT /XPROJ/(X(3,1))
  14. SEGMENT KON(ISUP,IRANGE)
  15. IF (QUAL.LT.0) RETURN
  16. IRANGE=NUMNP-NCTIN+1
  17. SEGINI IVOI
  18. ITENT=0
  19. 11 CONTINUE
  20. ISUP=0
  21. DO 100 I=1,IRANGE
  22. 100 IVOI(I)=0
  23. DO 1 J=1,NBNN
  24. DO 1 I=1,NUMELG
  25. IF (NUM(J,I).EQ.0) GOTO 1
  26. IC=NUM(J,I)-NCTIN+1
  27. IF (IC.LT.1) GOTO 1
  28. IVOI(IC)=IVOI(IC)+1
  29. 1 CONTINUE
  30. IF (IIMPI.EQ.2) WRITE (IOIMP,2001) ((NUM(I,J),I=1,NBNN),J=1,
  31. # NUMELG)
  32. 2001 FORMAT(' LISTE DE L''OBJET APRES SA CREATION',/,(20I4))
  33. IF (IIMPI.EQ.1) WRITE(IOIMP,2002) QUAL,NUMINI,NUMNP
  34. 2002 FORMAT(' QUAL ',G12.5,' NUMINI ',I5,' NUMNP ',I5)
  35. DO 3 J=1,IRANGE
  36. IF (IVOI(J).GT.ISUP) ISUP=IVOI(J)
  37. 3 CONTINUE
  38. SEGINI KON
  39. IF (ICLE.EQ.2) CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP, NUMINI,
  40. # ICLE,IVOI(1),ISUP,QUAL,KON(1,1),NCTIN,NBNN)
  41. SEGSUP KON
  42. IF (ICLE.EQ.2) SEGSUP IVOI
  43. IF (ICLE.EQ.2) RETURN
  44. IF (ICLE.EQ.6) QUAL=QUAL/0.75
  45. IF (ICLE.EQ.10) GOTO 12
  46. ICLE=10
  47. GOTO 11
  48. 12 CONTINUE
  49. SEGINI KON
  50. CALL AMELIO(X(1,1),NUM(1,1),NUMELG,NUMNP,NUMINI,ICLE,IVOI(1),ISUP,
  51. # QUAL,KON(1,1),NCTIN,NBNN)
  52. SEGSUP KON
  53. ICLE=2
  54. ITENT=ITENT+1
  55. IF (ITENT.EQ.10) SEGSUP IVOI
  56. IF (ITENT.EQ.10) RETURN
  57. QUAL=QUAL*0.75
  58. IF (IIMPI.EQ.1) WRITE (IOIMP,1000) QUAL
  59. 1000 FORMAT (' NOUVELLE QUALITE TENTEE ',G12.5)
  60. GOTO 11
  61. END
  62.  
  63.  

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