Sources Esope | Cast3M

fuspr5
C FUSPR5    SOURCE    PV        20/09/26    21:17:00     10724          
C FUSPR5    SOURCE    MAGN      09/07/30    21:17:05     6458
      SUBROUTINE FUSPR5(PMORSS,NTTDDL,
     $     PMTOT,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : FUSPR5
C PROJET      : Assemblage matrice élémentaire -> matrice Morse
C DESCRIPTION : Assemblage d'un ensemble de profils Morse
C               Le résultat est dans PMTOT.
C               Subroutine quasi-identique à FUSPR5. On
C               suppose la matrice totale carrée
C
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          :
C APPELE PAR       : PRASEM, MAKPMT
C***********************************************************************
C ENTREES            : PMORSS
C SORTIES            : PMTOT
C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
C***********************************************************************
C VERSION    : v1, 13/12/99, version initiale
C HISTORIQUE : v1, 13/12/99, 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
      INTEGER NTT,NJA
      POINTEUR PMCOU.PMORS
      POINTEUR PMTOT.PMORS
*
      SEGMENT PMORSS
      POINTEUR LISDD(NBPM).MLENTI
      POINTEUR LISPM(NBPM).PMORS
      ENDSEGMENT
*
 
-INC SMLENTI
      POINTEUR LDDCOU.MLENTI
      POINTEUR INDEX.MLENTI
      POINTEUR IWORK.MLENTI
*
      INTEGER IMPR,IRET
*
      INTEGER NTTDU2,NTTDUA,NTTPRI
      INTEGER NNZTOT
*
* Executable statements
*
      IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fuspr5'
      NBPM=PMORSS.LISDD(/1)
*
      DO IPM=1,NBPM
         LDDCOU=PMORSS.LISDD(IPM)
         PMCOU=PMORSS.LISPM(IPM)
         SEGACT LDDCOU
         SEGACT PMCOU
      ENDDO
*
* On compte le nombre de termes par ligne
*
      NTT=NTTDDL
      NJA=0
      SEGINI PMTOT
* Ici IA est le nombre de termes par ligne
      DO IPM=1,NBPM
         LDDCOU=PMORSS.LISDD(IPM)
         PMCOU=PMORSS.LISPM(IPM)
         NLIG=PMCOU.IA(/1)-1
         DO ILIG=1,NLIG
            ILIGG=LDDCOU.LECT(ILIG)
            NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
            PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
            NJA=NJA+NCOL
         ENDDO
      ENDDO
      SEGADJ PMTOT
* Calcul de NJA
*  Maintenant, IA va être le pointeur sur l'indice courant dans JA
      NCOL1=PMTOT.IA(1)
      PMTOT.IA(1)=1
      DO ITT=1,NTT
         NCOL=PMTOT.IA(ITT+1)
         PMTOT.IA(ITT+1)=PMTOT.IA(ITT)+NCOL1
         NCOL1=NCOL
      ENDDO
*
* Remplissage de PMTOT
*
      DO IPM=1,NBPM
         LDDCOU=PMORSS.LISDD(IPM)
         PMCOU=PMORSS.LISPM(IPM)
         NLIG=PMCOU.IA(/1)-1
         DO ILIG=1,NLIG
            ILIGG=LDDCOU.LECT(ILIG)
            NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
            DO ICOL=1,NCOL
               IJA=PMCOU.IA(ILIG)+ICOL-1
               IJAG=PMTOT.IA(ILIGG)+ICOL-1
               PMTOT.JA(IJAG)=PMCOU.JA(IJA)
            ENDDO
            PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
         ENDDO
      ENDDO
*  On rétablit IA comme pointeur sur le premier indice courant dans JA
      DO ITT=NTT,1,-1
         PMTOT.IA(ITT+1)=PMTOT.IA(ITT)
      ENDDO
      PMTOT.IA(1)=1
      DO IPM=1,NBPM
         LDDCOU=PMORSS.LISDD(IPM)
         PMCOU=PMORSS.LISPM(IPM)
         SEGDES LDDCOU
         SEGDES PMCOU
      ENDDO
      SEGDES PMTOT
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine fuspr5'
      RETURN
*
* End of subroutine FUSPR5
*
      END