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

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