Télécharger openmm.eso

Retour à la liste

Numérotation des lignes :

  1. C OPENMM SOURCE JC220346 16/03/24 21:15:12 8866
  2. C SORMAT SOURCE JC220346 12/06/18 21:15:25 7403
  3. ************************************************************************
  4. * NOM : openmm.eso
  5. * DESCRIPTION : Ouverture d'un fichier au format MATRIX MARKET (.mm)
  6. * REFERENCES : - The Matrix Market Exchange Formats: Initial Design,
  7. * Boisvert R. F., Pozo R., Remington K. A. (Dec 1996)
  8. * - The Rutherford-Boeing Sparse Matrix Collection,
  9. * Duff I. S., Grimes R. G., Lewis G. L. (Sep 1997)
  10. ************************************************************************
  11. * HISTORIQUE : 4/12/2012 : JCARDO : création de la subroutine
  12. * HISTORIQUE :
  13. * HISTORIQUE :
  14. ************************************************************************
  15. * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES
  16. * en cas de modification de ce sous-programme afin de faciliter
  17. * la maintenance !
  18. ************************************************************************
  19. * APPELÉ PAR : sormat.eso
  20. ************************************************************************
  21.  
  22. SUBROUTINE OPENMM(CHNOMF,CHTYPE,CHTITR,
  23. & IVA1,IVA2,IVA3,
  24. & CVA1)
  25.  
  26. IMPLICIT INTEGER(I-N)
  27. IMPLICIT REAL*8(A-H,O-Z)
  28.  
  29. EXTERNAL LONG
  30.  
  31. -INC CCOPTIO
  32.  
  33. CHARACTER*(*) CHNOMF,CHTYPE,CHTITR,CVA1
  34. CHARACTER*8 CHA8
  35.  
  36.  
  37. * ====================
  38. * OUVERTURE DU FICHIER
  39. * ====================
  40.  
  41. OPEN(UNIT = IOPER ,
  42. & STATUS = 'UNKNOWN' ,
  43. & FILE = CHNOMF(1:LONG(CHNOMF))//'.'//
  44. & CHTYPE(1:LONG(CHTYPE))//'.mm',
  45. & IOSTAT = IOS ,
  46. & FORM = 'FORMATTED' )
  47.  
  48.  
  49. * ====================
  50. * ÉCRITURE DE L'ENTETE
  51. * ====================
  52.  
  53. * Ligne d'entête (OBLIGATOIRE)
  54. WRITE(UNIT=IOPER,FMT='(A,A)')
  55. .'%%MatrixMarket ',CVA1
  56.  
  57. * Nom du programme (commentaire facultatif)
  58. WRITE(UNIT=IOPER,FMT='("%",/,A,/,A)')
  59. .'% PROGRAMME',
  60. .'% CASTEM/SORMAT'
  61.  
  62. * Utilisateur (commentaire facultatif)
  63. CALL GIBNAM(CHA8)
  64. CALL NETCHA(CHA8)
  65. WRITE(UNIT=IOPER,FMT='("%",/,A,/,A)')
  66. .'% UTILISATEUR',
  67. .'% '//CHA8(1:LONG(CHA8))
  68.  
  69. * Date (commentaire facultatif)
  70. CALL GIBDAT(IJOUR,IMOIS,IANNEE)
  71. IANNEE=MOD(IANNEE,100)+2000
  72. WRITE(UNIT=IOPER,FMT='("%",/,A,/,A,I2.2,A1,I2.2,A1,I4)')
  73. .'% DATE',
  74. .'% ',IJOUR,'/',IMOIS,'/',IANNEE
  75.  
  76. * Type de contenu
  77. WRITE(UNIT=IOPER,FMT='("%",/,A)')
  78. .'% CONTENU'
  79. WRITE(UNIT=IOPER,FMT='(A,A)')
  80. .'% ',CHTYPE(1:LONG(CHTYPE))
  81.  
  82. * Titre (commentaire facultatif)
  83. WRITE(UNIT=IOPER,FMT='("%",/,A)')
  84. .'% TITRE'
  85. LC=LONG(CHTITR)
  86. IF (LC.GT.0) THEN
  87. WRITE(UNIT=IOPER,FMT='(A,A)')
  88. . '% ',CHTITR(1:LC)
  89. ELSE
  90. WRITE(UNIT=IOPER,FMT='(A,A)')
  91. . '% ',CHNOMF(1:LONG(CHNOMF))
  92. ENDIF
  93.  
  94. * Nb de lignes et de colonnes + nb de valeurs non nulles si besoin
  95. IF (IVA3.EQ.0) THEN
  96. WRITE(IOPER,FMT='(I12,1X,I12)') IVA1,IVA2
  97. ELSE
  98. WRITE(IOPER,FMT='(I12,2(1X,I12))') IVA1,IVA2,IVA3
  99. ENDIF
  100.  
  101.  
  102.  
  103. RETURN
  104.  
  105. END
  106.  
  107.  
  108.  

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