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    PV090527  25/09/10    21:15:02     12360          
  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.       INCMOY = 0
  222.       NOEMOY = 0
  223.       DO 12 I=1,NNVA
  224. *     write (6,*) ' dans assem1 ',irigel(6,i)
  225.          ipt1=IRIGEL(1,I)
  226.          DESCR = irigel(3,i)
  227.          segact descr
  228.          NLIGRE=LISINC(/2)
  229.          INCMOY = INCMOY + NLIGRE*ipt1.num(/2)
  230.          NOEMOY = NOEMOY + ipt1.num(/1)*ipt1.num(/2)
  231. *  cas du frottement, on met -49 dans itypel pour le savoir dans numopt
  232.          IF (IRIGEL(6,i).eq.2) then
  233.             IPT8=ipt1
  234.             if(ipt8.itypel.eq.49) then
  235.                segact IPT8*mod
  236.                ipt8.itypel=-49
  237.             endif
  238.             ipt2=ipt8
  239.          else
  240.             ipt2=irigel(2,i)
  241.             if (ipt2.eq.0) ipt2=ipt1
  242.          ENDIF
  243.          LISOUS(I+1)=ipt2
  244.    12 CONTINUE
  245. **    write(6,*) 'ASSEM1 incmoy noemoy ',incmoy,noemoy
  246.       INCMOY = INCMOY/NOEMOY
  247. **    write(6,*) 'ASSEM1 incmoy ',incmoy
  248.       ICDOUR=0
  249.       SEGINI,INUINV
  250.       SEGDES,INUINV
  251.       CALL NUMOPT(MELEME,INUINV,ICDOUR)
  252. *
  253.       goto 58
  254. *  on ne deplace pas les multiplicateurs car le terme diagonal n'est pas nul
  255. *  deplacer les multiplicateur present dans les super elements
  256.       do 50 ir=1,nnva
  257.        ipt5= IRIGEL(1,ir)
  258.        segact ipt5
  259.        if (ipt5.itypel.ne.28) goto 50
  260.        descr=irigel(3,ir)
  261.        segact descr
  262. *  recherche du plus haut noeud non mult
  263.        do 51 iel=1,ipt5.num(/2)
  264.        ihaut=0
  265.        do 55 il=1,lisinc(/2)
  266. *       write (6,*) ' lisinc ',il,lisinc(il)
  267.         if (lisinc(il).eq.'LX  ') goto 55
  268.         ihaut=max(ihaut,inuinv(ipt5.num(noelep(il),iel)))
  269.   55   continue
  270.        do 60 il=1,lisinc(/2)
  271.         if (lisinc(il).eq.'LX  ') then
  272. * un mult ! on le deplace en ihaut
  273.          ipmult=inuinv(ipt5.num(noelep(il),iel))
  274. *        write (6,*) ' ASSEM1 ipmult ihaut ',ipmult,ihaut
  275.          if (ipmult.gt.ihaut) goto 60
  276.          do j=1,inuinv(/1)
  277.           if (inuinv(j).gt.ipmult.and.inuinv(j).le.ihaut)
  278.      >         inuinv(j)=inuinv(j)-1
  279.          enddo
  280.          inuinv(ipt5.num(noelep(il),iel))=ihaut
  281.          ihaut=ihaut-1
  282.         endif
  283.   60   continue
  284.   51  continue
  285.   50  continue
  286.   58  continue
  287. *
  288.       segact meleme
  289.       do i=1,lisous(/1)
  290.        ipt8=lisous(i)
  291.        segact ipt8
  292.        if (ipt8.itypel.eq.-49) then
  293.         segact ipt8*mod
  294.         ipt8.itypel=49
  295.        endif
  296.       enddo
  297.       SEGACT INUINV
  298.       SEGSUP,MELEME
  299. *     MELEME=IMELP
  300. *     SEGSUP,MELEME
  301. C
  302. C  ****  CREATION D'UN OBJET GEOMETRIE QU'IL FAUDRA CHANGER EN CAS DE
  303. C  ****  RENUMEROTATION GENERALE.ON PROFITE DE LA BOUCLE POUR CREE LE
  304. C  ****  TABLEAU IMIN(I)=J QUI DIT QUE J ELEMENTS TOUCHE LE NOEUD I(NU-
  305. C  ****  MEROTATION LOCALE).
  306. C
  307.  800  CONTINUE
  308.       NNOE=ICDOUR
  309.       SEGINI,IMIN
  310.       NNOE1=NNOE+1
  311.       SEGINI,IPOS
  312.       NBSOUS=0
  313.       NBREF=0
  314.       NBNN=1
  315.       NBELEM=ICDOUR
  316.       SEGINI,IPT1
  317.       IPT1.ITYPEL=IPOIN
  318.       DO 16 IRI=1,NNVA
  319. *      DO 170 I=1,NNOE
  320. *  170 IPOS(I)=0
  321.          meleme=IRIGEL(2,IRI)
  322.          if (meleme.eq.0) meleme=IRIGEL(1,IRI)
  323.          SEGACT,MELEME
  324.          N1=NUM(/1)
  325.          N2=NUM(/2)
  326.          DO  I=1,N2
  327.             DO  J=1,N1
  328.                K=NUM(J,I)
  329.                M=INUINV(K)
  330.                IF(IPOS(M).NE.I) THEN
  331.                   IMIN(M)=IMIN(M)+1
  332.                   IPT1.NUM(1,M)=K
  333.                   IPOS(M)=I
  334.                ENDIF
  335.             enddo
  336.          enddo
  337.          DO  I=1,N2
  338.             DO  J=1,N1
  339.                K=NUM(J,I)
  340.                M=INUINV(K)
  341.                ipos(m)=0
  342.             enddo
  343.          enddo
  344.    16 CONTINUE
  345. C
  346. C  ****  INITIALISATION DE ITOPO. ON UTILISE IMIN POUR SE POSITIONNER
  347. C  ****  DANS ITOPO .
  348. C
  349.       SEGINI,IITOP
  350.       IITOP(1)=1
  351.       DO 18 I=1,NNOE
  352.          IITOP(I+1)=IMIN(I)* 2  + IITOP(I)
  353.    18 CONTINUE
  354.       DO  I=1,NNOE
  355.          IMIN(I)=0
  356.       enddo
  357.       IENNO=IITOP(NNOE+1)
  358.       SEGINI,ITOPO
  359.       DO 21 IRI=1,NNVA
  360. *      DO 220 I=1,NNOE
  361. * 220  IPOS(I)=0
  362. C     DESCR=IRIGEL(3,IRI)
  363. C     SEGACT,DESCR
  364. C     N3=LISINC(/2)
  365. C     SEGDES,DESCR
  366.          meleme=IRIGEL(2,IRI)
  367.          if (meleme.eq.0) meleme=IRIGEL(1,IRI)
  368.          SEGACT,MELEME
  369.          N1=NUM(/1)
  370.          N2=NUM(/2)
  371.          DO  I=1,N2
  372.             DO  J=1,N1
  373.                M=INUINV(NUM(J,I))
  374.                IF(IPOS(M).NE.I) THEN
  375.                   IMIN(M)=IMIN(M)+1
  376.                   IUY= 2* ( IMIN(M)-1 )  + IITOP(M)
  377.                   ITOPO(IUY)=I
  378.                   ITOPO(IUY+1)=IRI
  379.                   IPOS(M)=I
  380.                ENDIF
  381.             enddo
  382.          enddo
  383.          DO  I=1,N2
  384.             DO  J=1,N1
  385.                M=INUINV(NUM(J,I))
  386.                IPOS(M)=0
  387.             enddo
  388.          enddo
  389.    21 CONTINUE
  390. C
  391. C  RECHERCHE DE LA VALEUR PAR DEFAUT DE L'HARMONIQUE DANS LE CAS
  392. C  DE L'UTILISATION DE " OPTION MODE FOUR NOHAR "
  393. C
  394.       DO 230 IRI=1,NNVA
  395.          IHARIR=IRIGEL(5,IRI)
  396.          IF( IHARIR . NE. NOHA) THEN
  397.             IARDEF = IHARIR
  398.             GO TO 231
  399.          ENDIF
  400.   230 CONTINUE
  401. c       CALL ERREUR (21)
  402. c       RETURN
  403. cbp: si toutes ont pour valeur NOHA, ce n'est a priori pas une erreur...
  404.   231 CONTINUE
  405.       DO 232 IRI=1,NNVA
  406.          IF( IRIGEL(5,IRI).EQ.NOHA  ) GOTO 232
  407.          IF( IRIGEL(5,IRI).EQ.IARDEF) GOTO 232
  408.          if(iimpi.ne.0) then
  409.             write(ioimp,*) 'IRIGEL(5,:)=',(IRIGEL(5,iou),iou=1,NNVA)
  410.          endif
  411.          CALL ERREUR (435)
  412.          RETURN
  413.  232  CONTINUE
  414. C
  415. C  ****  RECHERCHE DE LA VALEUR MAXINC QUI PERMET DE DIMENSIONNER INCPOS
  416. C
  417.       SEGINI,MIDUA
  418.       SEGINI,MIMIK
  419.       SEGINI,MHARK
  420.  
  421.       DESCR=IRIGEL(3,1)
  422.       SEGACT,DESCR
  423.  
  424.       IAAR=IRIGEL(5,1)
  425.       IF(IAAR.EQ.NOHA) IAAR = IARDEF
  426.       IMIK(**)=LISINC(1)
  427.       IHAR(**)= IAAR
  428.       IDUA(**)=LISDUA(1)
  429.  
  430.       MAXINC=1
  431.       DO 23 IRI=1,NNVA
  432.          DESCR=IRIGEL(3,IRI)
  433.          IHARIR=IRIGEL(5,IRI)
  434.          IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF
  435.          SEGACT,DESCR
  436.          NLIGRE=LISINC(/2)
  437.          DO 26 I=1,NLIGRE
  438.             DO 24 J=1,MAXINC
  439.                IF(IMIK(J).NE.LISINC(I).OR.IDUA(J).NE.LISDUA(I).OR.
  440.      >              IHAR(J).NE.IHARIR) GO TO 24
  441.                GO TO 26
  442.  24         CONTINUE
  443.             MAXINC=MAXINC+1
  444.             IHAR(**)=IHARIR
  445.             IMIK(**)=LISINC(I)
  446.             IDUA(**)=LISDUA(I)
  447.  26      CONTINUE
  448.          SEGDES,DESCR
  449.    23 CONTINUE
  450.       NDUA=IDUA(/2)
  451. C
  452. C  **** INITIALISATION DE INCPOS ET DE INCTRA.
  453. C
  454.       MAXI=MAXINC
  455.       SEGINI,MINCPO
  456.  
  457.       SEGINI DIATMP,strv
  458.  
  459.       DO 29 IRI=1,NNVA
  460.          IHARIR=IRIGEL(5,IRI)
  461.          IF(IHARIR.EQ.NOHA ) IHARIR = IARDEF
  462.  
  463.          DESCR=IRIGEL(3,IRI)
  464.          SEGACT,DESCR
  465.  
  466.          NLIGRE=LISINC(/2)
  467.          SEGINI,INCTRA
  468.          INCTRR(IRI)=INCTRA
  469.  
  470.          MELEME=IRIGEL(1,IRI)
  471.          SEGACT,MELEME
  472.          N2=NUM(/2)
  473.  
  474.          xmatri=irigel(4,iri)
  475.          segact xmatri
  476.  
  477.          DO 34 J=1,NLIGRE
  478.             DO 33 K=1,MAXINC
  479.                IF(IMIK(K).NE.LISINC(J).OR.IHAR(K).NE.IHARIR) GO TO 33
  480.                IF(IDUA(K).NE.LISDUA(J)) THEN
  481.                   MOTERR(1:4)=IMIK(K)
  482.                   MOTERR(5:8)=IDUA(K)
  483.                   MOTERR(9:12)=LISDUA(J)
  484.                   CALL ERREUR(1026)
  485.                   RETURN
  486.                ENDIF
  487.                GOTO 32
  488.  33         CONTINUE
  489.             CALL ERREUR(5)
  490.  32         CONTINUE
  491.             INCTRA(J)=K
  492.             DO 31 I=1,N2
  493.                IJ=INUINV(NUM(NOELEP(J),I))
  494.                INCPO(K,IJ)=1
  495. *  terme diagonal
  496.                diatmp(K,IJ)=diatmp(k,ij)+re(j,j,i)*coerig(iri)
  497.  31         continue
  498.  34      CONTINUE
  499.          SEGDES,DESCR
  500.          SEGDES,INCTRA
  501.  29   CONTINUE
  502. C
  503. C  ****  INITIALISATION DE IPOS
  504. C
  505.       IPOS(1)=0
  506.       NA=0
  507.       DO 37 I=1,NNOE
  508.          nad=na
  509.          diamax=0.d0
  510.          DO 35 K=1,MAXINC
  511.             IF(INCPO(K,I).EQ.0) GO TO 35
  512.             NA=NA+1
  513.             INCPO(K,I)=NA
  514.             itrv1(na-nad)=k
  515.             dtrv1(na-nad)= -diatmp(k,i)
  516.             diamax=max(diamax,abs(dtrv1(na-nad)))
  517.  35      CONTINUE
  518.          diaref = diamax * xszpre
  519.          do k=1,na-nad
  520.             if (abs(dtrv1(k)).lt.diaref) then
  521. **      write (6,*) ' terme diag petit ',dtrv1(k)
  522.                dtrv1(k)=dtrv1(k)+diamax
  523.             endif
  524.          enddo
  525.  
  526. **    write(6,*) ' avant ',(incpo(k,i),k=1,maxinc)
  527. *  trier incpo suivant les val de diatmp
  528.          call triflo(dtrv1,dtrv2,itrv1,itrv2,na-nad)
  529.          do 351 k=1,na-nad
  530.             incpo(itrv1(k),i)=k+nad
  531.  351     continue
  532. **    write(6,*) ' apres ',(incpo(k,i),k=1,maxinc)
  533.          IPOS(I+1)=NA
  534.  37   CONTINUE
  535.       SEGDES,MIDUA,MIMIK,MHARK
  536. C
  537. C  ****  INITIALISATION DE IMINI
  538. C SG 2024/11 on saute car ne semble pas utilisé
  539.       GOTO 444
  540.       INC=NA
  541.       SEGINI,IMINI
  542.       INC1=INC+1
  543.       DO 38 I=1,INC
  544.          IMINI(I)=INC1
  545.   38  CONTINUE
  546.       DO 40 IRI=1,NNVA
  547.          MELEME=IRIGEL(1,IRI)
  548.          SEGACT,MELEME
  549.          DESCR=IRIGEL(3,IRI)
  550.          SEGACT,DESCR
  551.          INCTRA=INCTRR(IRI)
  552.          SEGACT,INCTRA
  553.          N1=NOELEP(/1)
  554.          N2=NUM(/2)
  555.          N3=NUM(/1)
  556.          DO 41 I=1,N2
  557.             IJ=NNOE+1
  558.             DO 42 J=1,N3
  559.                IJ1=INUINV(NUM(J,I))
  560.                IJ=MIN(IJ1,IJ)
  561.  42         CONTINUE
  562.             IPR=IPOS(IJ)+1
  563.             DO 43 JJ=1,N1
  564.                IJA=INUINV(NUM(NOELEP(JJ),I))
  565.                IJB=INCTRA(JJ)
  566.                IK=INCPO(IJB,IJA)
  567.                IMINI(IK)=MIN(IMINI(IK),IPR)
  568.  43         CONTINUE
  569.  41      CONTINUE
  570.          SEGDES,DESCR
  571.          SEGDES,INCTRA
  572.  40   CONTINUE
  573. *
  574.  444  CONTINUE
  575.       segsup diatmp,strv
  576.       SEGDES,MRIGID
  577.       SEGDES,IPOS
  578. ccc      SEGDES,IMINI
  579.       SEGDES,ITOPO
  580.       SEGDES,IITOP
  581.       SEGDES,INUINV
  582.       SEGDES,MINCPO
  583.       SEGSUP,IMIN
  584.       SEGDES,INCTRR
  585.       INCTRY=INCTRR
  586.       SEGINI,MMATRI
  587.       NENS=0
  588.       IGEOMA=IPT1
  589.       IIDUA=MIDUA
  590.       IINCPO=MINCPO
  591.       IIMIK=MIMIK
  592.       IHARK=MHARK
  593.       INUINY=INUINV
  594.       ITOPOY=ITOPO
  595.       IITOPY=IITOP
  596.       MMATRX=MMATRI
  597. ccc      IMINIY=IMINI
  598.          iminiy=0
  599.       IPOY=IPOS
  600.       SEGDES,MMATRI
  601.       RETURN
  602.       END
  603.  
  604.  
  605.  

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