Télécharger kres3.eso

Retour à la liste

Numérotation des lignes :

  1. C KRES3 SOURCE PV 16/11/17 22:00:23 9180
  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. -INC CCOPTIO
  35. POINTEUR MATASS.MATRIK
  36. *
  37. CHARACTER*4 MRENU,MMULAG
  38. INTEGER IMPR,IRET
  39. *
  40. LOGICAL LRACOU,LCOMPA,LTIME
  41. *
  42. * Executable statements
  43. *
  44. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans kres3.eso'
  45. C On vérifie que MATRIK et MATASS sont compatibles
  46. IF (MATRIK.NE.MATASS) THEN
  47. CALL MCOMPA(MATRIK,MATASS,
  48. $ LCOMPA,
  49. $ IMPR,IRET)
  50. IF (IRET.NE.0) GOTO 9999
  51. IF (.NOT.LCOMPA) THEN
  52. WRITE(IOIMP,*) 'MATRIK et MATASS non compatibles'
  53. GOTO 9999
  54. ENDIF
  55. ENDIF
  56. LRACOU=(MATRIK.NE.MATASS)
  57. IF (.NOT.LRACOU) THEN
  58. * WRITE(IOIMP,*) 'METASS=',METASS
  59. IF (METASS.GE.1.AND.METASS.LE.2) THEN
  60. * Ancien assemblage
  61. * On créait un profil morse entier pour chaque IRIGEL(*,N)
  62. * et on le fusionnait incrémentalement (N fois) au profil morse total
  63. * avec fuspr METASS =1 ou en esope avec fuspr2 : METASS=2 le fortran est
  64. * plus rapide car bp d'adressage indirect semble-t-il)
  65. CALL PRASEM(MATRIK,MRENU,MMULAG,METASS,
  66. $ IMPR,IRET)
  67. IF (IRET.NE.0) GOTO 9999
  68. ELSEIF (METASS.GE.3.AND.METASS.LE.5) THEN
  69. * Nouvel assemblage
  70. * On crée un profil morse réduit pour chaque IRIGEL(*,I)
  71. * avec la liste des ddl duaux sur les lignes ou il y a des termes.
  72. * On les fusionne tous postérieurement (en 1 seul fois).
  73. * La fusion utilise deux passes (METASS=3 une passe pour dimensionner,
  74. * une passe pour remplir) ou une seule (METASS=4 avec SEGADJ)
  75. CALL PRASE3(MATRIK,MRENU,MMULAG,METASS,
  76. $ KTIME,LTIME,
  77. $ IMPR,IRET)
  78. IF (IRET.NE.0) GOTO 9999
  79. ELSE
  80. WRITE(IOIMP,*) 'Programming error'
  81. GOTO 9999
  82. ENDIF
  83. ELSE
  84. CALL PRASE2(MATRIK,MATASS,
  85. $ IMPR,IRET)
  86. IF (IRET.NE.0) GOTO 9999
  87. ENDIF
  88. *
  89. * Normal termination
  90. *
  91. IRET=0
  92. RETURN
  93. *
  94. * Format handling
  95. *
  96. *
  97. * Error handling
  98. *
  99. 9999 CONTINUE
  100. IRET=1
  101. WRITE(IOIMP,*) 'An error was detected in kres3.eso'
  102. RETURN
  103. *
  104. * End of KRES3
  105. *
  106. END
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  

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