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

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