Télécharger la plaquette Cast3M


fr en

Télécharger asse10.eso

Retour à la liste

Numérotation des lignes : 

asse10

  1. C ASSE10    SOURCE    MB234859  26/09/01    21:15:04     12631          
  2.       SUBROUTINE ASSE10(MRIGI1,ICLE,INUIN1,inwuit)
  3. *----------------------------------------------------------------------
  4. *  ICLE=1
  5. * ce subroutine a pour fonction d'initialiser le segment de
  6. * normalisation MDNOR et de fabriquer les matrices normalisees pour
  7. * les transferer a l'assemblage.
  8. *  ICLE=2
  9. *  destructions des matrices normalisees
  10. *----------------------------------------------------------------------
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8 (A-H,O-Z)
  13. C
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMRIGID
  17. -INC SMLMOTS
  18. -INC SMLREEL
  19. -INC SMLENTI
  20. -INC SMMATRI
  21. -INC SMELEME
  22. C
  23.       LOGICAL bSYME
  24.       SEGMENT,INUINV(NNGLOB)
  25.       SEGMENT INWAIT
  26.         INTEGER IIM(IRM)
  27.       ENDSEGMENT
  28. C
  29.       IF (IIMPI.NE.0) WRITE(IOIMP,*) 'Subroutine ASSE10 ',ICLE
  30. C
  31. C     =================================================================
  32.       IF (ICLE.EQ.1) THEN
  33. C     =================================================================
  34. C       Renseigner MDNOR et MDNO1 si necessaire
  35.         MRIGID=MRIGI1
  36.         SEGACT,MRIGID*MOD
  37.         MMATRI=ICHOLE
  38.         bSYME=(IILIGS.EQ.0)
  39. C
  40.         IRM=IRIGEL(/2)
  41.         SEGINI,INWAIT
  42.         INWUIT=inwait
  43. C
  44.         MDNOR =IDNORM
  45.         SEGACT MDNOR*MOD
  46.         INUINV=INUIN1
  47.         MINCPO=IINCPO
  48.         MIMIK=IIMIK
  49.         SEGACT,INUINV,MINCPO,MIMIK
  50.         NDDLP=INCPO(/1)
  51.         NODEP=INCPO(/2)
  52.         NDDLD=NDDLP
  53.         NODED=NODEP
  54.         MIPO1=MINCPO
  55. C
  56.         IF (NORINC.EQ.-1) THEN
  57. C
  58. C         Normalisation AUTOmatique
  59. C
  60.           DO 10 I=1,IRM
  61.             DESCR=IRIGEL(3,I)
  62.             SEGACT DESCR
  63.             NLIGRP=NOELEP(/1)
  64.             NLIGRD=NOELED(/1)
  65.             IF (NLIGRP.NE.NLIGRD) GOTO 10
  66.             JG=NLIGRP
  67.             SEGINI,MLENTI
  68. C
  69.             DO J=1,NLIGRP
  70.               DO K=1,NDDLP
  71.                 IF (IMIK(K).EQ.LISINC(J)) GOTO 11
  72.               ENDDO
  73.               CALL ERREUR(5)
  74.    11         CONTINUE
  75.               LECT(J)=K
  76.             ENDDO
  77. C
  78.             MELEME=IRIGEL(1,I)
  79.             SEGACT,MELEME
  80.             XMATRI=IRIGEL(4,I)
  81.             SEGACT,XMATRI
  82. C           Balayer toutes les matrices pour simuler l'assemblage du terme diagonale
  83.             DO J=1,RE(/3)
  84.               DO K=1,NLIGRP
  85.                 IA=INUINV(NUM(NOELEP(K),J))
  86.                 INC=INCPO(LECT(K),IA)
  87.                 DNOR(INC)=DNOR(INC)+RE(K,K,J)
  88.               ENDDO
  89.             ENDDO
  90.             SEGDES,XMATRI
  91.             SEGSUP,MLENTI
  92.    10     CONTINUE
  93. C
  94.           ILX=0
  95.           DO IU=1,IMIK(/2)
  96.             IF (IMIK(IU).EQ.'LX  ') THEN
  97.               ILX=IU
  98.               GOTO 12
  99.             ENDIF
  100.           ENDDO
  101.    12     CONTINUE
  102. C
  103. C         Les coefficients valent 0.8/sqrt(terme maxi) pour les DDL
  104. C         "physiques" et 1 pour les multiplicateurs de Lagrange
  105.           DO IO=1,NODEP
  106.             DO IOP=1,NDDLP
  107.               IA=INCPO(IOP,IO)
  108.               IF (IA.NE.0) THEN
  109.                 IF (IOP.EQ.ILX) THEN
  110.                   DNOR(IA)=1.D0
  111.                 ELSE
  112.                   IF(DNOR(IA).EQ.0.D0) DNOR(IA)=1.D0
  113.                   DNOR(IA)=0.8D0/SQRT(ABS(DNOR(IA)))
  114.                 ENDIF
  115.               ENDIF
  116.             ENDDO
  117.           ENDDO
  118. C
  119.           IF (.NOT.bSYME) THEN
  120.             MIPO1=IDUAPO
  121.             MDNO1=IDNORD
  122.             MIDUA=IIDUA
  123.             SEGACT,MIPO1,MIDUA
  124.             SEGACT,MDNO1=MDNOR
  125.             SEGACT,MDNO1*MOD
  126.           ENDIF
  127. C
  128.         ELSE
  129. C
  130. C         Normalisation via LISTMOTS + LISTREEL
  131. C
  132.           MLMOTS=NORINC
  133.           MLREEL=NORVAL
  134.           SEGACT,MLMOTS,MLREEL
  135.           LINP=PROG(/1)
  136. C
  137. C         Remplir le segment MDNOR
  138.           DO IOP=1,NDDLP
  139.             DO IU=1,LINP
  140.               IF (IMIK(IOP).EQ.MOTS(IU)) THEN
  141.                 XRE=PROG(IU)
  142.                 GOTO 13
  143.               ENDIF
  144.             ENDDO
  145.             XRE=1.D0
  146.    13       CONTINUE
  147.             DO 14 IO=1,NODEP
  148.               IA=INCPO(Iop,io)
  149.               IF (IA.EQ.0) GOTO 14
  150.               DNOR(IA)=XRE
  151.    14       CONTINUE
  152.           ENDDO
  153. C
  154.           IF (bSYME) GOTO 15
  155. C
  156.           MIPO1=IDUAPO
  157.           MDNO1=IDNORD
  158.           MIDUA=IIDUA
  159.           SEGACT,MIPO1,MIDUA
  160. C
  161.           IF (NORIND.EQ.0) THEN
  162.             SEGACT,MDNO1=MDNOR
  163.             SEGACT,MDNO1*MOD
  164.             GOTO 15
  165.           ENDIF
  166. C
  167.           MLMOT1=NORIND
  168.           MLREE1=NORVAD
  169.           SEGACT,MLMOT1,MLREE1
  170.           LIND=MLREE1.PROG(/1)
  171.           NDDLD=MIPO1.INCPO(/1)
  172.           NODED=MIPO1.INCPO(/2)
  173. C
  174. C         Remplir le segment MDNO1
  175.           DO IOP=1,NDDLD
  176.             DO IU=1,LIND
  177.               IF (IDUA(IOP).EQ.MLMOT1.MOTS(IU)) THEN
  178.                 XRE=MLREE1.PROG(IU)
  179.                 GOTO 16
  180.               ENDIF
  181.             ENDDO
  182.             XRE=1.D0
  183.    16       CONTINUE
  184.             DO 17 IO=1,NODED
  185.               IA=MIPO1.INCPO(IOP,IO)
  186.               IF (IA.EQ.0) GOTO 17
  187.               MDNO1.DNOR(IA)=XRE
  188.    17       CONTINUE
  189.           ENDDO
  190. C
  191.    15     CONTINUE
  192.         ENDIF
  193. C       ---------------------------------------------------------------
  194. C       Modifier les matrices elementaires
  195. C       ---------------------------------------------------------------
  196.         DO 1 I=1,IRM
  197.           DESCR=IRIGEL(3,I)
  198.           SEGACT,DESCR
  199.           NLIGRP=NOELEP(/1)
  200.           NLIGRD=NOELED(/1)
  201.           JG=NLIGRP
  202.           SEGINI,MLENTI
  203.           JG=NLIGRD
  204.           SEGINI,MLENT1
  205.           MELEME=IRIGEL(1,I)
  206.           SEGACT,MELEME
  207.           XMATRI=IRIGEL(4,I)
  208. C         Conserver le pointeur sur le XMATRI d'origine
  209.           IIM(I)=XMATRI
  210. C         Dupliquer le XMATRI pour lui appliquer la normalisation.
  211.           SEGINI,XMATR1=XMATRI
  212.           IRIGEL(4,I)=xMATR1
  213. C
  214.           DO IU=1,NLIGRP
  215.             DO IO=1,IMIK(/2)
  216.               IF(LISINC(IU).EQ.IMIK(IO)) GOTO 2 
  217.             ENDDO  
  218.             CALL ERREUR(5)
  219.     2       CONTINUE
  220.             LECT(IU)=IO
  221.           ENDDO
  222. C
  223.           IF (bSYME) GOTO 4
  224. C
  225.           DO IU=1,NLIGRD
  226.             DO IO=1,IDUA(/2)
  227.               IF(LISDUA(IU).EQ.IDUA(IO)) GOTO 3 
  228.             ENDDO
  229.             CALL ERREUR(5)
  230.     3       CONTINUE
  231.             MLENT1.LECT(IU)=IO
  232.           ENDDO
  233. C
  234.     4     CONTINUE
  235. C
  236.           NELMT=XMATR1.RE(/3)
  237.           DO 7 K=1,NELMT
  238. C
  239. C           Multiplication d'une colonne
  240.             DO 8 L=1,NLIGRP
  241.               IAB=INUINV(NUM(NOELEP(L),K))
  242.               INH=INCPO(LECT(L),IAB)
  243.               COE=DNOR(INH)
  244.               IF (COE.EQ.1.D0) GOTO 8
  245.               DO M=1,NLIGRD
  246.                 XMATR1.RE(M,L,K)=XMATR1.RE(M,L,K)*COE
  247.                 IF (bSYME) XMATR1.RE(L,M,K)=XMATR1.RE(L,M,K)*COE
  248.               ENDDO
  249.     8       CONTINUE
  250. C
  251.             IF (bSYME) GOTO 7
  252. C
  253. C           Multiplication d'une ligne
  254.             DO 9 L=1,NLIGRD
  255.               IAB=INUINV(NUM(NOELED(L),K))
  256.               INH=MIPO1.INCPO(MLENT1.LECT(L),IAB)
  257.               COE=MDNO1.DNOR(INH)
  258.               IF (COE.EQ.1.D0) GOTO 9
  259.               DO M=1,NLIGRP
  260.                 XMATR1.RE(L,M,K)=XMATR1.RE(L,M,K)*COE
  261.               ENDDO
  262.     9       CONTINUE
  263. C
  264.     7     CONTINUE
  265. C
  266.           IF (bSYME) THEN
  267. C           Verifier la symetrie des matrices elementaires 
  268. C           (sauf le super element qui peut etre tres grand)
  269.             IF (ITYPEL.NE.28) THEN
  270.               IF (XMATR1.SYMVER.NE.1) THEN
  271.                 CALL VERSYM(XMATR1.RE,NLIGRD,NLIGRP,NELMT,0)
  272.                 IF (IERR.NE.0) RETURN
  273.                 XMATR1.SYMRE=0
  274.                 XMATR1.SYMVER=1
  275.               ENDIF
  276.             ENDIF
  277.           ENDIF
  278. C
  279.           SEGDES,XMATRI,XMATR1
  280.           SEGSUP,MLENTI,MLENT1
  281.     1   CONTINUE
  282.         SEGDES INWAIT
  283. C     =================================================================
  284.       ELSEIF (ICLE.EQ.2) THEN
  285. C     =================================================================
  286. C       Destruction des matrices normalisees et remise dans MRIGID
  287. C       des matrices d'origine conservees dans INWAIT ...
  288.         INWAIT=INWUIT
  289.         IF (INWAIT.EQ.0) RETURN
  290.         SEGACT,INWAIT
  291.         MRIGID=MRIGI1
  292.         SEGACT,MRIGID*MOD
  293.         DO 20 I=1,IIM(/1)
  294.           IF(IIM(I).EQ.0) GOTO 20
  295.           XMATRI=IRIGEL(4,I)
  296.           SEGSUP,XMATRI
  297.           IRIGEL(4,I)=IIM(I)
  298.    20   CONTINUE
  299.         SEGSUP,INWAIT
  300.         SEGDES,MRIGID
  301.         INWUIT=0
  302. C     =================================================================
  303.       ENDIF
  304. C     =================================================================
  305.       END
  306.  
  307.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales