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

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