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

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