Télécharger la plaquette Cast3M


fr en

Télécharger zerop.eso

Retour à la liste

Numérotation des lignes : 

zerop

  1. C ZEROP     SOURCE    MB234859  25/09/08    21:16:18     12358          
  2.  
  3. C_______________________________________________________________________
  4. C
  5. C            OPERATEUR MCHAML A ZERO
  6. C
  7. C    Entrees:
  8. C    ________
  9. C
  10. C           IPMODL Pointeur sur un MMODEL
  11. C           MOT    Mot indiquant le type du MCHAML a creer
  12. C
  13. C    Sorties:
  14. C    ________
  15. C
  16. C           IPCHEL Pointeur sur un MCHAML resultat a ZERO
  17. C
  18. C    Passage aux nouveaux chamelems par i.monnier le 30.8.90
  19. C
  20. C_______________________________________________________________________
  21.  
  22.       SUBROUTINE ZEROP(IPMODL,MOT,IPCHEL)
  23.  
  24.       IMPLICIT INTEGER(I-N)
  25.       IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27.  
  28. -INC PPARAM
  29. -INC CCOPTIO
  30.  
  31. -INC SMMODEL
  32. -INC SMCHAML
  33. -INC SMLREEL
  34. -INC SMCOORD
  35.  
  36.       CHARACTER*(*) MOT
  37.  
  38.       PARAMETER (NMOT=24)
  39.       CHARACTER*8 LISMOT(NMOT)
  40.       CHARACTER*50 LISTIT(NMOT)
  41.       DIMENSION MSUPPO(NMOT)
  42.  
  43.       CHARACTER*8 CMATE
  44.       LOGICAL lsupre
  45.  
  46.       EXTERNAL LONG
  47.  
  48.       DATA LISMOT / 'NOEUD   ', 'GRAVITE ', 'RIGIDITE', 'MASSE   ',
  49.      &              'STRESSES', 'DEPLACEM', 'FORCES  ', 'REACTUAL',
  50.      &              'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  51.      &              'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  52.      &              'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  53.      &              'GRAFLEXI', 'VONMISES', 'VIMISTRU', 'DEFINELA'/
  54. *
  55. *                   'NOEUD   ', 'GRAVITE ', 'RIGIDITE', 'MASSE   ',
  56.       DATA MSUPPO /      1    ,     2     ,      3    ,     4     ,
  57. *                   'STRESSES', 'DEPLACEM', 'FORCES  ', 'REACTUAL',
  58.      &                   5    ,     1     ,      1    ,     1     ,
  59. *                   'FVOLUMIQ', 'GRADIENT', 'CONTRAIN', 'DEFORMAT',
  60.      &                   3    ,     5     ,      5    ,     5     ,
  61. *                   'MATERIAU', 'CARACTER', 'TEMPERAT', 'PRINCIPA',
  62.      &                   3    ,     3     ,      5    ,     5     ,
  63. *                   'MAHOOKE ', 'HOTANGEN', 'DILATATI', 'VARINTER',
  64.      &                   3    ,     5     ,      5    ,     5     ,
  65. *                   'GRAFLEXI', 'VONMISES', 'VIMISTRU', 'DEFINELA'/
  66.      &                   5    ,     5     ,      1    ,     5/
  67. *
  68.       DATA LISTIT / 'NOEUD', 'GRAVITE', 'RIGIDITE', 'MASSE',
  69.      &              'STRESSES', 'DEPLACEMENTS',   'FORCES',
  70.      &              'REACTUALISATION',      'FORCES VOLUMIQUES',
  71.      &              'GRADIENT', 'CONTRAINTES', 'DEFORMATIONS',
  72.      &              'CARACTERISTIQUES', 'CARACTERISTIQUES',
  73.      &              'TEMPERATURES', 'CONTRAINTES PRINCIPALES',
  74.      &              'MATRICE DE HOOKE', 'MATRICE DE HOOKE TANGENTE',
  75.      &              'DILATATIONS', 'VARIABLES INTERNES',
  76.      &              'GRADIENT DE FLEXION','VON MISES',
  77.      &              'VARIABLES INTERNES MICROSTRUCTURES',
  78.      &              'DEFORMATIONS INELASTIQUES'/
  79.  
  80.       IPCHEL = 0
  81. *
  82. * Verification que le sous-type du champ demande est prevu :
  83. *
  84.       IPLAC = 0
  85.       CALL PLACE(LISMOT,NMOT,IPLAC,MOT)
  86.       IF (IPLAC.EQ.0) THEN
  87.         CALL ERREUR(78)
  88.         RETURN
  89.       ENDIF
  90. *
  91.       NHRM = NIFOUR
  92. *
  93. *     Decompte des SOUS-MODELES utiles :
  94.       MMODEL = IPMODL
  95.       NSOUS=0
  96.       DO 111 is = 1, mmodel.KMODEL(/1)
  97.         imodel = mmodel.kmodel(is)
  98.  
  99. C       On determine si le sous-modele est a conserver
  100. C       avec traitement des cas particuliers
  101.         IF (imodel.nefmod .EQ. 22       ) GOTO 111
  102.         IF (formod(1)     .EQ. 'LIAISON') GOTO 111
  103.  
  104.         NSOUS=NSOUS+1
  105.  111  CONTINUE
  106.  
  107. C-----------------------------------------------------------------------
  108. C   CREATION DU MCHELM
  109. C-----------------------------------------------------------------------
  110.       N1     = NSOUS
  111.       L1     = LONG(LISTIT(IPLAC))
  112.       N3     = 6
  113.       ISUPPO = MSUPPO(IPLAC)
  114.  
  115.       SEGINI,MCHELM
  116. * vu que le champ est vide, il est le meme dans toutes les configurations
  117.       MCLCNF=0
  118.  
  119.       mchelm.TITCHE = LISTIT(IPLAC)(1:L1)
  120.       mchelm.IFOCHE = IFOUR
  121.  
  122. C-----------------------------------------------------------------------
  123. C     BOUCLE SUR LES SOUS-MODELES
  124. C-----------------------------------------------------------------------
  125.       NZ = 0
  126.  
  127.       DO 100 is = 1, NSOUS
  128.  
  129.         IMODEL = mmodel.kmodel(is)
  130. C       On determine si le sous-modele est a conserver
  131. C       avec traitement des cas particuliers
  132.         IF (imodel.nefmod .EQ. 22       ) GOTO 100
  133.         IF (formod(1)     .EQ. 'LIAISON') GOTO 100
  134.  
  135. C        IPMAIL = imodel.IMAMOD
  136.         MELE   = imodel.NEFMOD
  137.         MFR = NUMMFR(MELE)
  138.         CMATE = imodel.CMATEE
  139. C        MATE  = imodel.IMATEE
  140.         INATU = imodel.INATUU
  141.  
  142. *       AIGUILLAGE SUIVANT MOT CLE
  143. *
  144.         MOCOMP = 0
  145.         lsupre = .true.
  146. *
  147.         GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2,
  148.      &        99,20,21,99,23,24) IPLAC
  149. *
  150.   99    CONTINUE
  151.         GOTO 120
  152. *
  153.    1    NBROBL = 1
  154.         NBRFAC = 0
  155.         SEGINI,nomid
  156.         nomid.LESOBL(1) = 'SCAL'
  157.         MOCOMP = nomid
  158.         GOTO 120
  159. *
  160.    2    NBROBL = 1
  161.         NBRFAC = 0
  162.         SEGINI,nomid
  163.         nomid.LESOBL(1) = 'MAHO'
  164.         MOCOMP = nomid
  165.         GOTO 120
  166. *
  167.    6    IF (imodel.lnomid(1).NE.0) THEN
  168.           MOCOMP = imodel.lnomid(1)
  169.           lsupre = .false.
  170.         ELSE
  171.           CALL IDPRIM(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  172.         ENDIF
  173.         GOTO 120
  174. *
  175.    7    IF (imodel.lnomid(2).NE.0) THEN
  176.           MOCOMP = imodel.lnomid(2)
  177.           lsupre = .false.
  178.         ELSE
  179.           CALL IDDUAL(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  180.         ENDIF
  181.         GOTO 120
  182. *
  183.   10    IF (imodel.lnomid(3).NE.0) THEN
  184.           MOCOMP = imodel.lnomid(3)
  185.           lsupre = .false.
  186.         ELSE
  187.           CALL IDGRAD(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  188.         ENDIF
  189.         GOTO 120
  190. *
  191.   11    IF (imodel.lnomid(4).NE.0) THEN
  192.           MOCOMP = imodel.lnomid(4)
  193.           lsupre = .false.
  194.         ELSE
  195.           CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  196.         ENDIF
  197.         GOTO 120
  198. *
  199.   12    IF (imodel.lnomid(5).NE.0) THEN
  200.           MOCOMP = imodel.lnomid(5)
  201.           lsupre = .false.
  202.         ELSE
  203.           CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  204.         ENDIF
  205.         GOTO 120
  206. *
  207.   13    IF (imodel.lnomid(6).NE.0) THEN
  208.           MOCOMP = imodel.lnomid(6)
  209.           lsupre = .false.
  210.         ELSE
  211.           CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  212.         ENDIF
  213.         GOTO 120
  214. *
  215.   14    IF (imodel.lnomid(7).NE.0) THEN
  216.           MOCOMP = imodel.lnomid(7)
  217.           lsupre = .false.
  218.         ELSE
  219.           CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
  220.         ENDIF
  221.         GOTO 120
  222. *
  223.   15    IF (imodel.lnomid(8).NE.0) THEN
  224.           MOCOMP = imodel.lnomid(8)
  225.           lsupre = .false.
  226.         ELSE
  227.           CALL IDTEMP(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  228.         ENDIF
  229.         GOTO 120
  230. *
  231.   16    IF (imodel.lnomid(9).NE.0) THEN
  232.           MOCOMP = imodel.lnomid(9)
  233.           lsupre = .false.
  234.         ELSE
  235.           CALL IDPRIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  236.         ENDIF
  237.         GOTO 120
  238. *
  239.   20    IF (imodel.lnomid(10).NE.0) THEN
  240.           MOCOMP = imodel.lnomid(10)
  241.           lsupre = .false.
  242.         ELSE
  243.           CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  244.         ENDIF
  245.         GOTO 120
  246. *
  247.   21    IF (imodel.lnomid(11).NE.0) THEN
  248.           MOCOMP = imodel.lnomid(11)
  249.           lsupre = .false.
  250.         ELSE
  251.           CALL IDGRAF(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  252.         ENDIF
  253.         GOTO 120
  254. *
  255.   23    IF (imodel.lnomid(12).NE.0) THEN
  256.           MOCOMP = imodel.lnomid(12)
  257.           lsupre = .false.
  258.         ELSE
  259.           CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  260.         ENDIF
  261.         GOTO 120
  262. *
  263.   24    IF (imodel.lnomid(13).NE.0) THEN
  264.           MOCOMP = imodel.lnomid(13)
  265.           lsupre = .false.
  266.         ELSE
  267.           CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  268.         ENDIF
  269.         GOTO 120
  270. *
  271.  120    CONTINUE
  272. C Pas de composantes a traiter pour le sous-modele :
  273.         IF (MOCOMP.EQ.0) GOTO 100
  274.         nomid = MOCOMP
  275.         SEGACT,nomid
  276.         NOBL = nomid.LESOBL(/2)
  277.         NFAC = nomid.LESFAC(/2)
  278.         N2 = NOBL + NFAC
  279.         IF (N2.EQ.0) GOTO 110
  280.  
  281. C Recuperation d'informations sur le support :
  282. C Traitement des cas particuliers :
  283.           NFORQ = FORMOD(/2)
  284.           CALL PLACE(FORMOD,NFORQ,icont,'CONTACT         ')
  285.           CALL PLACE(FORMOD,NFORQ,ither,'THERMIQUE       ')
  286.           CALL PLACE(FORMOD,NFORQ,idiff,'DIFFUSION       ')
  287.           CALL PLACE(FORMOD,NFORQ,imeta,'METALLURGIE     ')
  288.           CALL PLACE(FORMOD,NFORQ,ichph,'CHANGEMENT_PHASE')
  289.           IF    (icont.NE.0 .OR. ichph.NE.0)THEN
  290. C           Pour le contact, on met aux noeuds d'office :
  291.             ISUPMO = 1
  292.             MINTE  = 0
  293.             NSTRS  = 0
  294.  
  295.           ELSEIF(ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  296.             ISUPMO = ISUPPO
  297.             IF (ISUPPO .GT. 2) ISUPMO = 6
  298.  
  299.             nmat   = imodel.matmod(/2)
  300.             CALL PLACE(imodel.matmod,nmat,iplr,'RAYONNEMENT')
  301. C           Support 6 SAUF pour le RAYONNEMENT...
  302. C           Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  303.             IF (iplr.eq.0) THEN
  304.               IF (ISUPMO .EQ. 1) THEN
  305.                 CALL TSHAPE(MELE,'NOEUD  ',MINTE)
  306.               ELSE IF (ISUPMO .EQ. 2) THEN
  307.                 CALL TSHAPE(MELE,'GRAVITE',MINTE)
  308.               ELSE
  309.                 CALL TSHAPE(MELE,'GAUSS  ',MINTE)
  310.               ENDIF
  311.             ELSE
  312.               ISUPMO = ISUPPO
  313.               NLG = NUMGEO(MELE)
  314.               CALL TSHAPE(NLG,'GAUSS',MINTE)
  315.             ENDIF
  316.             NSTRS = 0
  317.  
  318.           ELSE
  319. C           Pour les autres formulations :
  320.             ISUPMO = ISUPPO
  321.             MINTE = imodel.INFMOD(2+ISUPMO)
  322.             NSTRS = imodel.INFELE(16)
  323.           ENDIF
  324. c     write(6,*) 'ISUPMO,ISUPPO =',ISUPMO,ISUPPO
  325. C
  326.         SEGINI,MCHAML
  327. C
  328.         IF (NOBL.EQ.0) GOTO 130
  329.         DO io = 1, NOBL
  330.           mchaml.NOMCHE(io) = nomid.LESOBL(io)
  331.           N1PTEL = 0
  332.           N1EL   = 0
  333.           N2PTEL = 0
  334.           N2EL   = 0
  335.           IF (IPLAC.EQ.17.OR.IPLAC.EQ.18) THEN
  336.             mchaml.TYPCHE(io) = 'POINTEURLISTREEL'
  337.             N2PTEL = 1
  338.             N2EL   = 1
  339.             SEGINI,MELVAL
  340.             JG = 1
  341.             SEGINI,MLREEL
  342.             melval.IELCHE(1,1) = MLREEL
  343.           ELSE IF (IPLAC.EQ.20.AND.CMATE.EQ.'SECTION')THEN
  344.             mchaml.TYPCHE(io) = 'POINTEURMCHAML  '
  345.             N2PTEL = 1
  346.             N2EL   = 1
  347.             SEGINI,MELVAL
  348.             melval.IELCHE(1,1) = 0
  349. *
  350. *  MODELE DE MAXWELL - COMPOSANTES AUTRES QUE EPSE
  351.           ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.74.AND.io.GT.1) THEN
  352.             mchaml.TYPCHE(IO) = 'POINTEURLISTREEL'
  353.             N2PTEL = 1
  354.             N2EL   = 1
  355.             SEGINI,MELVAL
  356.             JG = NSTRS
  357.             SEGINI,MLREEL
  358.             melval.IELCHE(1,1) = MLREEL
  359. *
  360. *  MODELE MAXOTT COMPOSANTE AUTRES QUE REAL*8
  361.           ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.106) THEN
  362.             IF ((IFOUR.EQ.2.AND.MFR.EQ.1)
  363.      &          .AND. io.GT.21) THEN
  364.               mlreel = 1
  365.             ELSE IF ((IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
  366.      &                IFOUR.EQ.0 .OR.IFOUR.EQ.1)
  367.      &              .AND. io.GT.16) THEN
  368.               mlreel = 1
  369.             ELSE IF ((IFOUR.EQ.-2.OR.
  370.      &               (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)))
  371.      &              .AND. io.GT.13) THEN
  372.               mlreel = 1
  373.             ELSE
  374.               mlreel = 0
  375.             ENDIF
  376.             IF (mlreel .EQ. 0) THEN
  377.               mchaml.TYPCHE(io) = 'REAL*8'
  378.               N1PTEL = 1
  379.               N1EL   = 1
  380.               SEGINI,MELVAL
  381.             ELSE
  382.               mchaml.TYPCHE(io) = 'POINTEURLISTREEL'
  383.               N2PTEL = 1
  384.               N2EL   = 1
  385.               SEGINI,MELVAL
  386.               JG = NSTRS
  387.               SEGINI,MLREEL
  388.               melval.IELCHE(1,1) = MLREEL
  389.             ENDIF
  390.           ELSE
  391.             mchaml.TYPCHE(io) = 'REAL*8'
  392.             N1PTEL = 1
  393.             N1EL   = 1
  394.             SEGINI,MELVAL
  395.           ENDIF
  396.           mchaml.IELVAL(io) = MELVAL
  397.         ENDDO
  398.  130    CONTINUE
  399.  
  400.         IF (NFAC.EQ.0) GOTO 140
  401.         DO io = 1, NFAC
  402.           mchaml.NOMCHE(io+NOBL) = nomid.LESFAC(io)
  403.           N1PTEL = 0
  404.           N1EL   = 0
  405.           N2PTEL = 0
  406.           N2EL   = 0
  407.  
  408. *  MODELE MAXOTT - SUITE
  409.           IF (INATU.EQ.106) THEN
  410.             mchaml.TYPCHE(io+NOBL) = 'POINTEURLISTREEL'
  411.             N2PTEL = 1
  412.             N2EL   = 1
  413.             SEGINI,MELVAL
  414.             JG = NSTRS
  415.             SEGINI,MLREEL
  416.             melval.IELCHE(1,1) = MLREEL
  417. *
  418. *  MODELE DE MAXWELL - SUITE
  419.          ELSE IF (INATU.EQ.74) THEN
  420.             mchaml.TYPCHE(io+NOBL) = 'POINTEURLISTREEL'
  421.             N2PTEL = 1
  422.             N2EL   = 1
  423.             SEGINI,MELVAL
  424.             JG = NSTRS
  425.             SEGINI,MLREEL
  426.             melval.IELCHE(1,1) = MLREEL
  427.           ELSE
  428.             mchaml.TYPCHE(io+NOBL) = 'REAL*8'
  429.             N1PTEL = 1
  430.             N1EL   = 1
  431.             SEGINI,MELVAL
  432.           ENDIF
  433.           mchaml.IELVAL(io+NOBL) = MELVAL
  434.         ENDDO
  435.  140    CONTINUE
  436. C
  437.         IF (IPLAC.EQ.11 .OR. IPLAC.EQ.20) THEN
  438.           IF (CMATE.EQ.'MODAL' .OR. CMATE.EQ.'STATIQUE') THEN
  439.             N2 = 1
  440.             SEGADJ,MCHAML
  441.           ENDIF
  442.         ENDIF
  443. C
  444.         NZ = NZ + 1
  445.         mchelm.IMACHE(NZ)   = imodel.IMAMOD
  446.         mchelm.CONCHE(NZ)   = imodel.CONMOD
  447.         mchelm.ICHAML(NZ)   = MCHAML
  448.         mchelm.INFCHE(NZ,1) = 0
  449.         mchelm.INFCHE(NZ,2) = 0
  450.         mchelm.INFCHE(NZ,3) = NHRM
  451.         mchelm.INFCHE(NZ,4) = MINTE
  452.         mchelm.INFCHE(NZ,5) = 0
  453.         mchelm.INFCHE(NZ,6) = ISUPMO
  454.  
  455.  110    CONTINUE
  456.         nomid = MOCOMP
  457.         IF (lsupre) THEN
  458.           SEGSUP,nomid
  459.         ENDIF
  460.  
  461.  100  CONTINUE
  462. C-----------------------------------------------------------------------
  463. C Fin de la boucle sur les SOUS-MODELES retenus
  464. C-----------------------------------------------------------------------
  465.       IF (NZ.NE.NSOUS) THEN
  466.         N1 = NZ
  467.         SEGADJ,MCHELM
  468.       ENDIF
  469.       IPCHEL = MCHELM
  470.  
  471.  900  CONTINUE
  472.  
  473. c      return
  474.       END
  475.  
  476.  
  477.  
  478.  
  479.  
  480.  
  481.  
  482.  

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