Télécharger kres3.eso

Retour à la liste

Numérotation des lignes :

kres3
  1. C KRES3 SOURCE GOUNAND 22/08/25 21:15:06 11434
  2. SUBROUTINE KRES3(MATRIK,MATASS,MRENU,MMULAG,METASS,
  3. $ KTIME,LTIME,
  4. $ IMPR,IRET)
  5. IMPLICIT INTEGER(I-N)
  6. IMPLICIT REAL*8 (A-H,O-Z)
  7. C***********************************************************************
  8. C NOM : KRES3
  9. C DESCRIPTION : Effectue l'assemblage d'une matrice.
  10. C Conversion du format matrices élémentaires
  11. C au format matrice Morse.
  12. C
  13. C LANGAGE : ESOPE
  14. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15. C mél : gounand@semt2.smts.cea.fr
  16. C***********************************************************************
  17. C APPELES : MCOMPA, PRASEM, PRASE2
  18. C APPELE PAR : KRES2
  19. C***********************************************************************
  20. C ENTREES : MRENU, MMULAG
  21. C ENTREES/SORTIES : MATRIK, MATASS
  22. C SORTIES : -
  23. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  24. C***********************************************************************
  25. C VERSION : v1, 14/04/2000, version initiale
  26. C HISTORIQUE : v1, 14/04/2000, création
  27. C HISTORIQUE :
  28. C HISTORIQUE :
  29. C***********************************************************************
  30. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  31. C en cas de modification de ce sous-programme afin de faciliter
  32. C la maintenance !
  33. C***********************************************************************
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. POINTEUR MATASS.MATRIK
  38. *
  39. CHARACTER*4 MRENU,MMULAG
  40. INTEGER IMPR,IRET
  41. *
  42. LOGICAL LRACOU,LCOMPA,LTIME
  43. *
  44. * Executable statements
  45. *
  46. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans kres3.eso'
  47. C On vérifie que MATRIK et MATASS sont compatibles
  48. IF (MATRIK.NE.MATASS) THEN
  49. CALL MCOMPA(MATRIK,MATASS,
  50. $ LCOMPA,
  51. $ IMPR,IRET)
  52. IF (IRET.NE.0) GOTO 9999
  53. IF (.NOT.LCOMPA) THEN
  54. WRITE(IOIMP,*) 'MATRIK et MATASS non compatibles'
  55. GOTO 9999
  56. ENDIF
  57. ENDIF
  58. LRACOU=(MATRIK.NE.MATASS)
  59. IF (.NOT.LRACOU) THEN
  60. * WRITE(IOIMP,*) 'METASS=',METASS
  61. IF (METASS.GE.1.AND.METASS.LE.2) THEN
  62. * Ancien assemblage
  63. * On créait un profil morse entier pour chaque IRIGEL(*,N)
  64. * et on le fusionnait incrémentalement (N fois) au profil morse total
  65. * avec fuspr METASS =1 ou en esope avec fuspr2 : METASS=2 le fortran est
  66. * plus rapide car bp d'adressage indirect semble-t-il)
  67. CALL PRASEM(MATRIK,MRENU,MMULAG,METASS,
  68. $ IMPR,IRET)
  69. IF (IRET.NE.0) GOTO 9999
  70. ELSEIF (METASS.GE.3.AND.METASS.LE.5) THEN
  71. * Nouvel assemblage
  72. * On crée un profil morse réduit pour chaque IRIGEL(*,I)
  73. * avec la liste des ddl duaux sur les lignes ou il y a des termes.
  74. * On les fusionne tous postérieurement (en 1 seul fois).
  75. * La fusion utilise deux passes (METASS=3 une passe pour dimensionner,
  76. * une passe pour remplir) ou une seule (METASS=4 avec SEGADJ)
  77. CALL PRASE3(MATRIK,MRENU,MMULAG,METASS,
  78. $ KTIME,LTIME,
  79. $ IMPR,IRET)
  80. * Gestion du CTRL-C
  81. if (ierr.NE.0) return
  82. IF (IRET.NE.0) GOTO 9999
  83. ELSE
  84. WRITE(IOIMP,*) 'Programming error'
  85. GOTO 9999
  86. ENDIF
  87. ELSE
  88. CALL PRASE2(MATRIK,MATASS,
  89. $ IMPR,IRET)
  90. IF (IRET.NE.0) GOTO 9999
  91. ENDIF
  92. *
  93. * Normal termination
  94. *
  95. IRET=0
  96. RETURN
  97. *
  98. * Format handling
  99. *
  100. *
  101. * Error handling
  102. *
  103. 9999 CONTINUE
  104. IRET=1
  105. WRITE(IOIMP,*) 'An error was detected in kres3.eso'
  106. RETURN
  107. *
  108. * End of KRES3
  109. *
  110. END
  111.  
  112.  

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