Esope source files

   1 : C RELR1D    SOURCE    GOUNAND   12/07/23    21:15:06     7441           
   2 :       SUBROUTINE RELR1D(MINCP,KRSPGP,KRINCP,
   3 :      $     MINCD,KRSPGD,KRINCD,
   4 :      $     COEF,MEL,DES,XMAT,
   5 :      $     PROFM,
   6 :      $     VALM,
   7 :      $     IMPR,IRET)
   8 :       IMPLICIT REAL*8 (A-H,O-Z)
   9 :       IMPLICIT INTEGER (I-N)
  10 : C***********************************************************************
  11 : C NOM         : RELR1D
  12 : C DESCRIPTION :
  13 : * Compléter les valeurs de la matrice morse avec celles
  14 : * de XMAT
  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, 01/07/2003, version initiale
  35 : C HISTORIQUE : v1, 01/07/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 : *      POINTEUR IMAT.IMATRI
  47 :       POINTEUR XMAT.XMATRI
  48 : -INC SMELEME
  49 :       POINTEUR MEL.MELEME
  50 : * Includes persos
  51 : CBEGININCLUDE SMMINC
  52 :       SEGMENT MINC
  53 :       INTEGER     NPOS(NPT+1)
  54 :       INTEGER     MPOS(NPT,NBI+1)
  55 :       ENDSEGMENT
  56 :       SEGMENT IMINC
  57 :       INTEGER LNUPO (NDDL)
  58 :       INTEGER LNUINC(NDDL)
  59 :       ENDSEGMENT
  60 : CENDINCLUDE SMMINC
  61 :       POINTEUR MINCP.MINC
  62 :       POINTEUR MINCD.MINC
  63 : CBEGININCLUDE SMPMORS
  64 :       SEGMENT PMORS
  65 :       INTEGER IA (NTT+1)
  66 :       INTEGER JA (NJA)
  67 :       ENDSEGMENT
  68 : CENDINCLUDE SMPMORS
  69 :       POINTEUR PROFM.PMORS
  70 : CBEGININCLUDE SMIZA
  71 :       SEGMENT IZA
  72 :       REAL*8  A(NBVA)
  73 :       ENDSEGMENT
  74 : CENDINCLUDE SMIZA
  75 :       POINTEUR VALM.IZA
  76 : *
  77 : -INC SMLENTI
  78 :       POINTEUR KJSPGP.MLENTI
  79 :       POINTEUR KJSPGD.MLENTI
  80 :       POINTEUR KRSPGP.MLENTI
  81 :       POINTEUR KRSPGD.MLENTI
  82 :       POINTEUR KRINCP.MLENTI
  83 :       POINTEUR KRINCD.MLENTI
  84 : *     
  85 :       INTEGER IMPR,IRET
  86 : *     
  87 : * Executable statements
  88 : *     
  89 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr1d.eso' 
  90 :       NEL=MEL.NUM(/2)
  91 : *      NEL2=IMAT.IMATTT(/1)
  92 :       NEL2=XMAT.RE(/3)
  93 :       IF (NEL.NE.NEL2) THEN
  94 :          WRITE(IOIMP,*) 'Erreur grave no1'
  95 :          GOTO 9999
  96 :       ENDIF
  97 :       NLIGRP=DES.NOELEP(/1)
  98 :       NLIGRD=DES.NOELED(/1)
  99 :       DO IEL=1,NEL
 100 : *         XMAT=IMAT.IMATTT(IEL)
 101 : *         SEGACT XMAT
 102 :          DO ILIGRD=1,NLIGRD
 103 :             IPODU=KRSPGD.LECT(MEL.NUM(DES.NOELED(ILIGRD),IEL))
 104 :             IINCDU=KRINCD.LECT(ILIGRD)
 105 :             IPOSDU=MINCD.MPOS(IPODU,IINCDU)
 106 :             IF (IPOSDU.EQ.0) THEN
 107 :                WRITE(IOIMP,*) 'Erreur grave no1'
 108 :                GOTO 9999
 109 :             ENDIF
 110 :             IDDLDU=MINCD.NPOS(IPODU)+IPOSDU-1
 111 :             DO ILIGRP=1,NLIGRP
 112 :                IPOPR=KRSPGP.LECT(MEL.NUM(DES.NOELEP(ILIGRP),IEL))
 113 :                IINCPR=KRINCP.LECT(ILIGRP)
 114 :                IPOSPR=MINCP.MPOS(IPOPR,IINCPR)
 115 :                IF (IPOSPR.EQ.0) THEN
 116 :                   WRITE(IOIMP,*) 'Erreur grave no2'
 117 :                   GOTO 9999
 118 :                ENDIF
 119 :                IDDLPR=MINCP.NPOS(IPOPR)+IPOSPR-1
 120 :                IBVA=PROFM.IA(IDDLDU)
 121 :                LBVA=PROFM.IA(IDDLDU+1)-IBVA
 122 : * A quel index du profil morse trouve-t-on le ddl IDDLPR ?
 122 :                CALL IFIDIC(LBVA,PROFM.JA(IBVA),IDDLPR,
 123 :      $              JBVA,
 124 :      $              IMPR,IRET)
 125 :                IF (IRET.NE.0) GOTO 9999
 126 :                VALM.A(IBVA+JBVA-1)=
 127 :      $              VALM.A(IBVA+JBVA-1)+
 128 :      $              (COEF*XMAT.RE(ILIGRD,ILIGRP,IEL))
 129 :             ENDDO
 130 :          ENDDO
 131 : *         WRITE(IOIMP,*) 'IEL=',IEL
 131 : *         CALL ECMORS(PROFM,VALM,3) 
 132 : *         SEGDES XMAT
 133 :       ENDDO
 134 : *     
 135 : * Normal termination
 136 : *     
 137 :       IRET=0
 138 :       RETURN
 139 : *     
 140 : * Format handling
 141 : *     
 142 : *     
 143 : * Error handling
 144 : *     
 145 :  9999 CONTINUE
 146 :       IRET=1
 147 :       WRITE(IOIMP,*) 'An error was detected in subroutine relr1d'
 148 :       RETURN
 149 : *     
 150 : * End of subroutine RELR1D
 151 : *     
 152 :       END
 153 : 
 154 :  
 155 :