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

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