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    JK148537  25/04/01    21:15:01     12223          
  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.       if (mchel1.infche(/2) .ne. 6) then
  153.         write(ioimp,*) 'ACTOBJ : MCHELM =',MCHEL1,' INFCHE(/2) != 6'
  154.         call erreur(5)
  155.       endif
  156. *  verif configuration
  157.  
  158.        titloc=mchel1.titche                     
  159.       if (mchel1.mclcnf.ne.0.and.mcoord.ne.0.and.mchel1.mclcnf.ne.mcoord
  160.      >   .and.(titloc(1:13).eq.'CONTRAINTES  '.or.titloc(1:14) 
  161.      >                     .eq.'DEFORMATIONS  ').and.ikod.ne.2) then
  162.         moterr(1:8) = 'CHAMELEM'
  163.         interr(1) = mchel1.mclcnf
  164.         interr(2) = mcoord
  165.         interr(3) = mchel1
  166.         if (.false.) then
  167.          CALL oooprl(0)
  168.          call erreur(1149)
  169. **       ichaml(2**31)=1
  170.          return
  171.         endif
  172.       endif
  173.  
  174.       do ii = 1, mchel1.ichaml(/1)
  175.         jj = mchel1.infche(ii,6)
  176.         if (jj.LT.1 .OR. jj.GT.9) then                                
  177.           write(ioimp,*)'ACTOBJ : MCHELM =',MCHEL1,' support INFCHE(',
  178.      &                  ii,'6) incorrect'
  179.           call erreur(5)                                         
  180.         endif
  181.       enddo
  182.  
  183.         DO 111 II=1,MCHEL1.ICHAML(/1)
  184.           MCHAM1=MCHEL1.ICHAML(II)
  185.           SEGACT,MCHAM1
  186.  111    CONTINUE
  187.         CALL oooprl(0)
  188.  
  189.         IF (BCODE) CALL PREACT(ITAB,MCHEL1)
  190.         DO 110 II=1,MCHEL1.ICHAML(/1)
  191.           MCHAM1=MCHEL1.ICHAML(II)
  192.           IPT1=MCHEL1.IMACHE(II)
  193.           CALL PREACT(ITAB,IPT1)
  194.           MINTE = MCHEL1.INFCHE(II,4)
  195.           IF (MINTE .NE. 0) CALL PREACT(ITAB,MINTE)
  196.  
  197.           IF (BCODE) CALL PREACT(ITAB,MCHAM1)
  198.           DO 120 JJ=1,MCHAM1.IELVAL(/1)
  199.             MOT16 =MCHAM1.TYPCHE(JJ)
  200.             MELVA1=MCHAM1.IELVAL(JJ)
  201.  
  202.             IF(MELVA1 .EQ. MELSAV) GOTO 120
  203.             MELSAV=MELVA1
  204.  
  205.             IF    (MOT16(1:6)  .EQ. 'REAL*8'        .OR.
  206.      &             MOT16(1:13) .EQ. 'POINTEURPOINT'      )THEN
  207.               CALL PREACT(ITAB,MELVA1)
  208.  
  209.             ELSEIF(MOT16(1:12) .EQ. 'POINTEURLIST')THEN
  210.               SEGACT,MELVA1
  211.               IF (BCODE) CALL PREACT(ITAB,MELVA1)
  212.               IPOI2 = 0
  213.               DO 130 KK=1,MELVA1.IELCHE(/2)
  214.                 DO 140 LL=1,MELVA1.IELCHE(/1)
  215.                   ISEG=MELVA1.IELCHE(LL,KK)
  216.                   IF(ISEG .NE. IPOI2 .AND. ISEG.NE.0)THEN
  217.                     CALL PREACT(ITAB,ISEG)
  218.                     IPOI2 = ISEG
  219.                   ENDIF
  220.  140            CONTINUE
  221.  130          CONTINUE
  222.  
  223.             ELSEIF(MOT16(1:16) .EQ. 'POINTEUREVOLUTIO')THEN
  224.               SEGACT,MELVA1
  225.               IF (BCODE) CALL PREACT(ITAB,MELVA1)
  226.               IPOI2 = 0
  227.               DO 150 KK=1,MELVA1.IELCHE(/2)
  228.                 DO 160 LL=1,MELVA1.IELCHE(/1)
  229.                   MEVOL1=MELVA1.IELCHE(LL,KK)
  230.                   IF(MEVOL1 .NE. IPOI2 .AND. MEVOL1.NE.0)THEN
  231.                     IPOI2 = MEVOL1
  232.                     SEGACT,MEVOL1
  233.                     IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  234.                     DO 170 MM=1,MEVOL1.IEVOLL(/1)
  235.                       KEVOL1=MEVOL1.IEVOLL(MM)
  236.                       SEGACT,KEVOL1
  237.                       IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  238.                       ISEG=KEVOL1.IPROGX
  239.                       CALL PREACT(ITAB,ISEG)
  240.                       ISEG=KEVOL1.IPROGY
  241.                       CALL PREACT(ITAB,ISEG)
  242.  170                CONTINUE
  243.                   ENDIF
  244.  160            CONTINUE
  245.  150          CONTINUE
  246.  
  247.             ELSEIF(MOT16(1:8) .EQ. 'POINTEUR')THEN
  248. C             Cas des MCHAML de POINTEURS necessitant du travail
  249.               SEGACT,MELVA1
  250.               IF (BCODE) CALL PREACT(ITAB,MELVA1)
  251.               IPOI2 = 0
  252.               CTYP1 = MOT16(9:16)
  253.               CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  254.               IF(IPLAC .NE. 0)THEN
  255.                 DO 180 KK=1,MELVA1.IELCHE(/2)
  256.                   DO 190 LL=1,MELVA1.IELCHE(/1)
  257.                     ISEG   =MELVA1.IELCHE(LL,KK)
  258.                     IF(ISEG.NE.IPOI2 .AND. ISEG.NE.0)THEN
  259.                       IPOI2 = ISEG
  260.                       IF(.NOT. BSEG)THEN
  261.                         SEGINI,JPOINT,IPOINT
  262.                         BSEG=.TRUE.
  263.                       ENDIF
  264.                       JPOINT(**)=MELVA1.IELCHE(LL,KK)
  265.                       IPOINT(**)=IPLAC
  266.                     ENDIF
  267.  190              CONTINUE
  268.  180            CONTINUE
  269. C             ELSE
  270. C               PRINT*,'ACTOBJ:MCHAML de TYPE',MOT16,' non traite'
  271.               ENDIF
  272.  
  273.             ELSE
  274.               CALL PREACT(ITAB,MELVA1)
  275.             ENDIF
  276.  120      CONTINUE
  277.  110    CONTINUE
  278.         GOTO 9999
  279.  
  280.  200  CONTINUE
  281. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  282. C     OBJET DE TYPE CHPOINT
  283. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  284.       MCHPO1=IPOI1
  285.       CALL oooprl(1)
  286.       SEGACT,MCHPO1
  287.       NSOUPO=MCHPO1.IPCHP(/1)
  288.       DO 211 II=1,NSOUPO
  289.         MSOUP1=MCHPO1.IPCHP(II)
  290.         SEGACT,MSOUP1
  291.  211  CONTINUE
  292.       CALL oooprl(0)
  293.  
  294.       IF (BCODE) CALL PREACT(ITAB,MCHPO1)
  295.       DO 210 II=1,NSOUPO
  296.         MSOUP1=MCHPO1.IPCHP(II)
  297.         IF (BCODE) CALL PREACT(ITAB,MSOUP1)
  298.         IPT1=MSOUP1.IGEOC
  299.         CALL PREACT(ITAB,IPT1)
  300.         MPOVA1=MSOUP1.IPOVAL
  301.         CALL PREACT(ITAB,MPOVA1)
  302.  210  CONTINUE
  303.       GOTO 9999
  304.  
  305.  300  CONTINUE
  306. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  307. C     OBJET DE TYPE MMODEL
  308. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  309.       MMODE1=IPOI1
  310.       SEGACT,MMODE1
  311.       IF (BCODE) CALL PREACT(ITAB,MMODE1)
  312.  
  313. * jk148537 
  314.       N1 = MMODE1.KMODEL(/1)
  315.       SEGINI,MMODE2
  316.       NN1 = 0
  317.       DO 305 II=1,MMODE1.KMODEL(/1)
  318.         IMODE1=MMODE1.KMODEL(II)
  319.         NN1 = NN1 + 1
  320.         MMODE2.KMODEL(NN1) = IMODE1
  321.         SEGACT,IMODE1
  322.         NIVM = IMODE1.IVAMOD(/1)
  323.         N1 = N1 + NIVM
  324.         SEGADJ,MMODE2
  325.         DO 307 JJ=1,NIVM
  326.           CTYP1=IMODE1.TYMODE(JJ)
  327.           IF(CTYP1 .EQ. 'IMODEL  ')THEN
  328. C           Construction d'un MODELE AVEC les IMODEL (Cas des MODELES de melange)
  329.             if (imode1.ivamod(JJ).gt.0) then
  330.               NN1 = NN1 + 1
  331.               MMODE2.KMODEL(NN1) = imode1.ivamod(JJ)
  332.             endif
  333.           ENDIF  
  334.           IF(CTYP1 .EQ. 'MMODEL  ')THEN
  335. C           Construction d'un MODELE AVEC les IMODEL (Cas des MODELES associes MODAL)
  336.             if (imode1.ivamod(JJ).gt.0) then
  337.               MMODE3 = imode1.ivamod(JJ)
  338.               SEGACT,MMODE3
  339.               IF (BCODE) CALL PREACT(ITAB,MMODE3)
  340.               N1 = N1 + mmode3.kmodel(/1)
  341.               SEGADJ,MMODE2
  342.               do ll=1,mmode3.kmodel(/1)
  343.                 NN1 = NN1 + 1
  344.                 MMODE2.KMODEL(NN1) = mmode3.kmodel(ll)
  345.               enddo
  346.             endif
  347.           ENDIF  
  348.  307    CONTINUE               
  349.  305  CONTINUE
  350.       N1 = NN1 
  351.       SEGADJ,MMODE2
  352.  
  353.       NN1    = 0
  354.       DO 310 II=1,MMODE2.KMODEL(/1)
  355.         IMODE1=MMODE2.KMODEL(II)
  356.         SEGACT,IMODE1
  357.         IF (BCODE) CALL PREACT(ITAB,IMODE1)
  358.         IPT1=IMODE1.IMAMOD
  359.         SEGACT IPT1
  360.         CALL PREACT(ITAB,IPT1)
  361.         DO 350 III=1,IPT1.LISOUS(/1)
  362.           IPT2 =IPT1.LISOUS(III)
  363.           CALL PREACT(ITAB,IPT2)
  364.  350    CONTINUE
  365.         IPT3 = IMODE1.IPDPGE
  366.         IF (IPT3.NE.0) CALL PREACT(ITAB,IPT3)
  367.         NIVM = IMODE1.IVAMOD(/1)
  368.         DO 320 JJ=1,NIVM
  369.           CTYP1=IMODE1.TYMODE(JJ)
  370.           CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  371.           IF(IPLAC .NE. 0)THEN
  372.             IF(.NOT. BSEG)THEN
  373.               SEGINI,JPOINT,IPOINT
  374.               BSEG=.TRUE.
  375.             ENDIF
  376.             JPOINT(**)=IMODE1.IVAMOD(JJ)
  377.             IPOINT(**)=IPLAC
  378.           ENDIF
  379.  320    CONTINUE
  380.  
  381.         NBNOMI =IMODE1.LNOMID(/1)
  382.         DO 330 INOM=1,NBNOMI
  383.           IPT1=IMODE1.LNOMID(INOM)
  384.           IF (IPT1 .GT. 0) CALL PREACT(ITAB,IPT1)
  385.  330    CONTINUE
  386.  
  387.        if (imode1.INFMOD(/1).lt.1) then
  388.          write(ioimp,*) 'ACTOBJ : IMODEL =',imode1,' INFMOD(/1) < 1'
  389.          call erreur(5)
  390.        endif
  391.        DO 340 IINFMO=3,IMODE1.INFMOD(/1)
  392.           IPT1=IMODE1.INFMOD(IINFMO)
  393.           IF (IPT1 .GT. 0) CALL PREACT(ITAB,IPT1)
  394.  340   CONTINUE
  395.  
  396.  310  CONTINUE
  397.  
  398.       GOTO 9999
  399.  
  400.  400  CONTINUE
  401. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  402. C     OBJET DE TYPE MAILLAGE
  403. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  404.       IPT1=IPOI1
  405.       SEGACT,IPT1
  406.       IF (BCODE) CALL PREACT(ITAB,IPT1)
  407.       DO 410 II=1,IPT1.LISOUS(/1)
  408.         IPT2 =IPT1.LISOUS(II)
  409.         CALL PREACT(ITAB,IPT2)
  410.  410  CONTINUE
  411.       GOTO 9999
  412.  
  413.  500  CONTINUE
  414. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  415. C     OBJET DE TYPE EVOLUTIO
  416. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  417.       MEVOL1=IPOI1
  418.       SEGACT,MEVOL1
  419.       IF (BCODE) CALL PREACT(ITAB,MEVOL1)
  420.       DO 510 II=1,MEVOL1.IEVOLL(/1)
  421.         KEVOL1=MEVOL1.IEVOLL(II)
  422.         SEGACT,KEVOL1
  423.         IF (BCODE) CALL PREACT(ITAB,KEVOL1)
  424.         ISEG=KEVOL1.IPROGX
  425.         CALL PREACT(ITAB,ISEG)
  426.         ISEG=KEVOL1.IPROGY
  427.         CALL PREACT(ITAB,ISEG)
  428.  510  CONTINUE
  429.       GOTO 9999
  430.  
  431.  600  CONTINUE
  432. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  433. C     OBJET DE TYPE LISTXXXX
  434. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  435.       IF(IPLAC .EQ. 10)THEN
  436. C       Cas des LISTCHPO
  437.         MLCHPO=IPOI1
  438.         SEGACT,MLCHPO
  439.         IF (BCODE) CALL PREACT(ITAB,MLCHPO)
  440.         CTYP1='CHPOINT '
  441.         CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  442.         IF(.NOT. BSEG)THEN
  443.           SEGINI,JPOINT,IPOINT
  444.           BSEG=.TRUE.
  445.         ENDIF
  446.         DO 610 II=1,MLCHPO.ICHPOI(/1)
  447.           JPOINT(**)=MLCHPO.ICHPOI(II)
  448.           IPOINT(**)=IPLAC
  449.  610    CONTINUE
  450.       ELSE
  451. C       Cas des LISTENTI,LISTREEL,LISTMOTS
  452.         CALL PREACT(ITAB,IPOI1)
  453.       ENDIF
  454.       GOTO 9999
  455.  
  456.  700  CONTINUE
  457. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  458. C     OBJET DE TYPE NUAGE
  459. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  460.       MNUAG1=IPOI1
  461.       SEGACT,MNUAG1
  462.       IF (BCODE) CALL PREACT(ITAB,MNUAG1)
  463.       DO 710 II=1,MNUAG1.NUAPOI(/1)
  464.         CTYP1=MNUAG1.NUATYP(II)
  465.         CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  466.         IF(IPLAC .NE. 0)THEN
  467.           IF(.NOT. BSEG)THEN
  468.             SEGINI,JPOINT,IPOINT
  469.             BSEG=.TRUE.
  470.           ENDIF
  471.           NUAVIN=MNUAG1.NUAPOI(II)
  472.           SEGACT,NUAVIN
  473.           IF (BCODE) CALL PREACT(ITAB,NUAVIN)
  474.           DO 720 JJ=1,NUAVIN.NUAINT(/1)
  475.             JPOINT(**)=NUAVIN.NUAINT(JJ)
  476.             IPOINT(**)=IPLAC
  477.  720      CONTINUE
  478.  
  479.         ELSE
  480.           ISEG=MNUAG1.NUAPOI(II)
  481.           CALL PREACT(ITAB,ISEG)
  482.         ENDIF
  483.  710  CONTINUE
  484.       GOTO 9999
  485.  
  486.  800  CONTINUE
  487. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  488. C     OBJET DE TYPE CHARGEMENT
  489. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  490.       MCHAR1=IPOI1
  491.       SEGACT,MCHAR1
  492.       IF (BCODE) CALL PREACT(ITAB,MCHAR1)
  493.       DO 810 II=1,MCHAR1.KCHARG(/1)
  494.         ICHAR1=MCHAR1.KCHARG(II)
  495.         SEGACT,ICHAR1
  496.         IF (BCODE) CALL PREACT(ITAB,ICHAR1)
  497.  
  498.         CTYP1=ICHAR1.CHATYP
  499.         CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,CTYP1)
  500.         IF(IPLAC .NE. 0)THEN
  501.           IF(.NOT. BSEG)THEN
  502.             SEGINI,JPOINT,IPOINT
  503.             BSEG=.TRUE.
  504.           ENDIF
  505.           JPOINT(**)=ICHAR1.ICHPO1
  506.           IPOINT(**)=IPLAC
  507.         ENDIF
  508.  810  CONTINUE
  509.       GOTO 9999
  510.  
  511.  900  CONTINUE
  512. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  513. C     OBJET DE TYPE RIGIDITE
  514. C       Ne traite que la partie non assemblee des objets RIGIDITE
  515. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  516.       MRIGID=IPOI1
  517.       SEGACT,MRIGID
  518.       IF (BCODE) CALL PREACT(ITAB,MRIGID)
  519.  
  520.       IMGEOD=MRIGID.IMGEO1
  521. C     PRINT *,' -- IMGEOD:',IMGEOD
  522.       IF (IMGEOD.NE.0)CALL PREACT(ITAB,IMGEOD)
  523.  
  524.       MVECRI=MRIGID.IVECRI
  525. C     PRINT *,' -- MVECRI:',MVECRI
  526.       IF (MVECRI.NE.0)CALL PREACT(ITAB,MVECRI)
  527.  
  528.       DO 910 II=1,MRIGID.COERIG(/1)
  529.         IPT1  = MRIGID.IRIGEL(1,II)
  530. C       PRINT *,' -- IPT1  :',IPT1
  531.         CALL PREACT(ITAB,IPT1)
  532.  
  533.         IPT2  = MRIGID.IRIGEL(2,II)
  534. C       PRINT *,' -- IPT2  :',IPT2
  535.         IF(IPT2 .GT. 0)CALL PREACT(ITAB,IPT2)
  536.  
  537.         DESCR = MRIGID.IRIGEL(3,II)
  538. C       PRINT *,' -- DESCR :',DESCR
  539.         CALL PREACT(ITAB,DESCR)
  540.  
  541.         XMATRI = MRIGID.IRIGEL(4,II)
  542. C       PRINT *,' -- XMATRI:',XMATRI
  543.         CALL PREACT(ITAB,XMATRI)
  544.  910  CONTINUE
  545.       GOTO 9999
  546.  
  547.  
  548.  1000 CONTINUE
  549. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  550. C     OBJET DE TYPE ANNOTATI
  551. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  552.       MANNOT=IPOI1
  553.       SEGACT,MANNOT
  554.       IF (BCODE) CALL PREACT(ITAB,MANNOT)
  555.  
  556.       DO 1010 II=1,MANNOT.ICLAS(/1)
  557.         IF(MANNOT.ICLAS(II) .EQ. 2)THEN
  558.           METIQU = MANNOT.ISEGT(II)
  559.           SEGACT,METIQU
  560.           IF (BCODE) CALL PREACT(ITAB,METIQU)
  561.           MELEME = METIQU.INUPT
  562.           CALL PLAMO8(DTAOBJ,NBTYP,IPLAC,'MAILLAGE')
  563.           IF(IPLAC .NE. 0)THEN
  564.             IF(.NOT. BSEG)THEN
  565.               SEGINI,JPOINT,IPOINT
  566.               BSEG=.TRUE.
  567.             ENDIF
  568.             JPOINT(**)=MELEME
  569.             IPOINT(**)=IPLAC
  570.           ENDIF
  571.         ENDIF
  572.  1010 CONTINUE
  573.       GOTO 9999
  574.  
  575. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  576.  9999 CONTINUE
  577.  
  578.       IF(BCODE)THEN
  579. C       Boucle a la main en attendant SEGDES par paquets !
  580.         DO II=2,ICOUNT
  581.           ISEG=ITAB(II)
  582.           SEGDES,ISEG
  583.         ENDDO
  584.       ELSE
  585. C       Appel a SEGACT par paquet !
  586.         CALL FINACT(ITAB)
  587.       ENDIF
  588.  
  589.       IF(.NOT. BSEG) GOTO 9990
  590.       IF(IOBJ .NE. JPOINT(/1))THEN
  591.         IOBJ  = IOBJ + 1
  592.         IPLAC = IPOINT(IOBJ)
  593.         IPOI1 = JPOINT(IOBJ)
  594.         GOTO 1
  595.       ENDIF
  596.  
  597.  9990 CONTINUE
  598.  
  599.       IF (BSEG) SEGSUP,JPOINT,IPOINT
  600.       IF (MMODE2 .NE. 0) SEGSUP,MMODE2
  601.  
  602. c      return
  603.       END
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611.  
  612.  
  613.  
  614.  

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