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.  
  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. IF (IRET.NE.0) GOTO 9999
  81. ELSE
  82. WRITE(IOIMP,*) 'Programming error'
  83. GOTO 9999
  84. ENDIF
  85. ELSE
  86. CALL PRASE2(MATRIK,MATASS,
  87. $ IMPR,IRET)
  88. IF (IRET.NE.0) GOTO 9999
  89. ENDIF
  90. *
  91. * Normal termination
  92. *
  93. IRET=0
  94. RETURN
  95. *
  96. * Format handling
  97. *
  98. *
  99. * Error handling
  100. *
  101. 9999 CONTINUE
  102. IRET=1
  103. WRITE(IOIMP,*) 'An error was detected in kres3.eso'
  104. RETURN
  105. *
  106. * End of KRES3
  107. *
  108. END
  109.  
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  

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