Sources Esope | Cast3M

kres3
C KRES3     SOURCE    GOUNAND   22/08/25    21:15:06     11434          
      SUBROUTINE KRES3(MATRIK,MATASS,MRENU,MMULAG,METASS,
     $     KTIME,LTIME,
     $     IMPR,IRET)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C NOM         : KRES3
C DESCRIPTION : Effectue l'assemblage d'une matrice.
C               Conversion du format matrices élémentaires
C               au format matrice Morse.
C
C LANGAGE     : ESOPE
C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
C               mél : gounand@semt2.smts.cea.fr
C***********************************************************************
C APPELES          : MCOMPA, PRASEM, PRASE2
C APPELE PAR       : KRES2
C***********************************************************************
C ENTREES            : MRENU, MMULAG
C ENTREES/SORTIES    : MATRIK, MATASS
C SORTIES            : -
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 14/04/2000, version initiale
C HISTORIQUE : v1, 14/04/2000, création
C HISTORIQUE :
C HISTORIQUE :
C***********************************************************************
C Prière de PRENDRE LE TEMPS de compléter les commentaires
C en cas de modification de ce sous-programme afin de faciliter
C la maintenance !
C***********************************************************************
 
-INC PPARAM
-INC CCOPTIO
-INC SMMATRIK
      POINTEUR MATASS.MATRIK
*
      CHARACTER*4 MRENU,MMULAG
      INTEGER IMPR,IRET
*
      LOGICAL LRACOU,LCOMPA,LTIME
*
* Executable statements
*
      IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans kres3.eso'
C  On vérifie que MATRIK et MATASS sont compatibles
      IF (MATRIK.NE.MATASS) THEN
         CALL MCOMPA(MATRIK,MATASS,
     $        LCOMPA,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         IF (.NOT.LCOMPA) THEN
            WRITE(IOIMP,*) 'MATRIK et MATASS non compatibles'
            GOTO 9999
         ENDIF
      ENDIF
      LRACOU=(MATRIK.NE.MATASS)
      IF (.NOT.LRACOU) THEN
*         WRITE(IOIMP,*) 'METASS=',METASS
         IF (METASS.GE.1.AND.METASS.LE.2) THEN
* Ancien assemblage
* On créait un profil morse entier pour chaque IRIGEL(*,N)
* et on le fusionnait incrémentalement (N fois) au profil morse total
* avec fuspr METASS =1 ou en esope avec fuspr2 : METASS=2 le fortran est
* plus rapide car bp d'adressage indirect semble-t-il)
            CALL PRASEM(MATRIK,MRENU,MMULAG,METASS,
     $           IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ELSEIF (METASS.GE.3.AND.METASS.LE.5) THEN
* Nouvel assemblage
* On crée un profil morse réduit pour chaque IRIGEL(*,I)
* avec la liste des ddl duaux sur les lignes ou il y a des termes.
* On les fusionne tous postérieurement (en 1 seul fois).
* La fusion utilise deux passes (METASS=3 une passe pour dimensionner,
* une passe pour remplir) ou une seule (METASS=4 avec SEGADJ)
            CALL PRASE3(MATRIK,MRENU,MMULAG,METASS,
     $           KTIME,LTIME,
     $           IMPR,IRET)
* Gestion du CTRL-C
            if (ierr.NE.0) return
            IF (IRET.NE.0) GOTO 9999
         ELSE
            WRITE(IOIMP,*) 'Programming error'
            GOTO 9999
         ENDIF
      ELSE
         CALL PRASE2(MATRIK,MATASS,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in kres3.eso'
      RETURN
*
* End of KRES3
*
      END