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

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