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

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