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    PV090527  24/12/24    21:15:03     12108          
  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.         NPINT = imodel.INFMOD(1)
  142.         MFR = NUMMFR(MELE)
  143.         CMATE = imodel.CMATEE
  144. C        MATE  = imodel.IMATEE
  145.         INATU = imodel.INATUU
  146.  
  147. *       AIGUILLAGE SUIVANT MOT CLE
  148. *
  149.         MOCOMP = 0
  150.         lsupre = .true.
  151. *
  152.         GOTO ( 1, 1, 1, 1, 1, 6, 7,99,99,10,11,12,13,14,15,16, 2, 2,
  153.      &        99,20,21,99,23,24) IPLAC
  154. *
  155.   99    CONTINUE
  156.         GOTO 120
  157. *
  158.    1    NBROBL = 1
  159.         NBRFAC = 0
  160.         SEGINI,nomid
  161.         nomid.LESOBL(1) = 'SCAL'
  162.         MOCOMP = nomid
  163.         GOTO 120
  164. *
  165.    2    NBROBL = 1
  166.         NBRFAC = 0
  167.         SEGINI,nomid
  168.         nomid.LESOBL(1) = 'MAHO'
  169.         MOCOMP = nomid
  170.         GOTO 120
  171. *
  172.    6    IF (imodel.lnomid(1).NE.0) THEN
  173.           MOCOMP = imodel.lnomid(1)
  174.           lsupre = .false.
  175.         ELSE
  176.           CALL IDPRIM(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  177.         ENDIF
  178.         GOTO 120
  179. *
  180.    7    IF (imodel.lnomid(2).NE.0) THEN
  181.           MOCOMP = imodel.lnomid(2)
  182.           lsupre = .false.
  183.         ELSE
  184.           CALL IDDUAL(IMODEL,MFR,MOCOMP,NOBL,NFAC)
  185.         ENDIF
  186.         GOTO 120
  187. *
  188.   10    IF (imodel.lnomid(3).NE.0) THEN
  189.           MOCOMP = imodel.lnomid(3)
  190.           lsupre = .false.
  191.         ELSE
  192.           CALL IDGRAD(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  193.         ENDIF
  194.         GOTO 120
  195. *
  196.   11    IF (imodel.lnomid(4).NE.0) THEN
  197.           MOCOMP = imodel.lnomid(4)
  198.           lsupre = .false.
  199.         ELSE
  200.           CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  201.         ENDIF
  202.         GOTO 120
  203. *
  204.   12    IF (imodel.lnomid(5).NE.0) THEN
  205.           MOCOMP = imodel.lnomid(5)
  206.           lsupre = .false.
  207.         ELSE
  208.           CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  209.         ENDIF
  210.         GOTO 120
  211. *
  212.   13    IF (imodel.lnomid(6).NE.0) THEN
  213.           MOCOMP = imodel.lnomid(6)
  214.           lsupre = .false.
  215.         ELSE
  216.           CALL IDMATR(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  217.         ENDIF
  218.         GOTO 120
  219. *
  220.   14    IF (imodel.lnomid(7).NE.0) THEN
  221.           MOCOMP = imodel.lnomid(7)
  222.           lsupre = .false.
  223.         ELSE
  224.           CALL IDCARB(MELE,IFOUR,MOCOMP,NOBL,NFAC)
  225.         ENDIF
  226.         GOTO 120
  227. *
  228.   15    IF (imodel.lnomid(8).NE.0) THEN
  229.           MOCOMP = imodel.lnomid(8)
  230.           lsupre = .false.
  231.         ELSE
  232.           CALL IDTEMP(MFR,IFOUR,NPINT,MOCOMP,NOBL,NFAC)
  233.         ENDIF
  234.         GOTO 120
  235. *
  236.   16    IF (imodel.lnomid(9).NE.0) THEN
  237.           MOCOMP = imodel.lnomid(9)
  238.           lsupre = .false.
  239.         ELSE
  240.           CALL IDPRIN(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  241.         ENDIF
  242.         GOTO 120
  243. *
  244.   20    IF (imodel.lnomid(10).NE.0) THEN
  245.           MOCOMP = imodel.lnomid(10)
  246.           lsupre = .false.
  247.         ELSE
  248.           CALL IDVARI(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  249.         ENDIF
  250.         GOTO 120
  251. *
  252.   21    IF (imodel.lnomid(11).NE.0) THEN
  253.           MOCOMP = imodel.lnomid(11)
  254.           lsupre = .false.
  255.         ELSE
  256.           CALL IDGRAF(MFR,IFOUR,MOCOMP,NOBL,NFAC)
  257.         ENDIF
  258.         GOTO 120
  259. *
  260.   23    IF (imodel.lnomid(12).NE.0) THEN
  261.           MOCOMP = imodel.lnomid(12)
  262.           lsupre = .false.
  263.         ELSE
  264.           CALL IDPHAS(MFR,IMODEL,MOCOMP,NOBL,NFAC)
  265.         ENDIF
  266.         GOTO 120
  267. *
  268.   24    IF (imodel.lnomid(13).NE.0) THEN
  269.           MOCOMP = imodel.lnomid(13)
  270.           lsupre = .false.
  271.         ELSE
  272.           CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  273.         ENDIF
  274.         GOTO 120
  275. *
  276.  120    CONTINUE
  277. C Pas de composantes a traiter pour le sous-modele :
  278.         IF (MOCOMP.EQ.0) GOTO 100
  279.         nomid = MOCOMP
  280.         SEGACT,nomid
  281.         NOBL = nomid.LESOBL(/2)
  282.         NFAC = nomid.LESFAC(/2)
  283.         N2 = NOBL + NFAC
  284.         IF (N2.EQ.0) GOTO 110
  285.  
  286. C Recuperation d'informations sur le support :
  287. C Traitement des cas particuliers :
  288.           NFORQ = FORMOD(/2)
  289.           CALL PLACE(FORMOD,NFORQ,icont,'CONTACT         ')
  290.           CALL PLACE(FORMOD,NFORQ,ither,'THERMIQUE       ')
  291.           CALL PLACE(FORMOD,NFORQ,idiff,'DIFFUSION       ')
  292.           CALL PLACE(FORMOD,NFORQ,imeta,'METALLURGIE     ')
  293.           CALL PLACE(FORMOD,NFORQ,ichph,'CHANGEMENT_PHASE')
  294.           IF    (icont.NE.0 .OR. ichph.NE.0)THEN
  295. C           Pour le contact, on met aux noeuds d'office :
  296.             ISUPMO = 1
  297.             MINTE  = 0
  298.             NSTRS  = 0
  299.  
  300.           ELSEIF(ither.NE.0 .OR. idiff.NE.0 .OR. imeta.NE.0) THEN
  301.             ISUPMO = ISUPPO
  302.             IF (ISUPPO .GT. 2) ISUPMO = 6
  303.  
  304.             nmat   = imodel.matmod(/2)
  305.             CALL PLACE(imodel.matmod,nmat,iplr,'RAYONNEMENT')
  306. C           Support 6 SAUF pour le RAYONNEMENT...
  307. C           Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  308.             IF (iplr.eq.0) THEN
  309.               IF (ISUPMO .EQ. 1) THEN
  310.                 CALL TSHAPE(MELE,'NOEUD  ',MINTE)
  311.               ELSE IF (ISUPMO .EQ. 2) THEN
  312.                 CALL TSHAPE(MELE,'GRAVITE',MINTE)
  313.               ELSE
  314.                 CALL TSHAPE(MELE,'GAUSS  ',MINTE)
  315.               ENDIF
  316.             ELSE
  317.               ISUPMO = ISUPPO
  318.               NLG = NUMGEO(MELE)
  319.               CALL TSHAPE(NLG,'GAUSS',MINTE)
  320.             ENDIF
  321.             NSTRS = 0
  322.  
  323.           ELSE
  324. C           Pour les autres formulations :
  325.             ISUPMO = ISUPPO
  326.             IF (imodel.infmod(/1).LT.2+ISUPMO) THEN
  327.               CALL ELQUOI(MELE,0,ISUPMO,ipinf,imodel)
  328.               IF (IERR.NE.0) GOTO 900
  329.               info = ipinf
  330.               MINTE = info.infell(11)
  331.               NSTRS = info.infell(16)
  332.               SEGSUP,info
  333.             ELSE
  334.               MINTE = imodel.INFMOD(2+ISUPMO)
  335.               NSTRS = imodel.INFELE(16)
  336.             ENDIF
  337.           ENDIF
  338. c     write(6,*) 'ISUPMO,ISUPPO =',ISUPMO,ISUPPO
  339. C
  340.         SEGINI,MCHAML
  341. C
  342.         IF (NOBL.EQ.0) GOTO 130
  343.         DO io = 1, NOBL
  344.           mchaml.NOMCHE(io) = nomid.LESOBL(io)
  345.           N1PTEL = 0
  346.           N1EL   = 0
  347.           N2PTEL = 0
  348.           N2EL   = 0
  349.           IF (IPLAC.EQ.17.OR.IPLAC.EQ.18) THEN
  350.             mchaml.TYPCHE(io) = 'POINTEURLISTREEL'
  351.             N2PTEL = 1
  352.             N2EL   = 1
  353.             SEGINI,MELVAL
  354.             JG = 1
  355.             SEGINI,MLREEL
  356.             melval.IELCHE(1,1) = MLREEL
  357.           ELSE IF (IPLAC.EQ.20.AND.CMATE.EQ.'SECTION')THEN
  358.             mchaml.TYPCHE(io) = 'POINTEURMCHAML  '
  359.             N2PTEL = 1
  360.             N2EL   = 1
  361.             SEGINI,MELVAL
  362.             melval.IELCHE(1,1) = 0
  363. *
  364. *  MODELE DE MAXWELL - COMPOSANTES AUTRES QUE EPSE
  365.           ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.74.AND.io.GT.1) THEN
  366.             mchaml.TYPCHE(IO) = 'POINTEURLISTREEL'
  367.             N2PTEL = 1
  368.             N2EL   = 1
  369.             SEGINI,MELVAL
  370.             JG = NSTRS
  371.             SEGINI,MLREEL
  372.             melval.IELCHE(1,1) = MLREEL
  373. *
  374. *  MODELE MAXOTT COMPOSANTE AUTRES QUE REAL*8
  375.           ELSE IF (IPLAC.EQ.20.AND.INATU.EQ.106) THEN
  376.             IF ((IFOUR.EQ.2.AND.MFR.EQ.1)
  377.      &          .AND. io.GT.21) THEN
  378.               mlreel = 1
  379.             ELSE IF ((IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR.
  380.      &                IFOUR.EQ.0 .OR.IFOUR.EQ.1)
  381.      &              .AND. io.GT.16) THEN
  382.               mlreel = 1
  383.             ELSE IF ((IFOUR.EQ.-2.OR.
  384.      &               (IFOUR.EQ.2.AND.(MFR.EQ.3.OR.MFR.EQ.9)))
  385.      &              .AND. io.GT.13) THEN
  386.               mlreel = 1
  387.             ELSE
  388.               mlreel = 0
  389.             ENDIF
  390.             IF (mlreel .EQ. 0) THEN
  391.               mchaml.TYPCHE(io) = 'REAL*8'
  392.               N1PTEL = 1
  393.               N1EL   = 1
  394.               SEGINI,MELVAL
  395.             ELSE
  396.               mchaml.TYPCHE(io) = 'POINTEURLISTREEL'
  397.               N2PTEL = 1
  398.               N2EL   = 1
  399.               SEGINI,MELVAL
  400.               JG = NSTRS
  401.               SEGINI,MLREEL
  402.               melval.IELCHE(1,1) = MLREEL
  403.             ENDIF
  404.           ELSE
  405.             mchaml.TYPCHE(io) = 'REAL*8'
  406.             N1PTEL = 1
  407.             N1EL   = 1
  408.             SEGINI,MELVAL
  409.           ENDIF
  410.           mchaml.IELVAL(io) = MELVAL
  411.         ENDDO
  412.  130    CONTINUE
  413.  
  414.         IF (NFAC.EQ.0) GOTO 140
  415.         DO io = 1, NFAC
  416.           mchaml.NOMCHE(io+NOBL) = nomid.LESFAC(io)
  417.           N1PTEL = 0
  418.           N1EL   = 0
  419.           N2PTEL = 0
  420.           N2EL   = 0
  421.  
  422. *  MODELE MAXOTT - SUITE
  423.           IF (INATU.EQ.106) THEN
  424.             mchaml.TYPCHE(io+NOBL) = 'POINTEURLISTREEL'
  425.             N2PTEL = 1
  426.             N2EL   = 1
  427.             SEGINI,MELVAL
  428.             JG = NSTRS
  429.             SEGINI,MLREEL
  430.             melval.IELCHE(1,1) = MLREEL
  431. *
  432. *  MODELE DE MAXWELL - SUITE
  433.          ELSE IF (INATU.EQ.74) THEN
  434.             mchaml.TYPCHE(io+NOBL) = 'POINTEURLISTREEL'
  435.             N2PTEL = 1
  436.             N2EL   = 1
  437.             SEGINI,MELVAL
  438.             JG = NSTRS
  439.             SEGINI,MLREEL
  440.             melval.IELCHE(1,1) = MLREEL
  441.           ELSE
  442.             mchaml.TYPCHE(io+NOBL) = 'REAL*8'
  443.             N1PTEL = 1
  444.             N1EL   = 1
  445.             SEGINI,MELVAL
  446.           ENDIF
  447.           mchaml.IELVAL(io+NOBL) = MELVAL
  448.         ENDDO
  449.  140    CONTINUE
  450. C
  451.         IF (IPLAC.EQ.11 .OR. IPLAC.EQ.20) THEN
  452.           IF (CMATE.EQ.'MODAL' .OR. CMATE.EQ.'STATIQUE') THEN
  453.             N2 = 1
  454.             SEGADJ,MCHAML
  455.           ENDIF
  456.         ENDIF
  457. C
  458.         NZ = NZ + 1
  459.         mchelm.IMACHE(NZ)   = imodel.IMAMOD
  460.         mchelm.CONCHE(NZ)   = imodel.CONMOD
  461.         mchelm.ICHAML(NZ)   = MCHAML
  462.         mchelm.INFCHE(NZ,1) = 0
  463.         mchelm.INFCHE(NZ,2) = 0
  464.         mchelm.INFCHE(NZ,3) = NHRM
  465.         mchelm.INFCHE(NZ,4) = MINTE
  466.         mchelm.INFCHE(NZ,5) = 0
  467.         mchelm.INFCHE(NZ,6) = ISUPMO
  468.  
  469.  110    CONTINUE
  470.         nomid = MOCOMP
  471.         IF (lsupre) THEN
  472.           SEGSUP,nomid
  473.         ENDIF
  474.  
  475.  100  CONTINUE
  476. C-----------------------------------------------------------------------
  477. C Fin de la boucle sur les SOUS-MODELES retenus
  478. C-----------------------------------------------------------------------
  479.       IF (NZ.NE.NSOUS) THEN
  480.         N1 = NZ
  481.         SEGADJ,MCHELM
  482.       ENDIF
  483.       IPCHEL = MCHELM
  484.  
  485.  900  CONTINUE
  486.  
  487. c      return
  488.       END
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  

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