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

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