Esope source files

   1 : C KRES3     SOURCE    GOUNAND   11/07/21    21:15:23     7046           
   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 : -INC SMMATRIK
  36 :       POINTEUR MATASS.MATRIK
  37 : *
  38 :       CHARACTER*4 MRENU,MMULAG
  39 :       INTEGER IMPR,IRET
  40 : *
  41 :       LOGICAL LRACOU,LCOMPA,LTIME
  42 : *     
  43 : * Executable statements
  44 : *
  45 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans kres3.eso' 
  46 : C  On vérifie que MATRIK et MATASS sont compatibles
  47 :       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)
  64 :             CALL PRASEM(MATRIK,MRENU,MMULAG,METASS,
  65 :      $           IMPR,IRET)
  66 :             IF (IRET.NE.0) GOTO 9999
  67 :          ELSEIF (METASS.GE.3.AND.METASS.LE.5) THEN
  68 : * Nouvel assemblage
  69 : * On crée un profil morse réduit pour chaque IRIGEL(*,I)
  70 : * avec la liste des ddl duaux sur les lignes ou il y a des termes.
  71 : * On les fusionne tous postérieurement (en 1 seul fois).
  72 : * La fusion utilise deux passes (METASS=3 une passe pour dimensionner,
  73 : * une passe pour remplir) ou une seule (METASS=4 avec SEGADJ)
  73 :             CALL PRASE3(MATRIK,MRENU,MMULAG,METASS,
  74 :      $           KTIME,LTIME,
  75 :      $           IMPR,IRET)
  76 :             IF (IRET.NE.0) GOTO 9999
  77 :          ELSE
  78 :             WRITE(IOIMP,*) 'Programming error'
  79 :             GOTO 9999
  80 :          ENDIF
  81 :       ELSE
  81 :          CALL PRASE2(MATRIK,MATASS,
  82 :      $        IMPR,IRET)
  83 :          IF (IRET.NE.0) GOTO 9999
  84 :       ENDIF
  85 : *     
  86 : * Normal termination
  87 : *     
  88 :       IRET=0
  89 :       RETURN
  90 : *     
  91 : * Format handling
  92 : *     
  93 : *     
  94 : * Error handling
  95 : *     
  96 :  9999 CONTINUE
  97 :       IRET=1
  98 :       WRITE(IOIMP,*) 'An error was detected in kres3.eso'
  99 :       RETURN
 100 : *     
 101 : * End of KRES3
 102 : *     
 103 :       END
 104 : 
 105 : 
 106 : 
 107 : 
 108 : 
 109 : 
 110 : 
 111 :  
 112 :  
 113 :  
 114 :  
 115 :  
 116 :  
 117 :  
 118 :  
 119 :  
 120 :  
 121 :