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

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