Télécharger la plaquette Cast3M


fr en

Télécharger manur3.eso

Retour à la liste

Numérotation des lignes : 

manur3

  1. C MANUR3    SOURCE    BP208322  15/06/22    21:20:28     8543
  2.       SUBROUTINE MANUR3 (IPELEM,IINCO,IDUAL,IPDESC)
  3. ************************************************************************
  4. *
  5. *                             M A N U R 3
  6. *                             -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. *     CONSTRUCTION DU DESCRIPTEUR D'UN OBJET 'RIGIDITE' CREE
  12. *     MANUELLEMENT.
  13. *     L'UTILISATION DE CE SOUS-PROGRAMME N'EST PAS UNIVERSELLE.
  14. *
  15. * MODE D'APPEL:
  16. * -------------
  17. *
  18. *     CALL MANUR3 (IPELEM,IINCO,IDUAL,IPDESC)
  19. *
  20. * PARAMETRES:   (E)=ENTREE   (S)=SORTIE
  21. * -----------
  22. *
  23. *     IPELEM  ENTIER    (E)  POINTEUR DE L'OBJET 'MAILLAGE' SUR LEQUEL
  24. *                            VA S'APPUYER LA 'RIGIDITE'.
  25. *     IINCO   SEGMENT   (E)  REGROUPEMENT DE POINTEURS SUR DES
  26. *                            'LISTMOTS'.
  27. *                            SOIT IL N'Y A QU'1 'LISTMOTS', QUI CONTIENT
  28. *                            LES NOMS DES COMPOSANTES POUR UN NOEUD D'UN
  29. *                            ELEMENT DE L'OBJET DE POINTEUR "IPELEM",
  30. *                            SOIT IL Y A AUTANT DE 'LISTMOTS' QUE DE
  31. *                            NOEUDS PAR ELEMENT ET LE N-IEME 'LISTMOTS'
  32. *                            CONTIENT LES NOMS DES COMPOSANTES POUR LE
  33. *                            N-IEME NOEUD D'UN ELEMENT.
  34. *     IDUAL   SEGMENT   (E)  IDEM POUR LES DUALES
  35. *     IPDESC  ENTIER    (S)  POINTEUR SUR LE SEGMENT DESCRIPTEUR DE
  36. *                            L'OBJET 'RIGIDITE'.
  37. *
  38. * LEXIQUE: (ORDRE ALPHABETIQUE)
  39. * --------
  40. *
  41. *     MTEM3   SEGMENT   REGROUPEMENT DE POINTEURS SUR DES 'LISTMOTS'.
  42. *                       MEME ORGANISATION QUE "MTEMP3", MAIS LES
  43. *                       'LISTMOTS' CONTIENNENT LES NOMS DES INCONNUES
  44. *                       DUALES.
  45. *     NBCOMP  ENTIER    NOMBRE DE COMPOSANTES POUR UN NOEUD D'ELEMENT.
  46. *     NBLMOT  ENTIER    NOMBRE DE 'LISTMOTS' REFERENCES PAR "MTEMP3".
  47. *     NBMOTT  ENTIER    NOMBRE TOTAL DE NOMS DE COMPOSANTES DONNES.
  48. *
  49. *     LES AUTRES VARIABLES IMPORTANTES SONT EXPLIQUEES DANS LES MODULES
  50. *     INCLUS.
  51. *
  52. * SOUS-PROGRAMMES APPELES:
  53. * ------------------------
  54. *
  55. *     ERREUR.
  56. *
  57. * AUTEUR, DATE DE CREATION:
  58. * -------------------------
  59. *
  60. *     PASCAL MANIGOT     19 FEVRIER 1985
  61. *
  62. * LANGAGE:
  63. * --------
  64. *
  65. *     ESOPE + FORTRAN77 + EXTENSION: CARACTERES MIS DANS DES ENTIERS.
  66. *
  67. ************************************************************************
  68. *
  69.       IMPLICIT INTEGER(I-N)
  70.  
  71. -INC PPARAM
  72. -INC CCOPTIO
  73. -INC CCHAMP
  74. -INC SMELEME
  75. -INC SMLMOTS
  76. -INC SMRIGID
  77. *
  78.       SEGMENT /MTEMP3/ (ILMOTS(0)),MTEM3.MTEMP3
  79. *
  80.       LOGICAL BADNAM
  81. *
  82. *
  83. *
  84. *     -- VERIFICATION DES NOMS DE COMPOSANTES DONNES ET ENREGISTREMENT
  85. *     DES COMPOSANTES DUALES --
  86. *
  87.       MTEMP3=IINCO
  88.       SEGACT,MTEMP3
  89.       NBLMOT = ILMOTS(/1)
  90. *
  91. *     ON N'A PAS DONNE LES NOMS DES DUALES
  92. *     ON CHERCHE DANS NOMDD
  93. *
  94.       IF (IDUAL.EQ.0) THEN
  95.          SEGINI,MTEM3=MTEMP3
  96. *
  97.          NBMOTT = 0
  98.          DO 100 IB100=1,NBLMOT
  99. *
  100.             MLMOTS = ILMOTS(IB100)
  101.             SEGACT,MLMOTS
  102.             NBMOTS = MOTS(/2)
  103.             NBMOTT = NBMOTT + NBMOTS
  104.             SEGINI,MLMOT1=MLMOTS
  105.             MTEM3.ILMOTS(IB100) = MLMOT1
  106. *
  107.             DO 110 IB110=1,NBMOTS
  108. *
  109.                BADNAM = .TRUE.
  110.                DO 120 IB120=1,LNOMDD
  111.                   IF (MOTS(IB110) .EQ. NOMDD(IB120) ) THEN
  112.                      MLMOT1.MOTS(IB110) = NOMDU(IB120)
  113.                      BADNAM = .FALSE.
  114. *                    --> SORTIE DE BOUCLE N.120
  115.                      GOTO 122
  116.                   END IF
  117.   120             CONTINUE
  118. *              END DO
  119.   122          CONTINUE
  120. *
  121.                IF (BADNAM) THEN
  122.                   MOTERR(1:4) = MOTS(IB110)
  123.                   NUMERR = 197
  124.                   CALL ERREUR (NUMERR)
  125.                   RETURN
  126.                END IF
  127. *
  128.   110          CONTINUE
  129. *           END DO
  130. *
  131.             SEGDES,MLMOTS
  132.             SEGDES,MLMOT1
  133. *
  134.   100       CONTINUE
  135. *        END DO
  136. *
  137. *     ON A DONNE LES NOMS DES DUALES
  138. *     ON NE FAIT AUCUNE VERIF SUR LES NOMS
  139. *
  140.       ELSE
  141.  
  142.          MTEM3=IDUAL
  143.          SEGACT MTEM3
  144. *
  145.          NBMOTT=0
  146.          DO 200 IB200=1,NBLMOT
  147.             MLMOTS = ILMOTS(IB200)
  148.             SEGACT,MLMOTS
  149.             MLMOT1 = MTEM3.ILMOTS(IB200)
  150.             SEGACT MLMOT1
  151.             NBMOTS = MOTS(/2)
  152.             IF (NBMOTS.NE.MLMOT1.MOTS(/2)) THEN
  153.                    CALL ERREUR(217)
  154.                    RETURN
  155.             ENDIF
  156.             NBMOTT = NBMOTT + NBMOTS
  157.             SEGDES MLMOTS
  158.             SEGDES MLMOT1
  159.   200    CONTINUE
  160.  
  161.       ENDIF
  162. *
  163. *     -- REMPLISSAGE DU DESCRIPTEUR DE L'OBJET "RIGIDITE" --
  164. *
  165.       MELEME = IPELEM
  166.       SEGACT,MELEME
  167.       NBNN = NUM(/1)
  168.       SEGDES,MELEME
  169. *
  170.       IF (NBLMOT .EQ. 1) THEN
  171. *
  172.          NLIGRP= NBMOTT * NBNN
  173.          NLIGRD=NBMOTT * NBNN
  174.          SEGINI,DESCR
  175.          MLMOTS = ILMOTS(1)
  176.          SEGACT,MLMOTS
  177.          MLMOT1 = MTEM3.ILMOTS(1)
  178.          SEGACT,MLMOT1
  179.          NBCOMP = NBMOTT
  180. *
  181.          DO 500 IB500=1,NBNN
  182.             ICONST = (IB500 - 1) * NBCOMP
  183.             DO 510 IB510=1,NBCOMP
  184.                III = IB510 + ICONST
  185.                NOELEP(III) = IB500
  186.                NOELED(III) = IB500
  187.                LISINC(III) = MOTS(IB510)
  188.                LISDUA(III) = MLMOT1.MOTS(IB510)
  189.   510          CONTINUE
  190. *           END DO
  191.   500       CONTINUE
  192. *        END DO
  193. *
  194.          SEGDES,MLMOTS
  195. *
  196.       ELSE IF (NBLMOT .GT. 1) THEN
  197. *
  198.          IF (NBLMOT .NE. NBNN) THEN
  199.             NUMERR = 198
  200.             CALL ERREUR (NUMERR)
  201.             RETURN
  202.          END IF
  203. *
  204.          NLIGRP = NBMOTT
  205.          NLIGRD=NBMOTT
  206.          SEGINI,DESCR
  207. *
  208.          ICONST = 0
  209.          DO 550 IB550=1,NBNN
  210. *
  211.             MLMOTS = ILMOTS(IB550)
  212.             SEGACT,MLMOTS
  213.             MLMOT1 = MTEM3.ILMOTS(IB550)
  214.             SEGACT,MLMOT1
  215.             NBCOMP = MOTS(/2)
  216. *
  217.             DO 570 IB570=1,NBCOMP
  218.                III = IB570 + ICONST
  219.                NOELEP(III) = IB550
  220.                NOELED(III) = IB550
  221.                LISINC(III) = MOTS(IB570)
  222.                LISDUA(III) = MLMOT1.MOTS(IB570)
  223.   570          CONTINUE
  224. *           END DO
  225. *
  226.             ICONST = ICONST + NBCOMP
  227. *
  228.             SEGDES,MLMOTS
  229. *
  230.   550       CONTINUE
  231. *        END DO
  232. *
  233.       ELSE
  234. *
  235. *        IL N'A PAS ETE FOURNI DE 'LISTMOTS':
  236.          MOTERR(1:8) = 'LISTMOTS'
  237.          NUMERR = 37
  238.          CALL ERREUR (NUMERR)
  239.          RETURN
  240. *
  241.       END IF
  242. *
  243.       IPDESC = DESCR
  244.       SEGDES,DESCR
  245.       SEGDES,MTEMP3
  246.       IF (IDUAL.EQ.0) THEN
  247.          SEGSUP MTEM3
  248.       ELSE
  249.          SEGDES MTEM3
  250.       ENDIF
  251. *
  252.       END
  253.  
  254.  
  255.  
  256.  
  257.  
  258.  
  259.  
  260.  
  261.  
  262.  
  263.  

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