Télécharger la plaquette Cast3M


fr en

Télécharger conne1.eso

Retour à la liste

Numérotation des lignes : 

conne1

  1. C CONNE1    SOURCE    OF166741  25/02/21    21:15:39     12166          
  2.       SUBROUTINE CONNE1(IPMODL,XLONG,IXLONG,CONSTI,ICLE,JPT1,JPT2,JPT3,
  3.      >                  IPCHCO,IRET)
  4. C_______________________________________________________________________
  5. C
  6. C           CALCUL DES CONNECTIVITES APPELE PAR CONNEC
  7. C
  8. C    Entrees:
  9. C    ________
  10. C
  11. C           IPMODL Pointeur sur un objet MMODEL
  12. C           XLONG  Longeur caracteristique
  13. C           IXLONG Champ de longeur caracteristique
  14. C           CONSTI nom du constituant
  15. C           ICLE   mode de modification du maillage pour le calcul
  16. C                  (1=NORM, 3=POIN, 4=DROI, 5=PLAN, 2=TRAN)
  17. C           JPT1|
  18. C           JPT2|  pointeurs eventuels sur des objets de type point
  19. C           JPT3|
  20. C
  21. C
  22. C    Sorties:
  23. C    ________
  24. C
  25. C           IPCHCO Pointeur sur un MCHAML de Connectivite
  26. C           de composantes obligatoires ...
  27. C
  28. C                  'NLAR': Non local Longueur cARacteristique
  29. C                  'PMOD': Pointeur sur un MMODEL contenant
  30. C                          l'ensemble des IMODEL accessibles
  31. C                          pour la sous zone
  32. C                  'NPNI': Non local Pointeur Numero Imodel de nmod
  33. C                  'NPLI': Non local Pointeur LIstenti
  34. C
  35. C           ... et eventuellement
  36. C
  37. C                  'POT1': Point ou vecteur de construction de symetrie
  38. C                          (POIN, DROI, PLAN, TRAN)
  39. C                  'POT2': Point de construction de symetrie (DROI)
  40. C                  'DISP': Distance pour calcul de symetrie PLAN (PLAN)
  41. C
  42. C           IRET   1 ou 0 suivant succes ou pas
  43. C
  44. C    Appele par: CONNEC
  45. C    -----------
  46. C
  47. C    Appel a:
  48. C    --------
  49. C
  50. C    LOADPO : lecture d'un point (pointeur --> x(3))
  51. C    NORPLA : calcul de l'eq. canonique d'un plan passant par 3 pts
  52. C    ADJUPO : ajout d'un point dans la pile des points (x(3) --> pointeur)
  53. C    NORDRO : calcul du vect. dir. norme de la droite passant par 2 pts
  54. C    DISYPT : distance a un point
  55. C    DISYDR : distance a une droite
  56. C    DISYPL : distance a un plan
  57. C    TRTRVE : point translate
  58. C    TRSYPT : point symetrique par rapport a un point
  59. C    TRSYDR : point symetrique par rapport a une droite
  60. C    TRSYPL : point symetrique par rapport a un plan
  61. C    ELQUOI, DOXE, DTSHAM
  62. C
  63. C    AUTEUR P.PEGON 22/10/92 d'apres C. LA BORDERIE d'apres P.PEGON
  64. C_______________________________________________________________________
  65. C
  66.       IMPLICIT INTEGER(I-N)
  67.       IMPLICIT REAL*8(A-H,O-Z)
  68.  
  69. -INC PPARAM
  70. -INC CCOPTIO
  71. -INC CCASSIS
  72. -INC CCREEL
  73.  
  74. -INC SMELEME
  75. -INC SMCOORD
  76. -INC SMMODEL
  77. -INC SMCHAML
  78. -INC SMLENTI
  79.  
  80. -INC TMPTVAL
  81.  
  82.       PARAMETER(MASDIM=64)
  83.       common/CCONNE/iwrk3,ipmodl1,xmultl,icle1,ihgsel
  84.       common/CCONNE/jconl,ihg1,ihg2,ihg,nbthr,ixlong1
  85.       COMMON/CHSELE/imfopa,ishg,ihug,imcord,ihgt
  86.       common/CCONN1/d,pt1(3),pt2(3)
  87.       common/CCONN1/xmn(masdim),ymn(masdim),zmn(masdim)
  88.       common/CCONN1/xmx(masdim),ymx(masdim),zmx(masdim)
  89.       common/CCONN1/hmxt(masdim),xlg2m(masdim)
  90.       external crbary
  91.       external hselei
  92.       logical zthr
  93.       SEGMENT,WRK1
  94.         REAL*8 XE(3,nbno1)
  95. C coord des noeuds
  96.       ENDSEGMENT
  97.  
  98.       SEGMENT,WRK2
  99.         REAL*8 XEJ(3,nbno1)
  100.       ENDSEGMENT
  101.  
  102.       SEGMENT,WRK3
  103.          INTEGER IWRK1(NSOUS,nbthr), IWRK2(NSOUS,nbthr)
  104.      +   ,imptv(nsous)
  105. C iwrk1 pointe vers les wrk1 et iwrk2 pointe sur les wrk2
  106.       ENDSEGMENT
  107.  
  108.       pointeur IPMAIL.MELEME
  109.       pointeur MLNIMO.MLENTI
  110.       pointeur MLNUEL.MLENTI
  111.       pointeur MCORD2.MCOORD
  112.  
  113.       SEGMENT NOTYPE
  114.         CHARACTER*16 TYPE(NBTYPE)
  115.       ENDSEGMENT
  116.  
  117.       SEGMENT INFO
  118.         INTEGER INFELL(JG)
  119.       ENDSEGMENT
  120.  
  121. C hg1 contient les coordonnees des barycentres de la zone de travail
  122. C hg2 contient les coordonnees des barycentres  de la deuxieme zone
  123.       SEGMENT HG1
  124.         REAL*8 HCOOR(3*nbpb)
  125.       ENDSEGMENT
  126.       pointeur hg2.hg1
  127. C HG contient les correspondances entre numérotation locale et numerotation castem
  128. C    ainsi que des donnees permettant d'ecrire le resultat
  129.       SEGMENT HG
  130.         INTEGER IELH(nbpb,2)
  131. C IELH(i,1)=numero de l'element dans la sous zone
  132. C IELH(i,2)=numero de la sous zone
  133. C Tableau qui contient le max d(noeuds, barycentre)
  134.         REAL*8 HMax(nbpb)
  135. C si ixlong different de zero contient le max de ixlong dans l'element
  136.         REAL*8 XLL(nbpb)
  137. C Tableau qui contient nombre d'ele en connex par sous zone
  138.         INTEGER INOA(nbpb,NSOUS+1)
  139.       ENDSEGMENT
  140. C hgt contient les tableaux utile pour le tri
  141.       SEGMENT HGT
  142. C       integer ka(nels),kb(nels)
  143. C Tableau contenant proj ortho sur la droite apres tri
  144.         REAL*8 Xp(nels)
  145. C Tableau auxiliaire  pour triflot
  146.         REAL*8 Xw(nels)
  147. C Tableau auxiliaire pour triflot
  148.         INTEGER Ke(nels)
  149. C Tableau donne la correspondance entre le tableau trie et la numerotation de la zone 2
  150.         INTEGER ICO(nels)
  151.       ENDSEGMENT
  152.  
  153.       SEGMENT mfopa
  154. C Premier element dans un segment de la droite
  155.         INTEGER ind(indt)
  156.       ENDSEGMENT
  157. C  lhug la liste des elements en relation - on s'y retrouve grace a inoa
  158.       SEGMENT iVECTI
  159.         INTEGER Lhug(JG)
  160.       ENDSEGMENT
  161.       pointeur ivect1.ivecti
  162.  
  163.       segment mlhug
  164.          integer ilhug(nbthr)
  165.          integer nhug(nbthr)
  166.       endsegment
  167. C VECTEUR corresp entre numero des elements conserves (cas symetrie) et numerotation locale
  168.       SEGMENT SHG
  169.         INTEGER NSYM(NELS)
  170.       ENDSEGMENT
  171.  
  172. C permet de ne pas recalculer le symetrique d'un noeud
  173.       SEGMENT NOETR
  174.         INTEGER NDEJVU(NBPTS)
  175.       ENDSEGMENT
  176. C permet de savoir s'il faut creer un segment resultat (1 oui 0 non)
  177.       SEGMENT CONL
  178.         INTEGER ICONL(NBPB)
  179.       ENDSEGMENT
  180.       segment kkzt
  181.         integer kzt(nbpb)
  182.       endsegment
  183.  
  184.       segment hgsele
  185.          real*8 xmult,ymult,zmult
  186.          real*8 hmaxt,xlong2,tmax,tmin,xlong2m
  187.          integer nels,nbpb,ipass
  188.          integer nbzt,indt,khug
  189.       endsegment
  190.  
  191.       CHARACTER*(NCONCH) CONM
  192.       PARAMETER (NINF=3)
  193.       INTEGER INFOS(NINF)
  194.  
  195.       CHARACTER*16 CONSTI
  196.       DIMENSION PT3(3)
  197.  
  198.       integer ittime(4)
  199.       data xmultl/1.5D0/
  200. c
  201. C      i232 = 2**32
  202.  
  203.       ixlong1 = ixlong
  204.       icle1 = icle
  205. C LECTURE DES POINTS
  206.       CALL LOADPO(JPT1,PT1)
  207.       CALL LOADPO(JPT2,PT2)
  208.       CALL LOADPO(JPT3,PT3)
  209.  
  210. C CALCUL DE LA NORMALE NORMEE ET DE LA DISTANCE POUR KE CAS DU PLAN
  211. C ET AJOUT DU POINT A LA PILE
  212.  
  213.       segini hgsele
  214.        ihgsel = hgsele
  215.        khug = 0
  216. C     call timespv(ittime,othrd)
  217. C     ide = ittime(1) + ittime(2)
  218.       IF (ICLE.EQ.5) then
  219.          CALL NORPLA(PT1,PT2,PT3,pt1,D)
  220.          CALL ADJUPO(PT1,JPT1)
  221.       ENDIF
  222. C CALCUL DU VECTEURE DIRECTEUR NORME DANS
  223. C DANS LE CAS DE LA DROITE ET AJOUT DU POINT A LA PILE
  224. C
  225.       IF (ICLE.EQ.4) THEN
  226.         CALL NORDRO(PT1,PT2,PT2)
  227.         CALL ADJUPO(PT2,JPT2)
  228.       ENDIF
  229. C
  230. C
  231.  
  232.       iret=1
  233. C
  234. C
  235. C____________________________________________________________________
  236. C
  237. C     PREPARATIONS DE LA LONGUEUR CARACTERISTIQUE
  238. C____________________________________________________________________
  239. C
  240.       IF(IXLONG.NE.0)THEN
  241. C
  242.         INFOS(1)=0
  243.         INFOS(2)=0
  244.         INFOS(3)=NIFOUR
  245. C
  246.         NBROBL=1
  247.         NBRFAC=0
  248.         SEGINI NOMID
  249.         NOMLAR=NOMID
  250.         LESOBL(1)='LCAR'
  251.         NBTYPE=1
  252.         SEGINI NOTYPE
  253.         MOTYPE=NOTYPE
  254.         TYPE(1)='REAL*8'
  255.       ELSE
  256.         XLONG2 = XMULTl * XLONG
  257.       ENDIF
  258. C
  259. C     ACTIVATION DU MODELE
  260. C
  261.       MMODEL=IPMODL
  262.       SEGACT,MMODEL
  263.       NSOUS=KMODEL(/1)
  264. C
  265. C     ACTIVATION DES ZONES ELEMENTAIRES DU MAILLAGE
  266. C
  267.        nbthr = nbthrs
  268.        segini wrk3
  269.        nbelz=0
  270.        DO ISOUS=1,NSOUS
  271.           IMODEL=KMODEL(ISOUS)
  272.           SEGACT,IMODEL
  273.           IPMAIL=IMAMOD
  274.           SEGACT,IPMAIL
  275.           nbno1=IPMAIL.num(/1)
  276.           nbelz=nbelz + IPMAIL.num(/2)
  277.           do i = 1, nbthrs
  278.              segini wrk1
  279.              segini wrk2
  280.              wrk3.iwrk1(isous,i)=wrk1
  281.              wrk3.iwrk2(isous,i)=wrk2
  282.           enddo
  283.           if (ixlong.ne.0) then
  284.              conm = conmod
  285.              mele = ipmail.itypel
  286.              if (infmod(/1).lt.7) then
  287.                 call elquoi(mele,0,5,ipinf,imodel)
  288.                 if (ierr.ne.0) goto 9999
  289.                 info = ipinf
  290.                 minte = infell(11)
  291.                 segsup info
  292.              else
  293.                 minte = infmod(7)
  294.              endif
  295.              call komcha(ixlong,ipmail,conm,nomlar,motype,1,infos,3
  296.      +                  ,ivalar)
  297.              if (ierr.ne.0) then
  298.                 nomid  = nomlar
  299.                 notype = motype
  300.                 segsup ,nomid,notype
  301.                 goto 9999
  302.              endif
  303.              mptval = ivalar
  304.              melval = ival(1)
  305.              segact melval
  306.              imptv(isous) = melval
  307.              call dtmval(ivalar,2)
  308.           endif
  309.        ENDDO
  310.  
  311.        nbpb=nbelz
  312.  
  313.        segini kkzt
  314.        SEGINI HG
  315.        ihg = hg
  316.        segini hg1
  317.        ihg1   = hg1
  318.        ihg2   = hg1
  319.        xmin=xgrand
  320.        ymin=xgrand
  321.        zmin=xgrand
  322.        xmax=-xgrand
  323.        ymax=-xgrand
  324.        zmax=-xgrand
  325.        hmaxt = 0d0
  326.        xlong2m = 0d0
  327. C
  328.        mcord2=mcoord
  329.        imcord = mcord2
  330.        hg2=hg1
  331.        SEGINI CONL
  332.        do ib1=1,nbpb
  333.           iconl(ib1)=1
  334.        ENDDO
  335. C on regarde si on parallelise
  336.        if (LODESL.or.nbthrs.eq.1.or.nbpb.lt.nbthrs) then
  337.           zthr = .FALSE.
  338.           nbthr = 1
  339.        else
  340.           zthr = .TRUE.
  341.           nbthr = nbthrs
  342. C         nbthr = 20
  343.        endif
  344. C        zthr = .FALSE.
  345. C        nbthr = 1
  346. C On fait une boucle pour créer une numerotation
  347. C
  348.        ib1 = 0
  349.        NELS = NBPB
  350.        ishg = 0
  351.        if (icle.ne.1) then
  352.          SEGINI SHG,hg2
  353.          ishg   = shg
  354.          ihg2   = hg2
  355.        endif
  356.        do isous = 1, nsous
  357.           IMODEL   = KMODEL(ISOUS)
  358.           IPMAIL   = IMAMOD
  359.           nbel1    = IPMAIL.num(/2)
  360.           nbno1    = IPMAIL.num(/1)
  361.           do iel1 = 1, nbel1
  362.              IB1         = IB1 + 1
  363.              IELH(IB1,1) = iel1
  364.              IELH(IB1,2) = ISOUS
  365.           enddo
  366.        enddo
  367.        jconl  = conl
  368.        inoetr = noetr
  369.        iwrk3  = wrk3
  370. C       ihg    = hg
  371.        ipmodl1 = ipmodl
  372.  
  373. C On fait une boucle sur tous les éléments pour créer les centres de gravité et une numérotation
  374.        if (zthr) then
  375.           call threadii
  376.           do ith = 2, nbthr
  377.              call threadid(ith,crbary)
  378.           enddo
  379.           call crbary(1)
  380.           do ith = 2, nbthr
  381.              call threadif(ith)
  382.           enddo
  383.           call threadis
  384.        else
  385.           call crbar1(iwrk3,ipmodl1,1,nbpb,xmultl,icle,d,pt1,pt2
  386.      +      ,jconl,ihg1,ihg2,xmn,ymn,zmn,xmx,ymx,zmx
  387.      +      ,hmxt,ihg,1,ixlong,xlong2,xlg2m)
  388.        endif
  389. c
  390.        do i = 1, nbthr
  391.           xmax = max (xmax,xmx(i))
  392.           ymax = max (ymax,ymx(i))
  393.           zmax = max (zmax,zmx(i))
  394.           xmin = min (xmin,xmn(i))
  395.           ymin = min (ymin,ymn(i))
  396.           zmin = min (zmin,zmn(i))
  397.           hmaxt = max (hmaxt,hmxt(i))
  398.           xlong2m = max(xlong2m,xlg2m(i))
  399.        enddo
  400.  
  401. C
  402. C on fait une boucle pour tasser les tableaux dans le cas icle = 3,4,5
  403.        if (icle.eq.2.or.icle.eq.3.or.icle.eq.4.or.icle.eq.5) then
  404.        ik1 = 0
  405.        ib  = 0
  406.        do ib = 1, nbpb
  407.           if (iconl(ib).eq.1) then
  408.              ik1 = ik1 + 1
  409.              nsym(ik1) = ib
  410.              hg2.HCOOR((IK1-1)*3+1) = hg2.HCOOR((Ib-1)*3+1)
  411.              hg2.HCOOR((IK1-1)*3+2) = hg2.HCOOR((Ib-1)*3+2)
  412.              hg2.HCOOR((IK1-1)*3+3) = hg2.HCOOR((Ib-1)*3+3)
  413.                  HCOOR((IK1-1)*3+1) =     HCOOR((Ib-1)*3+1)
  414.                  HCOOR((IK1-1)*3+2) =     HCOOR((Ib-1)*3+2)
  415.                  HCOOR((IK1-1)*3+3) =     HCOOR((Ib-1)*3+3)
  416.  
  417.           endif
  418.        enddo
  419.        endif
  420.        if (icle.ne.1) then
  421.           NELS=IK1
  422.           SEGADJ SHG,hg2,hg1
  423.        endif
  424. C CALCUL DES NOEUDS DES SYM QU'ON STOCKE DANS HCOR2
  425.         if (icle.ne.1) then
  426.            SEGINI MCORD2
  427.            imcord = mcord2
  428.            SEGINI NOETR
  429.            DO IB = 1, NELS
  430.               ib1 = ib
  431.               if (icle.eq.5) IB1 = NSYM(IB)
  432.               if (icle.eq.4) IB1 = NSYM(IB)
  433.               if (icle.eq.3) IB1 = NSYM(IB)
  434.               IEL = IELH(IB1,1)
  435.               IZO = IELH(IB1,2)
  436.               imodel = kmodel(izo)
  437.               ipmail = imamod
  438.               nn2    = ipmail.num(/1)
  439.               do ij = 1, nn2
  440.                  ino1=ipmail.num(ij,iel)
  441.                  IF (NDEJVU(INO1).EQ.0) THEN
  442.                     NDEJVU(INO1) = 1
  443.                     B = D
  444.                     if (icle.eq.5) then
  445.                        DO J = 1, idim
  446.                           B = B + XCOOR((ino1-1)*(idim+1)+J)*PT1(J)
  447.                       ENDDO
  448.                       B = B * 2
  449.                       DO J = 1, idim
  450.                          MCORD2.XCOOR((ino1-1)*(idim+1)+J) =
  451.      +                        XCOOR((ino1-1)*(idim+1)+J) - B * PT1(J)
  452.                       enddo
  453. C
  454.                     elseif(icle.eq.4) then
  455.                       b=0D0
  456.                       DO J = 1, idim
  457.                          B = B + PT2(J)
  458.      +                     * (xcoor((ino1-1)*(idim+1)+J)-PT1(J))
  459.                       ENDDO
  460.  
  461.                       DO J = 1, idim
  462.                          tata = +2*(PT1(J)-xcoor((ino1-1)*
  463.      +                    (idim+1)+J)+B*PT2(J))
  464.                          titi=(xcoor((ino1-1)*(idim+1)+J))+tata
  465.                          MCORD2.XCOOR((ino1-1)*(idim+1)+J)=titi
  466.                       enddo
  467.  
  468.                     elseif(icle.eq.3) then
  469.                       DO J=1,idim
  470.                           MCORD2.XCOOR((ino1-1)*(idim+1)+J)=
  471.      +                      xcoor((ino1-1)*(idim+1)+J)+2*(PT1(J)
  472.      +                     -xcoor((ino1-1)*(idim+1)+J))
  473.                       ENDDO
  474.                    elseif(icle.eq.2) then
  475.                       DO J=1,idim
  476.                           MCORD2.XCOOR((ino1-1)*(idim+1)+J)=
  477.      +                      xcoor((ino1-1)*(idim+1)+J)+PT1(J)
  478.                       ENDDO
  479.                    endif
  480.                  ENDIF
  481.               enddo
  482.            ENDDO
  483.         endif
  484. C
  485. C debut du tri des projs
  486. C
  487. C
  488. C
  489. C
  490.        segini hgt
  491.        ihgt = hgt
  492.        xmult = 3.1415926 * (xmax-xmin)
  493.        ymult = 2.7182818 * (ymax-ymin)
  494.        zmult = 1.        * (zmax-zmin)
  495.        tmult = sqrt(xmult**2+ymult**2+zmult**2)
  496.        if (tmult.le.xpetit) then
  497.           xmult = 3.1415926
  498.           ymult = 2.7182818
  499.           zmult = 1.
  500.           tmult = sqrt(xmult**2+ymult**2+zmult**2)
  501.        endif
  502.        xmult = xmult / tmult
  503.        ymult = ymult / tmult
  504.        zmult = zmult / tmult
  505.        tmin =   xgrand
  506.        tmax =  -xgrand
  507.        DO ib1 = 1, nels
  508.           xproj = hg2.HCOOR((IB1-1)*3+1) * xmult
  509.      +          + HG2.HCOOR((IB1-1)*3+2) * ymult
  510.      +          + HG2.HCOOR((IB1-1)*3+3) * zmult
  511.  
  512.           Xp(ib1)  = xproj
  513.           tmin     = min(xproj,tmin)
  514.           tmax     = max(xproj,tmax)
  515.           ico(ib1) = ib1
  516.        ENDDO
  517.        if (abs(tmin-tmax).le.xpetit) then
  518.           tmin = tmin - 0.5
  519.           tmax = tmax + 0.5
  520.        endif
  521.        if (ixlong.ne.0)  xlong2 = xlong2m
  522. *  quelques contorsions pour eviter un integer overflow
  523.        xbzt = (tmax-tmin) / xlong2
  524.        xbzt = max(xbzt,1.d0)
  525.        xels=nels
  526.        xbzt = min(xels,xbzt)
  527.        nbzt=xbzt
  528.  
  529.        CALL TRIFLO(Xp,Xw,ico,Ke,nels)
  530.  
  531.        if (icle.eq.3) then
  532.  
  533.        endif
  534.        indt=nbzt+1
  535.        segini mfopa
  536.        imfopa = mfopa
  537.        DO i = nels, 1, -1
  538.          id = nbzt*(Xp(i)-tmin) / (tmax-tmin) + 1
  539.          ind(id)=i
  540.        ENDDO
  541.        DO i = 1, nbzt
  542.           if (ind(i+1).eq.0) ind(i+1)=ind(i)
  543.           if(ind(i+1).lt.ind(i)) call erreur(5)
  544.        ENDDO
  545.        if (zthr) then
  546.           ilon1 = nels / nbthr + 1
  547.        else
  548.           ilon1 = nels
  549.        endif
  550. C         jg = I232
  551. C         jg1 = jg / nbthr
  552. C         jg = jg1
  553. C double passage pour estimation taille de ivecti
  554.        do ipas = 1, 2
  555.           ipass = ipas
  556.        if (ipas.eq.1) then
  557.        segini mlhug
  558.        ihug = mlhug
  559.        endif
  560. C       JG= ilon1 * nels
  561. C       jg = min(jg,jg1)
  562. C       khug = jg
  563.        if (ipas.eq.2) then
  564.        do i = 1, nbthr
  565.           jg = nhug(i)
  566.           segini ivecti
  567.           ilhug(i) = ivecti
  568.           nhug(i) = 0
  569.        enddo
  570.        endif
  571.  
  572.        if (zthr) then
  573.           call threadii
  574.           do ith = 2, nbthr
  575.              call threadid(ith,hselei)
  576.           enddo
  577.           call hselei(1)
  578.           do ith = 2, nbthr
  579.              call threadif(ith)
  580.           enddo
  581.           call threadis
  582.        else
  583.           call hsele1(1,1,nels,imfopa,ihg1,ihg2,iwrk3,ishg,ihug
  584.      +          ,ihgsel,ihg,ipmodl,icle,imcord,ihgt,ixlong)
  585.        endif
  586. C fin de la boucle ipass
  587.        enddo
  588. C
  589. C ecriture du chamelem resultat
  590. C
  591.        N1=NSOUS
  592.        L1=22
  593.        N3=6
  594.        SEGINI,MCHELM
  595.        IPCHCO=MCHELM
  596.        TITCHE='CONNECTIVITE NON LOCAL'
  597.        IFOCHE=IFOUR
  598.        DO ISOUS = 1, NSOUS
  599.           IMODEL = KMODEL(ISOUS)
  600.           IPMAIL = IMAMOD
  601.           CONCHE(ISOUS) = CONSTI
  602.           CONM = CONMOD
  603.           NBEL = IPMAIL.NUM(/2)
  604.           NBNN = IPMAIL.NUM(/1)
  605. C INFORMATIONS SUR L'ELEMENT FINI
  606.           MELE=IPMAIL.ITYPEL
  607.           IF (infmod(/1).lt.7) then
  608.              CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
  609.              IF (IERR.NE.0) THEN
  610.                 GOTO 9999
  611.              endif
  612.              INFO=IPINF
  613.              MINTE=INFELL(11)
  614.              SEGSUP INFO
  615.           ELSE
  616.               minte=infmod(7)
  617.           ENDIF
  618. C
  619. C COMPLEMENT DU CHAMELEM
  620. C
  621.          IMACHE(ISOUS)=IPMAIL
  622.          INFCHE(ISOUS,1)=0
  623.          INFCHE(ISOUS,2)=0
  624.          INFCHE(ISOUS,3)=NIFOUR
  625.          INFCHE(ISOUS,4)=MINTE
  626.          INFCHE(ISOUS,5)=0
  627.          INFCHE(ISOUS,6)=5
  628.  
  629. C____________________________________________________________________
  630. C
  631.  
  632.  
  633.         IF (ICLE.EQ.1) n2=4
  634.         IF (ICLE.EQ.2.OR.ICLE.EQ.3) N2=5
  635.         IF(ICLE.EQ.4.OR.ICLE.EQ.5)  N2=6
  636. C TAILLE DES MELVALS A ALLOUER ET ALLOCATION
  637. C CREATION DU MCHAML DE LA SS ZONE
  638. C CAS SYMETRIE A PAS OUBLIER
  639.         SEGINI MCHAML
  640.         ICHAML(ISOUS) = MCHAML
  641. C CREATION DU PREMIER MELVAL
  642. C        'NLAR': DONNE LA LONGUEUR CARACTERISTIQUE
  643. C CE MELVAL EST CONSTANT DANS CHAQUE SS ZONE
  644.          NOMCHE(1) = 'NLAR'
  645.          TYPCHE(1) = 'REAL*8'
  646.          N2PTEL = 0
  647.          N2EL   = 0
  648. C CAS CHAMP CARA
  649.          if (ixlong.ne.0) then
  650.             melval = imptv(isous)
  651.             segini,melva1=melval
  652.             ielval(1) = melva1
  653.          else
  654.             N1PTEL = 1
  655.             N1EL   = 1
  656.             SEGINI, MELVAL
  657.             IELVAL(1)   = MELVAL
  658.             VELCHE(1,1) = XLONG
  659.          endif
  660. C CREATION DU DEUXIEME MELVAL
  661. C 'PMOD': PONTE SUR UN MODELE INDIQUANT LES ZONES GEOMETRIQUES
  662. C CE MELVAL EST CONSTANT
  663.          N1PTEL = 0
  664.          N1EL   = 0
  665.          N2PTEL = 1
  666.          N2EL   = 1
  667.          NOMCHE(2) = 'PMOD'
  668.          TYPCHE(2) = 'POINTEURMMODEL '
  669.          SEGINI MELVAL
  670.          IELVAL(2)   = MELVAL
  671.          IELCHE(1,1) = MMODEL
  672.  
  673. C 'NPNI : POINTE SUR UN LISTENTI CONTENANT LE NUMERO DU IMODEL
  674. C ACCESSIBLE POUR CHAQUE ELEMENT
  675. C 'NPLI': POINTE SUR UN LISTENTI CONTENANT UNE LINKED
  676. C LISTE DES ELEMENTS ACCESSIBLES SUR CHAQUE ZONE
  677.  
  678.           N1EL   = 0
  679.           N1PTEL = 0
  680.           N2PTEL = 1
  681.           N2EL   = NBEL
  682.           NOMCHE(3) = 'NPNI'
  683.           TYPCHE(3) = 'POINTEURLISTENTI'
  684.           SEGINI, MELVAL
  685.           IELVAL(3) = MELVAL
  686.           NOMCHE(4) = 'NPLI'
  687.           TYPCHE(4) = 'POINTEURLISTENTI'
  688.           SEGINI, MELVAL
  689.           IELVAL(4) = MELVAL
  690. C
  691. C
  692. C     'POT1' : POINTE SUR UN OBJET DE TYPE POINT
  693. C
  694. C              CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  695. C
  696.         IF(ICLE.NE.1)THEN
  697.           N1PTEL=0
  698.           N1EL=0
  699.           N2PTEL=1
  700.           N2EL=1
  701.           NOMCHE(5)='POT1'
  702.           TYPCHE(5)='POINTEURPOINT   '
  703.           SEGINI MELVAL
  704.           IELVAL(5)=MELVAL
  705.           IELCHE(1,1)=JPT1
  706.         ENDIF
  707. C
  708. C
  709. C     'POT2' : POINTE SUR UN OBJET DE TYPE POINT
  710. C
  711. C              CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  712. C
  713.         IF(ICLE.EQ.4)THEN
  714.           N1PTEL=0
  715.           N1EL=0
  716.           N2PTEL=1
  717.           N2EL=1
  718.           NOMCHE(6)='POT2'
  719.           TYPCHE(6)='POINTEURPOINT   '
  720.           SEGINI MELVAL
  721.           IELVAL(6)=MELVAL
  722.           IELCHE(1,1)=JPT2
  723.         ENDIF
  724. C
  725. C     'DISP' : DONNE LA DISTANCE AU PLAN
  726. C
  727. C              CE MELVAL EST CONSTANT DANS CHAQUE SS_ZONE
  728. C
  729.         IF(ICLE.EQ.5)THEN
  730.           N2PTEL=0
  731.           N2EL=0
  732.           N1PTEL=1
  733.           N1EL=1
  734.           NOMCHE(6)='DISP'
  735.           TYPCHE(6)='REAL*8'
  736.           SEGINI,MELVAL
  737.           IELVAL(6)=MELVAL
  738.           VELCHE(1,1)=D
  739.         ENDIF
  740. C
  741.        ENDDO
  742.  
  743. C debut de la boucle pour ranger les numeros d element
  744.  
  745.        DO IB1= 1, nbpb
  746.          kzt(ib1) = 0
  747.          knb=0
  748.          DO ISOUS=1, NSOUS
  749.             IF(inoa(IB1,ISOUS).NE.0) then
  750.               kzt(ib1)=kzt(ib1)+1
  751.               knb=knb+inoa(IB1,ISOUS)+1
  752.             ENDIF
  753.  
  754.          ENDDO
  755.          IZO=IELH(IB1,2)
  756.          IEL=IELH(IB1,1)
  757.          MCHAML=ICHAML(IZO)
  758.          if(iconl(ib1).eq.0.or.kzt(ib1).eq.0) then
  759.            melval=ielval(3)
  760.            ielche(1,iel)=0
  761.            melval=ielval(4)
  762.            ielche(1,IEL)=0
  763.          else
  764.            melval=ielval(3)
  765.              jg=kzt(ib1)
  766.              SEGINI MLENTI
  767.              Ielche(1,Iel)=MLENTI
  768.              melval=ielval(4)
  769.              JG=KNB
  770.              SEGINI MLENTI
  771.              ielche(1,IEL)=MLENTI
  772.          endif
  773.        ENDDO
  774. C REMPLISSAGE DES LISTENTI
  775.  
  776.        do ith = 1, nbthr
  777.           ivecti = ilhug(ith)
  778.           nbthr1 = nbthr
  779.           if (ith.gt.nbthr1) goto 999
  780.           ires = mod(nels,nbthr1)
  781.           if (ires.eq.0) then
  782.              ilon1 = nels / nbthr1
  783.              ideb = (ith - 1) * ilon1 + 1
  784.           else
  785.              if (ith.le.ires) then
  786.                 ilon1 = nels / nbthr1 + 1
  787.                 ideb = (ith - 1) * ilon1 + 1
  788.              else
  789.                 ilon1 = nels / nbthr1
  790.                 ideb = (ires * (ilon1 + 1)) + (ith - ires - 1)*ilon1+1
  791.              endif
  792.           endif
  793.           ifin = ideb + ilon1 - 1
  794.           if (ifin.ge.ideb) then
  795.           ICP=0
  796.           DO iIB1=ideb, ifin
  797.              ib1 = iib1
  798.              if (icle.eq.3.or.icle.eq.4.or.icle.eq.5) ib1=nsym(iib1)
  799.              if (iconl(IB1).eq.1.and.kzt(ib1).ne.0) then
  800.                 KZTl=0
  801.                 IEL=IELH(IB1,1)
  802.                 IZO=IELH(IB1,2)
  803.                 MCHAML=ICHAML(IZO)
  804.                 MELVAL=IELVAL(3)
  805.                 MLENTI=IELCHE(1,IEL)
  806.                 MELVAL=IELVAL(4)
  807.                 MLNIMO=IELCHE(1,IEL)
  808.                 N1=MLNIMO.LECT(/1)
  809.                 NCP1=0
  810.                 NTOT=0
  811.                 DO ISOUS=1, NSOUS
  812.                 IF (INOA(IB1,ISOUS).NE.0) THEN
  813.                    NTOT=NTOT+INOA(IB1,ISOUS)
  814.                    NCP=INOA(IB1,ISOUS)
  815.  
  816.                    NCP1=NCP1+1
  817.                    MLNIMO.LECT(NCP1)=INOA(IB1,ISOUS)
  818.  
  819.                    KZTl=KZTl+1
  820.                    MLENTI.LECT(KZTl)=ISOUS
  821.                    DO I1=1, INOA(IB1,NSOUS+1)
  822.                       IB2=LHUG(ICP+I1)
  823.                       IZO2=IELH(IB2,2)
  824.                       IF (IZO2.EQ.ISOUS) THEN
  825.                          IEL2=IELH(IB2,1)
  826.                          NCP1=NCP1+1
  827.                          MLNIMO.LECT(NCP1)=IEL2
  828.                       ENDIF
  829.                    ENDDO
  830.                 ENDIF
  831.  
  832.           ENDDO
  833.          ICP=ICP+NTOT
  834.          endif
  835. C fin de la boucle sur les éléments
  836.        ENDDO
  837.        endif
  838.  999  continue
  839. C fin de la boucle sur nbthr
  840.           segsup ivecti
  841.        enddo
  842.  
  843.  
  844.        segsup mlhug
  845.       segsup hg1,hgt,hg,conl
  846.       do ii = 1, nsous
  847.          do i = 1, nbthr
  848.             wrk1 =iwrk1(ii,i)
  849.             wrk2 =iwrk2(ii,i)
  850.             segsup wrk1,wrk2
  851.          enddo
  852.       enddo
  853.       segsup wrk3
  854.       segsup mfopa
  855.       segsup ivecti
  856.       segsup kkzt
  857.       if (icle.ne.1) then
  858.          segsup hg2,shg,noetr,mcord2
  859.       endif
  860. c
  861. C desactivation de l'objet resultat pour qu'il ne soit plus actif en ecriture
  862. C ce qui n'a pas ete cree dans la routine est laisse ouvert
  863. c
  864.  
  865.       mchelm = ipchco
  866.       do isous = 1, nsous
  867.          mchaml = ichaml(isous)
  868.          melval = ielval(1)
  869.          segdes melval
  870.          melval = ielval(2)
  871.          segdes melval
  872.          if (icle.ne.1) then
  873.             melval = ielval(5)
  874.             segdes melval
  875.          endif
  876.          if (icle.eq.4.or.icle.eq.5) then
  877.             melval = ielval(6)
  878.             segdes melval
  879.          endif
  880.          melval = ielval(3)
  881.          do jj = 1, ielche(/2)
  882.             if (ielche(1,jj).ne.0) then
  883.                mlenti = ielche(1,jj)
  884.                segdes mlenti
  885.             endif
  886.          enddo
  887.          segdes melval
  888.          melval = ielval(4)
  889.          do jj = 1, ielche(/2)
  890.             if (ielche(1,jj).ne.0) then
  891.                mlenti = ielche(1,jj)
  892.                segdes mlenti
  893.             endif
  894.          enddo
  895.          segdes melval
  896.          segdes mchaml
  897.       enddo
  898.       segdes mchelm
  899.  
  900.        if (zthr) then
  901.           call threadis
  902.        endif
  903.       return
  904. C____________________________________________________________________
  905. C
  906. C     ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR
  907. C____________________________________________________________________
  908. C
  909.  9999 CONTINUE
  910.       IF(ISOUS.GT.1)THEN
  911.           DO  IE1=1,ISOUS
  912.             CALL DTSHAM(ICHAML(IE1))
  913.           ENDDO
  914.       ENDIF
  915.       SEGSUP,MCHELM
  916.       IPCHCO=0
  917.       IRET=0
  918. C
  919.       DO IE1=1,NSOUS
  920.         IMODEL=KMODEL(IE1)
  921.         IPMAIL=IMAMOD
  922.         SEGDES,IPMAIL,IMODEL
  923.       ENDDO
  924.       SEGDES,MMODEL
  925.  
  926.       RETURN
  927.       END
  928.  
  929.  
  930.  

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