Esope source files

   1 : C RELR1A    SOURCE    GOUNAND   11/05/24    21:15:58     6976           
   2 :       SUBROUTINE RELR1A(MINCD,KRSPGD,KRINCD,
   3 :      $     MEL,DES,
   4 :      $     DDDNUL,
   5 :      $     IMPR,IRET)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 :       IMPLICIT INTEGER (I-N)
   8 : C***********************************************************************
   9 : C NOM         : RELR1A
  10 : C DESCRIPTION :
  11 : *   construction de la correspondance :
  12 : *   ieme ddl dual de la matrice assemblée <->
  13 : *   (numéro d'élément, numéro ddl dual local)
  14 : *   de la rigidité dans lesquels il apparait
  15 : C     
  16 : C     
  17 : C     
  18 : C LANGAGE     : ESOPE
  19 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  20 : C               mél : gounand@semt2.smts.cea.fr
  21 : C***********************************************************************
  22 : C APPELES          :
  23 : C APPELES (E/S)    :
  24 : C APPELES (BLAS)   :
  25 : C APPELES (CALCUL) :
  26 : C APPELE PAR       : RELR14
  27 : C***********************************************************************
  28 : C SYNTAXE GIBIANE    :
  29 : C ENTREES            :
  30 : C ENTREES/SORTIES    :
  31 : C SORTIES            :
  32 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  33 : C***********************************************************************
  34 : C VERSION    : v1, 30/06/2003, version initiale
  35 : C HISTORIQUE : v1, 30/06/2003, création
  36 : C HISTORIQUE :
  37 : C HISTORIQUE :
  38 : C***********************************************************************
  39 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  40 : C en cas de modification de ce sous-programme afin de faciliter
  41 : C la maintenance !
  42 : C***********************************************************************
  43 : -INC CCOPTIO
  44 : -INC SMRIGID
  45 :       POINTEUR DES.DESCR
  46 : -INC SMELEME
  47 :       POINTEUR MEL.MELEME
  48 : * Includes persos
  49 : CBEGININCLUDE SMMINC
  50 :       SEGMENT MINC
  51 :       INTEGER     NPOS(NPT+1)
  52 :       INTEGER     MPOS(NPT,NBI+1)
  53 :       ENDSEGMENT
  54 :       SEGMENT IMINC
  55 :       INTEGER LNUPO (NDDL)
  56 :       INTEGER LNUINC(NDDL)
  57 :       ENDSEGMENT
  58 : CENDINCLUDE SMMINC
  59 :       POINTEUR MINCD.MINC
  60 : *     Segment LSTIND (liste séquentielle indexée)
  61 :       SEGMENT LSTIND
  62 :       INTEGER IDX(NBM+1)
  63 :       INTEGER IELRIG(NBTVAL)
  64 :       INTEGER ILIGR (NBTVAL)
  65 :       ENDSEGMENT
  66 :       POINTEUR DDDNUL.LSTIND
  67 : *     
  68 : -INC SMLENTI
  69 :       POINTEUR KRSPGD.MLENTI
  70 :       POINTEUR KRINCD.MLENTI
  71 :       POINTEUR DDDNOL.MLENTI
  72 :       POINTEUR DDDIUL.MLENTI
  73 : *     
  74 :       INTEGER IMPR,IRET
  75 : *     
  76 : * Executable statements
  77 : *     
  78 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr1a.eso' 
  79 :       NPODUA=MINCD.NPOS(/1)-1
  80 :       NDDLDU=MINCD.NPOS(NPODUA+1)-1
  81 :       NEL=MEL.NUM(/2)
  82 :       NDDLOD=DES.NOELED(/1)
  83 : *     
  84 : *   Passe 1 : construction de la correspondance :
  85 : *             ieme ddl dual  <-> nombre de fois qu'il
  86 : *                                apparait dans MEL
  87 : *             DDDNOL
  88 : *     
  89 :       JG=NDDLDU
  90 :       SEGINI DDDNOL
  91 :       DO IEL=1,NEL
  92 :          DO IDDLOD=1,NDDLOD
  93 :             IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL))
  94 :             IINC=KRINCD.LECT(IDDLOD)
  95 :             IPOS=MINCD.MPOS(IPO,IINC)
  96 :             IF (IPOS.EQ.0) THEN
  97 :                WRITE(IOIMP,*) 'Erreur grave no1'
  98 :                GOTO 9999
  99 :             ENDIF
 100 :             IDDLDU=MINCD.NPOS(IPO)+IPOS-1
 101 :             DDDNOL.LECT(IDDLDU)=DDDNOL.LECT(IDDLDU)+1
 102 :          ENDDO
 103 :       ENDDO
 104 : *     
 105 : *   Passe 2 : construction de la correspondance :
 106 : *             ieme ddl dual <-> (numéro d'élément de MEL)
 107 : *             DDDNUL
 108 :       JG=NDDLDU
 109 :       SEGINI DDDIUL
 110 :       IDEPA=1
 111 :       DO IDDLDU=1,NDDLDU
 112 :          DDDIUL.LECT(IDDLDU)=IDEPA
 113 :          IDEPA=IDEPA+DDDNOL.LECT(IDDLDU)
 114 :       ENDDO
 115 :       SEGSUP DDDNOL
 116 :       NBM=NDDLDU
 117 :       NBTVAL=IDEPA-1
 118 :       SEGINI DDDNUL
 119 :       DO IDDLDU=1,NDDLDU
 120 :          DDDNUL.IDX(IDDLDU)=DDDIUL.LECT(IDDLDU)
 121 :       ENDDO
 122 :       DDDNUL.IDX(NDDLDU+1)=IDEPA
 123 :       DO IEL=1,NEL
 124 :          DO IDDLOD=1,NDDLOD
 125 :             IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL))
 126 :             IINC=KRINCD.LECT(IDDLOD)
 127 :             IPOS=MINCD.MPOS(IPO,IINC)
 128 :             IF (IPOS.EQ.0) THEN
 129 :                WRITE(IOIMP,*) 'Erreur grave no2'
 130 :                GOTO 9999
 131 :             ENDIF
 132 :             IDDLDU=MINCD.NPOS(IPO)+IPOS-1
 133 :             IDXCOU=DDDIUL.LECT(IDDLDU)
 134 :             DDDNUL.IELRIG(IDXCOU)=IEL
 135 :             DDDNUL.ILIGR (IDXCOU)=IDDLOD
 136 :             DDDIUL.LECT(IDDLDU)=IDXCOU+1
 137 :          ENDDO
 138 :       ENDDO
 139 :       SEGSUP DDDIUL
 140 :       SEGDES DDDNUL
 141 : *     
 142 : * Normal termination
 143 : *     
 144 :       IRET=0
 145 :       RETURN
 146 : *     
 147 : * Format handling
 148 : *     
 149 : *     
 150 : * Error handling
 151 : *     
 152 :  9999 CONTINUE
 153 :       IRET=1
 154 :       WRITE(IOIMP,*) 'An error was detected in subroutine relr1a'
 155 :       RETURN
 156 : *     
 157 : * End of subroutine RELR1A
 158 : *     
 159 :       END
 160 : 
 161 :