Esope source files

   1 : C FUSPR5    SOURCE    GOUNAND   11/07/21    21:15:14     7046           
   2 : C FUSPR5    SOURCE    MAGN      09/07/30    21:17:05     6458           
   3 :       SUBROUTINE FUSPR5(PMORSS,NTTDDL,
   4 :      $     PMTOT,
   5 :      $     IMPR,IRET)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 :       IMPLICIT INTEGER (I-N)
   8 : C***********************************************************************
   9 : C NOM         : FUSPR5
  10 : C PROJET      : Assemblage matrice élémentaire -> matrice Morse
  11 : C DESCRIPTION : Assemblage d'un ensemble de profils Morse
  12 : C               Le résultat est dans PMTOT.
  13 : C               Subroutine quasi-identique à FUSPR5. On 
  14 : C               suppose la matrice totale carrée
  15 : C               
  16 : C                   
  17 : C LANGAGE     : ESOPE
  18 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  19 : C               mél : gounand@semt2.smts.cea.fr
  20 : C***********************************************************************
  21 : C APPELES          : 
  22 : C APPELE PAR       : PRASEM, MAKPMT
  23 : C***********************************************************************
  24 : C ENTREES            : PMORSS
  25 : C SORTIES            : PMTOT
  26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27 : C***********************************************************************
  28 : C VERSION    : v1, 13/12/99, version initiale
  29 : C HISTORIQUE : v1, 13/12/99, création
  30 : C HISTORIQUE :
  31 : C HISTORIQUE :
  32 : C***********************************************************************
  33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34 : C en cas de modification de ce sous-programme afin de faciliter
  35 : C la maintenance !
  36 : C***********************************************************************
  37 : *
  38 : -INC CCOPTIO
  39 : -INC SMMATRIK
  40 :       INTEGER NTT,NJA
  41 :       POINTEUR PMCOU.PMORS
  42 :       POINTEUR PMTOT.PMORS
  43 : *
  44 :       SEGMENT PMORSS
  45 :       POINTEUR LISDD(NBPM).MLENTI
  46 :       POINTEUR LISPM(NBPM).PMORS
  47 :       ENDSEGMENT
  48 : *
  49 : 
  50 : -INC SMLENTI
  51 :       POINTEUR LDDCOU.MLENTI
  52 :       POINTEUR INDEX.MLENTI
  53 :       POINTEUR IWORK.MLENTI
  54 : *
  55 :       INTEGER IMPR,IRET
  56 : *
  57 :       INTEGER NTTDU2,NTTDUA,NTTPRI
  58 :       INTEGER NNZTOT
  59 : *
  60 : * Executable statements
  61 : *
  62 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans fuspr5'
  63 :       NBPM=PMORSS.LISDD(/1)
  64 : *
  65 :       DO IPM=1,NBPM
  66 :          LDDCOU=PMORSS.LISDD(IPM)
  67 :          PMCOU=PMORSS.LISPM(IPM)
  68 :          SEGACT LDDCOU
  69 :          SEGACT PMCOU
  70 :       ENDDO
  71 : *
  72 : * On compte le nombre de termes par ligne
  73 : *
  74 :       NTT=NTTDDL
  75 :       NJA=0
  76 :       SEGINI PMTOT
  77 : * Ici IA est le nombre de termes par ligne
  78 :       DO IPM=1,NBPM
  79 :          LDDCOU=PMORSS.LISDD(IPM)
  80 :          PMCOU=PMORSS.LISPM(IPM)
  81 :          NLIG=PMCOU.IA(/1)-1
  82 :          DO ILIG=1,NLIG
  83 :             ILIGG=LDDCOU.LECT(ILIG)
  84 :             NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
  85 :             PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
  86 :             NJA=NJA+NCOL
  87 :          ENDDO
  88 :       ENDDO
  89 :       SEGADJ PMTOT
  90 : * Calcul de NJA
  91 : *  Maintenant, IA va être le pointeur sur l'indice courant dans JA      
  92 :       NCOL1=PMTOT.IA(1)
  93 :       PMTOT.IA(1)=1
  94 :       DO ITT=1,NTT
  95 :          NCOL=PMTOT.IA(ITT+1)
  96 :          PMTOT.IA(ITT+1)=PMTOT.IA(ITT)+NCOL1
  97 :          NCOL1=NCOL
  98 :       ENDDO
  99 : *
 100 : * Remplissage de PMTOT
 101 : *
 102 :       DO IPM=1,NBPM
 103 :          LDDCOU=PMORSS.LISDD(IPM)
 104 :          PMCOU=PMORSS.LISPM(IPM)
 105 :          NLIG=PMCOU.IA(/1)-1
 106 :          DO ILIG=1,NLIG
 107 :             ILIGG=LDDCOU.LECT(ILIG)
 108 :             NCOL=PMCOU.IA(ILIG+1)-PMCOU.IA(ILIG)
 109 :             DO ICOL=1,NCOL
 110 :                IJA=PMCOU.IA(ILIG)+ICOL-1
 111 :                IJAG=PMTOT.IA(ILIGG)+ICOL-1
 112 :                PMTOT.JA(IJAG)=PMCOU.JA(IJA)
 113 :             ENDDO
 114 :             PMTOT.IA(ILIGG)=PMTOT.IA(ILIGG)+NCOL
 115 :          ENDDO
 116 :       ENDDO
 117 : *  On rétablit IA comme pointeur sur le premier indice courant dans JA      
 118 :       DO ITT=NTT,1,-1
 119 :          PMTOT.IA(ITT+1)=PMTOT.IA(ITT)
 120 :       ENDDO
 121 :       PMTOT.IA(1)=1
 122 :       DO IPM=1,NBPM
 123 :          LDDCOU=PMORSS.LISDD(IPM)
 124 :          PMCOU=PMORSS.LISPM(IPM)
 125 :          SEGDES LDDCOU
 126 :          SEGDES PMCOU
 127 :       ENDDO
 128 :       SEGDES PMTOT
 129 : *
 130 : * Normal termination
 131 : *
 132 :       IRET=0
 133 :       RETURN
 134 : *
 135 : * Format handling
 136 : *
 137 : *
 138 : * Error handling
 139 : *
 140 :  9999 CONTINUE
 141 :       IRET=1
 142 :       WRITE(IOIMP,*) 'An error was detected in subroutine fuspr5'
 143 :       RETURN
 144 : *
 145 : * End of subroutine FUSPR5
 146 : *
 147 :       END
 148 : 
 149 :  
 150 :  
 151 :  
 152 :  
 153 :