Télécharger la plaquette Cast3M


fr en

Télécharger inomid.eso

Retour à la liste

Numérotation des lignes : 

inomid

  1. C INOMID    SOURCE    OF166741  24/05/06    21:15:21     11082          
  2. *
  3. *  iqmod est un pointeur sur un segment imodel de l'objet modele, il est
  4. *  suppose actif
  5. *
  6. *  A)  ITYP= '        '
  7. *     creation des segments de noms de composantes des MCHAML
  8. *     CREES PAR LE MODELE ELEMENTAIRE
  9. *     Rn entree l_vari,l_mato, l_matf et l_paex sont des listmots pour 
  10. *     les variables internes, materiaux, parametreis externes s'ils 
  11. *     ont ete definis (<= 0 sinon).
  12. *     Ces arguments ne doivent absolument pas a etre modifies ici !
  13. *   attention : une modele de mecanique ne peut creer de composantes thermiques
  14. *  ou phases metallurgiques !
  15. *  fortement inspire de comou2
  16. *
  17. *  B) ITYP different de '        '  on renvoie dans iret le nomid associe.
  18. *
  19.       SUBROUTINE INOMID(iqmod,ityp,iret,l_vari,l_mato,l_matf,l_paex)
  20.  
  21.       IMPLICIT INTEGER(I-N)
  22.       IMPLICIT REAL*8(A-H,O-Z)
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26.  
  27. -INC SMMODEL
  28.       pointeur nomid1.nomid
  29. -INC SMLMOTS
  30.  
  31.       character*(*) ityp
  32.       CHARACTER*(LOCOMP) CCOMP
  33.  
  34.       parameter(ninc=13,ntyp=19)
  35.       logical dcmate,d_mc
  36.       character*8 nomtyp(ntyp)
  37.       CHARACTER*4 lesinc(ninc),lesdua(ninc)
  38.       CHARACTER*5 FMT1
  39.  
  40.       EXTERNAL LONG
  41.  
  42.       DATA lesinc/'UX','UY','UZ','RX','RY','RZ','UR','UT','RT',
  43.      &            'LX','P','ALFA','BETA'/
  44.       DATA lesdua/'FX','FY','FZ','MX','MY','MZ','FR','FT','MT',
  45.      &            'FLX','FP','FALF','FBET'/
  46.        data nomtyp/ 'DEPLACEM', 'FORCES  ', 'GRADIENT', 'CONTRAIN',
  47.      &              'DEFORMAT', 'MATERIAU', 'CARACTER', 'TEMPERAT',
  48.      &              'PRINCIPA', 'VARINTER', 'GRAFLEXI', 'VINMETAL',
  49.      &              'DEFINELA', 'PARAMEXT', 'VIDE    ', 'SCAL    ',
  50.      &              'TEMP    ', 'MAHO    ', 'MAHT    ' /
  51.  
  52. C modele metallurgie ajoute par T.L. en mai 2018
  53. C Donnees pour la metallurgie :
  54.       parameter(NBMET=2)
  55.       CHARACTER*4 TYPMET(NBMET),LEBLON(3),KOISTI(2)
  56.       DATA TYPMET/'LEBL', 'KOIS'/
  57.       DATA LEBLON/'PEQ ', 'TAU ', 'F   '/
  58.       DATA KOISTI/'MS  ', 'KM  '/
  59.  
  60. * on suppose le sous-modele (imodel) est actif
  61.       imodel = iqmod
  62.  
  63. * Petit test normalement inutile :
  64.       if (imodel.lnomid(/1).ne.ntyp) then
  65.         write(ioimp,*) 'INOMID : Incoherence lnomid(/1) et ntyp'
  66.         call erreur(5)
  67.         return
  68.       endif
  69.  
  70.       iret = 0
  71. * -------------------
  72. * CAS PARTICULIER B :
  73. * -------------------
  74. C On sort le NOMID demande et on ne le cree pas
  75.       if (ityp.NE.'        ') then
  76.         do ideb = 1, ntyp
  77.           if (ityp.eq.nomtyp(ideb)) then
  78.             iret = imodel.lnomid(ideb)
  79.             goto 100
  80.           endif
  81.         enddo
  82.         call erreur(5)
  83.  100    continue
  84.         return
  85.       endif
  86.  
  87. * ---------------
  88. * CAS GENERAL A :
  89. * ---------------
  90. *  On passe en *mod pour remplir imodel.lnomid(.)
  91.       segact,imodel*mod
  92.  
  93. * Recopie locale des arguments d'entrees :
  94.       luvari = l_vari
  95.       lumato = l_mato
  96.       lumatf = l_matf
  97.       lupaex = l_paex
  98.  
  99.       NFOR=formod(/2)
  100.       CALL PLACE(formod,NFOR,IMECA,'MECANIQUE       ')
  101.       CALL PLACE(formod,NFOR,IPORE,'POREUX          ')
  102.       CALL PLACE(formod,NFOR,ITHHY,'THERMOHYDRIQUE  ')
  103.       CALL PLACE(formod,NFOR,ITHER,'THERMIQUE       ')
  104.       CALL PLACE(formod,NFOR,IMAGN,'MAGNETODYNAMIQUE')
  105.       CALL PLACE(formod,NFOR,IELEC,'ELECTROSTATIQUE ')
  106.       CALL PLACE(formod,NFOR,IDIFF,'DIFFUSION       ')
  107.       CALL PLACE(formod,NFOR,ILIAI,'LIAISON         ')
  108.       CALL PLACE(formod,NFOR,ICONT,'CONTACT         ')
  109.       CALL PLACE(formod,NFOR,ICHGM,'CHARGEMENT      ')
  110.       CALL PLACE(formod,NFOR,IMETA,'METALLURGIE     ')
  111.       CALL PLACE(formod,NFOR,ICHPH,'CHANGEMENT_PHASE')
  112.       CALL PLACE(formod,NFOR,INAST,'NAVIER_STOKES   ')
  113.       CALL PLACE(formod,NFOR,IMELA,'MELANGE         ')
  114.       CALL PLACE(formod,NFOR,ICNTR,'CONTRAINTE      ')
  115.  
  116.       d_mc = .false.
  117.       if (imela.gt.0) then 
  118.         d_mc = CMATEE.EQ.'PARALLELE' .OR. CMATEE.EQ.'SERIE'
  119.       endif
  120.  
  121.       dcmate = .false.
  122.       nimcom = 0
  123.       do im = 1,matmod(/2)
  124.         if (matmod(im).eq.'IMPEDANCE') then
  125.           dcmate = .true.
  126.           if (luvari.gt.0) then
  127.             mlmot5 = luvari
  128.             luvari = 0
  129.             mlmot6 = lumato
  130.             lumato = 0
  131.             segact mlmot5,mlmot6
  132.             nimcom = mlmot5.mots(/2)
  133.             nbrobl = nimcom
  134.             nbrfac = nimcom
  135.             segini nomid,nomid1
  136.             do inim = 1,nimcom
  137.               CALL PLACE(lesinc,ninc,IMOT,mlmot5.mots(inim))
  138.               if (imot.eq.0) call erreur(26)
  139.               lesobl(inim) = mlmot5.mots(inim)
  140.               nomid1.lesobl(inim) = lesdua(imot)
  141.               CALL PLACE(lesinc,ninc,IMOT,mlmot6.mots(inim))
  142.               if (imot.eq.0) call erreur(26)
  143.               lesfac(inim) = mlmot6.mots(inim)
  144.               nomid1.lesfac(inim) = lesdua(imot)
  145.             enddo
  146.           endif
  147.         endif
  148.       enddo
  149.  
  150. * Cas particulier d'un modele de CHANGEMENT_PHASE :
  151. *     write(6,*)'inomidichph',ichph,(MATMOD(1)(1:10) .EQ.'PARFAIT   ')
  152.       IF (ICHPH .GT. 0) THEN
  153.         IF    (MATMOD(1)(1:10) .EQ. 'PARFAIT   ')THEN
  154.           DO im=1,LNOMID(/1)
  155.               IF    (im .EQ. 1 )THEN
  156. C               COMPOSANTES PRIMALES
  157.                 NBROBL=1
  158.                 NBRFAC=0
  159.                 SEGINI,NOMID
  160.                 MLMOT1=IMODEL.IVAMOD(1)
  161.                 NOMID.LESOBL(1)=MLMOT1.MOTS(1)
  162.               ELSEIF(im .EQ. 2 )THEN
  163. C               COMPOSANTES DUALES
  164.                 NBROBL=1
  165.                 NBRFAC=0
  166.                 SEGINI,NOMID
  167.                 MLMOT1=IMODEL.IVAMOD(1)
  168.                 NOMID.LESOBL(1)=MLMOT1.MOTS(2)
  169.               ELSEIF(im .EQ. 6 )THEN
  170. C               COMPOSANTES MATERIAU
  171.                 NBROBL=2
  172.                 NBRFAC=0
  173.                 SEGINI,NOMID
  174.                 NOMID.LESOBL(1)='PRIM'
  175.                 NOMID.LESOBL(2)='DUAL'
  176.               ELSEIF(im .EQ. 10)THEN
  177. C               COMPOSANTES VARINTER
  178.                 NBROBL=1
  179.                 NBRFAC=0
  180.                 SEGINI,NOMID
  181.                 NOMID.LESOBL(1)='PPHA'
  182.               ELSE
  183. C               NOMID vide
  184.                 NBROBL=0
  185.                 NBRFAC=0
  186. c                SEGINI,NOMID
  187.                 nomid = 0
  188.               ENDIF
  189.               LNOMID(im)=NOMID
  190.           ENDDO
  191.  
  192.         ELSEIF(MATMOD(1)(1:10) .EQ. 'SOLUBILITE')THEN
  193.             DO im=1,LNOMID(/1)
  194.               IF    (im .EQ. 1 )THEN
  195. C               COMPOSANTES PRIMALES
  196.                 NBROBL=2
  197.                 NBRFAC=0
  198.                 SEGINI,NOMID
  199.                 MLMOT1=IMODEL.IVAMOD(1)
  200.                 NOMID.LESOBL(1)=MLMOT1.MOTS(1)
  201.                 NOMID.LESOBL(2)=MLMOT1.MOTS(2)
  202.               ELSEIF(im .EQ. 2 )THEN
  203. C               COMPOSANTES DUALES
  204.                 NBROBL=2
  205.                 NBRFAC=0
  206.                 SEGINI,NOMID
  207.                 MLMOT1=IMODEL.IVAMOD(1)
  208.                 NOMID.LESOBL(1)=MLMOT1.MOTS(3)
  209.                 NOMID.LESOBL(2)=MLMOT1.MOTS(4)
  210.               ELSEIF(im .EQ. 6 )THEN
  211. C               COMPOSANTES MATERIAU
  212.                 NBROBL=1
  213.                 NBRFAC=0
  214.                 SEGINI,NOMID
  215.                 NOMID.LESOBL(1)='SOLU'
  216.               ELSE
  217. C               NOMID vide
  218.                 NBROBL=0
  219.                 NBRFAC=0
  220.                 SEGINI,NOMID
  221.               ENDIF
  222.               LNOMID(im)=NOMID
  223.             ENDDO
  224.         ELSE
  225.           CALL ERREUR(5)
  226.         ENDIF
  227.  
  228.         RETURN
  229.       ENDIF
  230.  
  231. * Cas general :
  232.       MELE=nefmod
  233.  
  234. C  Formulation GENERALE
  235.       MFR3=nummfr(mele)
  236.  
  237. C  Determination de la Formulation Specifique MFR2
  238.       MFR2=MFR3
  239.  
  240.       if (formod(1).eq.'LIAISON') MFR2= infele(13)
  241.       do im=1,matmod(/2)
  242.         if (matmod(im).eq.'MODAL' .or. matmod(im).eq.'STATIQUE'
  243.      &    .or.matmod(im).eq.'IMPEDANCE')  MFR2= infele(13)
  244.       enddo
  245.  
  246.       IF (ITHHY.EQ.1) MFR2=65
  247.       IF (IELEC.EQ.1) MFR2=71
  248.  
  249.       IF (IDIFF.EQ.1) THEN
  250.         IF (MFR3.EQ.1) THEN
  251. C         Cas MASSIF
  252.           MFR2=73
  253.         ELSEIF (MFR3.EQ.3  .OR. MFR3.EQ.5  .OR. MFR3.EQ.9 .OR.
  254.      &          MFR3.EQ.27 .OR. MFR3.EQ.75 .OR. MFR3.EQ.79) THEN
  255. C        Cas COQUES, BARRES, JOI1, TUY2, TUY3
  256.           MFR2=MFR3
  257.         ELSE
  258.           CALL ERREUR(21)
  259.           RETURN
  260.         ENDIF
  261.       ENDIF
  262. *
  263. *       Modele CHARGEMENT PRESSION, dans certains cas, il est necessaire
  264. *       de definir les noms des composantes CARACTERISTIQUES, d'ou les
  265. *       distinctions ci-apres
  266.       IF (ICHGM.GT.0) THEN
  267.         IF (IFOUR.EQ.-2) THEN
  268.           MFR2 = MFR3
  269.         ELSE
  270.           IF (MFR3.EQ.1) THEN
  271.             MFR2 = 72
  272.           ELSEIF (MFR3.EQ.3 .OR. MFR3.EQ.7 .OR.
  273.      &            MFR3.EQ.9 .OR. MFR3.EQ.13) THEN
  274.             MFR2 = 74
  275.           ELSEIF (MFR3.EQ.5) THEN
  276.             MFR2 = MFR3
  277.           ELSE
  278.             CALL ERREUR(21)
  279.             RETURN
  280.           ENDIF
  281.         ENDIF
  282.       ENDIF
  283. *
  284.       npint3=0
  285.       if(infmod(/1).gt.0) npint3=infmod(1)
  286. *      write(6,*) ' inomid formod', (formod(im),im=1,nfor)
  287. *      write(6,*) 'inomidmeleMFR2 ',mele,mfr2,dcmate,imela
  288. c      write(6,*) 'inomid', imeta,luvari,lumato,lumatf,lupaex
  289.  
  290.       DO ino = 1, ntyp
  291.  
  292.         mocomp=0
  293. *         write(6,*) 'inomino',ino
  294.  
  295. *       AIGUILLAGE SUIVANT MOT CLE
  296.         GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19) ino
  297.         GOTO 120
  298.  
  299. C       Composantes PRIMALES (DEPLACEMENT en MECANIQUE, etc...)
  300.    1    if (dcmate.and.nimcom.gt.0) then
  301.          nobl = nimcom*2
  302.          nfac = 0
  303.          mocomp=nomid
  304.         else
  305.           if(icont.eq.0) then
  306.            CALL IDPRIM(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  307.            NOMID=MOCOMP
  308.           endif
  309.         endif
  310. c         write(6,*) ' modepl  MFR2 ', mocomp,MFR2,nobl,nomid.lesobl(1)
  311.         GOTO 120
  312.  
  313. C       Composantes DUALES (FORCES en MECANIQUE, etc...)
  314.    2    if (dcmate.and.nimcom.gt.0) then
  315.          nobl = nimcom*2
  316.          nfac = 0
  317.          mocomp=nomid1
  318.         elseif(icont.eq.0) then
  319.          CALL IDDUAL(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  320.         endif
  321.         GOTO 120
  322.  
  323. C       Composantes GRADIENTS des grandeurs PRIMALES
  324.    3    if(ither.gt.0) then
  325.           IF (MFR2.EQ.1) THEN
  326.             MDM=29
  327.           ELSE IF (MFR2.EQ.3  .OR. MFR2.EQ.5 .OR. MFR2.EQ.9) THEN
  328. C           Formulation THERMIQUE COQUE
  329.             MDM=39
  330.           ELSE IF (MFR2.EQ.79 .OR. MFR2.EQ.27) THEN
  331. C           Formulation THERMIQUE TUY2, TUY3, BARR
  332.             MDM=40
  333.           ENDIF
  334.  
  335.         ELSEIF(IDIFF.GT.0)then
  336.           IF (MFR2.EQ.73) THEN
  337. C           Formulation DIFFUSION MASSIF
  338.             MDM=73
  339.           ELSE IF (MFR2.EQ.3  .OR. MFR2.EQ.5 .OR. MFR2.EQ.9) THEN
  340. C           Formulation DIFFUSION COQUE
  341.             MDM=74
  342.           ELSE IF (MFR2.EQ.79 .OR. MFR2.EQ.27) THEN
  343. C           Formulation DIFFUSION TUY2, TUY3, BARR
  344.             MDM=76
  345.           ENDIF
  346.  
  347.         ELSEIF(IMAGN.GT.0)then
  348.             MDM=69
  349.  
  350.         ELSE
  351.           MDM=MFR2
  352.         ENDIF
  353.  
  354.         IF( IMETA .GT. 0) THEN
  355.           NBRFAC=0
  356.           NBROBL=0
  357.           SEGINI NOMID
  358.           MOCOMP=NOMID
  359.         ENDIF
  360.  
  361.         IF( icont.eq.0 .AND. ICHGM.EQ.0 .AND. IMETA.EQ.0) THEN
  362. C         Remarque CB215821 :
  363. C         Il vaudrait mieux envoyer IMODEL a IDGRAD parce que ca fait faire
  364. C         toute une gymnastique inutile
  365.  
  366.           IF (IDIFF.GT.0) THEN
  367. C           Recuperation du LISTMOTS dans IVAMOD(1)
  368.             MLMOT1=IVAMOD(1)
  369.  
  370. C           Recuperation de l'inconnue PRIMALE
  371.             CCOMP =MLMOT1.MOTS(1)
  372.  
  373. C           On met juste l'inconnue PRIMALE dans un nomid vu que IDGRAD ne connais pas le IMODEL...
  374.             NBROBL   = 1
  375.             NBRFAC   = 0
  376.             SEGINI,NOMID
  377.             LESOBL(1)= CCOMP
  378.             MOCOMP   = NOMID
  379.             CALL IDGRAD(MDM,IFOUR,MOCOMP,NOBL,NFAC)
  380.             SEGSUP,NOMID
  381.           ELSE
  382.             CALL IDGRAD(MDM,IFOUR,MOCOMP,NOBL,NFAC)
  383.           ENDIF
  384.         ENDIF
  385.         GOTO 120
  386.  
  387. C       Composantes CONTRAINTES
  388.    4    continue
  389.         if (imeca.gt.0 .or. iliai.gt.0 .or. inast.gt.0 .or. 
  390.      &      ipore.gt.0 .or. idiff.gt.0 .or. ielec.gt.0 .or.
  391.      &      ichgm.gt.0) then
  392.           CALL IDCONT(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  393.         endif
  394. *           write(6,*) ' mocont ' , mocomp
  395.         if (dcmate.and.nimcom.gt.0) then
  396.           nbrobl = nimcom
  397.           nbrfac = nfac
  398.           nomid = mocomp
  399.           segadj nomid
  400.         endif
  401.         GOTO 120
  402.  
  403. C       Composantes DEFORMATION
  404.    5    continue
  405.         if (imeca.gt.0 .or. iliai.gt.0 .or. inast.gt.0 .or. 
  406.      &      ipore.gt.0 .or. idiff.gt.0 .or. ielec.gt.0 ) then
  407.           CALL IDDEFO(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  408.         endif
  409. *        write(6,*) ' modefo ',mocomp
  410.         if (dcmate.and.nimcom.gt.0) then
  411.           nbrobl = nimcom
  412.           nbrfac = nfac
  413.           nomid = mocomp
  414.           segadj nomid
  415.         endif
  416.         GOTO 120
  417.  
  418. C       Composantes MATERIAU
  419.    6    IF (lumato.le.0) THEN
  420.           CALL IDMATR(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  421.           NOMID=MOCOMP
  422. c          write(6,*) 'nobl',nobl,(lesobl(jj),jj=1,nobl)
  423. c          write(6,*) 'nfac',nfac,(lesfac(jj),jj=1,nfac)
  424.         ELSE
  425. C         Cas de la metallurgie
  426.           if( IMETA .gt. 0 ) then
  427.             mlmot5 = lumato
  428.             lumato = 0
  429.             segact mlmot5
  430.             nimcom = mlmot5.mots(/2)
  431. C             On a au plus (Nb_modele*3) vars internes materiaux obl
  432.             nbrobl = nimcom*3
  433.             nbrfac = 0
  434.             segini nomid
  435.             i_obl = 0
  436.             if(nimcom .GE. 1 .AND. nimcom .LT. 10 )then
  437.               FMT1 = '(I1)'
  438.             else
  439.               INTERR(1)=nimcom
  440.               INTERR(2)=10
  441.               CALL ERREUR(1076)
  442.               RETURN
  443.             endif
  444.  
  445.             do inim = 1,nimcom
  446.               CALL PLACE(TYPMET,NBMET,IMOT,mlmot5.mots(inim))
  447.                   i_obl = i_obl + 1
  448.               if (IMOT.eq.0) then
  449.                 MOTERR=mlmot5.mots(inim)
  450.                 CALL erreur(1082)
  451.                 RETURN
  452.               else if( imot .eq. 1) then
  453. C                 la formulation est LEBLOND
  454.                 LESOBL(i_obl)   = LEBLON(1)
  455.                 WRITE(LESOBL(i_obl  )(4:4), fmt=FMT1) inim
  456.                 LESOBL(i_obl+1) = LEBLON(2)
  457.                 WRITE(LESOBL(i_obl+1)(4:4), fmt=FMT1) inim
  458.                 LESOBL(i_obl+2) = LEBLON(3)
  459.                 WRITE(LESOBL(i_obl+2)(2:2), fmt=FMT1) inim
  460.                 i_obl = i_obl + 2
  461.               else if( imot .eq. 2) then
  462. C                 la formulation est KOISTINEN
  463.                 LESOBL(i_obl)   = KOISTI(1)
  464.                 WRITE(LESOBL(i_obl  )(3:3), fmt=FMT1) inim
  465.                 LESOBL(i_obl+1) = KOISTI(2)
  466.                 WRITE(LESOBL(i_obl+1)(3:3), fmt=FMT1) inim
  467.                 i_obl = i_obl + 1
  468.               endif
  469.             enddo
  470. C             on ajuste la taille du tableau LESOBL(nbrobl)
  471.             nbrobl = i_obl
  472.             segadj nomid
  473.             segact,nomid*NOMOD
  474.             mocomp=nomid
  475.           else if( IMETA .eq. 0 ) then
  476.             mlmots=lumato
  477.             segact MLMOTS
  478.             nbrobl=mots(/2)
  479.             nbrfac=0
  480.             IF (lumatf.GT.0) THEN
  481.               mlmot1=lumatf
  482.               segact mlmot1
  483.               nbrfac=mlmot1.mots(/2)
  484.             ENDIF
  485.             SEGINI,nomid
  486.             DO im=1,nbrobl
  487.               lesobl(im)=mots(im)
  488.             enddo
  489.             if(lumatf.gt.0) then
  490.               do im=1,nbrfac
  491.                 lesfac(im)=mlmot1.mots(im)
  492.               enddo
  493.             endif
  494.             mocomp=nomid
  495.           endif
  496.  
  497.         ENDIF
  498. *        write(6,*) ' momatr ',mocomp
  499.  
  500. C== FORMULATION HHO == Ajout de composantes specifiques ================
  501.         CALL HHOIDC(imodel,mocomp)
  502. C== FORMULATION HHO ====================================================
  503.  
  504.         GOTO 120
  505.  
  506. C       Composantes CARACTERISTIQUES GEOMETRIQUES
  507.    7    CONTINUE
  508.  
  509.         if(icont.eq.0.AND.(ICHGM.EQ.0.OR.(ICHGM.EQ.1.AND.MFR2.EQ.5)))
  510.      &   then
  511. * exception impedance
  512.           CALL IDCARA(IMODEL,MFR2,MOCOMP,NOBL,NFAC)
  513.           if (nobl.gt.0.or.nfac.gt.0) then
  514.           else
  515.             nomid = mocomp
  516.             segsup nomid
  517.             mocomp = 0
  518.           endif
  519.         endif
  520. *        write(6,*) ' mocara ',mocomp,nobl,nfac
  521.         GOTO 120
  522.  
  523. C       Composante TEMPERATURE
  524.    8    mocomp=0
  525.         if(ither.eq.0 .AND. icont.eq.0 .AND. ICHGM.EQ.0 .AND.
  526.      &     IDIFF.EQ.0 .AND. icntr.eq.0) THEN
  527.           CALL IDTEMP(MFR2,IFOUR,npint3,MOCOMP,NOBL,NFAC)
  528.         endif
  529. *        write(6,*) ' motemp ',mocomp
  530.         GOTO 120
  531.  
  532. C       Composantes des contraintes PRINCIPALES
  533.    9    continue
  534. c        if (d_mc) then
  535.         if(imeca.gt.0.or.iliai.gt.0.or.inast.gt.0.or.ipore.gt.0) then
  536.           CALL IDPRIN(MFR2,IFOUR,MOCOMP,NOBL,NFAC)
  537.         else if( IMETA .GT. 0 .OR. ITHER .GT. 0) then
  538. c          NOMID = IMODEL.LNOMID(3)
  539.           NBRFAC=0
  540.           NBROBL=0
  541.           SEGINI NOMID
  542.           MOCOMP=NOMID
  543.         else
  544.         endif
  545. *        write(6,*) ' moprin ',mocomp
  546.         GOTO 120
  547.  
  548. C       Composantes des VARIABLES INTERNES
  549.   10    CONTINUE
  550.         if ( imeca.gt.0 .or. iliai.gt.0 .or. inast.gt.0 .or.
  551.      &       ipore.gt.0 .or. idiff.gt.0 ) then
  552.             CALL IDVARI(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  553.         endif
  554.         if (luvari.ne.0) then
  555.           mlmots=luvari
  556.           segact MLMOTS
  557.           nomid= mocomp
  558.           if (nomid.GT.0) then
  559.             segact nomid*mod
  560.             ndej=lesobl(/2)
  561.             if(ndej.eq.1) ndej=0
  562.             nbrobl=mots(/2)+ndej
  563.             nbrfac=0
  564.             ista=ndej+1
  565.             segadj nomid
  566.             iau=1
  567.             do im=ista,nbrobl
  568.               lesobl(im)=mots(iau)
  569.               iau=iau+1
  570.             enddo
  571.           else
  572.             nbrobl=mots(/2)
  573.             nbrfac=0
  574.             segini nomid
  575.             do im=1,nbrobl
  576.               lesobl(im)=mots(im)
  577.             enddo
  578.           endif
  579.           mocomp=nomid
  580.         endif
  581. c        write(6,*) ' movari ', mocomp
  582. c        nomid = mocomp
  583. c        write(6,*) (lesobl(jj),jj=1,lesobl(/2))
  584.         GOTO 120
  585. *
  586. C       Composantes des GRADIENTS de FLEXION
  587.   11    continue
  588.         if (imeca.gt.0) then
  589.           CALL IDGRAF(MFR2,IFOUR,MOCOMP,NOBL,NFAC)
  590.           if (nobl.gt.0.or.nfac.gt.0) then
  591.           else
  592.             nomid = mocomp
  593.             segsup nomid
  594.             mocomp = 0
  595.           endif
  596.         endif
  597. *          write(6,*) ' movari ', mocomp
  598.         GOTO 120
  599.  
  600. C       Composantes des DES PHASES en formulation MELANGE
  601.   12    continue
  602. c  if(icont.eq.0.AND.ICHGM.EQ.0)
  603.         if (imela.gt.0) then 
  604.           CALL IDPHAS(MFR2,IMODEL,MOCOMP,NOBL,NFAC)
  605. c         write(6,*) 'inomidmophas ', mocomp,nobl,nfac,imela
  606.         endif
  607.         GOTO 120
  608.  
  609. C       Composantes des DEFORMATIONS INELASTIQUES
  610.   13    continue
  611.         if(imeca.gt.0.or.iliai.gt.0.or.inast.gt.0.or.ipore.gt.0) then
  612.           CALL IDDEIN(IMODEL,IFOUR,MOCOMP,NOBL,NFAC)
  613.         endif
  614. *          write(6,*) ' modein ', mocomp
  615.         GOTO 120
  616.  
  617. C       Composantes des PARAMETRES EXTERNES (LISTMOTS)
  618.   14    continue
  619.         IF (LUPAEX.GT.0) THEN
  620.           mlmots=lupaex
  621.           segact MLMOTS
  622.           nbrobl=mots(/2)
  623.           nbrfac=0
  624.           segini nomid
  625.           do im=1,nbrobl
  626.             lesobl(im)=mots(im)
  627.           enddo
  628.           mocomp=nomid
  629. *         write(6,*)'  mopaex ',nomid
  630.         ENDIF
  631.         GOTO 120
  632. *
  633. C       15 a 19 : Pour les besoins de 'COMP' (SUBROUTINE comou2)
  634. C       Composantes VIDE
  635.   15    continue
  636.         if (imeca.gt.0.or.iliai.gt.0) then
  637.           NBROBL=0
  638.           NBRFAC=0
  639.           SEGINI NOMID
  640.           MOCOMP=NOMID
  641.         else if(inast.gt.0) then
  642.           NBROBL = 3
  643.           NBRFAC = 0
  644.           SEGINI NOMID
  645.           LESOBL(1) = 'FLX1'
  646.           LESOBL(2) = 'FLX2'
  647.           LESOBL(3) = 'FLX3'
  648.           MOCOMP = NOMID
  649.         endif
  650.         GOTO 120
  651.  
  652. C       Composantes 'SCAL'
  653.   16    continue
  654.         if (imeca.gt.0.or.iliai.gt.0.or.ipore.gt.0) then
  655.           NBROBL=1
  656.           NBRFAC=0
  657.           SEGINI NOMID
  658.           LESOBL(1)='SCAL'
  659.           MOCOMP=NOMID
  660.         else if(inast.gt.0) then
  661.           NBROBL = 3
  662.           NBRFAC = 0
  663.           SEGINI NOMID
  664.           LESOBL(1) = 'LX1'
  665.           LESOBL(2) = 'LX2'
  666.           LESOBL(3) = 'LX3'
  667.           MOCOMP = NOMID
  668.         endif
  669.         GOTO 120
  670.  
  671. C       Composantes 'TEMP'
  672.   17    continue
  673.         if (icntr.eq.0) then
  674.           NBROBL=1
  675.           NBRFAC=0
  676.           SEGINI NOMID
  677.           LESOBL(1)='TEMP'
  678.           MOCOMP=NOMID
  679.         endif
  680.         GOTO 120
  681.  
  682. C       Composantes 'MAHO'
  683.   18    continue
  684.         if(imeca.gt.0.and.imatee.le.3) then
  685.           NBROBL=1
  686.           NBRFAC=0
  687.           SEGINI NOMID
  688.           LESOBL(1)='MAHO'
  689.           MOCOMP=NOMID
  690.         endif
  691.         GOTO 120
  692.  
  693. C       Composantes 'MAHT'
  694.   19    continue
  695.         if(imeca.gt.0.and.imatee.le.3) then
  696.           NBROBL=1
  697.           NBRFAC=0
  698.           SEGINI NOMID
  699.           LESOBL(1)='MAHT'
  700.           MOCOMP=NOMID
  701.         endif
  702.         GOTO 120
  703.  
  704.   120   CONTINUE
  705.         nomid = mocomp
  706.         imodel.lnomid(ino) = mocomp
  707.  
  708. C Fin du DO ino=1,ntyp
  709.       ENDDO
  710.  
  711. C Retour en *nomod effectue dans modeli
  712. C      segact,imodel*nomod
  713.  
  714. c      RETURN
  715.       END
  716.  
  717.  
  718.  
  719.  
  720.  
  721.  
  722.  
  723.  
  724.  

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