Télécharger la plaquette Cast3M


fr en

Télécharger manuci.eso

Retour à la liste

Numérotation des lignes : 

  1. C MANUCI    SOURCE    CB215821  17/01/16    21:16:15     9279           
  2.       SUBROUTINE MANUCI(IPMODL,MOT1,MOT2,IEN1,IEN2,IEN3,XFLO, IPRES)
  3. *______________________________________________________________________
  4. *
  5. *         Donne une valeur en 1 point pour un MCHAML
  6. *                     Appele par MANUCE
  7. *
  8. *
  9. *   Entrees :
  10. *   ---------
  11. *
  12. *     IPMODL  Pointeur sur un MMODEL
  13. *     MOT1    Mot indiquant le type du MCHAML a creer
  14. *     MOT2    Nom de la composante concernee
  15. *     IEN1    Numero de l'element
  16. *     ENT2    Numero du point de gauss
  17. *     ENT3    Numero de la sous zone concernee
  18. *             (vaut 1 par defaut - cf. MANUCE)
  19. *     XFLO   Flottant ( Valeur de la composante MOT2 )
  20. *
  21. *
  22. *   Sortie :
  23. *   --------
  24. *
  25. *      IPRES  Pointeur sur le MCHAML resultat (=0 si erreur)
  26. *
  27. *   EBERSOLT     JANVIER 86
  28. *
  29. *   Passage aux nouveaux MCHAMLs par JM CAMPENON le 06/91
  30. *
  31. *______________________________________________________________________
  32. *
  33.       IMPLICIT INTEGER(I-N)
  34.       IMPLICIT REAL*8(A-H,O-Z)
  35. *
  36. -INC SMMODEL
  37. -INC SMCHAML
  38. -INC SMELEME
  39. -INC SMINTE
  40. -INC CCOPTIO
  41. *
  42.       CHARACTER*(*) MOT1, MOT2
  43. *
  44.       SEGMENT INFO
  45.        INTEGER INFELL(JG)
  46.       ENDSEGMENT
  47. *
  48.       PARAMETER (NMOT=22)
  49.       CHARACTER*8 LISMOT(NMOT)
  50.       CHARACTER*50 LISTIT(NMOT)
  51.       INTEGER MSUPPO(NMOT)
  52.       LOGICAL LSUPNO
  53. *
  54.       EXTERNAL LONG
  55. *
  56.       DATA LISMOT / 'NOEUD   ', 'GRAVITE ', 'RIGIDITE', 'MASSE   ',
  57.      1              'STRESSES', 'DEPLACEM', 'FORCES  ', 'REACTUAL',
  58.      1              'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  59.      1              'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  60.      1              'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  61.      1              'GRAFLEXI', 'VONMISES'/
  62. *
  63. *    LES MATERIAU ET CARACTERISTIQUE SONT MIS AUX NOEUDS
  64. *
  65. *                   'NOEUD   ', 'GRAVITE ', 'RIGIDITE', 'MASSE   ',
  66.       DATA MSUPPO /      0    ,     2     ,      3    ,     4     ,
  67. *                   'STRESSES', 'DEPLACEM', 'FORCES  ', 'REACTUAL',
  68.      1                   5    ,     0     ,      0    ,     0     ,
  69. *                   'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  70.      1                   3    ,     5     ,      5    ,     5     ,
  71. *                   'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  72.      1                   0    ,     0     ,      5    ,     5     ,
  73. *                   'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  74.      1                   3    ,     5     ,      5    ,     5     ,
  75. *                   'GRAFLEXI', 'VONMISES'/
  76.      1                   5    ,     5     /
  77. *
  78.       DATA LISTIT / 'NOEUD', 'GRAVITE', 'RIGIDITE', 'MASSE',
  79.      1              'STRESSES', 'DEPLACEMENTS',   'FORCES',
  80.      1              'REACTUALISATION',      'FORCES VOLUMIQUES',
  81.      1              'GRADIENT', 'CONTRAINTES', 'DEFORMATIONS',
  82.      1              'CARACTERISTIQUES', 'CARACTERISTIQUES',
  83.      1              'TEMPERATURES', 'CONTRAINTES PRINCIPALES',
  84.      1              'MATRICE DE HOOKE', 'MATRICE DE HOOKE TANGENTE',
  85.      1              'DILATATIONS', 'VARIABLES INTERNES',
  86.      1              'GRADIENT DE FLEXION','VON MISES'/
  87. *
  88.       IPRES = 0
  89. *
  90.       NHRM=NIFOUR
  91. *
  92.       MMODEL=IPMODL
  93.       SEGACT MMODEL
  94.       NSOUS=KMODEL(/1)
  95. *
  96.       IF (IEN3.GT.NSOUS) THEN
  97.         CALL ERREUR (279)
  98.         GOTO 990
  99.       ENDIF
  100. *
  101. *     CREATION DU MCHELM
  102. *     On ne cree qu'un MCHAML a une sous zone
  103. *
  104.       CALL PLACE(LISMOT,NMOT,IPLAC,MOT1)
  105.       L1=LONG(LISTIT(IPLAC))
  106.       N1=1
  107.       IF (MSUPPO(IPLAC).EQ.0) THEN
  108.          N3=3
  109.       ELSE
  110.          N3=6
  111.       ENDIF
  112.       SEGINI MCHELM
  113.       TITCHE=LISTIT(IPLAC)(1:L1)
  114.       IFOCHE=IFOUR
  115. *
  116. *     On active la sous zone concernee
  117. *
  118.       IMODEL=KMODEL(IEN3)
  119.       SEGACT IMODEL
  120.       IF(INFMOD(/1).NE.0)  THEN
  121.          NPINT=INFMOD(1)
  122.       ELSE
  123.          NPINT = 0
  124.       ENDIF
  125.       IPMAIL=IMAMOD
  126.       MELEME=IMAMOD
  127.       MELE  =NEFMOD
  128.       MFR=NUMMFR(MELE)
  129. *
  130.       SEGACT MELEME
  131.       NBELEM=NUM(/2)
  132.       IF (MSUPPO(IPLAC).EQ.0) THEN
  133.          NBPGAU=NUM(/1)
  134.       ENDIF
  135.       SEGDES MELEME
  136. *
  137.       IMACHE(1)=IPMAIL
  138.       CONCHE(1)=CONMOD
  139.       INFCHE(1,1)=0
  140.       INFCHE(1,2)=0
  141.       INFCHE(1,3)=NHRM
  142.       IF (N3.GT.3) INFCHE(1,5)=0
  143. *
  144.       lsupno=.true.
  145.       MOCOMP=0
  146. *
  147.       IF (MSUPPO(IPLAC).NE.0) THEN
  148.            if(infmod(/1).lt.2+msuppo(iplac)) then
  149.          CALL ELQUOI(MELE,0,MSUPPO(IPLAC),IPINF,IMODEL)
  150.          IF (IERR.NE.0) GOTO 991
  151.          INFO=IPINF
  152.          MINTE=INFELL(11)
  153.          SEGSUP INFO
  154.          else
  155.          minte=infmod(2+msuppo(iplac))
  156.          endif
  157. *
  158.          SEGACT MINTE
  159.          NBPGAU=POIGAU(/1)
  160.          SEGDES MINTE
  161.       ENDIF
  162. *
  163. *     Si le numero du point de gauss ou de l'element est trop eleve
  164. *
  165.       IF(IEN2.GT.NBPGAU.OR.IEN1.GT.NBELEM) THEN
  166.          CALL ERREUR(262)
  167.          GOTO 991
  168.       ENDIF
  169. *
  170.       IF (N3.GT.3) THEN
  171.          INFCHE(1,4)=MINTE
  172.          INFCHE(1,6)=MSUPPO(IPLAC)
  173.       ENDIF
  174. *
  175. *     AIGUILLAGE SUIVANT MOT CLE
  176. *
  177.       GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2,
  178.      1      99,20,99,99) IPLAC
  179. *
  180.   99  MOTERR(1:8)='MCHAML  '
  181.       CALL ERREUR(302)
  182.       GOTO 991
  183. *
  184.    1  NBROBL=1
  185.       NBRFAC=0
  186.       SEGINI NOMID
  187.       MOCOMP=NOMID
  188.       LESOBL(1)='SCAL'
  189.       GOTO 120
  190. *
  191.    2  NBROBL=1
  192.       NBRFAC=0
  193.       SEGINI NOMID
  194.       MOCOMP=NOMID
  195.       LESOBL(1)='MAHO'
  196.       GOTO 120
  197. *
  198.    6  if(lnomid(1).ne.0) then
  199.         mocomp=lnomid(1)
  200.         lsupno=.false.
  201.         else
  202.          CALL IDPRIM(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  203.         endif
  204.       GOTO 120
  205. *
  206.    7  if(lnomid(2).ne.0) then
  207.         mocomp=lnomid(2)
  208.         lsupno=.false.
  209.         else
  210.          CALL IDDUAL(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  211.         endif
  212.       GOTO 120
  213. *
  214.   10  if(lnomid(3).ne.0) then
  215.          mocomp=lnomid(3)
  216.          lsupno=.false.
  217.         else
  218.          CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  219.         endif
  220.       GOTO 120
  221. *
  222.   11  if(lnomid(4).ne.0) then
  223.          MOCOMP=lnomid(4)
  224.          lsupno=.false.
  225.         else
  226.         CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  227.         endif
  228.       GOTO 120
  229. *
  230.   12  IF(lnomid(5).ne.0) then
  231.        mocomp=lnomid(5)
  232.        lsupno=.false.
  233.        else
  234.         CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  235.        endif
  236.       GOTO 120
  237. *
  238.   13  if(lnomid(6).ne.0) then
  239.          MOCOMP=lnomid(6)
  240.          lsupno=.false.
  241.         else
  242.         CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  243.         endif
  244.       GOTO 120
  245. *
  246.   14  if(lnomid(7).ne.0) then
  247.          MOCOMP=lnomid(7)
  248.          lsupno=.false.
  249.         else
  250.         CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
  251.         endif
  252.       GOTO 120
  253. *
  254.   15  if(lnomid(8).ne.0) then
  255.          MOCOMP=lnomid(8)
  256.          lsupno=.false.
  257.        else
  258.        CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
  259.        endif
  260.       GOTO 120
  261. *
  262.   16  if(lnomid(9).ne.0) then
  263.           MOCOMP=lnomid(9)
  264.          lsupno=.false.
  265.       else
  266.          CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  267.        endif
  268.       GOTO 120
  269. *
  270.   20  if(lnomid(10).ne.0) then
  271.          MOCOMP=lnomid(10)
  272.          lsupno=.false.
  273.        else
  274.        CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  275.        endif
  276.       GOTO 120
  277. *
  278.  120  CONTINUE
  279.       NOMID=MOCOMP
  280.       SEGACT NOMID
  281.       nobl=lesobl(/2)
  282.       nfac=lesfac(/2)
  283.       IF (NOBL.EQ.0.AND.NFAC.EQ.0) THEN
  284.          CALL ERREUR(404)
  285.          GOTO 992
  286.       ENDIF
  287. *
  288.       IPLAO=0
  289.       IPLAF=0
  290. *
  291.       CALL PLACE(LESOBL,NOBL,IPLAO,MOT2)
  292. *
  293.       IF (IPLAO.EQ.0) THEN
  294.          CALL PLACE(LESFAC,NFAC,IPLAF,MOT2)
  295.          IF(IPLAF.EQ.0) THEN
  296.             MOTERR(1:4)=MOT1
  297.             MOTERR(5:8)=MOT2
  298.             CALL ERREUR(260)
  299.             GOTO 992
  300.          ENDIF
  301.       ENDIF
  302. *
  303. *     Creation du MCHAML
  304. *
  305.       N2=NOBL+NFAC
  306.       SEGINI MCHAML
  307.       ICHAML(1)=MCHAML
  308.       N1PTEL=NBPGAU
  309.       N1EL=NBELEM
  310.       N2PTEL=0
  311.       N2EL=0
  312.       DO 130 ICOMP=1,NOBL
  313.          NOMCHE(ICOMP)=LESOBL(ICOMP)
  314.          TYPCHE(ICOMP)='REAL*8'
  315.          SEGINI MELVAL
  316.          IELVAL(ICOMP)=MELVAL
  317.          DO 230 IGAU=1,N1PTEL
  318.             DO 230 IB=1,N1EL
  319.                VELCHE(IGAU,IB)=0.D0
  320.  230     CONTINUE
  321.          IF (IPLAO.EQ.ICOMP) THEN
  322.             VELCHE(IEN2,IEN1)=XFLO
  323.          ENDIF
  324.          SEGDES MELVAL
  325.  130  CONTINUE
  326. *
  327. *  CORRECTIONS PP DEC92  : DECALAGE DE NOBL
  328. *
  329.       DO 140 ICOMP=1,NFAC
  330.          NOMCHE(ICOMP+NOBL)=LESFAC(ICOMP)
  331.          TYPCHE(ICOMP+NOBL)='REAL*8'
  332.          SEGINI MELVAL
  333.          IELVAL(ICOMP+NOBL)=MELVAL
  334.          DO 240 IGAU=1,N1PTEL
  335.             DO 240 IB=1,N1EL
  336.                VELCHE(IGAU,IB)=0.D0
  337.  240     CONTINUE
  338.          IF (IPLAF.EQ.ICOMP) THEN
  339.             VELCHE(IEN2,IEN1)=XFLO
  340.          ENDIF
  341.          SEGDES MELVAL
  342.  140  CONTINUE
  343. *
  344.       SEGDES MCHELM
  345.       IPRES=MCHELM
  346.  
  347.  992  CONTINUE
  348.       IF (lsupno) SEGSUP,NOMID
  349.  991  CONTINUE
  350.       SEGDES,IMODEL
  351.       IF (IERR.NE.0) THEN
  352.         SEGSUP,MCHELM
  353.         IPRES=0
  354.       ENDIF
  355.  990  CONTINUE
  356.       SEGDES MMODEL
  357.  
  358.       RETURN
  359.       END
  360.  
  361.  
  362.  
  363.  
  364.  

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