Télécharger profi2.eso

Retour à la liste

Numérotation des lignes :

  1. C PROFI2 SOURCE PV 16/11/17 22:01:16 9180
  2. SUBROUTINE PROFI2(PROMOR,
  3. $ VALPRO,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : PROFI2
  9. C DESCRIPTION : Valeur du profil d'un profil Morse (non ordonné).
  10. C
  11. C LANGAGE : ESOPE
  12. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  13. C mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C APPELE PAR : PRASEM
  16. C***********************************************************************
  17. C ENTREES : PROMOR
  18. C SORTIES : VALPRO
  19. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  20. C***********************************************************************
  21. C VERSION : v1, 08/11/99, version initiale
  22. C HISTORIQUE : v1, 08/11/99, création
  23. C HISTORIQUE :
  24. C HISTORIQUE :
  25. C***********************************************************************
  26. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  27. C en cas de modification de ce sous-programme afin de faciliter
  28. C la maintenance !
  29. C***********************************************************************
  30. -INC CCOPTIO
  31. POINTEUR PROMOR.PMORS
  32. INTEGER IMPR,IRET
  33. INTEGER VALPRO,VALMIN,I,J,JSTRT,JSTOP
  34. *
  35. * Executable statements
  36. *
  37. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans profi2'
  38. *
  39. SEGACT PROMOR
  40. DO 20 I=1,PROMOR.IA(/1)-1
  41. JSTRT=PROMOR.IA(I)
  42. JSTOP=PROMOR.IA(I+1)-1
  43. VALMIN=PROMOR.JA(JSTRT)
  44. *
  45. * Find lowest numbered neighbour of node I
  46. *
  47. DO 10 J=JSTRT+1,JSTOP
  48. VALMIN=MIN(VALMIN,PROMOR.JA(J))
  49. 10 CONTINUE
  50. *
  51. * Update profiles
  52. *
  53. VALPRO=VALPRO+DIM(I,VALMIN)
  54. 20 CONTINUE
  55. *
  56. * Add diagonal terms to profiles
  57. *
  58. VALPRO=VALPRO+PROMOR.IA(/1)-1
  59. SEGDES PROMOR
  60. *
  61. * Normal termination
  62. *
  63. IRET=0
  64. RETURN
  65. *
  66. * Format handling
  67. *
  68. *
  69. * Error handling
  70. *
  71. 9999 CONTINUE
  72. IRET=1
  73. WRITE(IOIMP,*) 'An error was detected in subroutine profi2'
  74. RETURN
  75. *
  76. * End of subroutine PROFI2
  77. *
  78. END
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  

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