Télécharger la plaquette Cast3M


fr en

Télécharger menag2.eso

Retour à la liste

Numérotation des lignes : 

menag2

  1. C MENAG2    SOURCE    PV090527  25/01/03    21:15:16     12111          
  2. C  SUPPRIMER LES SEGMENTS INDESIRABLES
  3. C  DESACTIVER LES AUTRES
  4. C
  5.       SUBROUTINE MENAG2(ISLIS,ICOLAC)
  6.  
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10. C=======================================================================
  11. C  TABLEAU KCOLA: VOIR SIGNIFICATION DANS SOUS-PROGRAMME TYPFIL
  12. C=======================================================================
  13.  
  14.       CHARACTER*8 MODYN
  15.  
  16.       SEGMENT ISLIS(NP)
  17.       SEGMENT IBLIS(ISLIS(/1))
  18. *                     SEGMENT BIDON POUR REMPLACER LES TROP NOMBREUSES
  19. *                     DECLARATION
  20.       SEGMENT ISEG(0)
  21. *
  22.       integer ooolen
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCOORD
  27. -INC TMCOLAC
  28. *-INC SMCOORD
  29. *-INC SMELEME
  30. -INC SMCHPOI
  31. -INC SMRIGID
  32. *-INC SMCLSTR
  33. *-INC SMELSTR
  34. -INC SMSTRUC
  35. *-INC SMTABLE
  36. -INC SMINTE
  37. -INC SMATTAC
  38. -INC SMMATRI
  39. -INC SMSOLUT
  40. *-INC SMSUPER
  41. -INC SMTEXTE
  42. *-INC SMDEFOR
  43. -INC CCASSIS
  45. -INC SILICRE
  46.  
  47.       MODYN='DYNAMIQU'
  48.  
  49.       ILISSE=ILISSG
  50.       NP=ILISEG(/1)
  51.       SEGINI ISLIS
  52. * A TOUT HASARD SAUVER LA CONFIGURATION COURANTE
  53.       ISLIS((MCOORD-1)/npgcd)=1
  54.       SEGACT MCOORD
  55.       IF (MROTA.NE.0) ISLIS((MROTA-1)/npgcd)=1
  56.       SEGDES MCOORD
  57.       SEGACT ICOLAC
  58. *
  59. *  CAS DES MELEME
  60. *
  61.       ITLACC=KCOLA(1)
  62.        IF (ITLAC(/1).EQ.0) GOTO 20
  63.        DO 12 I=1,ITLAC(/1)
  64.         ISEG=ITLAC(I)
  65.         IF (ISEG.NE.0) THEN
  66.          ISLIS((ISEG-1)/npgcd)=1
  67. *  ne pas desactiver si trop grand car boucle menage automatique
  68.          if (ooolen(iseg).lt.10000000) then
  69.           SEGDES ISEG
  70.          else
  71.           SEGact ISEG
  72.          endif
  73.         ENDIF
  74.   12  CONTINUE
  75.   20  CONTINUE
  76. *
  77. *  CAS DES CHPOINT
  78. *
  79.       ITLACC=KCOLA(2)
  80.        IF (ITLAC(/1).EQ.0) GOTO 30
  81.        DO 21 I=1,ITLAC(/1)
  82.         MCHPOI=ITLAC(I)
  83.         IF (MCHPOI.EQ.0) GOTO 21
  84.         ISLIS((MCHPOI-1)/npgcd)=1
  85.         SEGACT MCHPOI
  86.         if (ipchp(/1).gt.1000.or.ipchp(/1).lt.0) then
  87.            write (6,*) ' menag2 chpo incorrect ',
  88.      >         mchpoi,j,ipchp(/1),msoupo
  89.           goto 21
  90.          endif
  91.         DO 22 J=1,IPCHP(/1)
  92.          MSOUPO=IPCHP(J)
  93.          if (msoupo.eq.0) goto 22
  94.          if (msoupo.le.100) then
  95.            write (6,*) ' menag2 chpo incorrect ',
  96.      >         mchpoi,j,ipchp(/1),msoupo
  97.           goto 21
  98.          endif
  99.          ISLIS((MSOUPO-1)/npgcd)=1
  100.          SEGACT MSOUPO
  101.          MPOVAL=IPOVAL
  102. C
  103. C  BIZARRE : DANS UN ATTACH, ON TROUVE UN CHPOI SANS MPOVAL ?
  104.          IF(MPOVAL.NE.0) THEN
  105.              ISLIS((MPOVAL-1)/npgcd)=1
  106.              SEGDES MPOVAL
  107.          ENDIF
  108.          SEGDES MSOUPO
  109.   22    CONTINUE
  110.         SEGDES MCHPOI
  111.   21   CONTINUE
  112.   30  CONTINUE
  113. *
  114. *  CAS DES MRIGID   (ON REMPLIT MMATRI CAR CA N'A PAS L'AIR FAIT DANS
  115. *  FILLPO
  116. *
  117.       ITLACC=KCOLA(3)
  118.            ITLAC1=KCOLA(16)
  119.        IF (ITLAC(/1).EQ.0) GOTO 40
  120.        DO 31 I=1,ITLAC(/1)
  121.         MRIGID=ITLAC(I)
  122.         ISLIS((MRIGID-1)/npgcd)=1
  123.         SEGACT MRIGID
  124. *       IF (ICHOLE.NE.0) ITLAC1.ITLAC(**)=ICHOLE
  125.         IMGEOD=IMGEO1
  126.         IF (IMGEOD.NE.0) THEN
  127.          ISLIS((IMGEOD-1)/npgcd)=1
  128.          SEGDES IMGEOD
  129.         ENDIF
  130.         IF(IVECRI.NE.0) then
  131.           ISLIS((IVECRI-1)/npgcd)=1
  132.           MVECRI=IVECRI
  133.           SEGDES MVECRI
  134.         ENDIF
  135.         DO 32 J=1,IRIGEL(/2)
  136.          DESCR=IRIGEL(3,J)
  137.          ISLIS((DESCR-1)/npgcd)=1
  138.          SEGDES DESCR
  139. *  maintenant fait dans la pile imatri
  140. ***              xmatri=irigel(4,j)
  141. ***              islis((xmatri-1)/npgcd)=1
  142. ***              segdes xmatri
  143.   32    CONTINUE
  144.         SEGDES MRIGID
  145.   31  CONTINUE
  146.   40  CONTINUE
  147. *
  148. *  CAS DES BLOQ STRUC
  149. *
  150.       ITLACC=KCOLA(6)
  151.       IF (ITLAC(/1).EQ.0) GOTO 70
  152.       DO 61 I=1,ITLAC(/1)
  153. *       MCLSTR=ITLAC(I)
  154. *       ISLIS((MCLSTR-1)/npgcd)=1
  155. *       SEGDES MCLSTR
  156.         ISEG=ITLAC(I)
  157.         ISLIS((ISEG-1)/npgcd)=1
  158.         SEGDES ISEG
  159.   61  CONTINUE
  160.   70  CONTINUE
  161. *
  162. *  CAS DES ELEM STRUC
  163. *
  164.       ITLACC=KCOLA(7)
  165.       IF (ITLAC(/1).EQ.0) GOTO 80
  166.       DO 71 I=1,ITLAC(/1)
  167. *       MELSTR=ITLAC(I)
  168. *       ISLIS((MELSTR-1)/npgcd)=1
  169. *       SEGDES MELSTR
  170.         ISEG=ITLAC(I)
  171.         ISLIS((ISEG-1)/npgcd)=1
  172.         SEGDES ISEG
  173.   71  CONTINUE
  174.   80  CONTINUE
  175. *
  176. *  CAS DES MSOLUT
  177. *
  178.       ITLACC=KCOLA(8)
  179.       SEGACT ITLACC
  180.       IF (ITLAC(/1).EQ.0) GOTO 90
  181.       DO 81 I=1,ITLAC(/1)
  182.         MSOLUT=ITLAC(I)
  183.         ISLIS((MSOLUT-1)/npgcd)=1
  184.         SEGACT MSOLUT
  185. C
  186. C     ZONE COMMUNE PAS SI COMMUNE QUE CA |
  187. C
  188.         IF(ITYSOL.EQ.MODYN) THEN
  189.             MSOLRE=MSOLIS(1)
  190.             ISLIS((MSOLRE-1)/npgcd)=1
  191.             SEGDES MSOLRE
  192.             MSOLEN=MSOLIS(2)
  193.             IF(MSOLEN.NE.0) THEN
  194.                 ISLIS((MSOLEN-1)/npgcd)=1
  195.                 SEGDES MSOLEN
  196.             ENDIF
  197.         ENDIF
  198.         ISEG=MSOLIS(3)
  199.         IF(ISEG.NE.0) THEN
  200.             ISLIS((ISEG-1)/npgcd)=1
  201.             SEGDES ISEG
  202.         ENDIF
  203.         MSOLEN=MSOLIS(4)
  204.         IF(MSOLEN.NE.0) THEN
  205.             ISLIS((MSOLEN-1)/npgcd)=1
  206.             SEGACT MSOLEN
  207.             DO 82 NS=1,ISOLEN(/1)
  208.               MMODE=ISOLEN(NS)
  209.               ISLIS((MMODE-1)/npgcd)=1
  210.               SEGDES MMODE
  211.   82        CONTINUE
  212.             SEGDES MSOLEN
  213.         ENDIF
  214. C
  215.         NIPO=MSOLIS(/1)
  216.         DO 83 J=5,NIPO
  217.           MSOLEN=MSOLIS(J)
  218.           IF(MSOLEN.NE.0) THEN
  219.               ISLIS((MSOLEN-1)/npgcd)=1
  220.               SEGDES MSOLEN
  221.           ENDIF
  222.   83    CONTINUE
  223.         SEGDES MSOLUT
  224.   81  CONTINUE
  225.   90  CONTINUE
  226. *
  227. *  CAS DES MSTRUC
  228. *
  229.       ITLACC=KCOLA(9)
  230.       IF (ITLAC(/1).EQ.0) GOTO 100
  231.       DO 91 I=1,ITLAC(/1)
  232.         MSTRUC=ITLAC(I)
  233.         ISLIS((MSTRUC-1)/npgcd)=1
  234.         SEGDES MSTRUC
  235.   91  CONTINUE
  236.  100  CONTINUE
  237. *
  238. *  CAS DES MTABLE
  239. *
  240.       ITLACC=KCOLA(10)
  241.       IF (ITLAC(/1).EQ.0) GOTO 110
  242.       DO 101 I=1,ITLAC(/1)
  243. *        MTABLE=ITLAC(I)
  244. *        ISLIS((**-1)/npgcd)=MTABLE
  245. *        SEGDES MTABLE
  246.         ISEG=ITLAC(I)
  247.         ISLIS((ISEG-1)/npgcd)=1
  248.         SEGDES ISEG
  249.  101  CONTINUE
  250.  110  CONTINUE
  251. *
  252. *  CAS DES MSOSTU
  253. *
  254.       ITLACC=KCOLA(12)
  255.       IF (ITLAC(/1).EQ.0) GOTO 130
  256.       DO 121 I=1,ITLAC(/1)
  257.         MSOSTU=ITLAC(I)
  258.         ISLIS((MSOSTU-1)/npgcd)=1
  259.         SEGDES MSOSTU
  260.  121  CONTINUE
  261.  130  CONTINUE
  262. *
  263. *  CAS DES IMATRI
  264. *
  265.         ITLACC=KCOLA(13)
  266.         IF (ITLAC(/1).EQ.0) GOTO 140
  267.         DO 131 I=1,ITLAC(/1)
  268.          IMATRI=ITLAC(I)
  269.          ISLIS((IMATRI-1)/npgcd)=1
  270.  131   CONTINUE
  271.  140  CONTINUE
  272. *
  273. *  CAS DES MJONCT
  274. *
  275.       ITLACC=KCOLA(14)
  276.        IF (ITLAC(/1).EQ.0) GOTO 150
  277.        DO 141 I=1,ITLAC(/1)
  278.         MJONCT=ITLAC(I)
  279.         ISLIS((MJONCT-1)/npgcd)=1
  280.         SEGDES MJONCT
  281.  141   CONTINUE
  282.  150  CONTINUE
  283. *
  284. *  CAS DES MATTAC
  285. *
  286.       ITLACC=KCOLA(15)
  287.       SEGACT ITLACC
  288.        IF (ITLAC(/1).EQ.0) GOTO 160
  289.        DO 151 I=1,ITLAC(/1)
  290.         MATTAC=ITLAC(I)
  291.         SEGACT MATTAC
  292.         ISLIS((MATTAC-1)/npgcd)=1
  293.         DO 152 NM=1,LISATT(/1)
  294.          MSOUMA=LISATT(NM)
  295.          if (MSOUMA.gt.0) then
  296.          ISLIS((MSOUMA-1)/npgcd)=1
  297.          SEGACT MSOUMA
  298.          MPHYCH=IPHYCH
  299.          if (MPHYCH.gt.0) then
  300.          ISLIS((MPHYCH-1)/npgcd)=1
  301.          SEGDES MPHYCH
  302.          endif
  303.          MGEOCH=IGEOCH
  304.          if (MGEOCH.gt.0) then
  305.          ISLIS((MGEOCH-1)/npgcd)=1
  306.          SEGDES MGEOCH
  307.          endif
  308.          DO 153 NATR=1,IATREL(/1)
  309.           MJONCT=IATREL(NATR)
  310.           ISLIS((MJONCT-1)/npgcd)=1
  311. C
  312.           SEGDES MJONCT
  313.  153     CONTINUE
  314.          SEGDES MSOUMA
  315.          endif
  316.  152    CONTINUE
  317.         SEGDES MATTAC
  318.  151   CONTINUE
  319.  160   CONTINUE
  320. *
  321. *  CAS DES MMATRI : LES MMATRI N'ETANT PAS REMPLI DANS LE PROCESSUS
  322. *  NORMAL : FILLPO ON LES REMPLI  AU NIVEAU DE MRIGID
  323. *  ON EST EGALEMENT CONTRAINT DE SAUVER IGEOMA (MELEME) CAR CE N'EST
  324. *  PAS FAIT AUTOMATIQUEMENT
  325. *
  326.       ITLACC=KCOLA(16)
  327.        IF (ITLAC(/1).EQ.0) GOTO 170
  328.        DO 161 I=1,ITLAC(/1)
  329.         MMATRI=ITLAC(I)
  330.         ISLIS((MMATRI-1)/npgcd)=1
  331.         SEGACT MMATRI
  332.          ISEG=IGEOMA
  333.          ISLIS((ISEG-1)/npgcd)=1
  334.          SEGDES ISEG
  335.          MDIAG=IDIAG
  336.          ISLIS((MDIAG-1)/npgcd)=1
  337.          SEGDES MDIAG
  338.          MINCPO=IINCPO
  339.          ISLIS((MINCPO-1)/npgcd)=1
  340.          SEGDES MINCPO
  341.          IF(IDUAPO.GT.0) THEN
  342.             MINCPO=IDUAPO
  343.             ISLIS((MINCPO-1)/npgcd)=1
  344.             SEGDES MINCPO
  345.          ENDIF
  346.          MIDUA=IIDUA
  347.          ISLIS((MIDUA-1)/npgcd)=1
  348.          SEGDES MIDUA
  349.          MIMIK=IIMIK
  350.          ISLIS((MIMIK-1)/npgcd)=1
  351.          SEGDES MIMIK
  352.          MDNOR=IDNORM
  353.          ISLIS((MDNOR-1)/npgcd)=1
  354.          SEGDES MDNOR
  355.          MHARK=IHARK
  356.          ISLIS((MHARK-1)/npgcd)=1
  357.          SEGDES MHARK
  358.          IF(IHARDU.GT.0) THEN
  359.             MHARK=IHARDU
  360.             ISLIS((MHARK-1)/npgcd)=1
  361.             SEGDES MHARK
  362.          ENDIF
  363.          IF(IDNORD.GT.0) THEN
  364.             MDNO1=IDNORD
  365.             ISLIS((MDNO1-1)/npgcd)=1
  366.             SEGDES MDNO1
  367.          ENDIF
  368.          IF (JLICRE.NE.0) then
  369.           ISLIS((JLICRE-1)/npgcd)=1
  370.           ILICRE=JLICRE
  371.           SEGACT ILICRE
  372.           ligcre=ligcrp
  373.           ISLIS((LIGCRE-1)/npgcd)=1
  374.           segdes ligcre,ilicre
  375.          ENDIF
  376.  
  377.          MILIGN=IILIGN
  378.          ISLIS((MILIGN-1)/npgcd)=1
  379.          SEGACT MILIGN
  380.           DO 162 J=1,ILIGN(/1)
  381.            LIGN=ILIGN(J)
  382.            ISLIS((LIGN-1)/npgcd)=1
  383.            SEGDES LIGN
  384.  162      CONTINUE
  385.           SEGDES MILIGN
  386.  
  387.          IF(IILIGS.NE.0) THEN
  388.            MILIGN=IILIGS
  389.            ISLIS((MILIGN-1)/npgcd)=1
  390.            SEGACT MILIGN
  391.            DO 163 J=1,ILIGN(/1)
  392.              LIGN=ILIGN(J)
  393.              ISLIS((LIGN-1)/npgcd)=1
  394.              SEGDES LIGN
  395.  163       CONTINUE
  396.            SEGDES MILIGN
  397.          ENDIF
  398.          IF(IASLIG.NE.0) THEN
  399.             ISLIS((IASLIG-1)/npgcd)=1
  400.             MILIGN=IASLIG
  401.             SEGACT MILIGN
  402.             DO 164 J=1,ILIGN(/1)
  403.              LIGN=ILIGN(J)
  404.              ISLIS((LIGN-1)/npgcd)=1
  405.              SEGDES LIGN
  406.  164        CONTINUE
  407.            SEGDES MILIGN
  408.            MDIAG=IASDIA
  409.            ISLIS((MDIAG-1)/npgcd)=1
  410.            SEGDES MDIAG
  411.         ENDIF
  412.         SEGDES MMATRI
  413.  161   CONTINUE
  414.  170  CONTINUE
  415. *
  416. *  CAS DES MDEFOR
  417. *
  418.       ITLACC=KCOLA(17)
  419.        IF (ITLAC(/1).EQ.0) GOTO 180
  420.        DO 171 I=1,ITLAC(/1)
  421. *       MDEFOR=ITLAC(I)
  422. *       ISLIS((MDEFOR-1)/npgcd)=1
  423. *       SEGDES MDEFOR
  424.         ISEG=ITLAC(I)
  425.         ISLIS((ISEG-1)/npgcd)=1
  426.         SEGDES ISEG
  427.  171   CONTINUE
  428.  180  CONTINUE
  429. *
  430. *     LA SUITE EST DANS MENAG6
  431. *
  432.       CALL MENAG6(ILISSE,ISLIS,ICOLAC)
  433. *
  434. *     ORDONNER LES SEGMENTS
  435. *
  436.       NP=0
  437.       DO 11 I=1,ISLIS(/1)
  438.       IF( ISLIS(I).NE.0) THEN
  439.         NP=NP+1
  440.         ISLIS(NP)=I*npgcd+1
  441.       ENDIF
  442.    11 CONTINUE
  443.       SEGADJ ISLIS
  444. *      SEGINI IBLIS
  445. *      CALL TRIENT(ISLIS(1),IBLIS(1),ISLIS(/1))
  446. *      SEGSUP IBLIS
  447.  
  448.       RETURN
  449.       END
  450.  
  451.  
  452.  
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  
  463.  
  464.  
  465.  
  466.  
  467.  

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