Esope source files

   1 : C KOPIDR    SOURCE    GOUNAND   11/05/24    21:15:32     6976           
   2 :       SUBROUTINE KOPIDR(IGEOM,LPRIM,MRIGID)
   3 :       IMPLICIT REAL*8 (A-H,O-Z)
   4 :       IMPLICIT INTEGER (I-N)
   5 : C***********************************************************************
   6 : C NOM         : KOPIDR
   7 : C DESCRIPTION : Transforme un CHPOINt MCHPOI en matrice 
   8 : C               diagonale MRIGID
   9 : C
  10 : C
  11 : C
  12 : C LANGAGE     : ESOPE
  13 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14 : C               mél : gounand@semt2.smts.cea.fr
  15 : C***********************************************************************
  16 : C ENTREES            : IGEOM,LPRIM
  17 : C ENTREES/SORTIES    :
  18 : C SORTIES            : MRIGID
  19 : C***********************************************************************
  20 : C VERSION    : v1, 10/05/2011, version initiale
  21 : C HISTORIQUE : v1, 10/05/2011, création
  22 : C HISTORIQUE :
  23 : C HISTORIQUE :
  24 : C***********************************************************************
  25 : -INC CCOPTIO
  26 : -INC SMRIGID
  27 : -INC SMELEME
  28 : -INC SMLMOTS
  29 : -INC CCHAMP
  30 : *     
  31 : * Executable statements
  32 : *
  33 : C  
  34 : C
  35 : C**** On controle que le MELEME soit de type POI1
  36 : C     Si non changer
  37 : C
  38 :       MELEME = IGEOM
  39 :       SEGACT MELEME
  40 :       NBSOUS = MELEME.LISOUS(/1)
  41 :       NTYP = MELEME.ITYPEL
  42 : C
  43 :       IF ((NBSOUS.NE.0).OR.(NTYP.NE.1)) THEN
  44 : * In CHANGE : SEGINI MELEME
  44 :          CALL CHANGE(MELEME,1)
  45 :          IPT1 = IGEOM
  46 :          SEGDES IPT1
  47 :          IF (IERR.NE.0) RETURN
  48 :       ENDIF
  49 : *
  50 :       MLMOTS=LPRIM
  51 :       SEGACT MLMOTS
  52 :       NRIGEL=MOTS(/2)
  53 :       SEGINI MRIGID
  54 :       MTYMAT='DIAGONAL'
  55 : C
  56 :       NBEL=NUM(/2)
  57 :       DO I=1,NRIGEL
  58 :          COERIG(I)=1.D0
  59 :          IRIGEL(1,I)=MELEME
  60 :          NLIGRP=1
  61 :          NLIGRD=1
  62 :          SEGINI DESCR
  63 :          LISINC(1)=MOTS(I)
  63 :          CALL PLACE(NOMDD,LNOMDD,idx,MOTS(I))
  64 :          IF (idx.NE.0) THEN
  65 :             LISDUA(1)=NOMDU(idx)
  66 :          ELSE
  67 :             LISDUA(1)=MOTS(I)
  68 :          ENDIF
  69 :          NOELEP(1)=1
  70 :          NOELED(1)=1
  71 :          SEGDES DESCR
  72 :          IRIGEL(3,I)=DESCR
  73 :          NELRIG=NBEL
  74 :          SEGINI XMATRI
  75 :          DO IBEL=1,NBEL
  76 :             RE(1,1,IBEL)=1.D0
  77 :          ENDDO
  78 :          SEGDES XMATRI
  79 :          IRIGEL(4,I)=XMATRI
  80 :       ENDDO
  81 :       SEGDES MRIGID
  82 :       SEGDES MLMOTS
  83 :       SEGDES MELEME
  84 : *
  85 : * Normal termination
  86 : *
  87 :       RETURN
  88 : *
  89 : * End of subroutine KOPIDR
  90 : *
  91 :       END
  92 : 
  93 :