Télécharger la plaquette Cast3M


fr en

Télécharger assem2.eso

Retour à la liste

Numérotation des lignes : 

assem2

  1. C ASSEM2    SOURCE    MB234859  26/09/01    21:15:06     12631          
  2.       SUBROUTINE ASSEM2(ITRAV1,INSYM,MMMTRI,INUIN1,
  3.      &                  ITOPO1,IPO1,IITOP1,INCTR1,
  4.      &                  ITOPO2,IPO2,IITOP2,INCTR2,INORMU)
  5. C-----------------------------------------------------------------------
  6. C Realise l'assemblage des matrices elementaires
  7. C
  8. C  Entrees :
  9. C  ---------
  10. C    ITRAV1 : Pointeur sur un objet MRIGID
  11. C    INSYM  : Entier precisant si les matrices sont symetriques (=0) 
  12. C             ou non (=1)
  13. C    MMMTRI : Pointeur sur un objet MMATRI
  14. C    Informations provenant de ASSEM1 :
  15. C    INUIN1 : Pointeur sur le segment INUINV
  16. C    ITOPO1 : Pointeur sur le segment ITOPO
  17. C    IPO1   : Pointeur sur le segment IPOS
  18. C    IITOP1 : Pointeur sur le segment IITOP
  19. C    INCTR1 : Pointeur sur le segment INCTRR
  20. C    Pour les matrices non symetriques, les informations supplementaires
  21. C    ITOPO2 : Pointeur sur le segment ITOPO
  22. C    IPO2   : Pointeur sur le segment IPOS
  23. C    IITOP2 : Pointeur sur le segment IITOP
  24. C    INCTR2 : Pointeur sur le segment INCTRR
  25. C    INORMU : Entier indiquant si on veut normaliser les multiplicateurs 
  26. C             de Lagrange (>0) ou non (=0)
  27. C
  28. C  Sorties :
  29. C  ---------
  30. C    MMMTRI : Pointeur sur un objet MMATRI contenant les informations 
  31. C             suiavntes en plus
  32. C    IJMAX  : Entier donnant le nb de terme max sur une ligne
  33. C    IDIAG  : Pointeur sur le segment MDIAG
  34. C    IDNORM : Pointeur sur le segment MDNOR
  35. C    IILIGN : Pointeur sur le segment MILIGN de la partie inferieure
  36. C    En plus pour les matrices non symetriques
  37. C    IDNORD : Pointeur sur le segment MDNOR
  38. C    IILIGS : Pointeur sur le segment MILIGN de la partie superieure
  39. C
  40. C-----------------------------------------------------------------------
  41.       IMPLICIT INTEGER(I-N)
  42.       IMPLICIT REAL*8 (A-H,O-Z)
  43. -INC CCREEL
  44. -INC PPARAM
  45. -INC CCOPTIO
  46. -INC SMELEME
  47. -INC SMRIGID
  48. -INC SMMATRI
  49. C
  50.       SEGMENT,INUINV(NNGLOB)
  51.       SEGMENT,ITOPO(IENNO)
  52.       SEGMENT,IITOP(NNOE+1)
  53.       SEGMENT,IPOS(NNOE1)
  54.       SEGMENT,INCTRR(NIRI)
  55.       SEGMENT,INCTRS(NIRI)
  56.       SEGMENT,INCTRA(NLIGRE)
  57.       SEGMENT,INCTRB(NLIGRE)
  58.       SEGMENT,IPV(NNOE)
  59.       SEGMENT,VMAX(INC)
  60.       SEGMENT,IVAL(NNN)
  61.       SEGMENT,ITRA(NNN,2)
  62.       SEGMENT TRATRA
  63.         REAL*8  XTRA(INCRED,INCDIF)
  64.         INTEGER LTRA(INC,INCDIF)
  65.         INTEGER NTRA(INCRED,INCDIF)
  66.         INTEGER MTRA(INCDIF)
  67.       ENDSEGMENT
  68. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  69. C
  70. C  ****  IVAL(I)=J    : LA I EME LIGNE D'UNE PETITE MATRICE S'ASSEMBLE
  71. C                       DANS LA J EME DE LA GRANDE.
  72. C  ****  ITRAV(I,1)=J : LA IEME INCONNUE DU NOEUD EN COURS D'ASSEMBLAGE
  73. C                       ET QUI SE TROUVE DANS LA PETITE MATRICE SE TROUVE
  74. C                       EN J EME POSITION DE LA PETITE MATRICE.
  75. C  ****  ITRAV(I,2)   : LA IEME INCONNUE DU NOEUD EN COURS D'ASSEMBLAGE
  76. C                       PRESENT DANS LA PETITE MATRICE EST EN JEME
  77. C                       POSITION DANS LA GRANDE
  78. C
  79. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  80.       SEGMENT,RA(N1,N1)*D
  81.       SEGMENT JNOMUL
  82.          LOGICAL INOMUL(NNR)
  83.       ENDSEGMENT
  84.       REAL*8 DMAX,COER,DMAXY,DMAXGE
  85.       LOGICAL NOMUL,bSUP,bNONSYM,bNORMAL
  86. C
  87.       SAVE NJTOT
  88.       DATA NJTOT/0/
  89. C
  90.       bNONSYM=(INSYM.EQ.1)
  91.       bNORMAL=(NORINC.NE.0)
  92. C
  93. C  PV  ON ACTIVE UNE FOIS POUR TOUTES LES MELEME DESCR... DE LA RIGIDITE
  94. C      ON EN PROFITE POUR CREER INOMUL
  95. C
  96. C  ****  RECHERCHE DE LA DIMENSION MAX DE IVAL,ET SEGINI DE IVAL ET ITRA
  97. C
  98.       INCTRR=INCTR1
  99.       SEGACT,INCTRR
  100.       IF (bNONSYM) THEN
  101.         INCTRS=INCTR2
  102.         SEGACT,INCTRS
  103.       ENDIF
  104. C
  105.       MRIGID=ITRAV1
  106.       SEGACT,MRIGID*MOD
  107.       MRIGID.ICHOLE=MMMTRI
  108.       NNR=IRIGEL(/2)
  109.       NNN=0
  110.       SEGINI JNOMUL
  111.       DO 1 IRI=1,NNR
  112.         IPT1=IRIGEL(1,IRI)
  113.         SEGACT,IPT1
  114.         ipt2=IRIGEL(2,IRI)
  115.         if (ipt2.ne.0) segact,ipt2
  116.         INCTRA=INCTRR(IRI)
  117.         SEGACT,INCTRA
  118.         DESCR=IRIGEL(3,IRI)
  119.         SEGACT,DESCR
  120.         NA=LISINC(/2)
  121.         IF (bNONSYM) THEN
  122.           INCTRB=INCTRS(IRI)
  123.           SEGACT,INCTRB
  124.           NA=MAX(NA,LISDUA(/2))
  125.         ENDIF
  126.         NNN=MAX(NA,NNN)
  127.         INOMUL(IRI)=.TRUE.
  128.         IF (IPT1.ITYPEL.EQ.49) INOMUL(IRI)=.FALSE.
  129.    1  CONTINUE
  130.       SEGINI,IVAL
  131.       SEGINI,ITRA
  132. C
  133. C  ****  ACTIVATION DES SEGMENTS DE TRAVAILS ET DE MMATRI
  134. C
  135.       MMATRI=MMMTRI
  136.       SEGACT,MMATRI*MOD
  137.       INUINV=INUIN1
  138.       SEGACT,INUINV
  139.       ITOPO=ITOPO1
  140.       SEGACT,ITOPO
  141.       IITOP=IITOP1
  142.       SEGACT,IITOP
  143.       IPOS=IPO1
  144.       SEGACT,IPOS
  145.       MINCPO=IINCPO
  146.       SEGACT,MINCPO
  147.       INCDIF=INCPO(/1)
  148.       IF (bNONSYM) THEN
  149.         ITOPO=ITOPO2
  150.         SEGACT,ITOPO
  151.         IITOP=IITOP2
  152.         SEGACT,IITOP
  153.         IPOS=IPO2
  154.         SEGACT,IPOS
  155.         MIPO1=IDUAPO
  156.         SEGACT,MIPO1
  157.         INCDID=MIPO1.INCPO(/1)
  158.         INCDIF=MAX(INCDIF,INCDID)
  159.       ELSE
  160.         ITOPO2=ITOPO1
  161.         IITOP2=IITOP1
  162.         IPO2=IPO1
  163.       ENDIF
  164. C     NNOE : nombre de noeuds
  165.       NNOE=IPOS(/1)-1
  166. C     INC : dimension de la matrice
  167.       INC=IPOS(NNOE+1)
  168.       NJTOT=0
  169.       IJMAX=0
  170.       SEGINI,MDIAG
  171.       IDIAG=MDIAG
  172.       SEGINI,MILIGN
  173.       IILIGN=MILIGN
  174.       IF (bNONSYM) THEN
  175.         SEGINI,MILIGN
  176.         IILIGS=MILIGN
  177.       ENDIF
  178. C
  179.       SEGINI IPV
  180.       INCRED=0
  181.       DO 80 INO=1,NNOE
  182. C
  183.         ICOMPT=0
  184.         ITOPO=ITOPO2
  185.         IITOP=IITOP2
  186.         IPOS=IPO2
  187.         bSUP=.FALSE.
  188. C
  189.  84     CONTINUE
  190.         MAXELE = (IITOP(INO+1)-IITOP(INO))/2
  191.         DO 81 IELE=1,MAXELE
  192.           IIU=IITOP(INO) + IELE + IELE -2
  193.           IEL=ITOPO(IIU)
  194.           IRI=ITOPO(IIU+1)
  195.           meleme=IRIGEL(2,IRI)
  196.           if (meleme.eq.0) meleme=IRIGEL(1,IRI)
  197.           DO 83 I=1,NUM(/1)
  198.             IP=INUINV(NUM(I,IEL))
  199.             IF (IP.GT.INO) GOTO 83
  200.             IF (IPV(IP).EQ.INO) GOTO 83
  201.             IPV(IP)=INO
  202.             ICOMPT=ICOMPT+1
  203.  83       CONTINUE
  204.  81     CONTINUE
  205.         INCRED=MAX(INCRED,ICOMPT)
  206. C
  207.         IF (bNONSYM.AND.(.NOT.bSUP)) THEN
  208.           ITOPO=ITOPO1
  209.           IITOP=IITOP1
  210.           IPOS=IPO1
  211.           bSUP=.TRUE.
  212.           GOTO 84
  213.         ENDIF
  214. C
  215.   80  CONTINUE
  216.       SEGSUP IPV
  217. C
  218.       INCRED=INCRED*INCDIF
  219.       SEGINI TRATRA
  220.       SEGINI VMAX
  221. C
  222. C ... Coefficients de normalisation ...
  223. C     -----------------------------
  224.       SEGINI,MDNOR
  225.       IDNORM=MDNOR
  226.       IF (bNONSYM) THEN
  227.         SEGINI,MDNO1
  228.         IDNORD=MDNO1
  229.       ENDIF
  230.       IF (bNORMAL) THEN
  231.         inwuit=0
  232.         CALL ASSE10(MRIGID,1,INUIN1,inwuit)
  233.       ELSE
  234.         DO IU=1,INC
  235.           DNOR(IU)=1.d0
  236.           IF (bNONSYM) MDNO1.DNOR(IU)=1.d0
  237.         ENDDO
  238.       ENDIF
  239. C
  240. C  ****  BOUCLE   *100* SUR LES NUMEROS DE NOEUDS QUE L'ON ASSEMBLE
  241. C        -------------------------------------------------------------
  242.       LLVNUL=0
  243.       DO 100 INO=1,NNOE
  244. C
  245.         MILIGN=IILIGN
  246.         ITOPO=ITOPO2
  247.         IITOP=IITOP2
  248.         IPOS=IPO2
  249.         bSUP=.FALSE.
  250. C
  251.  113    CONTINUE
  252.         DO 101 IIT=1,INCDIF
  253.           MTRA(IIT)=0
  254.  101    CONTINUE
  255.  
  256.         IPRE=IPOS(INO)+1
  257.         IDER=IPOS(INO+1)
  258.         LLVVA=0
  259. C
  260. C  ****  BOUCLE   *99*   SUR LES ELEMENTS TOUCHANT LE NOEUD INO
  261. C                        POUR LES ELEMNTS MULTIPLICATEUR ON NE FAIT PAS
  262. C                        L'ASSEMBLAGE
  263. C
  264.         MAXELE= (IITOP(INO+1) -IITOP(INO))/2
  265.         DO 99 IELE=1,MAXELE
  266.           IIU=IITOP(INO) + IELE + IELE - 2
  267.           IEL=ITOPO(IIU)
  268.           IRI=ITOPO(IIU+1)
  269.           MELEME=IRIGEL(1,IRI)
  270.           DESCR=IRIGEL(3,IRI)
  271.           INCTRA=INCTRR(IRI)
  272.           IF (bNONSYM) INCTRB=INCTRS(IRI)
  273.           XMATRI=IRIGEL(4,IRI)
  274.           SEGACT,XMATRI
  275.           COER=COERIG(IRI)
  276.           NOMUL=INOMUL(IRI)
  277. C
  278. C  ****  NOMUL =.FALSE.  IL EXISTE  UN MULTIPLICATEUR
  279. C  ****  INITIALISATION DE IVAL. IVAL(I)=J VEUT DIRE QUE
  280. C  ****  LA I EME LIGNE DE LA PETITE MATRICE S'ASSEMBLE DANS
  281. C  ****  LA J EME DE LA GRANDE MATRICE.
  282. C
  283.           NA=0
  284.           IF (bNONSYM) THEN
  285. C
  286. C           Identifier les lignes (colonnes) a remplir
  287.             IF (bSUP) THEN
  288.               NIN=LISINC(/2)
  289.             ELSE
  290.               NIN=LISDUA(/2)
  291.             ENDIF
  292.             DO 96 ICO=1,NIN
  293.               IF (bSUP) THEN
  294.                 IJA=INUINV(NUM(NOELEP(ICO),IEL))
  295.                 IJB=INCTRA(ICO)
  296.               ELSE
  297.                 IJA=INUINV(NUM(NOELED(ICO),IEL))
  298.                 IJB=INCTRB(ICO)
  299.               ENDIF
  300.               IF (IJA.NE.INO) GOTO 96
  301. C             NA-eme DDL associe au noeud
  302. C             bSUP = T : partie superieure
  303. C             Sa colonne dans la matrice elementaire est ICO
  304. C             Sa colonne dans la matrice assemblee   est ICA
  305. C             bSUP = F : partie inferieure
  306. C             Sa ligne dans la matrice elementaire est ICO
  307. C             Sa ligne dans la matrice assemblee   est ICA
  308.               NA=NA+1
  309.               ITRA(NA,1)=ICO
  310.               IF (bSUP) THEN
  311.                 ICA=INCPO(IJB,IJA)
  312.               ELSE
  313.                 ICA=MIPO1.INCPO(IJB,IJA)
  314.               ENDIF
  315.               ITRA(NA,2)=ICA
  316.  96         CONTINUE
  317.  
  318.             IF (bSUP) THEN
  319.               NIN=LISDUA(/2)
  320.             ELSE
  321.               NIN=LISINC(/2)
  322.             ENDIF
  323. C           Identifier les colonnes (lignes) ou ajouter des valeurs
  324.             DO 98 ICO=1,NIN
  325.               IF (bSUP) THEN
  326.                 IJA=INUINV(NUM(NOELED(ICO),IEL))
  327.                 IJB=INCTRB(ICO)
  328.                 IVAL(ICO)=MIPO1.INCPO(IJB,IJA)
  329.               ELSE
  330.                 IJA=INUINV(NUM(NOELEP(ICO),IEL))
  331.                 IJB=INCTRA(ICO)
  332.                 IVAL(ICO)=INCPO(IJB,IJA)
  333.               ENDIF
  334.   98        CONTINUE
  335.           ELSE
  336.             NIN=LISINC(/2)
  337.             DO 97 ICO=1,NIN
  338.               IJA=INUINV(NUM(NOELEP(ICO),IEL))
  339.               IJB=INCTRA(ICO)
  340.               IVAL(ICO)=INCPO(IJB,IJA)
  341.               IF (IJA.NE.INO)  GOTO 97
  342.               NA=NA+1
  343.               ITRA(NA,1)=ICO
  344.               ITRA(NA,2)=IVAL(ICO)
  345.  97         CONTINUE
  346.           ENDIF
  347. C
  348. C  ****  BOUCLE  *95* SUR LES INCONNUES DE LA PETITE MATRICE
  349. C
  350.           DO 95 INCC=1,NA
  351.             INCO=ITRA(INCC,2)
  352.             if (inco.gt.ider) goto 95
  353.             ILOC=INCO-IPRE+1
  354.             JJ=ITRA(INCC,1)
  355.             DO 90 IK=1,NIN
  356.               IO=IVAL(IK)
  357.               IF (IO.GT.INCO)  GOTO 90
  358.               ILTT= LTRA(IO,ILOC)
  359.               IF (ILTT.EQ.0) THEN
  360.                 LLVVA=LLVVA+1
  361.                 IMMTT=MTRA(ILOC)+1
  362.                 MTRA(ILOC)=IMMTT
  363.                 XTRA(IMMTT,ILOC)=0.D0
  364.                 NTRA(IMMTT,ILOC)=IO
  365.                 LTRA(IO,ILOC)=IMMTT
  366.                 ILTT=IMMTT
  367.               ENDIF
  368.               IF (NOMUL) THEN
  369. C               Symetrie de RE
  370.                 IF ((.NOT.bNONSYM).OR.(bSUP)) THEN
  371.                   XTRA(ILTT,ILOC)=XTRA(ILTT,ILOC)+RE(IK,JJ,IEL)*COER
  372.                 ELSE
  373.                   XTRA(ILTT,ILOC)=XTRA(ILTT,ILOC)+RE(JJ,IK,IEL)*COER
  374.                 ENDIF
  375.               ENDIF
  376.  90         CONTINUE
  377.  95       CONTINUE
  378.  99     CONTINUE
  379. C
  380. C  *** COMPACTAGE DES LIGNES, EN MEME TEMPS CALCUL DE IJMAX QUI SERA
  381. C  *** LA DIMENSION MAX D'UN SEGMENT LIGN.
  382. C  *** LE SEGMENT ASSOCIE A UNE LIGNE (SEGMENT LLIGN) EST DE LA FORME :
  383. C  *** IMMMM(NA) PERMET DE SAVOIR SI UN MOUVEMENT D'ENSEMBLE SUR LA
  384. C  *** LIGNE EXISTE. IPPO(NA+1) DONNE LA POSITION DANS XXVA LA 1ERE
  385. C  *** VALEUR DE LA LIGNE .XXVA  VALEUR DE LA MATRICE.
  386. C  *** LINC(I) DONNE LE NUMERO DE LA COLONNE DU IEME ELEM DE XXVA
  387. C
  388.         NA = IDER-IPRE+1
  389.         LLVNUL=LLVNUL+LLVVA
  390.         SEGINI,LLIGN
  391.         MILIGN.ILIGN(INO)=LLIGN
  392.         NBA=0
  393.         DO 120 JPA=1,NA
  394.           IIIN=IPRE+JPA -1
  395.           IMMMM(JPA)=IIIN
  396.           IPPO(JPA)=NBA
  397.           DO 121 IPAK = 1,MTRA(JPA)
  398.             IUNPAK=NTRA(IPAK,JPA)
  399.             LTRA(IUNPAK,JPA)=0
  400.             NBA=NBA+1
  401.             LINC(NBA)=IUNPAK
  402.             XXVA(NBA)=XTRA(IPAK,JPA)
  403.             vmax(iiin)=max(abs(xxva(nba)),vmax(iiin))
  404.             IF (.NOT.bSUP) THEN
  405.               IF (IIIN.EQ.IUNPAK) DIAG(IIIN)=XXVA(NBA)
  406.             ENDIF
  407.  121      CONTINUE
  408.  120    CONTINUE
  409.         IPPO(NA+1)= NBA
  410.         NJMAX=0
  411. C  recherche du mini globale sur toutes les inconnues
  412.         LPA=IPRE
  413.         DO 126 JPA=IPRE,IDER
  414.           MILIGN.IPNO(JPA)=INO
  415.           IPDE=IPPO(JPA-IPRE+1)+1
  416.           IPDF=IPPO(JPA-IPRE+2)
  417.           DO 155 JHT=IPDE,IPDF
  418.             LPA=MIN(LPA,LINC(JHT))
  419.  155      CONTINUE
  420.  126    CONTINUE
  421.         DO 127 JPA=IPRE,IDER
  422.           LDEB(JPA-IPRE+1)=LPA
  423.           NNA= JPA- LPA       +1
  424.           NJMAX=NJMAX+NNA
  425.  127    CONTINUE
  426.         NJTOT=NJTOT+NJMAX
  427.         IF (IJMAX.LT.NJMAX) IJMAX=NJMAX
  428.         SEGDES,LLIGN
  429. C
  430.         IF (bNONSYM.AND.(.NOT.bSUP)) THEN
  431.           MILIGN=IILIGS
  432.           ITOPO=ITOPO1
  433.           IITOP=IITOP1
  434.           IPOS=IPO1
  435.           bSUP=.TRUE.
  436.           GOTO 113
  437.         ENDIF
  438. C
  439.  100  CONTINUE
  440.       SEGSUP TRATRA
  441. C
  442. C  ****  ON REPREND TOUTE LES MATRICES CONTENANT LES MULTIPLICATEURS
  443. C  ****  POUR MULTIPLIER TOUS LEURS TERMES PAR UNE NORME ATTACHEE
  444. C  ****  A CHAQUE MULTIPLICATEUR. PUIS ON LES ASSEMBLE.
  445. C
  446. *  d'abord etablir une norme generale pour le cas ou on n'arrive pas
  447. *  a calculer la norme particuliere
  448.       DMAXGE=XPETIT
  449.       DO 378 I=1,INC
  450.         DMAXGE=MAX(DMAXGE,abs(vmax(i)))
  451.   378 CONTINUE
  452.       if (iimpi.ne.0)
  453.      >  write (6,*) ' nb inconnues facteur multiplicatif general ',
  454.      >  INC,DMAXGE
  455.       if (dmaxge.lt.xpetit/xzprec) dmaxge=1.d0
  456.       IENMU=0
  457. C
  458.  375  CONTINUE
  459.       IENMU1=IENMU
  460.       IENMU =0
  461.       DO 376 I=1,NNR
  462.         IF (.NOT.INOMUL(I)) IENMU=IENMU+1
  463.  376  CONTINUE
  464.       IF (IENMU.EQ.0) GOTO 3750
  465.       DO 11 I=1,NNR
  466.         IF (INOMUL(I)) GOTO 11
  467.         DESCR=IRIGEL(3,I)
  468.         N3=LISINC(/2)
  469.         COER=COERIG(I)
  470.         MELEME=IRIGEL(1,I)
  471.         INCTRA=INCTRR(I)
  472.         XMATRI=IRIGEL(4,I)
  473.         N2=NUM(/2)
  474.         IF (RE(/3).EQ.0) THEN
  475.           INOMUL(I)=.TRUE.
  476.           SEGDES XMATRI
  477.           GOTO 11
  478.         ENDIF
  479.         N1=RE(/1)
  480. C
  481. C       ERREUR 756 : La matrice de rigidite n'est pas carree
  482.         IF (N1.NE.RE(/2)) THEN
  483.           CALL ERREUR(756)
  484.           RETURN
  485.         ENDIF
  486. C
  487.         SEGINI,RA
  488.         DO 14 IEL=1,N2
  489. C
  490.           MILIGN=IILIGN
  491.           bSUP=.FALSE.
  492. C
  493.  213      CONTINUE
  494.           DO 15 ICO=1,N3
  495.             IJA=INUINV(NUM(NOELEP(ICO),IEL))
  496.             IJB=INCTRA(ICO)
  497.             IVAL(ICO)=INCPO(IJB,IJA)
  498.  15       CONTINUE
  499. C
  500. C         JCARDO => pour les fous qui veulent se passer de la
  501. C                   normalisation des mult. de Lagrange :)
  502.           IF (INORMU.EQ.0) THEN
  503.             DMAX=1.D0
  504.             DMAXY=DMAX
  505.           ELSE
  506. C           Max termes diag des inconnues presentes dans la relation
  507.             DMAX=xpetit
  508. C           Boucle demarre a 3 car les deux premiers sont les multiplicateurs de lagrange
  509.             DO 19 ICO=3,N3
  510.               DMAX=MAX(DMAX,vmax(IVAL(ICO)))
  511.  19         CONTINUE
  512. C   AUX FINS D'EVITER DES PROBLEMES DANS LA DECOMPOSITION
  513.             IF (IIMPI.EQ.1524) WRITE(IOIMP,7391)DMAX,IENMU,IENMU1,I,IEL
  514.  7391       FORMAT(' DMAX IENMU IENMU1 I IEL',1E12.5,4I3)
  515.             IF (DMAX.LE.XZPREC*DMAXGE) THEN
  516.               IF (IENMU.NE.IENMU1.AND.IEL.EQ.1) GOTO 377
  517.               DMAX=DMAXGE
  518.             ENDIF
  519.             DMAX=DMAX*1.5D0
  520. C           Max des coeffs de la relation
  521.             DMAXY=SQRT(XPETIT)*1D5
  522.             IF (.NOT.bNORMAL) DMAXY=1.D0
  523. *  demarrage a 3 aussi. On a toujours 1 -1 sur les LX
  524.             DO ICO=3,N1
  525.               DMAXY=MAX(DMAXY,ABS(RE(ICO,1,IEL)))
  526.             ENDDO
  527.             DMAX = DMAX / DMAXY
  528. C
  529.             if (bSUP) dmax=dnor(ival(1))
  530.           ENDIF
  531. C
  532.           IF (IIMPI.EQ.1524) WRITE(IOIMP,7398) DMAX
  533.  7398     FORMAT('  facteur multiplicatif de norme ',e12.5)
  534.           DO 21 ICO=1,N1
  535.             DO 2110 IKO=1,N3
  536.               RA(ICO,IKO)=RE(ICO,IKO,IEL)*COER*DMAX
  537.  2110       CONTINUE
  538.  21       CONTINUE
  539. **  si on ne booste pas l'egalite des mults on a des problemes de precision sur ceux ci
  540.           IF (.NOT.bNORMAL) DMAXY=DMAXY*2.D0
  541.           RA(1,1)=RA(1,1)*DMAXY
  542.           RA(2,1)=RA(2,1)*DMAXY
  543.           RA(1,2)=RA(1,2)*DMAXY
  544.           RA(2,2)=RA(2,2)*DMAXY
  545.           IF (.NOT.bSUP) THEN
  546.             DO 22 ICO=1,2
  547.               DNOR(IVAL(ICO))=DMAX
  548.               IF (bNONSYM) MDNO1.DNOR(IVAL(ICO))=DMAX
  549.    22       CONTINUE
  550.           ENDIF
  551.           DO 24 ICO=1,N3
  552.             INO=INUINV(NUM(NOELEP(ICO),IEL))
  553.             IO=IVAL(ICO)
  554.             if (ico.eq.1) io1=io
  555.             if (ico.eq.2) io2=io
  556.             LLIGN=MILIGN.ILIGN(INO)
  557.             SEGACT,LLIGN*MOD
  558.             IF (.NOT.bSUP) DIAG(IO)=DIAG(IO)+RA(ICO,ICO)
  559.             DO 132 JLIJ=1,IMMMM(/1)
  560.               JLIJ1=JLIJ
  561.               IF (IMMMM(JLIJ).EQ.IO) GOTO 133
  562.  132        CONTINUE
  563.             IF (IIMPI.EQ.1524) WRITE(IOIMP,7354)
  564.  7354       FORMAT( ' PREMIERE ERREUR 5')
  565.             CALL ERREUR(5)
  566.             RETURN
  567.  133        CONTINUE
  568.             DO 26 IRO=1,N1
  569.               IA=IVAL(IRO)
  570.               IF (IA.GT.IO) GOTO 26
  571.               JLT=IPPO(JLIJ1+1)
  572.               JLD=IPPO(JLIJ1)+1
  573.               DO 134 JL=JLD,JLT
  574.                 JL1=JL
  575.                 IF (LINC(JL).EQ.IA) GOTO 135
  576.  134          CONTINUE
  577.               IF (IIMPI.NE.1524) WRITE(IOIMP,7355)
  578.  7355         FORMAT( ' DEUXIEME ERREUR 5')
  579.               CALL ERREUR(5)
  580.               RETURN
  581.  135          CONTINUE
  582.               IF (bSUP) THEN
  583.                 XXVA(JL1)=XXVA(JL1)+RA(IRO,ICO)
  584.               else
  585.                 XXVA(JL1)=XXVA(JL1)+RA(ICO,IRO)
  586.               endif
  587.  26         CONTINUE
  588.             SEGDES,LLIGN
  589.  24       CONTINUE
  590. C  on stocke dans ittr les couples de LX
  591.           MILIGN.ittr(io1)=io2
  592.           MILIGN.ittr(io2)=io1
  593. C
  594.           IF (bNONSYM.AND.(.NOT.bSUP)) THEN
  595.             MILIGN=IILIGS
  596.             bSUP=.TRUE.
  597.             GOTO 213
  598.           ENDIF
  599. C
  600.  14     CONTINUE
  601.         INOMUL(I)=.TRUE.
  602.  377    CONTINUE
  603.         SEGSUP,RA
  604.  11   CONTINUE
  605.       GOTO 375
  606. C
  607.  3750 CONTINUE
  608. C  PV ON DESACTIVE TOUT
  609.       NNR=IRIGEL(/2)
  610.       DO 2 IRI=1,NNR
  611.         DESCR=IRIGEL(3,IRI)
  612.         SEGDES DESCR
  613.         IPT1=IRIGEL(1,IRI)
  614.         XMATRI=IRIGEL(4,IRI)
  615.         SEGDES XMATRI
  616.    2  CONTINUE
  617. C
  618.       IF (IIMPI.EQ.1457) WRITE(IOIMP,4821) LLVNUL,NJTOT
  619.  4821 FORMAT('  NB DE VALEURS NON NULLES DANS LA MATRICE ',I9,/
  620.      &       '  NB DE VALEURS DANS LA MATRICE            ',I9)
  621. C
  622. C     Suppression des matrices normalisees
  623.       IF (bNORMAL) CALL ASSE10(MRIGID,2,INUIN1,inwuit)
  624. C
  625.       ITOPO=ITOPO1
  626.       IITOP=IITOP1
  627.       IPOS=IPO1
  628.       SEGSUP,IITOP,ITOPO,IPOS
  629.       DO IK=1,NNR
  630.         INCTRA=INCTRR(IK)
  631.         SEGSUP,INCTRA
  632.       ENDDO
  633.       SEGSUP,INCTRR
  634.       IF (bNONSYM) THEN
  635.         ITOPO=ITOPO2
  636.         IITOP=IITOP2
  637.         IPOS=IPO2
  638.         SEGSUP,IITOP,ITOPO,IPOS
  639.         DO IK=1,NNR
  640.           INCTRB=INCTRS(IK)
  641.           SEGSUP,INCTRB
  642.         ENDDO
  643.         SEGSUP,INCTRS
  644.         SEGDES,MIPO1
  645.       ENDIF
  646.       SEGSUP,INUINV
  647. C
  648.       SEGACT MRIGID*MOD
  649.       NNR=IRIGEL(/2)
  650.       DO IRI=1,NNR
  651.         IPT2=IRIGEL(2,IRI)
  652.         IF (IPT2.NE.0) THEN
  653.           SEGSUP,IPT2
  654.           IRIGEL(2,IRI)=0
  655.         ENDIF
  656.       ENDDO
  657.       SEGDES,MRIGID
  658.       SEGDES,MINCPO
  659.       SEGDES,MDIAG
  660.       SEGDES,MDNOR
  661.       SEGDES,MILIGN
  662.       SEGDES,MMATRI
  663.       SEGSUP,IVAL,ITRA,JNOMUL,VMAX
  664.       END
  665.  
  666.  
  667.  

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