Télécharger la plaquette Cast3M


fr en

Télécharger opto2.eso

Retour à la liste

Numérotation des lignes : 

opto2

  1. C OPTO2     SOURCE    GOUNAND   25/11/24    21:15:11     12406          
  2.       SUBROUTINE OPTO2(TRAVJ,JELEM,LTOPA)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : OPTO2 (anciennement optt2c)
  7. C DESCRIPTION : Une implémentation de l'amélioration d'une topologie
  8. C               autour d'un élément. On reprend OPTITOPO pour le corps
  9. C     du programme. On reprend l'extraction et la topologie inverse de
  10. C     EXTO. Le point crucial sera d'implémenter la modification de la
  11. C     topologie : enlever les anciens éléments et mettre les nouveaux.
  12. C
  13. C
  14. C     Ici, on est en numérotation locale et on fait l'extraction de la
  15. C     topologie proprement dite, son optimisation puis sa mise à jour.
  16. C     Les segments transmis sont supposés activés en *MOD
  17. C
  18. C     Le point important est de construire la topologie inverse.
  19. C
  20. C     Le début est identique à exto2.eso
  21. C
  22. C     Repris de optt2b : on raccourcit la subroutine en externalisant
  23. C     des opérations en subroutines.
  24. C
  25. C LANGAGE     : ESOPE
  26. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SEMT/LTA)
  27. C               mél : gounand@semt2.smts.cea.fr
  28. C***********************************************************************
  29. C APPELES          : EXTO4C, OPTO3
  30. C APPELES (E/S)    :
  31. C APPELES (BLAS)   :
  32. C APPELES (CALCUL) :
  33. C APPELE PAR       : OPTO1
  34. C***********************************************************************
  35. C SYNTAXE GIBIANE    :
  36. C ENTREES            : JELEM
  37. C ENTREES/SORTIES    : JCOORD, JTOPO
  38. C SORTIES            :
  39. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  40. C***********************************************************************
  41. C VERSION    : v1, 17/10/2017, version initiale
  42. C HISTORIQUE : v1, 17/10/2017, création
  43. C HISTORIQUE :
  44. C HISTORIQUE :
  45. C***********************************************************************
  46. -INC PPARAM
  47. -INC CCOPTIO
  48. -INC TMATOP2
  49. -INC SMLENTI
  50.       POINTEUR JNBL.MLENTI
  51.       POINTEUR JNNO.MLENTI,KNNO.MLENTI
  52.       POINTEUR NEXTO.MLENTI
  53. -INC SMELEME
  54. *
  55. *     Le nombre d'éléments de JTOPO et le nombre de points de JCOORD
  56. *     vont être variables. Pour ne pas avoir à ajuster ces segments en
  57. *     permanence, on va dimensionner plus large, mais du coup, il faut
  58. *     aussi maintenir à la main le nombre de noeuds et d'éléments
  59. *     courants.
  60. *
  61. *     Le nombre d'éléments courants est NVCOU et le nombre d'éléments
  62. *     max est NVMAX. Idem pour le nombre de noeuds courants et max :
  63. *     NPCOU et NPMAX.
  64. *
  65. * Numerotation locale des éléments JTOPO.NUM(NBNN,NBELEM)
  66. *      INTEGER NVCOU,NVMAX
  67.       POINTEUR JTOPO.MELEME
  68. *del      POINTEUR KTOPO.MELEME
  69.       POINTEUR JELEM.MELEME
  70.       POINTEUR JELEM1.MELEME
  71.       POINTEUR JEXTO.MELEME,KEXTO.MELEME
  72.       POINTEUR JTBES.MELEME
  73. -INC SMLOBJE
  74.       POINTEUR LTOPA.MLOBJE
  75. -INC SMCOORD
  76. * Numerotation locale (de 1 à NBPTS)
  77. *      INTEGER NPCOU,NPMAX
  78. *del      POINTEUR JCOORD.MCOORD
  79.       POINTEUR KCOORD.MCOORD
  80. -INC TMATOP1
  81. *-INC STOPINV
  82. *-INC SMETRIQ
  83.       POINTEUR JCMETR.METRIQ
  84.       POINTEUR KCMETR.METRIQ
  85. *-INC STRAVJ
  86.       POINTEUR TRAVK.TRAVJ
  87. *-INC STRAVL
  88. -INC SMLMOTS
  89.       POINTEUR JNMETR.MLMOTS
  90.       POINTEUR KNMETR.MLMOTS
  91. *
  92.       POINTEUR TRAVX.TRAVJ
  93. *
  94. *-INC SMLENTX
  95.       POINTEUR ICPRX.MLENTX
  96.       POINTEUR IDCPX.MLENTX
  97.       POINTEUR ICPR2.MLENTX
  98.       POINTEUR IDCP2.MLENTX
  99. *-INC SMELEMX
  100.       POINTEUR KELEMX.MELEMX
  101.       POINTEUR JELEM2.MELEMX
  102. *
  103.       logical lchang
  104. *
  105. * Executable statements
  106. *
  107.       if (impr.ge.4) WRITE(IOIMP,*) 'Entrée dans opto2.eso'
  108. *
  109. * Initialisation et extension des segments JTOPO et JCOORD
  110. *
  111.       IDIMP=IDIM+1
  112.  
  113.       JTOPO=TRAVJ.TOPO
  114. *
  115. * Initialisation de la topologie inverse
  116. *
  117. *      CALL INTOPI(NVMAX,NPMAX,TOPINV,IMPR)
  118.       CALL INTOP2(TRAVJ,IMPR)
  119.       IF (IERR.NE.0) RETURN
  120. *
  121. * Remplissage de la topologie inverse avec JTOPO
  122. *
  123. *      CALL RETOPI(JTOPO,NVCOU,TOPINV,IMPR)
  124.       CALL RETOP2(TRAVJ,IMPR)
  125.       IF (IERR.NE.0) RETURN
  126. *
  127.       if (.false.) then
  128.          TOPINV=TRAVJ.TOPI
  129.          call ectopi(TOPINV,1)
  130.          call ectopi(TOPINV,2)
  131.       endif
  132. *
  133. * Initialisation LTOPA
  134. *
  135.       NOBJ=0
  136.       SEGINI LTOPA
  137.       LTOPA.TYPOBJ='MAILLAGE'
  138. *
  139. * Segment de travail pour l'extraction des éléments
  140. *
  141.       JG=NVMAX
  142.       SEGINI JNBL
  143.       TRAVJ.NBL=JNBL
  144.       JG=NPMAX-NPINI
  145.       SEGINI JNNO
  146.       TRAVJ.NNO=JNNO
  147. *
  148. * Extraction de la topologie à optimiser
  149. *
  150. *     NELMOY=40
  151.       IF (IDIM.EQ.2) THEN
  152.          NELMOY=15
  153.          NPOMOY=10
  154.       ELSEIF (IDIM.EQ.3) THEN
  155.          NELMOY=40
  156.          NPOMOY=12
  157. *         NELMOY=40
  158. *         NPOMOY=25
  159.       ELSE
  160.          write(ioimp,*) 'idim=',idim
  161.          goto 9999
  162.       ENDIF
  163. *
  164. *!!!   A changer plus tard
  165. *
  166. *      NVXMAX=0
  167.       SEGINI TRAVX
  168. *old      if (isgadj.gt.0) write(ioimp,185) 'TRAVJ,TRAVX=',TRAVJ,TRAVX
  169.       TRAVX.NVINI=0
  170.       TRAVX.NVCOU=0
  171.       TRAVX.NVMAX=NELMOY
  172. *      TRAVX.NVMAX=0
  173.       JG=TRAVX.NVMAX
  174.       SEGINI NEXTO
  175.       TRAVX.NBL=NEXTO
  176. *
  177.  
  178.       NBNN=IDIMP
  179.       NBELEM=TRAVX.NVMAX
  180.       NBSOUS=0
  181.       NBREF=0
  182.       SEGINI JEXTO
  183.       JEXTO.ITYPEL=JTOPO.ITYPEL
  184.       TRAVX.TOPO=JEXTO
  185. *     Boucle sur les éléments
  186. *      write(ioimp,*) 'opto2 jelem(nno,nbnn=)',jelem.num(/1)
  187. *     $     ,jelem.num(/2)
  188.       NBNN1=JELEM.NUM(/1)
  189.       NBNN=NBNN1
  190.       NBELEM=1
  191.       NBSOUS=0
  192.       NBREF=0
  193.       SEGINI JELEM1
  194.       JELEM1.ITYPEL=JELEM.ITYPEL
  195.  
  196. *     Segment de travail TRAVK pour opto3 numérotation locale à
  197. *     l'élément extrait.
  198.       SEGINI TRAVK
  199.       TRAVK.NVINI=0
  200.       TRAVK.NVCOU=0
  201.       TRAVK.NVMAX=NELMOY
  202. * Important pour le segment NNO après
  203.       TRAVK.NPINI=0
  204.       TRAVK.NPCOU=0
  205.       TRAVK.NPMAX=NPOMOY
  206. * Topologie de TRAVK (KEXTO)
  207.       NBELEM=TRAVK.NVMAX
  208.       NBNN=IDIMP
  209.       NBSOUS=0
  210.       NBREF=0
  211.       SEGINI,KEXTO
  212.       KEXTO.ITYPEL=JEXTO.ITYPEL
  213.       TRAVK.TOPO=KEXTO
  214. *     Coordonnées de TRAVK (KCOORD)
  215.       NBPTS=TRAVK.NPMAX
  216.       SEGINI,KCOORD
  217.       TRAVK.COORD=KCOORD
  218.       JNMETR=TRAVJ.NMETR
  219.       IF (JNMETR.NE.0) THEN
  220.          SEGINI,KNMETR=JNMETR
  221.          TRAVK.NMETR=KNMETR
  222.       ENDIF
  223.       JCMETR=TRAVJ.CMETR
  224.       IF (JCMETR.NE.0) THEN
  225.          NNIN=JCMETR.XIN(/1)
  226.          NNNOE=TRAVK.NPMAX
  227.          SEGINI,KCMETR
  228.          TRAVK.CMETR=KCMETR
  229.       ENDIF
  230. *
  231. *     Segment de travail pour trouver les noeuds du contour ou de
  232. *     l'enveloppe pour étoiler dans topv2
  233. *
  234.       JG=TRAVK.NPMAX-TRAVK.NPINI
  235.       SEGINI KNNO
  236.       TRAVK.NNO=KNNO
  237. *     Segment de travail TRAVL pour topv2
  238.       NNM=JEXTO.NUM(/1)
  239.       ITYP=JEXTO.ITYPEL
  240. *del         CALL TRLINI(NELMOY,JEXTO.NUM(/1),JEXTO.ITYPEL,TRAVL)
  241.       CALL TRLINI(NELMOY,NNM,ITYP,TRAVL)
  242.       if (iveri.ge.2) then
  243.          call trlver(travl,'opto2 : Apres initialisation TRAVL')
  244.          if (ierr.ne.0) return
  245.       endif
  246. *
  247. *     Segment de travail pour le changement de numérotation dans opto3
  248. *
  249.       JGMAX=NPOMOY
  250.       SEGINI ICPRX
  251.       CALL mtxadj(ICPRX,0,lchang,'opto2 : ICPRX_INI')
  252.       if (ierr.ne.0) return
  253.       SEGINI IDCPX
  254.       CALL mtxadj(IDCPX,0,lchang,'opto2 : IDCPX_INI')
  255.       if (ierr.ne.0) return
  256. *
  257. *     Segment de travail pour jelem en numérotation très locale dans
  258. *     opto3. Ce segment a un élément et peut-être moins de noeuds que JELEM1
  259. *
  260.       NNMAX=JELEM.NUM(/1)
  261.       NLMAX=1
  262.       SEGINI KELEMX
  263.       KELEMX.ITYPEX=JELEM.ITYPEL
  264.       KELEMX.NLCOU=1
  265. *
  266. *   Segments de travail pour le voisinage des elements
  267. *
  268.       JGMAX=NPOMOY
  269.       SEGINI ICPR2
  270.       CALL mtxadj(ICPR2,0,lchang,'opto2 : ICPR2_INI')
  271.       if (ierr.ne.0) return
  272.       SEGINI IDCP2
  273.       CALL mtxadj(IDCP2,0,lchang,'opto2 : IDCP2_INI')
  274.       if (ierr.ne.0) return
  275.       NNMAX=1
  276.       NLMAX=NPOMOY
  277.       SEGINI JELEM2
  278.       JELEM2.ITYPEX=JELEM.ITYPEL
  279.       CALL mlxadl(JELEM2,0,lchang,'opto2 : JELEM2_INI')
  280.       if (ierr.ne.0) return
  281.  
  282.       NBNNT=JTOPO.NUM(/1)
  283.       TOPINV=TRAVJ.TOPI
  284. *
  285.       DO IAPARC=1,JELEM.NUM(/2)
  286.          DO IBNN=1,NBNN1
  287.             JELEM1.NUM(IBNN,1)=JELEM.NUM(IBNN,IAPARC)
  288.          ENDDO
  289.          JPARCO=JPARCO+1
  290.          IF (IMPR.GE.4) THEN
  291.             write(ioimp,*) '  opto2 : Autour de l''element ',iaparc
  292.             call ecmai1(jelem1,0)
  293.             segact jelem1*mod
  294.          ENDIF
  295. * On fait le voisinage de Gruau uniquement pour les noeuds en 2D
  296. * et les noeuds et les aretes un 3D.
  297. * Sinon, on fait l'ancienne manière. C'est un test parce que la
  298. * méthode Gruau n'est pas terrible dans les coins.
  299. *         IF (NBNN1.LT.IDIM+2) THEN
  300.          IF (.true.) THEN
  301. *     Voisinages des noeuds de JELEM1
  302.             NCOU=TRAVJ.NPCOU
  303.             CALL mtxadj(ICPR2,NCOU,lchang,'opto2 : ICPR2_dim')
  304.             if (ierr.ne.0) return
  305.             IIDCP2=0
  306. *     Voisinage pour chaque noeud
  307.             DO IBNN=1,NBNN1
  308.                INOD=JELEM1.NUM(IBNN,1)
  309.                IVAL=2**(IBNN-1)
  310. *       Parcours de la topologie inverse et cochage dans ICPR2
  311.                LAST=TIC(INOD)
  312.                LDG=TDC(INOD)
  313.                DO IDG=1,LDG
  314.                   IL=((LAST-1)/IDIMP)+1
  315.                   DO IBNNT=1,NBNNT
  316.                      IN=JTOPO.NUM(IBNNT,IL)
  317.                      IF (IN.NE.INOD) THEN
  318.                         ITOUCH=ICPR2.LECTX(IN)
  319.                         IF (ITOUCH.LT.IVAL) THEN
  320.                            ICPR2.LECTX(IN)=ITOUCH+IVAL
  321.                            IF (ITOUCH.EQ.0) THEN
  322.                               IIDCP2=IIDCP2+1
  323.                               CALL mtxadj(IDCP2,IIDCP2,lchang,'opto2 :
  324.      $                             IDCP2_dim')
  325.                               if (ierr.ne.0) return
  326.                               IDCP2.LECTX(IIDCP2)=IN
  327.                            ENDIF
  328.                         ENDIF
  329.                      ENDIF
  330.                   ENDDO
  331.                   LAST=TLC(LAST)
  332.                ENDDO
  333.             ENDDO
  334.             NIDCP2=IIDCP2
  335. *     JELEM2 a au moins les noeuds de JELEM1
  336.             NBNN=NBNN1
  337. *     segprt,icpr2
  338. *     Intersection des voisinages
  339.             IVAL=(2**NBNN1)-1
  340.             NIDCP2=IIDCP2
  341.             DO IIDCP2=1,NIDCP2
  342.                IN=IDCP2.LECTX(IIDCP2)
  343.                IF (ICPR2.LECTX(IN).eq.IVAL) THEN
  344.                   NBNN=NBNN+1
  345.                ENDIF
  346.             ENDDO
  347. *
  348.             call mlxadl(JELEM2,NBNN,lchang,'opto2 : JELEM2_NBNN')
  349.             if (ierr.ne.0) return
  350.             if (iveri.ge.2) then
  351.                call vemelx(jelem2,'opto2 : Apres requisition jelem2')
  352.                if (ierr.ne.0) return
  353.             endif
  354.  
  355.             ibnn=0
  356.             do i=1,nbnn1
  357.                ibnn=ibnn+1
  358.                jelem2.numx(1,ibnn)=jelem1.num(ibnn,1)
  359.             enddo
  360.             DO IIDCP2=1,NIDCP2
  361.                IN=IDCP2.LECTX(IIDCP2)
  362.                IF (ICPR2.LECTX(IN).eq.IVAL) THEN
  363.                   ibnn=ibnn+1
  364.                   jelem2.numx(1,ibnn)=IN
  365.                ENDIF
  366.                icpr2.lectx(IN)=0
  367.             ENDDO
  368.             IF (IMPR.GE.4) THEN
  369.                write(ioimp,*)
  370.      $              '  opto2 : Noeuds du voisinage de l''element '
  371.      $              ,iaparc
  372.                call ecmelx(jelem2,0)
  373.             ENDIF
  374. *
  375.             if (iveri.ge.2) call vetopi(travj,'Avant exto5c')
  376.             if (ierr.ne.0) return
  377. *
  378.             CALL EXTO5c(JELEM2,TRAVJ,
  379.      $           TRAVX)
  380. * Menage JELEM2
  381.             if (iveri.ge.2) then
  382.                DO IZER=1,JELEM2.NLCOU
  383.                   JELEM2.NUMX(1,IZER)=0
  384.                ENDDO
  385.             endif
  386.             CALL mlxadl(JELEM2,0,lchang,'opto2 : JELEM2_0')
  387.             if (ierr.ne.0) return
  388.             if (iveri.ge.2) then
  389.                call vemelx(jelem2,'opto2 : Apres nettoyage jelem2')
  390.                if (ierr.ne.0) return
  391.             endif
  392. *     verif que NBL est bien nettoyé
  393.             if (iveri.ge.2) call vetopi(travj,'Apres exto5c')
  394.             if (ierr.ne.0) return
  395.          ELSE
  396.             if (iveri.ge.2) call vetopi(travj,'Avant exto4')
  397.             if (ierr.ne.0) return
  398. *
  399.             CALL EXTO4c(JELEM1,TRAVJ,
  400.      $           TRAVX)
  401. *     verif que NBL est bien nettoyé
  402.             if (iveri.ge.2) call vetopi(travj,'Apres exto4')
  403.             if (ierr.ne.0) return
  404.          ENDIF
  405. *tst      write(ioimp,*) 'Elements de la topologie extraits :'
  406. *tst      write(ioimp,187) (nexto(I),I=1,travx.nvcou)
  407. *     Mise à jour de jexto
  408.          nexto=travx.nbl
  409.          jexto=travx.topo
  410.          do iel=1,travx.nvcou
  411.             do ino=1,IDIMP
  412.                JEXTO.NUM(ino,iel)=JTOPO.NUM(INO,nexto.lect(iel))
  413.             enddo
  414.          enddo
  415. *
  416. * Optimisation de la topologie extraite
  417. *
  418.          IF (IMPR.GE.4) THEN
  419.             write(ioimp,*) 'opto2.eso : on a extrait la topologie : '
  420.             call ecmai1(jexto,0)
  421.             segact jexto
  422.          ENDIF
  423. *
  424. *     Init
  425. *
  426.          CALL OPTO3(TRAVJ,TRAVX,JELEM1,TRAVK,TRAVL,ICPRX,IDCPX,
  427.      $        KELEMX,
  428.      $        JTBES,JCAND)
  429.          IF (IERR.NE.0) RETURN
  430.          if (iveri.ge.2) call vetopi(travj,'Apres opto3')
  431.          IF (IERR.NE.0) RETURN
  432.  
  433.          JEXPLO=JEXPLO+ABS(JCAND)
  434.          IF (IMPR.GE.4) THEN
  435.             IF (JEXTO.EQ.JTBES) THEN
  436.                WRITE(IOIMP,*) 'Pas damelioration JTBES=',JTBES
  437.             ELSE
  438.                WRITE(IOIMP,*) 'Topologie amelioree JTBES=',JTBES
  439.                CALL ECMAI1(JTBES,0)
  440.                segact jtbes
  441.             ENDIF
  442.          ENDIF
  443. *
  444. *     Si la topologie locale a été améliorée, on change la topologie
  445. *     globale en conséquence
  446. *
  447.          IF (JEXTO.NE.JTBES) THEN
  448.             JCHANG=JCHANG+1
  449. *            CALL TOPDIF(TRAVJ,TRAVX)
  450.             CALL TOPDI2(TRAVJ,TRAVX)
  451.             if (ierr.ne.0) return
  452.             if (iveri.ge.2) call vetopi(travj,'Apres DIFF')
  453.             if (ierr.ne.0) return
  454. *
  455. *     On ajoute les éléments de JTBES dans JTOPO
  456. *
  457.             CALL TOPFUS(TRAVJ,JTBES)
  458.             if (ierr.ne.0) return
  459.             if (iveri.ge.2) call vetopi(travj,'Apres ET')
  460.             if (ierr.ne.0) return
  461.             if (iseqm.ne.0) then
  462.                NOBJ=NOBJ+3
  463.                SEGADJ LTOPA
  464. *               WRITE(IOIMP,*) 'NOBJ=',NOBJ
  465. * Ajouter JELEM1
  466.                NBNN=JELEM1.NUM(/1)
  467.                NBELEM=1
  468.                NBSOUS=0
  469.                NBREF=0
  470.                SEGINI MELEME
  471.                ITYPEL=JELEM1.ITYPEL
  472.                DO IBNN=1,NBNN
  473.                   NUM(IBNN,1)=JELEM1.NUM(IBNN,1)
  474.                ENDDO
  475.                LTOPA.LISOBJ(NOBJ-2)=MELEME
  476. *               write(ioimp,*) 'jelem1'
  477. *               call ecmai1(meleme,0)
  478. *               segact meleme*mod
  479. *
  480. * Ajouter JEXTO reduit
  481.                NBNN=JEXTO.NUM(/1)
  482.                NBELEM=TRAVX.NVCOU
  483.                NBSOUS=0
  484.                NBREF=0
  485.                SEGINI MELEME
  486.                ITYPEL=JEXTO.ITYPEL
  487.                DO IBELEM=1,NBELEM
  488.                   DO IBNN=1,NBNN
  489.                      NUM(IBNN,IBELEM)=JEXTO.NUM(IBNN,IBELEM)
  490.                   ENDDO
  491.                ENDDO
  492.                LTOPA.LISOBJ(NOBJ-1)=MELEME
  493. *               write(ioimp,*) 'jexto'
  494. *               call ecmai1(meleme,0)
  495. *               segact meleme*mod
  496. * Ajouter JTBES
  497.                LTOPA.LISOBJ(NOBJ)=JTBES
  498. *               write(ioimp,*) 'jtbes'
  499. *               call ecmai1(jtbes,0)
  500. *               segact jtbes*mod
  501.             endif
  502.          ENDIF
  503. *
  504. *     Nettoyage de NEXTO et JEXTO (normalement inutile mais utilisé pour
  505. *     vetopi)
  506. *
  507.          if (iveri.ge.1) then
  508.             nexto=travx.nbl
  509.             jexto=travx.topo
  510.             do iel=1,travx.nvcou
  511.                do ino=1,IDIMP
  512.                   JEXTO.NUM(ino,iel)=0
  513.                   nexto.lect(iel)=0
  514.                enddo
  515.             enddo
  516.             travx.nvcou=0
  517.          endif
  518.  
  519. * Fin boucle sur les éléments
  520.       ENDDO
  521. *
  522. * Il faut appeler le nettoyage avant de sortir
  523. *
  524.       SEGSUP JELEM2
  525.       SEGSUP IDCP2
  526.       SEGSUP ICPR2
  527.       SEGSUP KELEMX
  528.       SEGSUP ICPRX
  529.       SEGSUP IDCPX
  530.       CALL TRLSUP(TRAVL)
  531. *      SEGSUP IPBTL
  532.       CALL TOPSUP(TRAVK)
  533. *tst      topinv=travj.topi
  534. *tst         write(ioimp,*) 'TOPINV Avant nettoyage elem TOPINV'
  535. *tst         call ectopi(topinv,1)
  536. *tst         call ectopi(topinv,2)
  537.       segsup jelem1
  538.       if (jtbes.ne.travx.topo.and.iseqm.eq.0) segsup jtbes
  539.       call topsup(travx)
  540.  
  541. *     Nettoyage des éléments vides
  542. *      impr=8
  543.       call topclv(travj,lchang)
  544.       if (ierr.ne.0) return
  545.       if (iveri.ge.2.and.lchang) call vetopi(travj
  546.      $     ,'Apres nettoyage elem')
  547.       if (ierr.ne.0) return
  548. *
  549. *     Nettoyage des noeuds non référencés dans la topologie mais
  550. *     seulement ceux ajoutés par nous, pas les autres !
  551. *
  552.       IF (iseqm.eq.0) call topclp(travj,lchang)
  553. * verif
  554.       if (iveri.ge.2.and.lchang) call vetopi(travj
  555.      $     ,'Apres nettoyage noeuds')
  556.       if (ierr.ne.0) return
  557.  
  558. *
  559. * Normal termination
  560. *
  561.       RETURN
  562. *
  563. * Error handling
  564. *
  565.  9999 CONTINUE
  566.       MOTERR(1:8)='OPTO2   '
  567. * 349 2
  568. *Problème non prévu dans le s.p. %m1:8 contactez votre assistance
  569.       CALL ERREUR(349)
  570.       RETURN
  571. *
  572. * End of subroutine OPTO2
  573. *
  574.       END
  575.  
  576.  

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