Télécharger la plaquette Cast3M


fr en

Télécharger zonag.eso

Retour à la liste

Numérotation des lignes : 

zonag

  1. C ZONAG     SOURCE    OF166741  25/07/28    21:15:15     12336          
  2.  
  3. C====================================================================
  4. C   localisation de points dans des elements  d une zone elementaire
  5. C     zonage  et construction  d un tableau de correspondance
  6. C
  7. C Entrees :
  8. C    ip1 pointeur sur le maillage elementaire  massif
  9. C    ip2 pointeur sur le maillage  poi1
  10. C    iexx pointeur sur un segment contenant les points deja vus
  11. C         (eviter comptage des points aux frontieres de 2 sous zones
  12. C          et le traitement des points qui sont des noeuds de ip1)
  13. C    ITR : COMPTEUR MIS A JOUR DANS ZONAG
  14. C Sorties :
  15. C    iccoun  pointeur sur le segment ICOUNT contenant le tableau de
  16. C    correspondance suivant
  17. C        IEINT(1,N) numero du point du meleme IP2
  18. C        IEINT(2,N) numero de l element du meleme IP1 le contenant
  19. C        IEINT(3,N) numero de la souszone ISZ correspondant a IP1
  20. C        MAXPZ nombre de points de IP2 contenus dans la s_zone (N max)
  21. C====================================================================
  22.       SUBROUTINE ZONAG(ISZ,IP1,IP2,ICCOUN,IEXX,ITR)
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8 (A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29. -INC CCREEL
  30. -INC CCGEOME
  31.  
  32. -INC SMCOORD
  33. -INC SMELEME
  34.  
  35.       DATA EPSI/1.D-5/
  36.  
  37.       SEGMENT iexclu
  38.         INTEGER IDEJVU(nbpti)
  39.       ENDSEGMENT
  40.  
  41.       SEGMENT icount
  42.         INTEGER NBPTOT
  43.         INTEGER MAXPZ(nbsz)
  44.         INTEGER IEINT(3,NODES)
  45.         REAL*8 QQQ(3,NODES)
  46.       ENDSEGMENT
  47.  
  48.       SEGMENT inomil(0)
  49.  
  50.       segment wrk4
  51.         real*8 qsi(3),xel(3,nbnn),shpp(6,nbnn)
  52.       endsegment
  53.       segment wrkl
  54.         real*8 shpl(6,nbnnl),xell(3,nbnnl)
  55.       endsegment
  56.  
  57.       SEGMENT ISEG1
  58.         REAL*8 XLIM(2,NBEL),YLIM(2,NBEL),ZLIM(2,NBEL)
  59.       ENDSEGMENT
  60.       SEGMENT ISEG3
  61.         INTEGER NIZO(NZO+1), NUMZO(NZO), IDEJ(NZO)
  62.       ENDSEGMENT
  63.       SEGMENT ISEG5
  64.         INTEGER NNMEL(ILON)
  65.       ENDSEGMENT
  66.  
  67.       DIMENSION XPU(3)
  68.  
  69.       IDIMP1 = IDIM + 1
  70. c*d       write(ioimp,*) 'ZONAGE',isz,ip1,ip2
  71.  
  72.       IPT2 = IP2
  73. C*      SEGACT IPT2 <- Actif en E/S et non modifie
  74.       NODES = IPT2.NUM(/2)
  75.  
  76.       IPT1 = IP1
  77. C*      SEGACT IPT1 <- Actif en E/S et non modifie
  78.       NBNN1 = IPT1.NUM(/1)
  79.       NBEL1 = IPT1.NUM(/2)
  80.       KELE1 = IPT1.ITYPEL
  81.  
  82. c*d      write(ioimp,*) 'ZONAGE',nbnn1,nbel1,kele1, nodes
  83.  
  84.       icount = ICCOUN
  85. C*      SEGACT,icount*MOD <- Actif en E/S en etat modifiable
  86.  
  87.       iexclu = IEXX
  88. C*      SEGACT,iexclu*MOD <- Actif en E/S en etat modifiable
  89.  
  90.       NBEL = NBEL1
  91.       SEGINI ISEG1
  92.  
  93.       XZO = 0.D0
  94.       YZO = 0.D0
  95.       ZZO = 0.D0
  96.       XZA = XGRAND
  97.       YZA = XGRAND
  98.       ZZA = XGRAND
  99.       XTOMI = +XGRAND
  100.       XTOMA = -XGRAND
  101.       YTOMI = +XGRAND
  102.       YTOMA = -XGRAND
  103.       ZTOMI = +XGRAND
  104.       ZTOMA = -XGRAND
  105.       D_X = 0.D0
  106.       D_Y = 0.D0
  107.       D_Z = 0.D0
  108.       DO I1 = 1, NBEL1
  109.         XMI = +XGRAND
  110.         XMA = -XGRAND
  111.         YMI = +XGRAND
  112.         YMA = -XGRAND
  113.         ZMI = +XGRAND
  114.         ZMA = -XGRAND
  115.         DO I2 = 1, NBNN1
  116.           IB = IPT1.NUM(I2,I1)
  117. c*          iexclu.IDEJVU(IB) = 2 <- Deja fait dans ACCRO.eso
  118.           IA = (IB-1)*IDIMP1
  119.           XMI = MIN(XMI,XCOOR(IA+1))
  120.           XMA = MAX(XMA,XCOOR(IA+1))
  121.           YMI = MIN(YMI,XCOOR(IA+2))
  122.           YMA = MAX(YMA,XCOOR(IA+2))
  123.           IF (IDIM.EQ.3) THEN
  124.             ZMI = MIN(ZMI,XCOOR(IA+3))
  125.             ZMA = MAX(ZMA,XCOOR(IA+3))
  126.           ENDIF
  127.         ENDDO
  128.         XLIM(1,I1) = XMI
  129.         XLIM(2,I1) = XMA
  130.         YLIM(1,I1) = YMI
  131.         YLIM(2,I1) = YMA
  132.         D_X = XMA - XMI
  133.         XZO = MAX(XZO,D_X)
  134.         XZA = MIN(XZA,D_X)
  135.         XTOMI = MIN(XMI,XTOMI)
  136.         XTOMA = MAX(XMA,XTOMA)
  137.         D_Y = YMA - YMI
  138.         YZO = MAX(YZO,D_Y)
  139.         YZA = MIN(YZA,D_Y)
  140.         YTOMI = MIN(YMI,YTOMI)
  141.         YTOMA = MAX(YMA,YTOMA)
  142.         IF (IDIM.EQ.3) THEN
  143.           ZLIM(1,I1)=ZMI
  144.           ZLIM(2,I1)=ZMA
  145.           D_Z = ZMA - ZMI
  146.           ZZO = MAX(ZZO,D_Z)
  147.           ZZA = MIN(ZZA,D_Z)
  148.           ZTOMI = MIN(ZMI,ZTOMI)
  149.           ZTOMA = MAX(ZMA,ZTOMA)
  150.         ENDIF
  151.       ENDDO
  152.       D_X = 1.D-4 * (XTOMA - XTOMI)
  153.       XPR = MIN(XZO*1.D-2, D_X*0.5D0)
  154.       XTOMI = XTOMI - D_X
  155.       XTOMA = XTOMA + D_X
  156.       D_X = XTOMA - XTOMI
  157.       XZA = MIN(XZA*0.97D0, D_X)
  158.       NXZO = D_X / XZA + 1
  159.       XZO = XZA
  160.  
  161.       D_Y = 1.D-4 * (YTOMA - YTOMI)
  162.       YPR = MIN(YZO*1.D-2, D_Y*0.5D0)
  163.       YTOMI = YTOMI - D_Y
  164.       YTOMA = YTOMA + D_Y
  165.       D_Y = YTOMA - YTOMI
  166.       YZA = MIN(YZA*0.97D0, D_Y)
  167.       NYZO = D_Y / YZA + 1
  168.       YZO = YZA
  169. c*d      WRITE(6,FMT='('' NXZO NYZO'',2I7)') NXZO,NYZO
  170.       NZZO = 1
  171.       IF (IDIM.EQ.3) THEN
  172.         D_Z = (ZTOMA - ZTOMI) * 1.D-4
  173.         ZPR = MIN(ZZO*1.D-2, 0.5D0*D_Z)
  174.         ZTOMI = ZTOMI - D_Z
  175.         ZTOMA = ZTOMA + D_Z
  176.         D_Z = ZTOMA - ZTOMI
  177.         ZZA = MIN(ZZA*0.97D0, D_Z)
  178.         IF (ZZA.EQ.0.D0) THEN
  179.           NZZO = 1
  180.         ELSE
  181.           NZZO = D_Z / ZZA + 1
  182.         ENDIF
  183.         ZZO = ZZA
  184. c*d      WRITE(6,FMT='('' zz0,zzA,ztomi,ztoma'',4e12.5)')
  185. c*d     $ xzo,xza,ztomi,ztoma
  186.       ENDIF
  187. c*d      WRITE(6,*)  XTOMI, XTOMA
  188. c*d      WRITE(6,*)  YTOMI ,YTOMA
  189. c*d      WRITE(6,*)  ZTOMI ,ZTOMA
  190.       IF (D_X.LT.EPSI) THEN
  191.         XTOMA = XTOMA + EPSI/2
  192.         XTOMI = XTOMI - EPSI/2
  193.         XZO = EPSI
  194.         D_X = XTOMA - XTOMI
  195.       ENDIF
  196.       IF (D_Y.LT.EPSI) THEN
  197.         YTOMA = YTOMA + EPSI/2
  198.         YTOMI = YTOMI - EPSI/2
  199.         YZO = EPSI
  200.         D_Y = YTOMA - YTOMI
  201.       ENDIF
  202.       IF (IDIM.EQ.3) THEN
  203.         IF (D_Z.LT.EPSI) THEN
  204.           ZTOMA = ZTOMA + EPSI/2
  205.           ZTOMI = ZTOMI - EPSI/2
  206.           ZZO = EPSI
  207.           D_Z = ZTOMA - ZTOMI
  208.         ENDIF
  209.       ENDIF
  210. C_______________________________
  211.       NXDEP = MIN(NXZO,10)
  212.       NYDEP = MIN(NYZO,10)
  213.       IF (IDIM.EQ.2) THEN
  214.         r_z = FLOAT(NXZO)*FLOAT(NYZO)
  215.         IF (r_z.GT.100000.) THEN
  216.           XY=SQRT(r_z)/90
  217.           NXZO=MAX(INT(NXZO/XY),NXDEP)
  218.           NYZO=MAX(INT(NYZO/XY),NYDEP)
  219.           r_z = FLOAT(NXZO)*FLOAT(NYZO)
  220.           IF (r_z.GT.100000.) THEN
  221.             XY=SQRT(r_z)/60
  222.             NXZO=MAX(INT(NXZO/XY),NXDEP)
  223.             NYZO=MAX(INT(NYZO/XY),NYDEP)
  224.           ENDIF
  225.           XZO= D_X /NXZO
  226.           YZO= D_Y /NYZO
  227.           NXZO = D_X /XZO +1
  228.           NYZO = D_Y /YZO +1
  229.         ENDIF
  230. c*d        WRITE(6,FMT='(''  XZO NXZO YZO NYZO '' , E12.5,I5,E12.5,I5)')
  231. c*d     $  XZO ,NXZO, YZO, NYZO
  232.       ELSE
  233.          NZDEP=MIN(NZZO,10)
  234.          r_z = FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO)
  235.          IF (r_z .GT. 250000.) THEN
  236.             XYZ = r_z**0.33333333D0/25
  237.             NXZO=MAX(INT(NXZO/XYZ),NXDEP)
  238.             NYZO=MAX(INT(NYZO/XYZ),NYDEP)
  239.             NZZO=MAX(INT(NZZO/XYZ),NZDEP)
  240.             r_z = FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO)
  241.             IF (r_z.GT.250000.) THEN
  242.                XYZ = r_z**0.3333333333D0/25
  243.                NXZO=MAX(INT(NXZO/XYZ),NXDEP)
  244.                NYZO=MAX(INT(NYZO/XYZ),NYDEP)
  245.                NZZO=MAX(INT(NZZO/XYZ),NZDEP)
  246. c*d               IF(IIMPI.NE.0)WRITE(IOIMP,FMT='('' NXZO NYZO NZZO  ''
  247. c*d     $              ,4I7) ') NXZO,NYZO,NZZO
  248.                r_z = FLOAT(NXZO)*FLOAT(NYZO)*FLOAT(NZZO)
  249.                IF (r_z.GT.250000.) THEN
  250.                  XYZ = r_z**0.3333333333D0/25
  251.                   NXZO=MAX(INT(NXZO/XYZ),NXDEP)
  252.                   NYZO=MAX(INT(NYZO/XYZ),NYDEP)
  253.                   NZZO=MAX(INT(NZZO/XYZ),NZDEP)
  254.                ENDIF
  255.             ENDIF
  256.             XZO=D_X / NXZO
  257.             YZO=D_Y / NYZO
  258.             ZZO=D_Z / NZZO
  259.             NXZO= D_X / XZO +1
  260.             NYZO= D_Y / YZO +1
  261.             NZZO= D_Z / ZZO +1
  262.         ENDIF
  263.       ENDIF
  264. *
  265. *  ON VEUT CONSTRUIRE LA LISTE DES ELEMENTS TOUCHANT UNE ZONE
  266. *  POUR CELA ON COMMENCE PAR COMPTER COMBIEN D'ELEMENTS TOUCHENT
  267. *  CHAQUE ZONE ET EN MEME TEMPS ON STOCKE LES ZONES TOUCHEES
  268. *  PAR CHAQUE ELEMENT ET LEUR NOMBRE
  269.       NXYZO = NXZO*NYZO
  270.       NZO   = NXYZO*NZZO
  271. c*d      WRITE(IOIMP,FMT='('' NZO NXZO NYZO NZZO  ''
  272. c*d     $,4I7) ') NZO,NXZO,NYZO,NZZO
  273.  
  274.       SEGINI ISEG3
  275.  
  276.       DO I1=1,NBEL1
  277.         NIZ1X = INT( (XLIM(1,I1)-XTOMI-XPR) / XZO ) + 1
  278.         NIZ1Y = INT( (YLIM(1,I1)-YTOMI-YPR) / YZO ) + 1
  279.         NIZ2X = INT( (XLIM(2,I1)-XTOMI+XPR) / XZO ) + 1
  280.         NIZ2Y = INT( (YLIM(2,I1)-YTOMI+YPR) / YZO ) + 1
  281.         IF (IDIM.EQ.3) THEN
  282.           NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1
  283.           NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1
  284.           DO L3=NIZ1Z,NIZ2Z
  285.             DO L1=NIZ1Y,NIZ2Y
  286.               DO L2=NIZ1X,NIZ2X
  287.                 NIZA = L2 + (L1-1) * NXZO + (L3-1)*NXYZO
  288.                 NUMZO(NIZA) = NUMZO(NIZA) +1
  289.               ENDDO
  290.             ENDDO
  291.           ENDDO
  292.         ELSE
  293.           DO L1=NIZ1Y,NIZ2Y
  294.              DO L2=NIZ1X,NIZ2X
  295.                 NIZA = L2 + ( L1-1) * NXZO
  296.                 NUMZO(NIZA) = NUMZO(NIZA) +1
  297.              ENDDO
  298.           ENDDO
  299.         ENDIF
  300.       ENDDO
  301. *
  302. *  CONSTRUCTION DU TABLEAU D'ADRESSAGE DU TABLEAU DONNANT LES
  303. *  ELEMENTS CONCERNES PAR UNE ZONE
  304. *
  305.       ILON=0
  306.       NIZO(1)=1
  307.       DO L1=1,NZO
  308.         NIZO(L1+1)=NIZO(L1)+NUMZO(L1)
  309.         ILON=ILON+ NUMZO(L1)
  310.       ENDDO
  311. C      WRITE(6,FMT='(''  ILON '',I5)') ILON
  312. C      WRITE(6,109) (KKK,NUMZO(KKK),(NELZO(KI,KKK),KI=1,4),KKK=1,NBEL)
  313. C  109 FORMAT(I6,I5,4I5)
  314. C      WRITE(6,110)( NIZO(KI),KI=1,NZO+1)
  315. C 110  FORMAT(16I5)
  316.  
  317.       SEGINI ISEG5
  318.  
  319.       DO I1=1,NBEL
  320.         NIZ1X=INT((XLIM(1,I1)-XTOMI-XPR)/XZO) +1
  321.         NIZ1Y=INT((YLIM(1,I1)-YTOMI-YPR)/YZO) +1
  322.         NIZ2X=INT((XLIM(2,I1)-XTOMI+XPR)/XZO) +1
  323.         NIZ2Y=INT((YLIM(2,I1)-YTOMI+YPR)/YZO) +1
  324.         IF(IDIM.EQ.3) THEN
  325.           NIZ1Z=INT((ZLIM(1,I1)-ZTOMI-ZPR)/ZZO) +1
  326.           NIZ2Z=INT((ZLIM(2,I1)-ZTOMI+ZPR)/ZZO) +1
  327.           DO 251 L3=NIZ1Z,NIZ2Z
  328.             DO 2511 L1=NIZ1Y,NIZ2Y
  329.               DO 25111 L2=NIZ1X,NIZ2X
  330.                 NIZA = L2 + (L1-1) * NXZO + (L3-1)*NXYZO
  331.                 IAD=NIZO(NIZA)+IDEJ(NIZA)
  332.                 NNMEL(IAD)=I1
  333.                 IDEJ(NIZA)=IDEJ(NIZA)+1
  334. 25111         CONTINUE
  335.  2511       CONTINUE
  336.  251      CONTINUE
  337.         ELSE
  338.           DO 252 L1=NIZ1Y,NIZ2Y
  339.             DO 2521 L2=NIZ1X,NIZ2X
  340.               NIZA = L2 + ( L1-1) * NXZO
  341.               IAD=NIZO(NIZA)+IDEJ(NIZA)
  342.              NNMEL(IAD)=I1
  343.               IDEJ(NIZA)=IDEJ(NIZA)+1
  344.  2521       CONTINUE
  345.  252      CONTINUE
  346.         ENDIF
  347.       ENDDO
  348.  
  349.       nbnn = NBNN1
  350.  
  351.       segini wrk4
  352.       segini inomil
  353. C element quaf ? si oui kell=numero lineaire correspondant
  354. C                si non kell=0
  355.       CALL NQF2NL(KELE1,kell)
  356.       IF (IERR.NE.0) RETURN
  357.       IF (KELL.NE.0) THEN
  358.         nsom  = nbsom(KELE1)
  359.         nbnnl = NBNNE(kell)
  360.         IF (nsom.NE.nbnnl) THEN
  361.           call erreur(5)
  362.           return
  363.         endif
  364.         idx = nspos(KELE1)-1
  365.         segini wrkl
  366.         do i=1,nbnnl
  367.           inomil(**)=i
  368.         enddo
  369.       ELSE
  370.         kd = kdegre(KELE1)
  371. C element quadratiques
  372.         if (kd.eq.3) then
  373.           nso = nbsom(KELE1)
  374.           idx = nspos(KELE1)-1
  375.           do 762  i=1,nbnn
  376.             do 763  j=1,nso
  377.               iso = ibsom(idx+j)
  378.               if (i.eq.iso) goto 762
  379.  763        continue
  380.             inomil(**)= i
  381.  762      continue
  382. C  elements  lineaires
  383.         else if (kd.eq.2) then
  384.           do i=1,nbnn
  385.             inomil(**)=i
  386.           enddo
  387.         endif
  388.       ENDIF
  389. c*d       write(6,*) (inomil(i),i=1,inomil(/1))
  390.  
  391. C*      IA1 = 0
  392. C*      IF (KELE1.EQ.14 .OR. KELE1.EQ.15) IA1 = 1
  393. C*      IF (KELE1.EQ.16 .OR. KELE1.EQ.17) IA1 = 7
  394.  
  395. C   on va tourner sur les elements poi1
  396.  
  397.       DO 2 K = 1, NODES
  398.         IP = IPT2.NUM(1,K)
  399. C      write(ioimp,*) 'on cherche l element contenant le noeud' ,ip
  400.         IF (iexclu.IDEJVU(IP).NE.0) GOTO 2
  401.  
  402.         IREFP = (IP-1) * IDIMP1
  403.         XPU(1) = XCOOR(IREFP+1)
  404.         IF (XPU(1).LT.XTOMI.OR.XPU(1).GT.XTOMA) GOTO 2
  405.         XPU(2) = XCOOR(IREFP+2)
  406.         IF (XPU(2).LT.YTOMI.OR.XPU(2).GT.YTOMA) GOTO 2
  407.         XPU(3) = 0.D0
  408.         IF (IDIM.EQ.3) THEN
  409.           XPU(3) = XCOOR(IREFP+3)
  410.           IF (XPU(3).LT.ZTOMI.OR.XPU(3).GT.ZTOMA) GOTO 2
  411.         ENDIF
  412.         INDZO=INT((XPU(1)-XTOMI)/XZO)+ 1 +INT((XPU(2)-YTOMI)/YZO)*NXZO
  413.         IF (IDIM.EQ.3) INDZO=INDZO+INT((XPU(3)-ZTOMI)/ZZO)*NXZO*NYZO
  414.         IDEB = NIZO(INDZO)
  415.         IFIN = NIZO(INDZO+1)-1
  416. C        write(6,fmt='('' ideb ifin'',2i5)') ideb,ifin ,indzo
  417.         IF (IDEB.GT.IFIN) GO TO 2
  418. C
  419.         ITROU = 1
  420. C-------------------------------------------------
  421.         DO 11 KK = IDEB,IFIN
  422.           jkk = NNMEL(KK)
  423.  
  424. *       write(6,*) '        '
  425. *       write(6,*) 'recherche point ',ip, 'ds elem ',jkk,'itrou',ITROU
  426.  
  427. C Dans le cas "ACCRO", on cherche tout d'abord si le noeud 
  428. C appartient aux deux maillages car si oui on ne le stocke pas dans 
  429. C les noeuds a traiter ensuite (pas de rigidite a construire)
  430. C Deja fait auparavant !
  431. c*          DO jl = 1, NBNN1
  432. c*            IF (IP.EQ.IPT1.NUM(jl,jkk)) THEN
  433. c*              ITROU = 2
  434. c*              GOTO 19
  435. c*            ENDIF
  436. c*          ENDDO
  437.  
  438.           CALL DOXE(xcoor,IDIM,nbnn,ipt1.num,jkk,xel)
  439. * cas quaf
  440.           IF (kell.NE.0) THEN
  441.             DO innl = 1, nbnnl
  442.               jl = ibsom(idx+innl)
  443.               DO iid = 1, IDIM
  444.                 xell(iid,innl) = xel(iid,jl)
  445.               ENDDO
  446.             ENDDO
  447.             qsi(1) = 0.D0
  448.             qsi(2) = 0.D0
  449.             qsi(3) = 0.D0
  450.             CALL qsijs(xell,kell ,nbnnl,IDIM,xpu,SHPL,qsi,iret)
  451.             CALL qsijs(xel ,KELE1,nbnn ,IDIM,xpu,SHPP,qsi,iret)
  452.           ELSE
  453.             qsi(1) = 0.D0
  454.             qsi(2) = 0.D0
  455.             qsi(3) = 0.D0
  456.             CALL qsijs(xel,KELE1,nbnn,IDIM,xpu,SHPP,qsi,iret)
  457.           ENDIF
  458.           IF (IRET.NE.0) GOTO 11
  459.  
  460. c*d        write(6,fmt='(8E12.5)')(shpp(1,ih),ih=1,nbnn)
  461.           if (kell.ne.0) then
  462.             do i=1,inomil(/1)
  463.               ilp= inomil(i)
  464.               if (shpl(1,ilp).lt.0.D0) goto 11
  465.             enddo
  466.           else
  467.             do i=1,inomil(/1)
  468.               ilp= inomil(i)
  469.               if (shpp(1,ilp).lt.0.D0) goto 11
  470.             enddo
  471.           endif
  472.           GOTO 100
  473.  11     CONTINUE
  474. C  on n a rien trouve pour ce point
  475.         ITROU = 0
  476.  100    CONTINUE
  477.  
  478.  19     CONTINUE
  479.         IF (ITROU.EQ.1) THEN
  480. C    on a trouve  l element contenant le point K  attention
  481.           iexclu.IDEJVU(ip) = 1
  482.           itr = itr + 1
  483.           icount.IEINT(1,itr) = IP
  484.           icount.IEINT(2,itr) = JKK
  485.           icount.IEINT(3,itr) = ISZ
  486.           icount.QQQ(1,itr) = qsi(1)
  487.           icount.QQQ(2,itr) = qsi(2)
  488.           icount.QQQ(3,itr) = qsi(3)
  489. *       write(6,*) 'trouve  point' ,IP, 'Element' ,JKK
  490. C      write(6,2375)ip,j,(xpu(i1),i1=1,IDIM),(qsi(i2),i2=1,IDIM)
  491. 2375    format(2i4,6e12.5)
  492. C*        ELSE IF (ITROU.EQ.2) THEN
  493. C*          iexclu.IDEJVU(ip) = 2
  494. C*C     write(6,*) 'trouve  point' ,IP, 'noeud Element' ,jll,JKK
  495.         ENDIF
  496.  
  497.  2    CONTINUE
  498.  
  499.       icount.MAXPZ(ISZ) = ITR  - ICOUNT.NBPTOT
  500.       icount.NBPTOT =  ITR
  501.  
  502.       segsup wrk4,inomil
  503.       IF (KELL.NE.0) SEGSUP wrkl
  504.       SEGSUP,ISEG1,ISEG5,ISEG3
  505. C
  506. C    le tableau des correspondances est termine
  507. C
  508. C*      SEGDES,IPT1,IPT2 <- Actifs en E/S et non modifies
  509. C*      SEGDES,icount,iexclu <- Actifs en E/S et modifies
  510.  
  511.       RETURN
  512.       END
  513.  
  514.  
  515.  

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