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

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