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

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