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

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