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    GOUNAND   24/11/12    21:15:03     12076          
  2.       SUBROUTINE ASSEM2(ITRAV1,ITOPO1,INUIN1,IMINI1,MMMTRI,IPO1,INCTR1
  3.      $     ,IITOP1)
  4. C
  5. C  ****  SUBROUTINE POUR FAIRE L'ASSEMBLAGE DE MATRICES SYMETRIQUES
  6. C        EN VUE D'UN TRAITEMENT PAR METHODE DE KROUT.
  7. C
  8. C  EN ENTREE:
  9. C  ****  ITRAV1 : POINTEUR OBJET MRIGIDITE
  10. C  ****  ITOPO1 : POINTEUR SEGMENT DE TRAVAIL ITOPO ( VOIR ASSEM1)
  11. C  ****  IITOP1 : POINTEUR SEGMENT DE TRAVAIL IITOP ( VOIR ASSEM1)
  12. C  ****  INUIN1 : POINTEUR SEGMENT DE TRAVAIL INUINV(VOIR ASSEM1)
  13. C  ****  IMINI1 : POINTEUR SEGMENT DE TRAVAIL IMINI (VOIR ASSEM1)
  14. C  ****  IPO1   : POINTEUR SEGMENT DE TRAVAIL IPOS  (VOIR ASSEM1)
  15. C  ****  MMMTRI : POINTEUR OBJET MATRICE TRIANGULARISEE (NON MODIFIE)
  16. C                 (VOIR SMMATRI)
  17. *
  18. *  modif janvier 2015 toutes les inconnues d'un noeud commencent à la même colonne
  19. *  modif mars 2018 la verification de symetrie des matrices elementaires est externalisee
  20. *
  21.       IMPLICIT REAL*8 (A-H,O-Z)
  22.       IMPLICIT INTEGER(I-N)
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMELEME
  26. -INC SMRIGID
  27. -INC SMMATRI
  28. -INC CCREEL
  29.       SEGMENT,INUINV(NNGLOB)
  30.       SEGMENT,ITOPO(IENNO)
  31.       SEGMENT,IITOP(NNOE+1)
  32.       SEGMENT,IMINI(INC)
  33.       SEGMENT,IPOS(NNOE1)
  34.       SEGMENT,INCTRR(NIRI)
  35.       SEGMENT,INCTRA(NLIGRE)
  36.       SEGMENT,IPV(NNOE)
  37.       SEGMENT,VMAX(INC)
  38.  
  39. C
  40. C  ****  CES TABLEAUX SERVENT AU REPERAGE DE LA MATRICE POUR L'ASSEMBLAG
  41. C  ****  IL SERONT TOUS SUPPRIMES EN FIN D'ASSEMBLAGE.
  42. C
  43. **
  44.       SEGMENT,IVAL(NNN)
  45.       SEGMENT,ITRA(NNN,2)
  46.       SEGMENT TRATRA
  47.       REAL*8 XTRA(INCRED,INCDIF)
  48.       INTEGER LTRA(INC,INCDIF)
  49.       INTEGER NTRA(INCRED,INCDIF)
  50.       INTEGER MTRA(INCDIF)
  51.       ENDSEGMENT
  52. C  ****  IVAL(I)=J     : LA I EME LIGNE D'UNE PETITE MATRICE S'ASSEMBLE
  53. C                      DANS LA J EME DE LA GRANDE.
  54. C  ****   ITRAV(I,1)=J : LA IEME INCONNUE DU NOEUD EN COURS D'ASSEMBLAGE
  55. C                      ET QUI SE TROUVE DANS LA PETITE MATRICE SE TROUVE
  56. C                      EN J EME POSITION DE LA PETITE MATRICE.
  57. C  ****   ITRAV(I,2)   : LA IEME INCONNUE DU NOEUD EN COURS D'ASSEMBLAGE
  58. C                      PRESENT DANS LA PETITE MATRICE EST EN JEME
  59. C                      POSITION DANS LA GRANDE
  60.       SEGMENT,RA(N1,N1)*D
  61.       SEGMENT JNOMUL
  62.          LOGICAL INOMUL(NNR)
  63.       ENDSEGMENT
  64.       REAL*8 DMAX,COER,DDDD,DMAXY,DMAXGE
  65.       LOGICAL NOMUL
  66. **    nbver=0
  67. *
  68. *  PV  ON ACTIVE UNE FOIS POUR TOUTES LES MELEME DESCR... DE LA RIGIDITE
  69. *      ON EN PROFITE POUR CREER INOMUL
  70. C
  71. C  ****  RECHERCHE DE LA DIMENSION MAX DE IVAL,ET SEGINI DE IVAL ET ITRA
  72. C
  73.       INCTRR=INCTR1
  74.       SEGACT,INCTRR
  75.  
  76.       MRIGID=ITRAV1
  77.       SEGACT,MRIGID
  78.       NNR=IRIGEL(/2)
  79.       NNN=0
  80.       SEGINI JNOMUL
  81.       DO 1 IRI=1,NNR
  82.          INCTRA=INCTRR(IRI)
  83.          SEGACT INCTRA
  84.          DESCR=IRIGEL(3,IRI)
  85.          SEGACT, DESCR
  86.          IPT1=IRIGEL(1,IRI)
  87.          SEGACT IPT1
  88.          ipt2=IRIGEL(2,IRI)
  89.          if (ipt2.ne.0) segact,ipt2
  90. *      XMATRI=IRIGEL(4,IRI)
  91. *      SEGACT XMATRI
  92.          NA=LISINC(/2)
  93.          NNN=MAX(NA,NNN)
  94.          INOMUL(IRI)=.TRUE.
  95.          IF(IPT1.ITYPEL.EQ.49) INOMUL(IRI)=.FALSE.
  96.    1  CONTINUE
  97.       SEGINI,IVAL
  98.       SEGINI,ITRA
  99. C
  100. C  ****  ACTIVATION DES SEGMENTS DE TRAVAILS ET DE MMATRI
  101. C
  102. *      IMINI=IMINI1
  103. *      SEGACT,IMINI
  104. *      N1=IMINI(/1)
  105.       ITOPO=ITOPO1
  106.       SEGACT,ITOPO
  107.       IITOP=IITOP1
  108.       SEGACT,IITOP
  109. *
  110.       INUINV=INUIN1
  111.       SEGACT,INUINV
  112.       IPOS=IPO1
  113.       SEGACT,IPOS
  114. *
  115.       NNOE=IPOS(/1)-1
  116. *
  117.       INC=IPOS(NNOE+1)
  118.       MMATRI=MMMTRI
  119.       SEGACT,MMATRI*MOD
  120.       SEGINI,MDIAG
  121.       SEGINI,MILIGN
  122.       IILIGN=MILIGN
  123.       IDIAG=MDIAG
  124.       MINCPO=IINCPO
  125.       SEGACT,MINCPO
  126.       INCDIF=INCPO(/1)
  127. *
  128.       MIMIK=IIMIK
  129.       SEGACT,MIMIK
  130.       SEGINI IPV
  131.       INCRED=0
  132.       DO 80 INO =1,NNOE
  133.          ICOMPT=0
  134.          MAXELE = (IITOP(INO+1)-IITOP(INO))/2
  135.          DO 81 IELE=1,MAXELE
  136.             IIU=IITOP(INO) + IELE + IELE -2
  137.             IEL=ITOPO(IIU)
  138.             IRI=ITOPO(IIU+1)
  139.             meleme=IRIGEL(2,IRI)
  140.             if (meleme.eq.0) meleme=IRIGEL(1,IRI)
  141.             DO 83 I=1,NUM(/1)
  142.                IP=INUINV(NUM(I,IEL))
  143.                IF (IP.GT.INO) GOTO 83
  144.                IF (IPV(IP).EQ.INO) GOTO 83
  145.                IPV(IP)=INO
  146.                ICOMPT=ICOMPT+1
  147.  83         CONTINUE
  148.  81      CONTINUE
  149.          INCRED=MAX(INCRED,ICOMPT)
  150.   80  CONTINUE
  151.       SEGSUP IPV
  152. *
  153.       INCRED=INCRED*INCDIF
  154.       SEGINI TRATRA
  155.       segini vmax
  156. C
  157. C  ****  BOUCLE   *100* SUR LES NUMEROS DE NOEUDS QUE L'ON ASSEMBLE
  158. C
  159.       LLVNUL=0
  160.       IJMAX=0
  161.       NJTOT=0
  162.       NNOE=IPOS(/1)-1
  163.       SEGINI MDNOR
  164.       IDNORM=MDNOR
  165. *
  166. * en cas de normalisation des variables.
  167. *
  168.       IF(NORINC.NE.0)  THEN
  169.          inwuit=0
  170.          CALL ASSE10(ITRAV1,1,MDNOR,MIMIK,MINCPO,INUIN1,inwuit)
  171.       ELSE
  172.          DO 53 IU=1,INC
  173.             DNOR(IU)=1.d0
  174.  53      CONTINUE
  175.       ENDIF
  176. *  verif de la symetrie des matrices elementaires (sauf le super element qui peut etre tres grand)
  177.       do jr=1,irigel(/2)
  178.        IPT6=IRIGEL(1,JR)
  179.        if (ipt6.itypel.ne.28) then
  180.         XMATRI=IRIGEL(4,jr)
  181.         SEGACT XMATRI*mod
  182. **      nbver=max(nbver,re(/1))
  183.         if(symver.ne.1) call versym(re,re(/1),re(/2),re(/3),0)
  184.         if (ierr.ne.0) return
  185.         symre=0
  186.         symver=1
  187.         segdes xmatri
  188.        endif
  189.       enddo
  190. *     On balaye les noeuds dans l'ordre des elements
  191. *     (Pourquoi ? Dans le non-symétrique, ce n'est pas fait ldmt2.eso )
  192.       DO 100 JR=1,IRIGEL(/2)
  193.          ipt6=IRIGEL(2,JR)
  194.          if (ipt6.eq.0) ipt6=IRIGEL(1,JR)
  195.          DO 101 JL=1,IPT6.num(/2)
  196.             DO 102 JP=1,IPT6.num(/1)
  197.                INO=INUINV(IPT6.NUM(JP,JL))
  198. **     DO 100 INO=1,NNOE
  199.                IF (ILIGN(INO).NE.0) GOTO 102
  200.                DO 103 IIT=1,INCDIF
  201.                   MTRA(IIT)=0
  202.  103           CONTINUE
  203.                IPRE=IPOS(INO)+1
  204.                IDER=IPOS(INO+1)
  205.                LLVVA=0
  206. C
  207. C  ****  BOUCLE   *99*   SUR LES ELEMENTS TOUCHANT LE NOEUD INO
  208. C                        POUR LES ELEMNTS MULTIPLICATEUR ON NE FAIT PAS
  209. C                        L'ASSEMBLAGE
  210. C
  211.                MAXELE= (IITOP(INO+1) -IITOP(INO))/2
  212.                DO 99 IELE=1,MAXELE
  213.                   IIU=IITOP(INO) + IELE + IELE - 2
  214.                   IEL=ITOPO(IIU)
  215.                   IRI=ITOPO(IIU+1)
  216.                   MELEME=IRIGEL(1,IRI)
  217.                   DESCR=IRIGEL(3,IRI)
  218.                   INCTRA=INCTRR(IRI)
  219.                   XMATRI=IRIGEL(4,IRI)
  220.                   SEGACT XMATRI
  221.                   COER=COERIG(IRI)
  222. C
  223. C  ****  NOMUL =.FALSE.  IL EXISTE  UN MULTUIPLICATEUR
  224. C  ****  INITIALISATION DE IVAL. IVAL(I)=J VEUT DIRE QUE
  225. C  ****  LA I EME LIGNE DE LA PETITE MATRICE S'ASSEMBLE DANS
  226. C  ****  LA J EME DE LA GRANDE MATRICE.
  227. C
  228.                   NIN=LISINC(/2)
  229.                   NOMUL=INOMUL(IRI)
  230.                   NA=0
  231.                   DO 98 ICO=1,NIN
  232.                      IJA=INUINV(NUM(NOELEP(ICO),IEL))
  233.                      IJB=INCTRA(ICO)
  234.                      IVAL(ICO)=INCPO(IJB,IJA)
  235.                      IF(IJA.NE.INO)  GO TO 98
  236.                      NA=NA+1
  237.                      ITRA(NA,1)=ICO
  238.                      ITRA(NA,2)=IVAL(ICO)
  239.  98               CONTINUE
  240. *      XMATRI=IMATTT(IEL)
  241. *      SEGACT,XMATRI
  242. C
  243. C  ****  BOUCLE  *95* SUR LES INCONNUES DE LA PETITE MATRICE
  244. C
  245.                   DO 90 INCC=1,NA
  246.                      INCO=ITRA(INCC,2)
  247.                      if (inco.gt.ider) goto 90
  248.                      ILOC=INCO-IPRE+1
  249.                      JJ=ITRA(INCC,1)
  250.                      DO 95 IK=1,NIN
  251.                         IO=IVAL(IK)
  252.                         IF(IO.GT.INCO)  GO TO 95
  253. *?                        IPOO=IK*NIN - NIN
  254. *?                        IPO=IPOO+JJ
  255.                         ILTT= LTRA(IO,ILOC)
  256.                         IF(ILTT.EQ.0) THEN
  257.                            LLVVA=LLVVA+1
  258.                            IMMTT=MTRA(ILOC)+1
  259.                            MTRA(ILOC)=IMMTT
  260.                            XTRA(IMMTT,ILOC)=0.D0
  261.                            NTRA(IMMTT,ILOC)=IO
  262.                            LTRA(IO,ILOC)=IMMTT
  263.                            ILTT=IMMTT
  264.                         ENDIF
  265.                         IF(NOMUL) THEN
  266. **    XTRA(ILTT,ILOC)=XTRA(ILTT,ILOC)+RE(JJ,IK,IEL)*COER
  267. ** on utilise la symetrie de re
  268.                            XTRA(ILTT,ILOC)=XTRA(ILTT,ILOC)+RE(IK,JJ,IEL)
  269.      $                          *COER
  270.                         ENDIF
  271.  95                  CONTINUE
  272.  90               CONTINUE
  273.                   SEGDES,XMATRI
  274.  99            CONTINUE
  275. C
  276. C  *** COMPACTAGE DES LIGNES, EN MEME TEMPS CALCUL DE IJMAX QUI SERA
  277. C  *** LA DIMENSION MAX D'UN SEGMENT LIGN.
  278. C  *** LE SEGMENT ASSOCIE A UNE LIGNE (SEGMENT LLIGN)EST DE LA FORME :
  279. C  *** IMMMM(NA) PERMET DE SAVOIR SI UN MOUVENENT D'ENSEMBLE SUR LA
  280. C  *** LIGNE EXISTE. IPPO(NA+1) DONNE LA POSITION DANS XXVA LA 1ERE
  281. C  *** VALEUR DE LA LIGNE .XXVA  VALEUR DE LA MATRICE.
  282. C  *** LINC(I)DONNE LE NUMERO DE LA COLONNE DU IEME ELEM DE XXVA
  283. C
  284.                NA = IDER-IPRE+1
  285.                LLVNUL=LLVNUL+LLVVA
  286.                SEGINI,LLIGN
  287.                ILIGN(INO)=LLIGN
  288.                NBA=0
  289.                DO 120 JPA=1,NA
  290.                   IIIN=IPRE+JPA -1
  291.                   IMMMM(JPA)=IIIN
  292.                   IPPO(JPA)=NBA
  293.                   DO 121 IPAK = 1,MTRA(JPA)
  294.                      IUNPAK=NTRA(IPAK,JPA)
  295.                      LTRA(IUNPAK,JPA)=0
  296. ** pas mur pour le test suivant
  297. ***   if (abs(xtra(ipak,jpa)).gt.xpetit) then
  298.                      NBA=NBA+1
  299.                      LINC(NBA)=IUNPAK
  300.                      XXVA(NBA)=XTRA(IPAK,JPA)
  301. **    write (6,*) 'assem2 iiin nba xxva(nba)',
  302. **   >                    iiin,nba,xxva(nba)
  303.                      vmax(iiin)=max(abs(xxva(nba)),vmax(iiin))
  304. ***   endif
  305.                      IF(IIIN.EQ.IUNPAK) DIAG(IIIN)=xtra(ipak,jpa)
  306.  121              CONTINUE
  307.  120           CONTINUE
  308.                IPPO(NA+1)= NBA
  309.                NJMAX= 0
  310. *  recherche du mini globale sur toutes les inconnues
  311.                LPA=IPRE
  312.                DO 126 JPA=IPRE,IDER
  313.                   IPNO(JPA)=INO
  314.                   IPDE=IPPO(JPA-IPRE+1)+1
  315.                   IPDF=IPPO(JPA-IPRE+2)
  316.                   DO 155 JHT=IPDE,IPDF
  317.                      LPA=MIN(LPA,LINC(JHT))
  318.  155              CONTINUE
  319.  126           CONTINUE
  320.                DO 127 JPA=IPRE,IDER
  321.                   LDEB(JPA-IPRE+1)=LPA
  322.                   NNA= JPA- LPA       +1
  323.                   NJMAX=NJMAX+NNA
  324.  127           continue
  325.                NJTOT=NJTOT+NJMAX
  326.                IF(IJMAX.LT.NJMAX) IJMAX=NJMAX
  327.                SEGDES,LLIGN
  328.  102        CONTINUE
  329.  101     CONTINUE
  330.  100  CONTINUE
  331.       SEGSUP TRATRA
  332. C
  333. C  ****  ON REPREND TOUTE LES MATRICES CONTENANT LES MULTIPLICATEURS
  334. C  ****  POUR MULTIPLIER TOUS LEURS TERMES PAR UNE NORME ATTACHEE
  335. C  ****  A CHAQUE MULTIPLICATEUR. PUIS ON LES ASSEMBLE.
  336. C
  337. *  d'abord etablir une norme generale pour le cas ou on n'arrive pas
  338. *  a calculer la norme particuliere
  339.       DMAXGE=xpetit
  340.       DO 378 I=1,INC
  341. **    write (6,*) ' assem2 diag vmav ',diag(i),vmax(i)
  342.          DMAXGE=MAX(DMAXGE,abs(vmax(i)))
  343.   378 CONTINUE
  344.       if (iimpi.ne.0   )
  345.      >  write (6,*) ' nb inconnues facteur multiplicatif general ',
  346.      >  INC,DMAXGE
  347.       if (dmaxge.lt.xpetit/xzprec) dmaxge=1.d0
  348.       IENMU=0
  349.  375  IENMU1 = IENMU
  350.       IENMU=0
  351.       DO 376 I=1,NNR
  352.          IF(.NOT.INOMUL(I)) IENMU=IENMU+1
  353.  376  CONTINUE
  354.       IF( IENMU.EQ.0) GO TO 3750
  355.       MIMIK=IIMIK
  356.       SEGACT,MIMIK
  357.       DO 11 I=1,NNR
  358.          IF(INOMUL(I)) GO TO 11
  359.          DESCR=IRIGEL(3,I)
  360.          N3=LISINC(/2)
  361.          COER=COERIG(I)
  362.          MELEME=IRIGEL(1,I)
  363.          INCTRA=INCTRR(I)
  364.          XMATRI=IRIGEL(4,I)
  365.          SEGACT XMATRI
  366.          N2=NUM(/2)
  367.          IF (RE(/3).EQ.0) THEN
  368.             INOMUL(I)=.TRUE.
  369.             SEGDES XMATRI
  370.             GOTO 11
  371.          ENDIF
  372. *      XMATRI=IMATTT(1)
  373. *      SEGACT,XMATRI
  374.          N1=RE(/1)
  375. c     ERREUR 756 : La matrice de rigidite n'est pas carree
  376.          if (n1.ne.re(/2)) call erreur(756)
  377.          if (ierr.ne.0) return
  378.          SEGINI,RA
  379.          DO 14 IEL=1,N2
  380.             DO 15 ICO=1,N3
  381.                IJA=INUINV(NUM(NOELEP(ICO),IEL))
  382.                IJB=INCTRA(ICO)
  383.                IVAL(ICO)=INCPO(IJB,IJA)
  384.  15         CONTINUE
  385.             DMAX=xpetit
  386. *  la boucle suivante demarre 3 car les deux premiers sont les multiplicateurs de lagrange
  387.             DO 19 ICO=3,N3
  388.                DMAX=MAX(DMAX,vmax(IVAL(ICO)))
  389.  19         CONTINUE
  390. **    write (6,*) ' assem2 dmax dmaxge ',dmax,dmaxge
  391. C   AUX FINS D'EVITER DES PROBLEMES DANS LA DECOMPOSITION
  392.             IF( IIMPI. EQ.1524 ) WRITE(IOIMP,7391)DMAX,IENMU,IENMU1,I
  393.      $           ,IEL
  394.  7391       FORMAT(' DMAX  IENMU IENMU1 I  IEL',1E12.5,4I3)
  395. **    write (6,*) ' assem2 dmax dmxge',dmax,dmaxge
  396.             IF(DMAX.LE.xzprec*dmaxge.AND.IENMU.NE.IENMU1.AND.IEL.EQ.1)
  397.      $           GOTO 377
  398.             IF(DMAX.LE.xzprec*dmaxge) DMAX = DMAXGE
  399. *  facteur de normalisation cf PV pour ne pas avoir de pivot nul
  400.             DMAX=DMAX*1.5D0
  401. *  on penalise la matrice en cas de resolution iterative
  402. **pv  if (nucrou.eq.1) DMAX=DMAX*1D5
  403. **    write (6,*) ' assem2 i iel dmax ',i,iel,dmax
  404. *      XMATRI=IMATTT(IEL)
  405. *      SEGACT,XMATRI
  406.             DMAXY=SQRT(XPETIT)*1D5
  407.             if (norinc.eq.0) dmaxy=1.D0
  408. *  demarrage a 3 aussi. On a toujours 1 -1 sur les LX
  409.             DO 821 ICO=3,N1
  410.                DMAXY = MAX ( DMAXY, ABS(RE(ICO,1,IEL)))
  411.  821        CONTINUE
  412. *     if (dmaxy.lt.1d-50) write (6,*) (re(ico,1),ico=1,n1)
  413. **    if (dmaxy.lt.1d+50)write (6,*)' assem2 dmax dmaxy ',
  414. **   >       dmax,dmaxy,dmaxge
  415.             DMAX = DMAX / DMAXY
  416.             IF( IIMPI. EQ.1524 ) WRITE(IOIMP,7398) DMAX
  417.  7398       FORMAT('  facteur multiplicatif de norme ',e12.5)
  418.             DO 21 ICO=1,N1
  419.                DO 2110 IKO=1,N1
  420.                   RA(ICO,IKO)=RE(ICO,IKO,IEL)*coer*DMAX
  421.  2110          CONTINUE
  422.  21         CONTINUE
  423. **    write (6,*) ' dmax ',dmax
  424. **  si on ne booste pas l'egalite des mults on a des problemes de precision sur ceux ci
  425.             if (norinc.eq.0) dmaxy=dmaxy*2.d0
  426.             RA(1,1)=RA(1,1)*DMAXY
  427.             RA(2,1)=RA(2,1)*DMAXY
  428.             RA(1,2)=RA(1,2)*DMAXY
  429.             RA(2,2)=RA(2,2)*DMAXY
  430.             DO 22 ICO=1,2
  431.                DNOR(IVAL(ICO))=DMAX
  432.  22         CONTINUE
  433. *      if (abs(dmax).gt. 1d50) write (6,*) ' assem2 dmax dmaxy ',dmax,
  434. *     >  dmaxy,dmaxge
  435.             DO 24 ICO=1,N3
  436.                INO=INUINV(NUM(NOELEP(ICO),IEL))
  437.                IO=IVAL(ICO)
  438.                if (ico.eq.1) io1=io
  439.                if (ico.eq.2) io2=io
  440.                LLIGN=ILIGN(INO)
  441.                SEGACT,LLIGN*MOD
  442.                DIAG(IO)=DIAG(IO)+RA(ICO,ICO)
  443.                DO 132 JLIJ=1,IMMMM(/1)
  444.                   JLIJ1=JLIJ
  445.                   IF( IMMMM(JLIJ).EQ.IO) GO TO 133
  446.  132           CONTINUE
  447.                IF(IIMPI.EQ.1524) WRITE(IOIMP,7354)
  448.  7354          FORMAT( ' PREMIERE ERREUR 5')
  449.                CALL ERREUR(5)
  450.                RETURN
  451.  133           CONTINUE
  452. *      IREE=ICO*N3-ICO
  453.                DO 26 IRO=1,N3
  454.                   IA=IVAL(IRO)
  455.                   IF(IA.GT.IO) GO TO 26
  456. *      IF(IRO.LE.ICO) IRE=(ICO*(ICO-1))/2+IRO
  457. *      IF(IRO.GT.ICO) IRE=(IRO*(IRO-1))/2+ICO
  458.                   JLT=IPPO(JLIJ1+1)
  459.                   JLD=IPPO(JLIJ1)+1
  460.                   DO 134 JL=JLD,JLT
  461.                      JL1=JL
  462.                      IF(LINC(JL).EQ.IA) GO TO 135
  463.  134              CONTINUE
  464.                   IF(IIMPI.NE.1524) WRITE(IOIMP,7355)
  465.  7355             FORMAT( ' DEUXIEME ERREUR 5')
  466.                   CALL ERREUR(5)
  467.                   RETURN
  468.  135              CONTINUE
  469.                   XXVA(JL1)=XXVA(JL1)+RA(ICO,IRO)
  470.  26            CONTINUE
  471.                SEGDES,LLIGN
  472.  24         CONTINUE
  473. *  on stocke dans ittr les couples de LX
  474.             ittr(io1)=io2
  475.             ittr(io2)=io1
  476.  14      CONTINUE
  477.          INOMUL(I)=.TRUE.
  478.  377     CONTINUE
  479.          SEGSUP,RA
  480.  11   CONTINUE
  481.       GO TO 375
  482.  3750 CONTINUE
  483.       DO 18 IK=1,NNR
  484.          INCTRA=INCTRR(IK)
  485.          SEGSUP,INCTRA
  486.  18   CONTINUE
  487. *  PV ON DESACTIVE TOUT
  488.       NNR=IRIGEL(/2)
  489.       DO 2 IRI=1,NNR
  490.          DESCR=IRIGEL(3,IRI)
  491.          SEGDES DESCR
  492.          IPT1=IRIGEL(1,IRI)
  493.          XMATRI=IRIGEL(4,IRI)
  494.          SEGDES XMATRI
  495.    2  CONTINUE
  496.  
  497.       INTERR(1)=NJTOT
  498.       IF(IIMPI.EQ.1457) WRITE(IOIMP,4821) LLVNUL,NJTOT
  499.  4821 FORMAT('  NB DE VALEURS NON NULLES DANS LA MATRICE ',I9,/
  500.      #       '  NB DE VALEURS DANS LA MATRICE            ',I9)
  501.       IF(NORINC.NE.0) THEN
  502.          CALL ASSE10(MRIGID,2,MDNOR,MIMIK,MINCPO,INUIN1,inwuit)
  503.           SEGDES,MRIGID
  504.       ELSE
  505.          SEGDES,MRIGID
  506.       ENDIF
  507.       SEGSUP,INCTRR
  508.       segact mrigid*mod
  509.       NNR=IRIGEL(/2)
  510.       DO  IRI=1,NNR
  511.          IPT2=IRIGEL(2,IRI)
  512.          IF (IPT2.NE.0) THEN
  513.             SEGSUP IPT2
  514.             IRIGEL(2,IRI)=0
  515.          ENDIF
  516.       ENDDO
  517.       segdes mrigid
  518.       SEGDES,MDIAG
  519.       SEGDES,MIMIK
  520.       SEGDES,MDNOR
  521. ccc      SEGSUP,IMINI
  522.       SEGSUP,ITOPO
  523.       SEGSUP,IITOP
  524.       SEGDES,MILIGN
  525.       SEGSUP,INUINV
  526.       SEGDES,MMATRI
  527.       MMMTRI=MMATRI
  528.       SEGDES,MINCPO
  529.       SEGDES,IPOS
  530.       SEGSUP,IVAL,ITRA,JNOMUL,vmax
  531. **    write(6,*) 'taille maxi matrice elementaire ',nbver
  532.       RETURN
  533.       END
  534.  
  535.  

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