Télécharger la plaquette Cast3M


fr en

Télécharger manuri.eso

Retour à la liste

Numérotation des lignes : 

manuri

  1. C MANURI    SOURCE    FANDEUR   22/01/03    21:15:30     11237          
  2.       SUBROUTINE MANURI
  3. ************************************************************************
  4. *
  5. *                             M A N U R I
  6. *                             -----------
  7. *
  8. *     SOUS-PROGRAMME ASSOCIE A L'OPTION "RIGIDITE" DE L'OPERATEUR
  9. *     "MANUEL".
  10. *
  11. * FONCTION:
  12. * ---------
  13. *
  14. *     CREER, EN LISANT EXPLICITEMENT SES COMPOSANTS, UN OBJET 'RIGIDITE'
  15. *     DANS LEQUEL TOUTES LES MATRICES DE RIGIDITE ELEMENTAIRES SONT LES
  16. *     MEMES.
  17. *     CAS PARTICULIER FREQUENT: LA 'RIGIDITE' S'APPUIE SUR UN SEUL
  18. *     ELEMENT GEOMETRIQUE ET ELLE NE CONTIENDRA QU'UNE SEULE MATRICE
  19. *     ELEMENTAIRE.
  20. *
  21. * PHRASE D'APPEL (EN GIBIANE):
  22. * ----------------------------
  23. *
  24. *     AA = MANUEL RIGIDITE (BB) CC <DD> ('DUAL' <FF>) ('ANTI') <EE> ;
  25. *
  26. *     LES PARENTHESES INDIQUANT DES OPERANDES FACULTATIFS ET LES
  27. *     CROCHETS DES OPERANDES POUVANT ETRE REPETES.
  28. *
  29. * OPERANDES ET RESULTATS:
  30. * -----------------------
  31. *
  32. *     BB        'MOT     '  SOUS-TYPE DE LA 'RIGIDITE' QUE L'ON CREE.
  33. *                           CE SOUS-TYPE S'ECRIVANT SUR 8 CARACTERES, ET
  34. *                           UN 'MOT' NE COMPORTANT ACTUELLEMENT QUE 4
  35. *                           CARACTERES, ON DOIT PROVISOIREMENT FOURNIR
  36. *                           NON PAS 1 MAIS 2 MOTS "BB1" ET "BB2".
  37. *     CC        'MAILLAGE'  SUPPORT GEOMETRIQUE.
  38. *     DD        'LISTMOTS'  CONTIENT LES NOMS DES COMPOSANTES POUR UN
  39. *                           NOEUD D'UN ELEMENT DE "CC".
  40. *                           SI TOUS LES NOEUDS D'UN MEME ELEMENT DE "CC"
  41. *                           N'ONT PAS LES MEMES COMPOSANTES, ON DONNE
  42. *                           PLUSIEURS 'LISTMOTS' (PLUS PRECISEMENT
  43. *                           AUTANT DE 'LISTMOTS' QU'IL Y A DE NOEUDS
  44. *                           PAR ELEMENT).
  45. C+PP
  46. C                           ILS PEUVENT ETRE CONTENUS DANS UNE TABLE
  47. C                           (IDEM POUR FF)
  48. C+PP
  49. *     FF        'LISTMOTS'  CONTIENT LES NOMS DES INCONNUES DUALES
  50. *                           AUTANT DE 'LISTMOTS' QUE POUR LES INCONNUES
  51. *     EE        'LISTREEL'  SI 1 SEUL "EE" EST FOURNI:
  52. *                           IL CONTIENT TOUS LES TERMES DU TRIANGLE
  53. *                           INFERIEUR DE LA MATRICE ELEMENTAIRE, LIGNE
  54. *                           PAR LIGNE.
  55. *                           SI PLUSIEURS "EE" SONT FOURNIS:
  56. *                           IL DOIT Y AVOIR AUTANT DE 'LISTREEL' QU'IL
  57. *                           Y A DE LIGNES DANS LA MATRICE ELEMENTAIRE,
  58. *                           LE N-IEME 'LISTREEL' DECRIVANT LA N-IEME
  59. *                           LIGNE DE LA MATRICE DU BORD GAUCHE JUSQU'A
  60. *                           LA DIAGONALE.
  61. *     AA        'RIGIDITE'  OBJET CREE.
  62. *
  63. *     EXEMPLE D'ENTREE DE LA MATRICE ELEMENTAIRE:
  64. *
  65. *     | A B C |
  66. *     | B D E |
  67. *     | C E F |
  68. *
  69. *     PEUT ETRE DONNEE PAR:  (PROG A B D C E F)
  70. *     OU BIEN PAR:  (PROG A) (PROG B D) (PROG C E F)
  71. *
  72. *     "PROG" ETANT L'OPERATEUR DE CREATION D'UN 'LISTREEL'.
  73. *
  74. * LEXIQUE: (ORDRE ALPHABETIQUE)
  75. * --------
  76. *
  77. *     IPELEM  ENTIER    POINTEUR DU SUPPORT GEOMETRIQUE "CC".
  78. *     IPRIGI  ENTIER    POINTEUR DE LA 'RIGIDITE' "AA".
  79. *     LETYPE  ENTIER    SOUS-TYPE DE L'OBJET 'RIGIDITE' (CONTIENT UNE
  80. *                       CHAINE DE CARACTERES).
  81. *     MTEMP3  SEGMENT   CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTMOTS'
  82. *                       "DD".
  83. *     MTEMP4  SEGMENT   CONTIENT LE(S) POINTEUR(S) DU (DES) 'LISTREEL'
  84. *                       "EE".
  85. *
  86. * SOUS-PROGRAMMES APPELES:
  87. * ------------------------
  88. *
  89. *     ECRIRE, LIRE, LIRMO8, MANUR1.
  90. *
  91. * REMARQUES:
  92. * ----------
  93. *
  94. *     ACTUELLEMENT, L'OBJET 'MAILLAGE' "CC" DOIT CONTENIR DES ELEMENTS
  95. *     GEOMETRIQUES TOUS DE MEME TYPE.
  96. *
  97. * AUTEUR, DATE DE CREATION:
  98. * -------------------------
  99. *
  100. *     PASCAL MANIGOT     19 FEVRIER 1985
  101. *     Lionel VIVAN       12 juin 1991, ajout du mot clé ANTI
  102. *     Michel BULIK       29 novembre 1995, ajout du mot clé QUEL
  103. *     Stephane Gounand   08 mai 2011, ajout de la syntaxe MANU RIGI
  104. *                        CHPO1 permettant de créer une rigidité
  105. *                        diagonale
  106. *     Benoit Prabel      16 fevrier 2012 : ajout des options COLOnnes
  107. *                        et LIGNes pour la syntaxe avec un chpoint
  108. *                        + possibilité rigidité vide
  109. *     Benoit Prabel      02/07/2014 : ajout de la lecture d'un LISTCHPO
  110. *
  111. * LANGAGE:
  112. * --------
  113. *
  114. *     ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS
  115. *
  116. ************************************************************************
  117. *
  118.       IMPLICIT INTEGER(I-N)
  119. -INC PPARAM
  120. -INC CCOPTIO
  121. -INC SMRIGID
  122. C+PP
  123. -INC SMTABLE
  124.       CHARACTER*8 TYPOBJ,CH0,CH1
  125.       REAL*8 X0,X1
  126.       INTEGER I1
  127.       LOGICAL L0,L1
  128. C+PP
  129. *
  130.       SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
  131.       SEGMENT /MTEMP4/ (ILREEL(0))
  132. *
  133.       PARAMETER (INFINI = 9999)
  134. *
  135.       CHARACTER*8 LETYPE,CTYP
  136.       CHARACTER*4 MODUA(1),MOTYP(2),MOMOT(1)
  137.       CHARACTER*4 MOCLE(3)
  138. *
  139.       DATA MODUA(1) /'DUAL'/
  140.       DATA MOTYP(1),MOTYP(2) /'ANTI','QUEL'/
  141.       DATA MOMOT(1) /'TYPE'/
  142.       DATA MOCLE(1),MOCLE(2),MOCLE(3) /'DIAG','COLO','LIGN'/
  143. C
  144. c
  145. C=== Syntaxe b : Rig1 = MANU RIGI (mocle) CHPO1 (...) ====================
  146. c
  147. *
  148. *     -- LECTURE EVENTUELLE DU MOT CLE : DIAG ou COLO ou LIGN ... --
  149. *
  150.       ICLE = 0
  151.       CALL LIRMOT(MOCLE,3,ICLE,0)
  152.       if(iimpi.ge.1) write(IOIMP,*) 'ICLE=',ICLE
  153. *
  154. *     -- LECTURE DU CHPOINT ? --
  155. *
  156.       IF (ICLE.NE.0) THEN
  157. c       cas ou on a lu DIAG, COLO ou LIGN
  158.         CALL LIROBJ('CHPOINT ',MCHPOI,1,IRET)
  159.         IF (IERR.NE.0) RETURN
  160.       ELSE
  161. c       si aucun mot clé, ...
  162. c       ... mais présence d'un chpoint, option DIAG par défaut
  163.         CALL QUETYP(CTYP,0,IRETOU)
  164.         IF (IRETOU.EQ.0) THEN
  165. c            CALL ERREUR(533)
  166. c          si rien du tout, CREATION D'UNE RIGIDITE VIDE
  167.            NRIGEL=0
  168.            segini,MRIGID
  169.            IPRIGI=MRIGID
  170.            MTYMAT='MANUELLE'
  171.            IFORIG = IFOUR
  172.            ICHOLE = 0
  173.            IMGEO1 = 0
  174.            IMGEO2 = 0
  175.            IFORIG = 0
  176. c          ISUPEQ,JRCOND,JRDEPP,JRDEPD = 0
  177. c          JRELIM,JRGARD,JRTOT,IMLAG = 0
  178. c          IPROFO,IVECRI = 0
  179.            segdes,MRIGID
  180.            CALL ECROBJ ('RIGIDITE',IPRIGI)
  181.            RETURN
  182.         ENDIF
  183.         IF(CTYP.EQ.'CHPOINT ') THEN
  184.           ICLE = 1
  185.           CALL LIROBJ(CTYP,MCHPOI,1,IRET)
  186.           IF (IERR.NE.0) RETURN
  187.         ENDIF
  188. c       ... mais présence d'un listchpo, matrice colonne pleine
  189.         IF(CTYP.EQ.'LISTCHPO') THEN
  190.           ICLE = 4
  191.           CALL LIROBJ(CTYP,MLCHPO,1,IRET)
  192.           IF (IERR.NE.0) RETURN
  193. c         lit-on une rigidite "modele" avec un mvecri ?
  194.           CALL LIROBJ('RIGIDITE',IPRIG1,0,IRET)
  195.           IF (IERR.NE.0) RETURN
  196.           IF(IRET.NE.0) THEN
  197.             MRIGID=IPRIG1
  198.             SEGACT,MRIGID
  199.             if(IVECRI.eq.0) then
  200.             write(ioimp,*) 'pour l instant, IVECRI doit etre non nul !'
  201.             call erreur(21)
  202.             endif
  203.             IVEC1 = IVECRI
  204.             SEGDES,MRIGID
  205.           ELSE
  206. c           lit-on un maillage de POI1 support des chpoints
  207. c           (de composante ALFA seulement)?
  208.             CALL LIROBJ('MAILLAGE',IPT1,0,IRET)
  209.             ICLE = 5
  210.           ENDIF
  211.         ENDIF
  212.       ENDIF
  213. *
  214. *     -- CREATION RIGIDITE DEPUIS UN CHPOINT (ou une listchpo) --
  215. *
  216.       IF (ICLE.NE.0) THEN
  217.          IF (ICLE.eq.1) THEN
  218. c          rigidite diagonale
  219.            CALL KOPDIR(MCHPOI,MRIGID)
  220.          ELSEIF (ICLE.le.3) THEN
  221. c          rigidite colonne ou ligne
  222.            CALL RICOLO(MCHPOI,ICLE,MRIGID)
  223.          ELSEIF (ICLE.eq.4) THEN
  224. c          rigidite colonne pleine depuis une listchpo
  225.            CALL RICOL2(MLCHPO,ICLE,MRIGID,IVEC1)
  226.          ELSEIF (ICLE.eq.5) THEN
  227. c          rigidite colonne pleine depuis une listchpo
  228.            CALL RICOL1(MLCHPO,ICLE,MRIGID,IPT1)
  229.          ELSE
  230.            CALL ERREUR(19)
  231.          ENDIF
  232.          IF (IERR.NE.0) RETURN
  233.          CALL ECROBJ('RIGIDITE',MRIGID)
  234.          RETURN
  235.       ENDIF
  236. c
  237. c
  238. C=== Syntaxe a : Rig1 = MANU RIGI (TYPE mot1) GEO1 LMOT1 (...) LREEL1 ====
  239. c
  240. *
  241. *     -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  242. *
  243.       ITYP = 0
  244.       CALL LIRMOT(MOMOT,1,ITYP,0)
  245.       IF(ITYP.EQ.1) THEN
  246.          ICODE = 1
  247.          CALL LIRCHA (LETYPE,ICODE,IRETOU)
  248.          IF (IERR .NE. 0) RETURN
  249.       ELSE
  250. C ... Si on n'a rien trouvé, on met les blancs dedans,
  251. C     sinon il y a des cochonneries ...
  252.          LETYPE='        '
  253.       ENDIF
  254. *
  255. *     -- LECTURE DU SUPPORT GEOMETRIQUE --
  256. *
  257.       CALL LIROBJ('POINT   ',KPOINT,0,IRETOU)
  258.       IF(IRETOU.NE.0) THEN
  259.          CALL CRELEM(KPOINT)
  260.          IPELEM=KPOINT
  261.       ELSE
  262.          ICODE = 1
  263.          CALL LIROBJ ('MAILLAGE',IPELEM,ICODE,IRETOU)
  264.          IF (IERR .NE. 0) RETURN
  265.       ENDIF
  266. *
  267. *     -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  268. *     COMPOSANTES DES NOEUDS D'UN ELEMENT DU SUPPORT GEOMETRIQUE --
  269. *
  270.       SEGINI,MTEMP3
  271.       IINCO=MTEMP3
  272. C+PP
  273.       CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  274.       IF (IRETOU.EQ.1)THEN
  275.         DO IE1=1,INFINI
  276.           TYPOBJ=' '
  277.           CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  278.      $                        TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  279.           IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  280.             ILMOTS(**) = IPLMOT
  281.           ELSE
  282.             IF (IE1 .EQ. 1)THEN
  283.               CALL ERREUR(314)
  284.               SEGSUP MTEMP3
  285.               RETURN
  286.             ENDIF
  287. *           --> SORTIE DE BOUCLE N.100
  288.             GOTO 102
  289.           ENDIF
  290.         ENDDO
  291.       ENDIF
  292. C+PP
  293.       ICODE = 1
  294.       DO 100 IB100=1,INFINI
  295.          CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  296.          IF(IERR.NE.0) THEN
  297.             SEGSUP MTEMP3
  298.             RETURN
  299.          ENDIF
  300.          IF (IRETOU .EQ. 1) THEN
  301.             ILMOTS(**) = IPLMOT
  302.          ELSE
  303. *           --> SORTIE DE BOUCLE N.100
  304.             GOTO 102
  305.          END IF
  306.          ICODE = 0
  307.   100    CONTINUE
  308. *     END DO
  309.   102 CONTINUE
  310.       SEGDES,MTEMP3
  311. *
  312. *     -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  313. *     DUALES
  314. *
  315.       IDUAL=0
  316.       CALL LIRMOT(MODUA,1,IDU,0)
  317.       IF (IDU.EQ.0) GOTO 400
  318.       SEGINI,MTEM3
  319. C+PP
  320.       CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  321.       IF (IRETOU.EQ.1)THEN
  322.         DO IE1=1,INFINI
  323.           TYPOBJ=' '
  324.           CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  325.      $                        TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  326.           IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  327.             MTEM3.ILMOTS(**) = IPLMOT
  328.           ELSE
  329.             IF (IE1 .EQ. 1)THEN
  330.               CALL ERREUR(314)
  331.               SEGSUP MTEMP3,MTEM3
  332.               RETURN
  333.             ENDIF
  334.             GOTO 302
  335.           ENDIF
  336.         ENDDO
  337.       ENDIF
  338. C+PP
  339.       ICODE = 1
  340.       DO 300 IB300=1,INFINI
  341.          CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  342.          IF(IERR.NE.0) THEN
  343.             SEGSUP MTEMP3,MTEM3
  344.             RETURN
  345.          ENDIF
  346.          IF (IRETOU .EQ. 1) THEN
  347.             MTEM3.ILMOTS(**) = IPLMOT
  348.          ELSE
  349.             GOTO 302
  350.          END IF
  351.          ICODE = 0
  352.   300 CONTINUE
  353.   302 CONTINUE
  354.  
  355.       SEGACT MTEMP3
  356.       IF (ILMOTS(/1).NE.MTEM3.ILMOTS(/1)) THEN
  357.          SEGSUP MTEMP3
  358.          SEGSUP MTEM3
  359.          CALL ERREUR(730)
  360.          RETURN
  361.       ENDIF
  362.       IDUAL=MTEM3
  363.       SEGDES MTEM3
  364.       SEGDES MTEMP3
  365. *
  366. *     Lecture du mot clé 'ANTI' ou 'QUEL'
  367. *
  368.  400  CONTINUE
  369.       IAN = 0
  370.       CALL LIRMOT(MOTYP,2,IAN,0)
  371.       IANTI = IAN
  372. *
  373. *     -- LECTURE DU (OU DES) "LISTREEL" CONTENANT LA MATRICE
  374. *     ELEMENTAIRE DE RIGIDITE --
  375. *
  376.  500  CONTINUE
  377.       SEGINI,MTEMP4
  378.       ICODE = 1
  379.       DO 200 IB200=1,INFINI
  380.          CALL LIROBJ ('LISTREEL',IPLREE,ICODE,IRETOU)
  381.          IF(IERR.NE.0) THEN
  382.             SEGSUP MTEMP3,MTEM3
  383.             SEGSUP MTEMP4
  384.             RETURN
  385.          ENDIF
  386.          IF (IRETOU .EQ. 1) THEN
  387.             ILREEL(**) = IPLREE
  388.          ELSE
  389. *           --> SORTIE DE BOUCLE N.200
  390.             GOTO 202
  391.          END IF
  392.          ICODE = 0
  393.   200 CONTINUE
  394. *     END DO
  395.   202 CONTINUE
  396.       SEGDES,MTEMP4
  397. *
  398. *     -- CREATION DE LA "RIGIDITE" --
  399. *
  400.       CALL MANUR1 (LETYPE,IPELEM,IINCO,IDUAL,MTEMP4,IPRIGI,IANTI)
  401.       IF (IERR .NE. 0) RETURN
  402. *
  403. *     SUPPRESSION DES SEGMENTS DE TRAVAIL:
  404.       MTEMP3=IINCO
  405.       SEGSUP MTEMP3
  406.       IF (IDUAL.NE.0) THEN
  407.          MTEMP3=IDUAL
  408.          SEGSUP MTEMP3
  409.       ENDIF
  410.       SEGSUP,MTEMP4
  411. *
  412.       CALL ECROBJ ('RIGIDITE',IPRIGI)
  413. *
  414.       END
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  

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