Télécharger la plaquette Cast3M


fr en

Télécharger actobj.eso

Retour à la liste

Numérotation des lignes : 

actobj

  1. C ACTOBJ    SOURCE    OF166741  24/11/14    21:15:02     12078          
  2.  
  3.       SUBROUTINE ACTOBJ(CTYPE,IPOIN,IKOD)
  4.  
  5. C____________________________________________________________________
  6. C
  7. C  OBJET :  Cette SUBROUTINE permet d''activer/desactiver un OBJET
  8. C           de Cast3M contenu dans le DATA DTAOBJ
  9. C
  10. C  ENTREES :
  11. C  °°°°°°°°°
  12. C
  13. C     CTYPE   Type d'objet a activer
  14. C     IPOIN   Pointeur sur l'objet a activer
  15. C     IKOD    ENTIER valant 0 pour SEGDES
  16. C                           1 pour SEGACT de l'objet
  17. C
  18. C  SORTIE :
  19. C  °°°°°°°°
  20. C     R.A.S l'objet et son contenu sont actives
  21. C_____________________________________________________________________
  22. C
  23.       IMPLICIT INTEGER(I-N)
  24.       IMPLICIT REAL*8(A-H,O-Z)
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC CCPRECO
  29. C-INC CCASSIS
  30.  
  31. -INC SMCHAML
  32. -INC SMINTE
  33. -INC SMCHPOI
  34. -INC SMLCHPO
  35. -INC SMMODEL
  36. -INC SMEVOLL
  37. -INC SMELEME
  38. -INC SMNUAGE
  39. -INC SMCHARG
  40. -INC SMRIGID
  41. -INC SMANNOT
  42.  
  43.       SEGMENT JPOINT(0)
  44.       SEGMENT IPOINT(0)
  45.       SEGMENT ISEG(0)
  46.       SEGMENT ITAB(NNN)
  47.  
  48.       PARAMETER(NBTYP=14)
  49.       CHARACTER*(*)CTYPE
  50.       CHARACTER*8  CTYP1,DTAOBJ(NBTYP),MOT8a
  51.       CHARACTER*16 MOT16
  52.  
  53.       LOGICAL BCODE,BSEG
  54.  
  55.       DATA DTAOBJ/'MCHAML  ','CHPOINT ','MMODEL  ','MAILLAGE',
  56.      &            'EVOLUTIO','LISTMOTS','LISTREEL','LISTENTI',
  57.      &            'NUAGE   ','LISTCHPO','CHARGEME','ANNULE  ',
  58.      &            'RIGIDITE','ANNOTATI'     /
  59.  
  60.       MMODE2 = 0
  61.  
  62.       CTYP1 = CTYPE
  63.       IF(IERR .NE. 0) RETURN
  64.  
  65.       CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  66.       IF(IPLAC.EQ.0 .OR. IPLAC.EQ.12)RETURN
  67. C     Les arguments optionnels dans les PROCEDURES sont de type ANNULE(12) s'ils sont absents
  68.  
  69.       IF(IPOIN .LE. 0) THEN
  70.         PRINT *,'ACTOBJ POINTEUR INVALIDE - TYPE ''',CTYP1,
  71.      &          ''' - POINTEUR ',IPOIN
  72. C       J'essaye de declencher un GEMAT_ERROR pour la capturer avec gdb
  73.         CALL TRBAC
  74.         ISEG=IPOIN
  75.         SEGACT,ISEG
  76.         CALL ERREUR(5)
  77.       ENDIF
  78.  
  79.       IPOI1 = IPOIN
  80.       BCODE = IKOD .EQ. 0
  81.  
  82. C     Portion a activer pour des recherches de SEGDES inutiles !
  83.       IF(.FALSE.)THEN
  84. C       Verification rapide de l'etat du SEGMENT IPOI1
  85.         CALL OOOETA(IPOI1,IETA,IMOD)
  86.         IF(BCODE)THEN
  87. C         Il est inactif et on veut SEGDES ==> RETURN
  88.           IF(IETA.EQ.2) RETURN
  89.  
  90.         ELSE
  91. C         Recherche de SEGMENT qui n'ont pas de raison d'etre desactives
  92. C          -Empecher le MENAGE dans PILOT pour ce test d'optimisation
  93. C          -Remettre l'include CCASSIS.INC
  94. C          IF(IETA.EQ.2 .AND. IMOD.NE.1) THEN
  95. C            CALL oooho1(IPOI1,IHO1)
  96. C            IF(MOD(IHO1,NBTHRS+1) .EQ. oothrd)THEN
  97. C              CALL OOOMES(IPOI1,'    ZARBI:'//CTYP1)
  98. C              STOP 16
  99. C            ENDIF
  100. C          ENDIF
  101.  
  102. C         Il est actif *NOMOD et on veut SEGACT ==> RETURN
  103.           IF(IETA.EQ.1 .AND. IMOD.EQ.0) RETURN
  104.         ENDIF
  105.       ENDIF
  106.  
  107.       IOBJ  = 0
  108.       IPOINT= 0
  109.       JPOINT= 0
  110.       BSEG  =.FALSE.
  111.  
  112. C     Initialisation des SEGMENTS de preconditionnement
  113.       nth=oothrd+1
  114.       ITAB=PACTOB(nth)
  115.       IF(ITAB .EQ. 0)THEN
  116.         NNN=50
  117.         SEGINI,ITAB
  118.         PACTOB(nth)=ITAB
  119.       ELSE
  120.         SEGACT,ITAB*MOD
  121.       ENDIF
  122.  
  123.       ICOUNT =1
  124. C     En premiere case on met la taille utile du tableau
  125.       ITAB(1)=1
  126.  
  127.  1    CONTINUE
  128.       IF(IPLAC.EQ.0) THEN
  129. C        PRINT *,'ACTOBJ.ESO :',CTYP1,' NON TRAITE ENCORE'
  130.         GOTO 9999
  131.       ENDIF
  132.  
  133.       GOTO (100,200,300,400,500,600,600,600,700,600,800,9999,900
  134.      &     ,1000),IPLAC
  135.       PRINT *,'ACTOBJ ERROR:',IPLAC
  136.       CALL ERREUR(5)
  137.       GOTO 9999
  138.  
  139.  100  CONTINUE
  140. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  141. C     OBJET DE TYPE MCHAML
  142. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  143.         MCHEL1=IPOI1
  144.         MELSAV=0
  145.  
  146.         CALL oooprl(1)
  147.         SEGACT,MCHEL1
  148.       if (mchel1.infche(/2) .ne. 6) then
  149.         write(ioimp,*) 'ACTOBJ : MCHELM =',MCHEL1,' INFCHE(/2) != 6'
  150.         call erreur(5)
  151.       endif
  152.       do ii = 1, mchel1.ichaml(/1)
  153.         jj = mchel1.infche(ii,6)
  154.         if (jj.LT.1 .OR. jj.GT.9) then
  155.           write(ioimp,*)'ACTOBJ : MCHELM =',MCHEL1,' support INFCHE(',
  156.      &                  jj,'6) incorrect'
  157.           call erreur(5)
  158.         endif
  159.       enddo
  160.  
  161.         DO 111 II=1,MCHEL1.ICHAML(/1)
  162.           MCHAM1=MCHEL1.ICHAML(II)
  163.           SEGACT,MCHAM1
  164.  111    CONTINUE
  165.         CALL oooprl(0)
  166.  
  167.         IF (BCODE) CALL PREACT(ITAB,MCHEL1)
  168.         DO 110 II=1,MCHEL1.ICHAML(/1)
  169.           MCHAM1=MCHEL1.ICHAML(II)
  170.           IPT1=MCHEL1.IMACHE(II)
  171.           CALL PREACT(ITAB,IPT1)
  172.           MINTE = MCHEL1.INFCHE(II,4)
  173.           IF (MINTE .NE. 0) CALL PREACT(ITAB,MINTE)
  174.  
  175.           IF (BCODE) CALL PREACT(ITAB,MCHAM1)
  176.           DO 120 JJ=1,MCHAM1.IELVAL(/1)
  177.             MOT16 =MCHAM1.TYPCHE(JJ)
  178.             MELVA1=MCHAM1.IELVAL(JJ)
  179.  
  180.             IF(MELVA1 .EQ. MELSAV) GOTO 120
  181.             MELSAV=MELVA1
  182.  
  183.             IF    (MOT16(1:6)  .EQ. 'REAL*8'        .OR.
  184.      &             MOT16(1:13) .EQ. 'POINTEURPOINT'      )THEN
  185.               CALL PREACT(ITAB,MELVA1)
  186.  
  187.             ELSEIF(MOT16(1:12) .EQ. 'POINTEURLIST')THEN
  188.               SEGACT,MELVA1
  189.               IF (BCODE) CALL PREACT(ITAB,MELVA1)
  190.               IPOI2 = 0
  191.               DO 130 KK=1,MELVA1.IELCHE(/2)
  192.                 DO 140 LL=1,MELVA1.IELCHE(/1)
  193.                   ISEG=MELVA1.IELCHE(LL,KK)
  194.                   IF(ISEG .NE. IPOI2 .AND. ISEG.NE.0)THEN
  195.                     CALL PREACT(ITAB,ISEG)
  196.                     IPOI2 = ISEG
  197.                   ENDIF
  198.  140            CONTINUE
  199.  130          CONTINUE
  200.  
  201.             ELSEIF(MOT16(1:16) .EQ. 'POINTEUREVOLUTIO')THEN
  202.               SEGACT,MELVA1
  203.               IF (BCODE) CALL PREACT(ITAB,MELVA1)
  204.               IPOI2 = 0
  205.               DO 150 KK=1,MELVA1.IELCHE(/2)
  206.                 DO 160 LL=1,MELVA1.IELCHE(/1)
  207.                   MEVOL1=MELVA1.IELCHE(LL,KK)
  208.                   IF(MEVOL1 .NE. IPOI2 .AND. MEVOL1.NE.0)THEN
  209.                     IPOI2 = MEVOL1
  210.                     SEGACT,MEVOL1
  211.                     IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  212.                     DO 170 MM=1,MEVOL1.IEVOLL(/1)
  213.                       KEVOL1=MEVOL1.IEVOLL(MM)
  214.                       SEGACT,KEVOL1
  215.                       IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  216.                       ISEG=KEVOL1.IPROGX
  217.                       CALL PREACT(ITAB,ISEG)
  218.                       ISEG=KEVOL1.IPROGY
  219.                       CALL PREACT(ITAB,ISEG)
  220.  170                CONTINUE
  221.                   ENDIF
  222.  160            CONTINUE
  223.  150          CONTINUE
  224.  
  225.             ELSEIF(MOT16(1:8) .EQ. 'POINTEUR')THEN
  226. C             Cas des MCHAML de POINTEURS necessitant du travail
  227.               SEGACT,MELVA1
  228.               IF (BCODE) CALL PREACT(ITAB,MELVA1)
  229.               IPOI2 = 0
  230.               CTYP1 = MOT16(9:16)
  231.               CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  232.               IF(IPLAC .NE. 0)THEN
  233.                 DO 180 KK=1,MELVA1.IELCHE(/2)
  234.                   DO 190 LL=1,MELVA1.IELCHE(/1)
  235.                     ISEG   =MELVA1.IELCHE(LL,KK)
  236.                     IF(ISEG.NE.IPOI2 .AND. ISEG.NE.0)THEN
  237.                       IPOI2 = ISEG
  238.                       IF(.NOT. BSEG)THEN
  239.                         SEGINI,JPOINT,IPOINT
  240.                         BSEG=.TRUE.
  241.                       ENDIF
  242.                       JPOINT(**)=MELVA1.IELCHE(LL,KK)
  243.                       IPOINT(**)=IPLAC
  244.                     ENDIF
  245.  190              CONTINUE
  246.  180            CONTINUE
  247. C             ELSE
  248. C               PRINT*,'ACTOBJ:MCHAML de TYPE',MOT16,' non traite'
  249.               ENDIF
  250.  
  251.             ELSE
  252.               CALL PREACT(ITAB,MELVA1)
  253.             ENDIF
  254.  120      CONTINUE
  255.  110    CONTINUE
  256.         GOTO 9999
  257.  
  258.  200  CONTINUE
  259. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  260. C     OBJET DE TYPE CHPOINT
  261. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  262.       MCHPO1=IPOI1
  263.       CALL oooprl(1)
  264.       SEGACT,MCHPO1
  265.       NSOUPO=MCHPO1.IPCHP(/1)
  266.       DO 211 II=1,NSOUPO
  267.         MSOUP1=MCHPO1.IPCHP(II)
  268.         SEGACT,MSOUP1
  269.  211  CONTINUE
  270.       CALL oooprl(0)
  271.  
  272.       IF (BCODE) CALL PREACT(ITAB,MCHPO1)
  273.       DO 210 II=1,NSOUPO
  274.         MSOUP1=MCHPO1.IPCHP(II)
  275.         IF (BCODE) CALL PREACT(ITAB,MSOUP1)
  276.         IPT1=MSOUP1.IGEOC
  277.         CALL PREACT(ITAB,IPT1)
  278.         MPOVA1=MSOUP1.IPOVAL
  279.         CALL PREACT(ITAB,MPOVA1)
  280.  210  CONTINUE
  281.       GOTO 9999
  282.  
  283.  300  CONTINUE
  284. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  285. C     OBJET DE TYPE MMODEL
  286. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  287.       MMODE1=IPOI1
  288.       SEGACT,MMODE1
  289.       IF (BCODE) CALL PREACT(ITAB,MMODE1)
  290.  
  291. * jk148537 
  292.       N1 = MMODE1.KMODEL(/1)
  293.       SEGINI,MMODE2
  294.       NN1 = 0
  295.       DO 305 II=1,MMODE1.KMODEL(/1)
  296.         IMODE1=MMODE1.KMODEL(II)
  297.         NN1 = NN1 + 1
  298.         MMODE2.KMODEL(NN1) = IMODE1
  299.         SEGACT,IMODE1
  300.         NIVM = IMODE1.IVAMOD(/1)
  301.         N1 = N1 + NIVM
  302.         SEGADJ,MMODE2
  303.         DO 307 JJ=1,NIVM
  304.           CTYP1=IMODE1.TYMODE(JJ)
  305.           IF(CTYP1 .EQ. 'IMODEL  ')THEN
  306. C           Construction d'un MODELE AVEC les IMODEL (Cas des MODELES de melange)
  307.             if (imode1.ivamod(JJ).gt.0) then
  308.               NN1 = NN1 + 1
  309.               MMODE2.KMODEL(NN1) = imode1.ivamod(JJ)
  310.             endif
  311.           ENDIF  
  312.  307    CONTINUE               
  313.  305  CONTINUE
  314.       N1 = NN1 
  315.       SEGADJ,MMODE2
  316.  
  317.       NN1    = 0
  318.       DO 310 II=1,MMODE2.KMODEL(/1)
  319.         IMODE1=MMODE2.KMODEL(II)
  320.         SEGACT,IMODE1
  321.         IF (BCODE) CALL PREACT(ITAB,IMODE1)
  322.         IPT1=IMODE1.IMAMOD
  323.         SEGACT IPT1
  324.         CALL PREACT(ITAB,IPT1)
  325.         DO 350 III=1,IPT1.LISOUS(/1)
  326.           IPT2 =IPT1.LISOUS(III)
  327.           CALL PREACT(ITAB,IPT2)
  328.  350    CONTINUE
  329.         IPT3 = IMODE1.IPDPGE
  330.         IF (IPT3.NE.0) CALL PREACT(ITAB,IPT3)
  331.         NIVM = IMODE1.IVAMOD(/1)
  332.         DO 320 JJ=1,NIVM
  333.           CTYP1=IMODE1.TYMODE(JJ)
  334.           CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  335.           IF(IPLAC .NE. 0)THEN
  336.             IF(.NOT. BSEG)THEN
  337.               SEGINI,JPOINT,IPOINT
  338.               BSEG=.TRUE.
  339.             ENDIF
  340.             JPOINT(**)=IMODE1.IVAMOD(JJ)
  341.             IPOINT(**)=IPLAC
  342.           ENDIF
  343.  320    CONTINUE
  344.  
  345.         NBNOMI =IMODE1.LNOMID(/1)
  346.         DO 330 INOM=1,NBNOMI
  347.           IPT1=IMODE1.LNOMID(INOM)
  348.           IF (IPT1 .GT. 0) CALL PREACT(ITAB,IPT1)
  349.  330    CONTINUE
  350.  
  351.        if (imode1.INFMOD(/1).lt.1) then
  352.          write(ioimp,*) 'ACTOBJ : IMODEL =',imode1,' INFMOD(/1) < 1'
  353.          call erreur(5)
  354.        endif
  355.        DO 340 IINFMO=3,IMODE1.INFMOD(/1)
  356.           IPT1=IMODE1.INFMOD(IINFMO)
  357.           IF (IPT1 .GT. 0) CALL PREACT(ITAB,IPT1)
  358.  340   CONTINUE
  359.  
  360.  310  CONTINUE
  361.  
  362.       GOTO 9999
  363.  
  364.  400  CONTINUE
  365. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  366. C     OBJET DE TYPE MAILLAGE
  367. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  368.       IPT1=IPOI1
  369.       SEGACT,IPT1
  370.       IF (BCODE) CALL PREACT(ITAB,IPT1)
  371.       DO 410 II=1,IPT1.LISOUS(/1)
  372.         IPT2 =IPT1.LISOUS(II)
  373.         CALL PREACT(ITAB,IPT2)
  374.  410  CONTINUE
  375.       GOTO 9999
  376.  
  377.  500  CONTINUE
  378. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  379. C     OBJET DE TYPE EVOLUTIO
  380. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  381.       MEVOL1=IPOI1
  382.       SEGACT,MEVOL1
  383.       IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  384.       DO 510 II=1,MEVOL1.IEVOLL(/1)
  385.         KEVOL1=MEVOL1.IEVOLL(II)
  386.         SEGACT,KEVOL1
  387.         IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  388.         ISEG=KEVOL1.IPROGX
  389.         CALL PREACT(ITAB,ISEG)
  390.         ISEG=KEVOL1.IPROGY
  391.         CALL PREACT(ITAB,ISEG)
  392.  510  CONTINUE
  393.       GOTO 9999
  394.  
  395.  600  CONTINUE
  396. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  397. C     OBJET DE TYPE LISTXXXX
  398. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  399.       IF(IPLAC .EQ. 10)THEN
  400. C       Cas des LISTCHPO
  401.         MLCHPO=IPOI1
  402.         SEGACT,MLCHPO
  403.         IF (BCODE) CALL PREACT(ITAB,MLCHPO)
  404.         CTYP1='CHPOINT '
  405.         CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  406.         IF(.NOT. BSEG)THEN
  407.           SEGINI,JPOINT,IPOINT
  408.           BSEG=.TRUE.
  409.         ENDIF
  410.         DO 610 II=1,MLCHPO.ICHPOI(/1)
  411.           JPOINT(**)=MLCHPO.ICHPOI(II)
  412.           IPOINT(**)=IPLAC
  413.  610    CONTINUE
  414.       ELSE
  415. C       Cas des LISTENTI,LISTREEL,LISTMOTS
  416.         CALL PREACT(ITAB,IPOI1)
  417.       ENDIF
  418.       GOTO 9999
  419.  
  420.  700  CONTINUE
  421. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  422. C     OBJET DE TYPE NUAGE
  423. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  424.       MNUAG1=IPOI1
  425.       SEGACT,MNUAG1
  426.       IF (BCODE) CALL PREACT(ITAB,MNUAG1)
  427.       DO 710 II=1,MNUAG1.NUAPOI(/1)
  428.         CTYP1=MNUAG1.NUATYP(II)
  429.         CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  430.         IF(IPLAC .NE. 0)THEN
  431.           IF(.NOT. BSEG)THEN
  432.             SEGINI,JPOINT,IPOINT
  433.             BSEG=.TRUE.
  434.           ENDIF
  435.           NUAVIN=MNUAG1.NUAPOI(II)
  436.           SEGACT,NUAVIN
  437.           IF (BCODE) CALL PREACT(ITAB,NUAVIN)
  438.           DO 720 JJ=1,NUAVIN.NUAINT(/1)
  439.             JPOINT(**)=NUAVIN.NUAINT(JJ)
  440.             IPOINT(**)=IPLAC
  441.  720      CONTINUE
  442.  
  443.         ELSE
  444.           ISEG=MNUAG1.NUAPOI(II)
  445.           CALL PREACT(ITAB,ISEG)
  446.         ENDIF
  447.  710  CONTINUE
  448.       GOTO 9999
  449.  
  450.  800  CONTINUE
  451. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  452. C     OBJET DE TYPE CHARGEMENT
  453. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  454.       MCHAR1=IPOI1
  455.       SEGACT,MCHAR1
  456.       IF (BCODE) CALL PREACT(ITAB,MCHAR1)
  457.       DO 810 II=1,MCHAR1.KCHARG(/1)
  458.         ICHAR1=MCHAR1.KCHARG(II)
  459.         SEGACT,ICHAR1
  460.         IF (BCODE) CALL PREACT(ITAB,ICHAR1)
  461.  
  462.         CTYP1=ICHAR1.CHATYP
  463.         CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  464.         IF(IPLAC .NE. 0)THEN
  465.           IF(.NOT. BSEG)THEN
  466.             SEGINI,JPOINT,IPOINT
  467.             BSEG=.TRUE.
  468.           ENDIF
  469.           JPOINT(**)=ICHAR1.ICHPO1
  470.           IPOINT(**)=IPLAC
  471.         ENDIF
  472.  810  CONTINUE
  473.       GOTO 9999
  474.  
  475.  900  CONTINUE
  476. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  477. C     OBJET DE TYPE RIGIDITE
  478. C       Ne traite que la partie non assemblee des objets RIGIDITE
  479. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  480.       MRIGID=IPOI1
  481.       SEGACT,MRIGID
  482.       IF (BCODE) CALL PREACT(ITAB,MRIGID)
  483.  
  484.       IMGEOD=MRIGID.IMGEO1
  485. C     PRINT *,' -- IMGEOD:',IMGEOD
  486.       IF (IMGEOD.NE.0)CALL PREACT(ITAB,IMGEOD)
  487.  
  488.       MVECRI=MRIGID.IVECRI
  489. C     PRINT *,' -- MVECRI:',MVECRI
  490.       IF (MVECRI.NE.0)CALL PREACT(ITAB,MVECRI)
  491.  
  492.       DO 910 II=1,MRIGID.COERIG(/1)
  493.         IPT1  = MRIGID.IRIGEL(1,II)
  494. C       PRINT *,' -- IPT1  :',IPT1
  495.         CALL PREACT(ITAB,IPT1)
  496.  
  497.         IPT2  = MRIGID.IRIGEL(2,II)
  498. C       PRINT *,' -- IPT2  :',IPT2
  499.         IF(IPT2 .GT. 0)CALL PREACT(ITAB,IPT2)
  500.  
  501.         DESCR = MRIGID.IRIGEL(3,II)
  502. C       PRINT *,' -- DESCR :',DESCR
  503.         CALL PREACT(ITAB,DESCR)
  504.  
  505.         XMATRI = MRIGID.IRIGEL(4,II)
  506. C       PRINT *,' -- XMATRI:',XMATRI
  507.         CALL PREACT(ITAB,XMATRI)
  508.  910  CONTINUE
  509.       GOTO 9999
  510.  
  511.  
  512.  1000 CONTINUE
  513. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  514. C     OBJET DE TYPE ANNOTATI
  515. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  516.       MANNOT=IPOI1
  517.       SEGACT,MANNOT
  518.       IF (BCODE) CALL PREACT(ITAB,MANNOT)
  519.  
  520.       DO 1010 II=1,MANNOT.ICLAS(/1)
  521.         IF(MANNOT.ICLAS(II) .EQ. 2)THEN
  522.           METIQU = MANNOT.ISEGT(II)
  523.           SEGACT,METIQU
  524.           IF (BCODE) CALL PREACT(ITAB,METIQU)
  525.           MELEME = METIQU.INUPT
  526.           CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,'MAILLAGE')
  527.           IF(IPLAC .NE. 0)THEN
  528.             IF(.NOT. BSEG)THEN
  529.               SEGINI,JPOINT,IPOINT
  530.               BSEG=.TRUE.
  531.             ENDIF
  532.             JPOINT(**)=MELEME
  533.             IPOINT(**)=IPLAC
  534.           ENDIF
  535.         ENDIF
  536.  1010 CONTINUE
  537.       GOTO 9999
  538.  
  539. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  540.  9999 CONTINUE
  541.  
  542.       IF(BCODE)THEN
  543. C       Boucle a la main en attendant SEGDES par paquets !
  544.         DO II=2,ICOUNT
  545.           ISEG=ITAB(II)
  546.           SEGDES,ISEG
  547.         ENDDO
  548.       ELSE
  549. C       Appel a SEGACT par paquet !
  550.         CALL FINACT(ITAB)
  551.       ENDIF
  552.  
  553.       IF(.NOT. BSEG) GOTO 9990
  554.       IF(IOBJ .NE. JPOINT(/1))THEN
  555.         IOBJ  = IOBJ + 1
  556.         IPLAC = IPOINT(IOBJ)
  557.         IPOI1 = JPOINT(IOBJ)
  558.         GOTO 1
  559.       ENDIF
  560.  
  561.  9990 CONTINUE
  562.  
  563.       IF (BSEG) SEGSUP,JPOINT,IPOINT
  564.       IF (MMODE2 .NE. 0) SEGSUP,MMODE2
  565.  
  566. c      return
  567.       END
  568.  
  569.  
  570.  

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