Télécharger la plaquette Cast3M


fr en

Télécharger assem1.eso

Retour à la liste

Numérotation des lignes : 

assem1

  1. C ASSEM1    SOURCE    GOUNAND   24/11/12    21:15:02     12076          
  2.       SUBROUTINE ASSEM1(IPOIRI,MMATRX,INUINY,ITOPOY,IMINIY,IPOY
  3.      $     ,INCTRY,IITOPY)
  4. C
  5. C  CE SUBROUTINE SERT A L'ASSEMBLAGE DE MATRICES SYMETRIQUES
  6. C  EN VUE D'UNE INVERSION PAR UNE METHODE DE CROUT
  7. C
  8. C  EN ENTREE:
  9. C  ****  IPOIRI: POINTEUR SUR OBJET MRIGIDITE,NON MODIFIE
  10. C  EN SORTIE:
  11. C  ****  INUINV IMINI ITOPO IPOY INCTRY  SONT DES POINTEURS DES SEGMENTS
  12. C        DE TRAVAIL SERVANT A L'ASSEMBLAGE ILS SONT DETRUITS EN FIN
  13. C        D'ASSEMBLAGE OU DE TRIANGULARISATION
  14. C  ****  MMATRI EST LE POINTEUR DE L'OBJET FUTUR MATRICE TRIANGULARISEE.
  15.       IMPLICIT INTEGER(I-N)
  16.       IMPLICIT REAL*8 (A-H,O-Z)
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. -INC SMELEME
  20. -INC SMCOORD
  21. -INC CCREEL
  22.       SEGMENT,IMIN(NNOE)
  23.       SEGMENT ICPR(nbpts)
  24. C      SEGMENT IPB(NLIGRE)
  25. C
  26. -INC SMRIGID
  27. C
  28. -INC SMMATRI
  29. C
  30.       SEGMENT,INUINV(NNGLOB)
  31.       SEGMENT,ITOPO(IENNO)
  32.       SEGMENT,IITOP(NNOE+1)
  33.       SEGMENT,IMINI(INC)
  34.       SEGMENT,IPOS(NNOE1)
  35.       SEGMENT,INCTRR(NIRI)
  36.       SEGMENT,INCTRA(NLIGRE)
  37.       SEGMENT DIATMP(maxinc,NNOE)
  38.       segment strv
  39.        integer itrv1(maxinc)
  40.        integer itrv2(maxinc)
  41.        real*8 dtrv1(maxinc)
  42.        real*8 dtrv2(maxinc)
  43.       endsegment
  44. C
  45. C  ****  CES TABLEAUX SERVENT AU REPERAGE DE LA MATRICE POUR L'ASSEMBLAG
  46. C  ****  IL SERONT TOUS SUPPRIMES EN FIN D'ASSEMBLAGE.
  47. C
  48. C
  49. C  ****   MAXINC= MAXIMUM DE COMPOSANTES CONCERNANT UN NOEUD
  50. C
  51. C
  52. C  ****   IITOP(K)=I LE 1ER ELEMENT TOUCHANT LE NOEUD K SE TROUVE EN
  53. C                    IEME POSITION DANS ITOPO
  54. C  ****   ITOPO(I)=L: LE 1ER ELEMENT TOUCHANT LE K EME NOEUD DE LA
  55. C         ITOPO(I+1)=M  MATRICE EST LE LIEME  DE L'OBJET GEOMETRIE
  56. C                       DEFINI PAR LE POINTEUR M
  57. C  ****   IPOS(I)=J   : LA 1 ERE INCONNUE DU NOEUD I EST EN J+1 EME
  58. C                       POSITION
  59. C  ****  IMINI(I)=J     LA PLUS PETITE INCONNUE QUI EST RELIEE A LA IEME
  60. C                       EST L'INCONNUE J.
  61. C  ****  INUINV(I)=J    J EST LE NOUVEAU NUMERO DU NOEUD I
  62. C
  63. *      DATA MOALFA/'ALFA'/
  64.       CHARACTER*4 CNOHA
  65.       integer*4   noha
  66.       equivalence (cnoha,noha)
  67.       DATA CNOHA/'NOHA'/
  68.       DATA IPOIN/1/
  69.  
  70.       NNGLOB=nbpts
  71.       MRIGID=IPOIRI
  72. *
  73. C     Quelquefois, les points de IRIGEL(1,I) ne sont pas
  74. C     tous references par le segment DESCR (cas des QUAFs notamment).
  75. C     Dans ce cas, on fait une reduction du MELEME et on le stocke dans
  76. C     IRIGEL(2,I)
  77. C
  78.       CALL RDSCRM(MRIGID)
  79.       IF (IERR.NE.0) RETURN
  80. *
  81.       SEGACT,MRIGID
  82.       NNVA=IRIGEL(/2)
  83.       NIRI=NNVA
  84.       SEGINI,INCTRR
  85.  
  86.       if (nnva.eq.0) goto 801
  87.       MELEME=IRIGEL(1,1)
  88.       SEGACT MELEME
  89.       IF(ITYPEL.NE.27) GO TO 801
  90. C
  91. C  **** ASSEMBLAGE DANS LE CAS DE L'ANALYSE MODALE. ON COMPTE LES POINTS
  92. C  **** DANS ICPR
  93. C
  94.       SEGINI INUINV,ICPR
  95.       IKI=0
  96.       DO 700 I=1,NNVA
  97.          meleme=irigel(2,i)
  98.          if (meleme.eq.0) meleme=IRIGEL(1,I)
  99.          SEGACT MELEME
  100.          NBNN=NUM(/1)
  101.          NBELEM=NUM(/2)
  102.          DO  I1=1,NBELEM
  103.             DO 701 I2=1,NBNN
  104.                IP1=NUM(I2,I1)
  105.                IF(ICPR(IP1).NE.0) GO TO 701
  106.                IKI=IKI+1
  107.                ICPR(IP1)=IKI
  108.  701        CONTINUE
  109.          enddo
  110.  700  CONTINUE
  111. C
  112. C  **** FABRICATION DU TABLEAU INUINV
  113. C  **** ON MET LES POINTS QUI ONT POUR INCONNUE ALFA EN TETE
  114. C
  115.       NNOE=IKI
  116.       NALFA=0
  117.       NBETA=0
  118.       DO 710 I=1,NNVA
  119.          meleme=irigel(2,i)
  120.          if (meleme.eq.0) meleme=IRIGEL(1,I)
  121.          DESCR =IRIGEL(3,I)
  122.          SEGACT MELEME,DESCR
  123.          NBNN=NUM(/1)
  124.          NBELEM=NUM(/2)
  125.          NLIGRE=LISINC(/2)
  126. *     SEGINI IPB                         A QUOI CA SERT  PV
  127. *     DO 703 K=1,NLIGRE
  128. *     IPB(NOELEP(K))=K
  129. *703  CONTINUE
  130.          DO  I1=1,NBELEM
  131.             DO 711 I2=1,NBNN
  132.                IP1=NUM(I2,I1)
  133.                IF(ICPR(IP1).EQ.0) GO TO 711
  134. *     IJA=IPB(I2)
  135. *     IF(IJA.NE.MOALFA) GO TO 715
  136. *     NALFA=NALFA+1
  137. *     IKI=NALFA
  138. *     GO TO 716
  139.  715           CONTINUE
  140.                NBETA=NBETA+1
  141.                IKI=NNOE-NBETA+1
  142.  716           CONTINUE
  143.                INUINV(IP1)=IKI
  144.                ICPR(IP1)=0
  145.  711        CONTINUE
  146.          enddo
  147.          SEGDES DESCR
  148. *     SEGSUP IPB
  149.  710  CONTINUE
  150.       SEGSUP ICPR
  151.       ICDOUR=NNOE
  152.       GO TO 800
  153. C
  154. C  ****  ON FABRIQUE UN NOUVEL OBJET GEOMETRIE CONTENANT TOUTES LES
  155. C  ****  GEOMETRIES ELEMENTAIRES. CET OBJET CONTIENT NNVA OBJETS
  156. C  ****  GEOMETRIQUES ELEMENTAIRES. PUIS ON ENVOIE DANS NUMOPT QUI
  157. C  ****  FOURNIT EN RETOUR INUINV(NUM(I,J))=K DONNE LE NOUVEAU
  158. C  ****  NUMERO LOCAL DU POINT NUM(I,J).K VARIE DE 1 A ICDOUR.
  159. C  ****  LE PREMIER NOEUD DE L'OBJET GEOMETRIQUE EST LE PREMIER NOEUD
  160. C  ****  DE LA MATRICE, ETC...
  161. C
  162.  801  CONTINUE
  163.       IKK=1
  164.  722  CONTINUE
  165.       IF(IKK.GT.NNVA)  GO TO 723
  166.       MELEME=IRIGEL(1,IKK)
  167.       SEGACT,MELEME
  168.       DESCR=IRIGEL(3,IKK)
  169.       SEGACT,DESCR
  170.       NLIGRE=LISINC(/2)
  171.       DO 720 K=1,NLIGRE
  172.          IF(LISINC(K).NE.'LX  ') GO TO 721
  173.   720 CONTINUE
  174.       SEGDES,DESCR
  175.       IKK=IKK+1
  176.       IF(IKK.LE.NNVA)  GO TO 722
  177.  723  continue
  178.       DO 4862 I=1,NNVA
  179.          MELEME= IRIGEL(1,I)
  180.          SEGACT MELEME
  181.          if (num(/2).eq.0) goto 4862
  182.          IF(ITYPEL.EQ.49) THEN
  183.             DESCR=IRIGEL(3,I  )
  184.             SEGACT,DESCR
  185.             K = 3
  186.             if (num(/2).le.2) k=num(/2)
  187.             GO TO 4863
  188.          ENDIF
  189.  4862 CONTINUE
  190.       K=1
  191.       do ir=1,nnva
  192.        MELEME= IRIGEL(1,ir)
  193.        segact meleme
  194.        if (num(/2).ne.0.and.itypel.ne.49) goto 4864
  195.       enddo
  196.       call erreur(5)
  197. 4864  continue
  198.       DESCR= IRIGEL(3,ir)
  199.       SEGACT MELEME,DESCR
  200. 4863  CONTINUE
  201.   721 IA=NOELEP(K)
  202.       I1=NUM(IA,1)
  203.       NBSOUS=0
  204.       NBNN=1
  205.       NBREF=0
  206.       NBELEM=1
  207.       SEGDES,DESCR
  208.       SEGINI,MELEME
  209.       ITYPEL=1
  210.       NUM(1,1)=I1
  211.       IMELP=MELEME
  212.  
  213. C ... Le MELEME créé ici est un MELEME composé qui contiendra le MELEME
  214. C     pointé par IMELP et tous les MELEME pointés par IRIGEL(1,*) ...
  215.       NBSOUS=NNVA+1
  216.       NBREF=0
  217.       NBNN=0
  218.       NBELEM=0
  219.       SEGINI,MELEME
  220.       LISOUS(1)=IMELP
  221.       DO 12 I=1,NNVA
  222. *     write (6,*) ' dans assem1 ',irigel(6,i)
  223.          ipt1=IRIGEL(1,I)
  224. *  cas du frottement, on met -49 dans itypel pour le savoir dans numopt
  225.          IF (IRIGEL(6,i).eq.2) then
  226.             IPT8=ipt1
  227.             if(ipt8.itypel.eq.49) then
  228.                segact IPT8*mod
  229.                ipt8.itypel=-49
  230.             endif
  231.             ipt2=ipt8
  232.          else
  233.             ipt2=irigel(2,i)
  234.             if (ipt2.eq.0) ipt2=ipt1
  235.          ENDIF
  236.          LISOUS(I+1)=ipt2
  237.    12 CONTINUE
  238.       ICDOUR=0
  239.       SEGINI,INUINV
  240.       SEGDES,INUINV
  241.       CALL NUMOPT(MELEME,INUINV,ICDOUR)
  242. *
  243.       goto 58
  244. *  on ne deplace pas les multiplicateurs car le terme diagonal n'est pas nul
  245. *  deplacer les multiplicateur present dans les super elements
  246.       do 50 ir=1,nnva
  247.        ipt5= IRIGEL(1,ir)
  248.        segact ipt5
  249.        if (ipt5.itypel.ne.28) goto 50
  250.        descr=irigel(3,ir)
  251.        segact descr
  252. *  recherche du plus haut noeud non mult
  253.        do 51 iel=1,ipt5.num(/2)
  254.        ihaut=0
  255.        do 55 il=1,lisinc(/2)
  256. *       write (6,*) ' lisinc ',il,lisinc(il)
  257.         if (lisinc(il).eq.'LX  ') goto 55
  258.         ihaut=max(ihaut,inuinv(ipt5.num(noelep(il),iel)))
  259.   55   continue
  260.        do 60 il=1,lisinc(/2)
  261.         if (lisinc(il).eq.'LX  ') then
  262. * un mult ! on le deplace en ihaut
  263.          ipmult=inuinv(ipt5.num(noelep(il),iel))
  264. *        write (6,*) ' assem1 ipmult ihaut ',ipmult,ihaut
  265.          if (ipmult.gt.ihaut) goto 60
  266.          do j=1,inuinv(/1)
  267.           if (inuinv(j).gt.ipmult.and.inuinv(j).le.ihaut)
  268.      >         inuinv(j)=inuinv(j)-1
  269.          enddo
  270.          inuinv(ipt5.num(noelep(il),iel))=ihaut
  271.          ihaut=ihaut-1
  272.         endif
  273.   60   continue
  274.   51  continue
  275.   50  continue
  276.   58  continue
  277. *
  278.       segact meleme
  279.       do i=1,lisous(/1)
  280.        ipt8=lisous(i)
  281.        segact ipt8
  282.        if (ipt8.itypel.eq.-49) then
  283.         segact ipt8*mod
  284.         ipt8.itypel=49
  285.        endif
  286.       enddo
  287.       SEGACT INUINV
  288.       SEGSUP,MELEME
  289. *     MELEME=IMELP
  290. *     SEGSUP,MELEME
  291. C
  292. C  ****  CREATION D'UN OBJET GEOMETRIE QU'IL FAUDRA CHANGER EN CAS DE
  293. C  ****  RENUMEROTATION GENERALE.ON PROFITE DE LA BOUCLE POUR CREE LE
  294. C  ****  TABLEAU IMIN(I)=J QUI DIT QUE J ELEMENTS TOUCHE LE NOEUD I(NU-
  295. C  ****  MEROTATION LOCALE).
  296. C
  297.  800  CONTINUE
  298.       NNOE=ICDOUR
  299.       SEGINI,IMIN
  300.       NNOE1=NNOE+1
  301.       SEGINI,IPOS
  302.       NBSOUS=0
  303.       NBREF=0
  304.       NBNN=1
  305.       NBELEM=ICDOUR
  306.       SEGINI,IPT1
  307.       IPT1.ITYPEL=IPOIN
  308.       DO 16 IRI=1,NNVA
  309. *      DO 170 I=1,NNOE
  310. *  170 IPOS(I)=0
  311.          meleme=IRIGEL(2,IRI)
  312.          if (meleme.eq.0) meleme=IRIGEL(1,IRI)
  313.          SEGACT,MELEME
  314.          N1=NUM(/1)
  315.          N2=NUM(/2)
  316.          DO  I=1,N2
  317.             DO  J=1,N1
  318.                K=NUM(J,I)
  319.                M=INUINV(K)
  320.                IF(IPOS(M).NE.I) THEN
  321.                   IMIN(M)=IMIN(M)+1
  322.                   IPT1.NUM(1,M)=K
  323.                   IPOS(M)=I
  324.                ENDIF
  325.             enddo
  326.          enddo
  327.          DO  I=1,N2
  328.             DO  J=1,N1
  329.                K=NUM(J,I)
  330.                M=INUINV(K)
  331.                ipos(m)=0
  332.             enddo
  333.          enddo
  334.    16 CONTINUE
  335. C
  336. C  ****  INITIALISATION DE ITOPO. ON UTILISE IMIN POUR SE POSITIONNER
  337. C  ****  DANS ITOPO .
  338. C
  339.       SEGINI,IITOP
  340.       IITOP(1)=1
  341.       DO 18 I=1,NNOE
  342.          IITOP(I+1)=IMIN(I)* 2  + IITOP(I)
  343.    18 CONTINUE
  344.       DO  I=1,NNOE
  345.          IMIN(I)=0
  346.       enddo
  347.       IENNO=IITOP(NNOE+1)
  348.       SEGINI,ITOPO
  349.       DO 21 IRI=1,NNVA
  350. *      DO 220 I=1,NNOE
  351. * 220  IPOS(I)=0
  352. C     DESCR=IRIGEL(3,IRI)
  353. C     SEGACT,DESCR
  354. C     N3=LISINC(/2)
  355. C     SEGDES,DESCR
  356.          meleme=IRIGEL(2,IRI)
  357.          if (meleme.eq.0) meleme=IRIGEL(1,IRI)
  358.          SEGACT,MELEME
  359.          N1=NUM(/1)
  360.          N2=NUM(/2)
  361.          DO  I=1,N2
  362.             DO  J=1,N1
  363.                M=INUINV(NUM(J,I))
  364.                IF(IPOS(M).NE.I) THEN
  365.                   IMIN(M)=IMIN(M)+1
  366.                   IUY= 2* ( IMIN(M)-1 )  + IITOP(M)
  367.                   ITOPO(IUY)=I
  368.                   ITOPO(IUY+1)=IRI
  369.                   IPOS(M)=I
  370.                ENDIF
  371.             enddo
  372.          enddo
  373.          DO  I=1,N2
  374.             DO  J=1,N1
  375.                M=INUINV(NUM(J,I))
  376.                IPOS(M)=0
  377.             enddo
  378.          enddo
  379.    21 CONTINUE
  380. C
  381. C  RECHERCHE DE LA VALEUR PAR DEFAUT DE L'HARMONIQUE DANS LE CAS
  382. C  DE L'UTILISATION DE " OPTION MODE FOUR NOHAR "
  383. C
  384.       DO 230 IRI=1,NNVA
  385.          IHARIR=IRIGEL(5,IRI)
  386.          IF( IHARIR . NE. NOHA) THEN
  387.             IARDEF = IHARIR
  388.             GO TO 231
  389.          ENDIF
  390.   230 CONTINUE
  391. c       CALL ERREUR (21)
  392. c       RETURN
  393. cbp: si toutes ont pour valeur NOHA, ce n'est a priori pas une erreur...
  394.   231 CONTINUE
  395.       DO 232 IRI=1,NNVA
  396.          IF( IRIGEL(5,IRI).EQ.NOHA  ) GOTO 232
  397.          IF( IRIGEL(5,IRI).EQ.IARDEF) GOTO 232
  398.          if(iimpi.ne.0) then
  399.             write(ioimp,*) 'IRIGEL(5,:)=',(IRIGEL(5,iou),iou=1,NNVA)
  400.          endif
  401.          CALL ERREUR (435)
  402.          RETURN
  403.  232  CONTINUE
  404. C
  405. C  ****  RECHERCHE DE LA VALEUR MAXINC QUI PERMET DE DIMENSIONNER INCPOS
  406. C
  407.       SEGINI,MIDUA
  408.       SEGINI,MIMIK
  409.       SEGINI,MHARK
  410.  
  411.       DESCR=IRIGEL(3,1)
  412.       SEGACT,DESCR
  413.  
  414.       IAAR=IRIGEL(5,1)
  415.       IF(IAAR.EQ.NOHA) IAAR = IARDEF
  416.       IMIK(**)=LISINC(1)
  417.       IHAR(**)= IAAR
  418.       IDUA(**)=LISDUA(1)
  419.  
  420.       MAXINC=1
  421.       DO 23 IRI=1,NNVA
  422.          DESCR=IRIGEL(3,IRI)
  423.          IHARIR=IRIGEL(5,IRI)
  424.          IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF
  425.          SEGACT,DESCR
  426.          NLIGRE=LISINC(/2)
  427.          DO 26 I=1,NLIGRE
  428.             DO 24 J=1,MAXINC
  429.                IF(IMIK(J).NE.LISINC(I).OR.IDUA(J).NE.LISDUA(I).OR.
  430.      >              IHAR(J).NE.IHARIR) GO TO 24
  431.                GO TO 26
  432.  24         CONTINUE
  433.             MAXINC=MAXINC+1
  434.             IHAR(**)=IHARIR
  435.             IMIK(**)=LISINC(I)
  436.             IDUA(**)=LISDUA(I)
  437.  26      CONTINUE
  438.          SEGDES,DESCR
  439.    23 CONTINUE
  440.       NDUA=IDUA(/2)
  441. C
  442. C  **** INITIALISATION DE INCPOS ET DE INCTRA.
  443. C
  444.       MAXI=MAXINC
  445.       SEGINI,MINCPO
  446.  
  447.       SEGINI DIATMP,strv
  448.  
  449.       DO 29 IRI=1,NNVA
  450.          IHARIR=IRIGEL(5,IRI)
  451.          IF(IHARIR.EQ.NOHA ) IHARIR = IARDEF
  452.  
  453.          DESCR=IRIGEL(3,IRI)
  454.          SEGACT,DESCR
  455.  
  456.          NLIGRE=LISINC(/2)
  457.          SEGINI,INCTRA
  458.          INCTRR(IRI)=INCTRA
  459.  
  460.          MELEME=IRIGEL(1,IRI)
  461.          SEGACT,MELEME
  462.          N2=NUM(/2)
  463.  
  464.          xmatri=irigel(4,iri)
  465.          segact xmatri
  466.  
  467.          DO 34 J=1,NLIGRE
  468.             DO 33 K=1,MAXINC
  469.                IF(IMIK(K).NE.LISINC(J).OR.IHAR(K).NE.IHARIR) GO TO 33
  470.                IF(IDUA(K).NE.LISDUA(J)) THEN
  471.                   MOTERR(1:4)=IMIK(K)
  472.                   MOTERR(5:8)=IDUA(K)
  473.                   MOTERR(9:12)=LISDUA(J)
  474.                   CALL ERREUR(1026)
  475.                   RETURN
  476.                ENDIF
  477.                GOTO 32
  478.  33         CONTINUE
  479.             CALL ERREUR(5)
  480.  32         CONTINUE
  481.             INCTRA(J)=K
  482.             DO 31 I=1,N2
  483.                IJ=INUINV(NUM(NOELEP(J),I))
  484.                INCPO(K,IJ)=1
  485. *  terme diagonal
  486.                diatmp(K,IJ)=diatmp(k,ij)+re(j,j,i)*coerig(iri)
  487.  31         continue
  488.  34      CONTINUE
  489.          SEGDES,DESCR
  490.          SEGDES,INCTRA
  491.  29   CONTINUE
  492. C
  493. C  ****  INITIALISATION DE IPOS
  494. C
  495.       IPOS(1)=0
  496.       NA=0
  497.       DO 37 I=1,NNOE
  498.          nad=na
  499.          diamax=0.d0
  500.          DO 35 K=1,MAXINC
  501.             IF(INCPO(K,I).EQ.0) GO TO 35
  502.             NA=NA+1
  503.             INCPO(K,I)=NA
  504.             itrv1(na-nad)=k
  505.             dtrv1(na-nad)= -diatmp(k,i)
  506.             diamax=max(diamax,abs(dtrv1(na-nad)))
  507.  35      CONTINUE
  508.          diaref = diamax * xszpre
  509.          do k=1,na-nad
  510.             if (abs(dtrv1(k)).lt.diaref) then
  511. **      write (6,*) ' terme diag petit ',dtrv1(k)
  512.                dtrv1(k)=dtrv1(k)+diamax
  513.             endif
  514.          enddo
  515.  
  516. **    write(6,*) ' avant ',(incpo(k,i),k=1,maxinc)
  517. *  trier incpo suivant les val de diatmp
  518.          call triflo(dtrv1,dtrv2,itrv1,itrv2,na-nad)
  519.          do 351 k=1,na-nad
  520.             incpo(itrv1(k),i)=k+nad
  521.  351     continue
  522. **    write(6,*) ' apres ',(incpo(k,i),k=1,maxinc)
  523.          IPOS(I+1)=NA
  524.  37   CONTINUE
  525.       SEGDES,MIDUA,MIMIK,MHARK
  526. C
  527. C  ****  INITIALISATION DE IMINI
  528. C SG 2024/11 on saute car ne semble pas utilisé
  529.       GOTO 444
  530.       INC=NA
  531.       SEGINI,IMINI
  532.       INC1=INC+1
  533.       DO 38 I=1,INC
  534.          IMINI(I)=INC1
  535.   38  CONTINUE
  536.       DO 40 IRI=1,NNVA
  537.          MELEME=IRIGEL(1,IRI)
  538.          SEGACT,MELEME
  539.          DESCR=IRIGEL(3,IRI)
  540.          SEGACT,DESCR
  541.          INCTRA=INCTRR(IRI)
  542.          SEGACT,INCTRA
  543.          N1=NOELEP(/1)
  544.          N2=NUM(/2)
  545.          N3=NUM(/1)
  546.          DO 41 I=1,N2
  547.             IJ=NNOE+1
  548.             DO 42 J=1,N3
  549.                IJ1=INUINV(NUM(J,I))
  550.                IJ=MIN(IJ1,IJ)
  551.  42         CONTINUE
  552.             IPR=IPOS(IJ)+1
  553.             DO 43 JJ=1,N1
  554.                IJA=INUINV(NUM(NOELEP(JJ),I))
  555.                IJB=INCTRA(JJ)
  556.                IK=INCPO(IJB,IJA)
  557.                IMINI(IK)=MIN(IMINI(IK),IPR)
  558.  43         CONTINUE
  559.  41      CONTINUE
  560.          SEGDES,DESCR
  561.          SEGDES,INCTRA
  562.  40   CONTINUE
  563. *
  564.  444  CONTINUE
  565.       segsup diatmp,strv
  566.       SEGDES,MRIGID
  567.       SEGDES,IPOS
  568. ccc      SEGDES,IMINI
  569.       SEGDES,ITOPO
  570.       SEGDES,IITOP
  571.       SEGDES,INUINV
  572.       SEGDES,MINCPO
  573.       SEGSUP,IMIN
  574.       SEGDES,INCTRR
  575.       INCTRY=INCTRR
  576.       SEGINI,MMATRI
  577.       NENS=0
  578.       IGEOMA=IPT1
  579.       IIDUA=MIDUA
  580.       IINCPO=MINCPO
  581.       IIMIK=MIMIK
  582.       IHARK=MHARK
  583.       INUINY=INUINV
  584.       ITOPOY=ITOPO
  585.       IITOPY=IITOP
  586.       MMATRX=MMATRI
  587. ccc      IMINIY=IMINI
  588.          iminiy=0
  589.       IPOY=IPOS
  590.       SEGDES,MMATRI
  591.       RETURN
  592.       END
  593.  
  594.  

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