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    CB215821  25/04/23    21:15:29     12247          
  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. -INC SMCOORD
  123. C+PP
  124. -INC SMTABLE
  125.       CHARACTER*8 TYPOBJ,CH0,CH1
  126.       REAL*8 X0,X1
  127.       INTEGER I1
  128.       LOGICAL L0,L1
  129. C+PP
  130. *
  131.       SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
  132.       SEGMENT /MTEMP4/ (ILREEL(0))
  133. *
  134.       PARAMETER (INFINI = 9999)
  135. *
  136.       CHARACTER*8 LETYPE,CTYP
  137.       CHARACTER*4 MODUA(1),MOTYP(2),MOMOT(1)
  138.       CHARACTER*4 MOCLE(3)
  139. *
  140.       DATA MODUA(1) /'DUAL'/
  141.       DATA MOTYP(1),MOTYP(2) /'ANTI','QUEL'/
  142.       DATA MOMOT(1) /'TYPE'/
  143.       DATA MOCLE(1),MOCLE(2),MOCLE(3) /'DIAG','COLO','LIGN'/
  144. C
  145. c
  146. C=== Syntaxe b : Rig1 = MANU RIGI (mocle) CHPO1 (...) ====================
  147. c
  148. *
  149. *     -- LECTURE EVENTUELLE DU MOT CLE : DIAG ou COLO ou LIGN ... --
  150. *
  151.       ICLE = 0
  152.       CALL LIRMOT(MOCLE,3,ICLE,0)
  153.       if(iimpi.ge.1) write(IOIMP,*) 'ICLE=',ICLE
  154. *
  155. *     -- LECTURE DU CHPOINT ? --
  156. *
  157.       IF (ICLE.NE.0) THEN
  158. c       cas ou on a lu DIAG, COLO ou LIGN
  159.         CALL LIROBJ('CHPOINT ',MCHPOI,1,IRET)
  160.         IF (IERR.NE.0) RETURN
  161.       ELSE
  162. c       si aucun mot clé, ...
  163. c       ... mais présence d'un chpoint, option DIAG par défaut
  164.         CALL QUETYP(CTYP,0,IRETOU)
  165.         IF (IRETOU.EQ.0) THEN
  166. c            CALL ERREUR(533)
  167. c          si rien du tout, CREATION D'UNE RIGIDITE VIDE
  168.            NRIGEL=0
  169.            segini,MRIGID
  170.            IPRIGI=MRIGID
  171.            MTYMAT='MANUELLE'
  172.            IFORIG = IFOUR
  173.            ICHOLE = 0
  174.            IMGEO1 = 0
  175.            IMGEO2 = 0
  176.            IFORIG = 0
  177. c          ISUPEQ,JRCOND,JRDEPP,JRDEPD = 0
  178. c          JRELIM,JRGARD,JRTOT,IMLAG = 0
  179. c          IPROFO,IVECRI = 0
  180.            segdes,MRIGID
  181.            CALL ECROBJ ('RIGIDITE',IPRIGI)
  182.            RETURN
  183.         ENDIF
  184.         IF(CTYP.EQ.'CHPOINT ') THEN
  185.           ICLE = 1
  186.           CALL LIROBJ(CTYP,MCHPOI,1,IRET)
  187.           IF (IERR.NE.0) RETURN
  188.         ENDIF
  189. c       ... mais présence d'un listchpo, matrice colonne pleine
  190.         IF(CTYP.EQ.'LISTCHPO') THEN
  191.           ICLE = 4
  192.           CALL LIROBJ(CTYP,MLCHPO,1,IRET)
  193.           IF (IERR.NE.0) RETURN
  194. c         lit-on une rigidite "modele" avec un mvecri ?
  195.           CALL LIROBJ('RIGIDITE',IPRIG1,0,IRET)
  196.           IF (IERR.NE.0) RETURN
  197.           IF(IRET.NE.0) THEN
  198.             MRIGID=IPRIG1
  199.             SEGACT,MRIGID
  200.             if(IVECRI.eq.0) then
  201.             write(ioimp,*) 'pour l instant, IVECRI doit etre non nul !'
  202.             call erreur(21)
  203.             endif
  204.             IVEC1 = IVECRI
  205.             SEGDES,MRIGID
  206.           ELSE
  207. c           lit-on un maillage de POI1 support des chpoints
  208. c           (de composante ALFA seulement)?
  209.             CALL LIROBJ('MAILLAGE',IPT1,0,IRET)
  210.             ICLE = 5
  211.           ENDIF
  212.         ENDIF
  213.       ENDIF
  214. *
  215. *     -- CREATION RIGIDITE DEPUIS UN CHPOINT (ou une listchpo) --
  216. *
  217.       IF (ICLE.NE.0) THEN
  218.          IF (ICLE.eq.1) THEN
  219. c          rigidite diagonale
  220.            CALL KOPDIR(MCHPOI,MRIGID)
  221.          ELSEIF (ICLE.le.3) THEN
  222. c          rigidite colonne ou ligne
  223.            CALL RICOLO(MCHPOI,ICLE,MRIGID)
  224.          ELSEIF (ICLE.eq.4) THEN
  225. c          rigidite colonne pleine depuis une listchpo
  226.            CALL RICOL2(MLCHPO,ICLE,MRIGID,IVEC1)
  227.          ELSEIF (ICLE.eq.5) THEN
  228. c          rigidite colonne pleine depuis une listchpo
  229.            CALL RICOL1(MLCHPO,ICLE,MRIGID,IPT1)
  230.          ELSE
  231.            CALL ERREUR(19)
  232.          ENDIF
  233.          IF (IERR.NE.0) RETURN
  234.          CALL ECROBJ('RIGIDITE',MRIGID)
  235.          RETURN
  236.       ENDIF
  237. c
  238. c
  239. C=== Syntaxe a : Rig1 = MANU RIGI (TYPE mot1) GEO1 LMOT1 (...) LREEL1 ====
  240. c
  241. *
  242. *     -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  243. *
  244.       ITYP = 0
  245.       CALL LIRMOT(MOMOT,1,ITYP,0)
  246.       IF(ITYP.EQ.1) THEN
  247.          ICODE = 1
  248.          CALL LIRCHA (LETYPE,ICODE,IRETOU)
  249.          IF (IERR .NE. 0) RETURN
  250.       ELSE
  251. C ... Si on n'a rien trouvé, on met les blancs dedans,
  252. C     sinon il y a des cochonneries ...
  253.          LETYPE='        '
  254.       ENDIF
  255. *
  256. *     -- LECTURE DU SUPPORT GEOMETRIQUE --
  257. *
  258.       CALL LIROBJ('POINT   ',KPOINT,0,IRETOU)
  259.       IF(IRETOU.NE.0) THEN
  260.          CALL CRELEM(KPOINT)
  261.          IPELEM=KPOINT
  262.       ELSE
  263.          ICODE = 1
  264.          CALL LIROBJ ('MAILLAGE',IPELEM,ICODE,IRETOU)
  265.          IF (IERR .NE. 0) RETURN
  266.       ENDIF
  267. *
  268. *     -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  269. *     COMPOSANTES DES NOEUDS D'UN ELEMENT DU SUPPORT GEOMETRIQUE --
  270. *
  271.       SEGINI,MTEMP3
  272.       IINCO=MTEMP3
  273. C+PP
  274.       CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  275.       IF (IRETOU.EQ.1)THEN
  276.         DO IE1=1,INFINI
  277.           TYPOBJ=' '
  278.           CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  279.      $                        TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  280.           IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  281.             ILMOTS(**) = IPLMOT
  282.           ELSE
  283.             IF (IE1 .EQ. 1)THEN
  284.               CALL ERREUR(314)
  285.               SEGSUP MTEMP3
  286.               RETURN
  287.             ENDIF
  288. *           --> SORTIE DE BOUCLE N.100
  289.             GOTO 102
  290.           ENDIF
  291.         ENDDO
  292.       ENDIF
  293. C+PP
  294.       ICODE = 1
  295.       DO 100 IB100=1,INFINI
  296.          CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  297.          IF(IERR.NE.0) THEN
  298.             SEGSUP MTEMP3
  299.             RETURN
  300.          ENDIF
  301.          IF (IRETOU .EQ. 1) THEN
  302.             ILMOTS(**) = IPLMOT
  303.          ELSE
  304. *           --> SORTIE DE BOUCLE N.100
  305.             GOTO 102
  306.          END IF
  307.          ICODE = 0
  308.   100    CONTINUE
  309. *     END DO
  310.   102 CONTINUE
  311.       SEGDES,MTEMP3
  312. *
  313. *     -- LECTURE DU (OU DES) "LISTMOTS" CONTENANT LES NOMS DES
  314. *     DUALES
  315. *
  316.       IDUAL=0
  317.       CALL LIRMOT(MODUA,1,IDU,0)
  318.       IF (IDU.EQ.0) GOTO 400
  319.       SEGINI,MTEM3
  320. C+PP
  321.       CALL LIROBJ ('TABLE',MTABLE,0,IRETOU)
  322.       IF (IRETOU.EQ.1)THEN
  323.         DO IE1=1,INFINI
  324.           TYPOBJ=' '
  325.           CALL ACCTAB(MTABLE,'ENTIER',IE1,X0,CH0,L0,IOBIN,
  326.      $                        TYPOBJ ,I1 ,X1,CH1,L1,IPLMOT)
  327.           IF (TYPOBJ .EQ. 'LISTMOTS')THEN
  328.             MTEM3.ILMOTS(**) = IPLMOT
  329.           ELSE
  330.             IF (IE1 .EQ. 1)THEN
  331.               CALL ERREUR(314)
  332.               SEGSUP MTEMP3,MTEM3
  333.               RETURN
  334.             ENDIF
  335.             GOTO 302
  336.           ENDIF
  337.         ENDDO
  338.       ENDIF
  339. C+PP
  340.       ICODE = 1
  341.       DO 300 IB300=1,INFINI
  342.          CALL LIROBJ ('LISTMOTS',IPLMOT,ICODE,IRETOU)
  343.          IF(IERR.NE.0) THEN
  344.             SEGSUP MTEMP3,MTEM3
  345.             RETURN
  346.          ENDIF
  347.          IF (IRETOU .EQ. 1) THEN
  348.             MTEM3.ILMOTS(**) = IPLMOT
  349.          ELSE
  350.             GOTO 302
  351.          END IF
  352.          ICODE = 0
  353.   300 CONTINUE
  354.   302 CONTINUE
  355.  
  356.       SEGACT MTEMP3
  357.       IF (ILMOTS(/1).NE.MTEM3.ILMOTS(/1)) THEN
  358.          SEGSUP MTEMP3
  359.          SEGSUP MTEM3
  360.          CALL ERREUR(730)
  361.          RETURN
  362.       ENDIF
  363.       IDUAL=MTEM3
  364.       SEGDES MTEM3
  365.       SEGDES MTEMP3
  366. *
  367. *     Lecture du mot clé 'ANTI' ou 'QUEL'
  368. *
  369.  400  CONTINUE
  370.       IAN = 0
  371.       CALL LIRMOT(MOTYP,2,IAN,0)
  372.       IANTI = IAN
  373. *
  374. *     -- LECTURE DU (OU DES) "LISTREEL" CONTENANT LA MATRICE
  375. *     ELEMENTAIRE DE RIGIDITE --
  376. *
  377.  500  CONTINUE
  378.       SEGINI,MTEMP4
  379.       ICODE = 1
  380.       DO 200 IB200=1,INFINI
  381.          CALL LIROBJ ('LISTREEL',IPLREE,ICODE,IRETOU)
  382.          IF(IERR.NE.0) THEN
  383.             SEGSUP MTEMP3,MTEM3
  384.             SEGSUP MTEMP4
  385.             RETURN
  386.          ENDIF
  387.          IF (IRETOU .EQ. 1) THEN
  388.             ILREEL(**) = IPLREE
  389.          ELSE
  390. *           --> SORTIE DE BOUCLE N.200
  391.             GOTO 202
  392.          END IF
  393.          ICODE = 0
  394.   200 CONTINUE
  395. *     END DO
  396.   202 CONTINUE
  397.       SEGDES,MTEMP4
  398. *
  399. *     -- CREATION DE LA "RIGIDITE" --
  400. *
  401.       CALL MANUR1 (LETYPE,IPELEM,IINCO,IDUAL,MTEMP4,IPRIGI,IANTI)
  402.       IF (IERR .NE. 0) RETURN
  403. *
  404. *     SUPPRESSION DES SEGMENTS DE TRAVAIL:
  405.       MTEMP3=IINCO
  406.       SEGSUP MTEMP3
  407.       IF (IDUAL.NE.0) THEN
  408.          MTEMP3=IDUAL
  409.          SEGSUP MTEMP3
  410.       ENDIF
  411.       SEGSUP,MTEMP4
  412. *
  413.       CALL ECROBJ ('RIGIDITE',IPRIGI)
  414. *
  415.       END
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  

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