Télécharger la plaquette Cast3M


fr en

Télécharger profi2.eso

Retour à la liste

Numérotation des lignes : 

profi2

  1. C PROFI2    SOURCE    PV        20/09/26    21:19:36     10724          
  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.  
  31. -INC PPARAM
  32. -INC CCOPTIO
  34.       POINTEUR PROMOR.PMORS
  35.       INTEGER IMPR,IRET
  36.       INTEGER VALPRO,VALMIN,I,J,JSTRT,JSTOP
  37. *
  38. * Executable statements
  39. *
  40.       IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans profi2'
  41. *
  43.       SEGACT PROMOR
  44.       DO 20 I=1,PROMOR.IA(/1)-1
  45.          JSTRT=PROMOR.IA(I)
  46.          JSTOP=PROMOR.IA(I+1)-1
  47.          VALMIN=PROMOR.JA(JSTRT)
  48. *
  49. *     Find lowest numbered neighbour of node I
  50. *
  51.          DO 10 J=JSTRT+1,JSTOP
  52.             VALMIN=MIN(VALMIN,PROMOR.JA(J))
  53.  10      CONTINUE
  54. *
  55. *     Update profiles
  56. *
  57.          VALPRO=VALPRO+DIM(I,VALMIN)
  58.  20   CONTINUE
  59. *
  60. *     Add diagonal terms to profiles
  61. *
  62.       VALPRO=VALPRO+PROMOR.IA(/1)-1
  63.       SEGDES PROMOR
  64. *
  65. * Normal termination
  66. *
  67.       IRET=0
  68.       RETURN
  69. *
  70. * Format handling
  71. *
  72. *
  73. * Error handling
  74. *
  75.  9999 CONTINUE
  76.       IRET=1
  77.       WRITE(IOIMP,*) 'An error was detected in subroutine profi2'
  78.       RETURN
  79. *
  80. * End of subroutine PROFI2
  81. *
  82.       END
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  

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