Télécharger la plaquette Cast3M


fr en

Télécharger matcar.eso

Retour à la liste

Numérotation des lignes : 

matcar

  1. C MATCAR    SOURCE    PV090527  25/10/07    21:15:01     12350          
  2.  
  3. *--------------------------------------------------------------------*
  4. *                                                                    *
  5. *   Sous-programme associe a l'operateur MATE et CARA                *
  6. *   __________________________________________________               *
  7. *                                                                    *
  8. *   Creation d'un champ de caracteristiques materielles et/ou        *
  9. *   geometriques.                                                    *
  10. *                                                                    *
  11. *   Commentaire :                                                    *
  12. *                                                                    *
  13. *    - En utilisant MATE : On est autorise a donner des caracteris-  *
  14. *                          tiques materielles et geometriques.       *
  15. *                          MONCAS = 'MATERIAU'                       *
  16. *                          Toutes les autres composantes ne seront   *
  17. *                          pas prises en compte.                     *
  18. *                                                                    *
  19. *    - En utilisant CARA : On est autorise a donner des caracteris-  *
  20. *                          tiques geometriques.                      *
  21. *                          MONCAS = 'CARACTER'                       *
  22. *                          Toutes les autres composantes ne seront   *
  23. *                          pas prises en compte.                     *
  24. *                                                                    *
  25. *   Remarque importante:                                             *
  26. *                                                                    *
  27. *   Un certain nombre de composantes par defaut est requis lors      *
  28. *   d'un processus de calcul. Il est possible d'en definir d'autres  *
  29. *   a la convenance de l'utilisateur. L'appel a MATCAR devra alors   *
  30. *   se faire avec MONCAS <> 'CARACTER' et MONCAS <> 'MATERIAU'.      *
  31. *                                                                    *
  32. *   Auteur, date de creation:                                        *
  33. *   -------------------------                                        *
  34. *                                                                    *
  35. *   Denis ROBERT-MOUGIN, le 21 decembre 1987.                        *
  36. *                                                                    *
  37. * - Mise a niveau avec MATE pour les materiaux ORTHOTROPES par :     *
  38. *   jm CAMPENON le 29 08 90                                          *
  39. *                                                                    *
  40. * - Autoriser uniquement la prise en compte des :                    *
  41. *      - carac. geom. quand provenance de CARB (MONCAS = 'CARACTER') *
  42. *      - carac. geom. et mater. quand provenance de MATR             *
  43. *        (MONCAS = 'MATERIAU')                                       *
  44. *   jm CAMPENON le 23 10 90                                          *
  45. *                                                                    *
  46. * -MISE A NIVEAU  POUR L'ANISOTROPIE ET L'ORTHOTROPIE DANS LES       *
  47. *  ELEMENTS MASSIFS  PAR P. DOWLATYARI OCT. 90                       *
  48. *--------------------------------------------------------------------*
  49.  
  50.       SUBROUTINE MATCAR(MONCAS)
  51.  
  52.       IMPLICIT INTEGER(I-N)
  53.       IMPLICIT REAL*8 (A-H,O-Z)
  54.  
  55. -INC PPARAM
  56. -INC CCOPTIO
  57. -INC CCREEL
  58. -INC CCHAMP
  59.  
  60. -INC SMLMOTS
  61. -INC SMLREEL
  62. -INC SMLENTI
  63. -INC SMMODEL
  64.       POINTEUR MOMATR.NOMID, MOCARA.NOMID
  65. -INC SMTABLE
  66. -INC SMELEME
  67. -INC SMCHAML
  68.  
  69. *     MOMATR pointera sur la liste des caracteristiques materielles
  70. *     MOCARA pointera sur la liste des caracteristiques geometriques
  71.  
  72.       CHARACTER*(*) MONCAS
  73.  
  74.       REAL*8      RECOM,RECOM2
  75.       LOGICAL     RFLAG,lsupca,d_mela,d_nast
  76.       CHARACTER*(LOCOMP) MOBUF
  77.       CHARACTER*(4) MOCHOI
  78.       CHARACTER*8 CAR,CMATE
  79.       CHARACTER*16 LETYP
  80.       LOGICAL Log0,Log1
  81.       CHARACTER*8 TYPRET,CHARRE
  82.  
  83. C     Tableau fixe pour appel a LIRMOT sans ARGUMENT ELEMENT DE SEGMENT
  84.       PARAMETER ( NMOT1=500 )
  85.       CHARACTER*(LOCOMP) CMOTS1(NMOT1)
  86.  
  87.       EXTERNAL LONG
  88.  
  89. *     MONCAS='MATERIAU' --> IFLAG=1 (SEULEMENT LES CARAC. GEOM. ET
  90. *                                    MATER. : MATE)
  91. *     MONCAS='CARACTER' --> IFLAG=2 (SEULEMENT LES CARAC. GEOM. : CARA)
  92. *                           IFLAG=0 tous les noms composantes voulues
  93.       IFLAG=0
  94.       IF (MONCAS(1:8).EQ.'CARACTER') IFLAG=2
  95.       IF (MONCAS(1:8).EQ.'MATERIAU') IFLAG=1
  96. *
  97. *     Lecture d'un MODELE :
  98. *
  99.       TYPRET = 'MMODEL  '
  100.       MOTERR = ' MODELE '
  101.       CALL MESLIR(-137)
  102.       CALL LIROBJ(TYPRET,IPMODE,1,IRET)
  103.       IF (IERR.NE.0) RETURN
  104.       CALL ACTOBJ(TYPRET,IPMODE,1)
  105.       IF (IERR.NE.0) RETURN
  106.  
  107.       MMODEL = IPMODE
  108.       N1 = mmodel.KMODEL(/1)
  109.  
  110.       JER1 = 16
  111.       LETYP = 'CARACTERISTIQUES'
  112.  
  113. * Cas particulier du mmodel VIDE (N1 = 0)
  114.       IF (N1.EQ.0) THEN
  115.         N1 = 0
  116.         N3 = 6
  117.         L1 = JER1
  118.         SEGINI,MCHELM
  119.         mchelm.IFOCHE = IFOUR
  120.         mchelm.TITCHE = LETYP
  121.         ICARA = mchelm
  122.         CALL ACTOBJ('MCHAML  ',ICARA,1)
  123.         CALL ECROBJ('MCHAML  ',ICARA)
  124.         RETURN
  125. *       CALL ERREUR(xx)
  126. *       GOTO 99
  127. *      ELSE IF (N1.GT.1) THEN
  128. *        write(ioimp,*) '(WARNING) MATCAR : N1 > 1 !!'
  129.       ENDIF
  130. *
  131. *     Initialisation des segments
  132. *
  133.       JG =0
  134.       JGN=LOCOMP
  135.       JGM=0
  136.       SEGINI,MLMOTS
  137.       SEGINI,MLMOT1
  138.       SEGINI,MLMOT2
  139.       SEGINI,MLMOT3
  140.       SEGINI,MLREE1
  141.       SEGINI,MLENT2
  142.  
  143.       ICARA = 0
  144.       IVECT = 0
  145.  
  146.       NUDIR1 = 0
  147.       NUDIR2 = 0
  148.       NUMP1  = 0
  149.       NUMP2  = 0
  150.       NUMP3  = 0
  151.       ANG    = 0.D0
  152.       ANG2   = 0.D0
  153.       IPLIQU = 0
  154.       IRACOR = 0
  155.  
  156.       ITHER = 0
  157.       IDIFF = 0
  158.       IMETA = 0
  159.       ICHPH = 0
  160.       ICONT = 0
  161.       IMELA = 0
  162. **      ILIMA = 0
  163.  
  164.       IGEO  = 0
  165.       ICOUD = 0
  166.       RFLAG = .FALSE.
  167.       ITBAS = 0
  168.       ITMOD = 0
  169.  
  170.       MOMATR = 0
  171.       MOCARA = 0
  172.       lsupca = .false.
  173.  
  174. * Ici on ne travaille que sur le 1er sous-modele !
  175. * Ce qui suppose que tous les autres sont identiques au 1er !!! 
  176.       IMODEL = mmodel.KMODEL(1)
  177.  
  178.       NFOR  = imodel.FORMOD(/2)
  179.       NMAT  = imodel.MATMOD(/2)
  180.       CMATE = imodel.CMATEE
  181.       MATE  = imodel.IMATEE
  182.       INAT  = imodel.INATUU
  183. *     Normalement ici, pas de souci ?
  184.       IF (CMATE.EQ.' ')THEN
  185.         CALL ERREUR(251)
  186.         GOTO 99
  187.       ENDIF
  188.  
  189.       IF (NFOR.EQ.2) THEN
  190.         IF ( (FORMOD(1).EQ.'MECANIQUE       '.AND.
  191.      1        FORMOD(2).EQ.'LIQUIDE         ') .OR.
  192.      2       (FORMOD(1).EQ.'LIQUIDE         '.AND.
  193.      3        FORMOD(2).EQ.'MECANIQUE       ') ) IRACOR=1
  194.       ENDIF
  195.  
  196.       CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
  197.       CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION')
  198.       CALL PLACE(FORMOD,NFOR,ICONT,'CONTACT')
  199.       CALL PLACE(FORMOD,NFOR,IMELA,'MELANGE')
  200.       CALL PLACE(FORMOD,NFOR,IMETA,'METALLURGIE')
  201.       CALL PLACE(FORMOD,NFOR,ICHPH,'CHANGEMENT_PHASE')
  202. *      CALL PLACE(FORMOD,NFOR,ILIMA,'LIAISON_MATERIELLE')
  203.  
  204. C= Element fini et formulation associee
  205. C= En DIMEnsion 1, on force formulation MASSIVE pour les elements POI1
  206. C= (utilises en convection et en rayonnement).
  207.       MELE = imodel.NEFMOD
  208.       MFR1 = NUMMFR(MELE)
  209.       IF (IDIM.EQ.1.AND.MELE.EQ.45) MFR1 = 1
  210.  
  211.       MOMATR  = imodel.lnomid(6)
  212.       NBRMAT  = momatr.lesobl(/2)
  213.       NBRMATF = momatr.lesfac(/2)
  214.       IF (nbrmat+nbrmatf .EQ. 0) THEN
  215.         MOTERR      = 'MATE    '
  216.         MOTERR(5:8) = NOMTP(MELE)
  217.         CALL ERREUR(76)
  218.         GO TO 99
  219.       ENDIF
  220. c*dbg      write(ioimp,*) 'MOMATR =',momatr,nbrmat,nbrmatf
  221.  
  222.       MOCARA = imodel.lnomid(7)
  223.       if (mocara.ne.0) THEN
  224.         lsupca  = .false.
  225.         NBRCAR  = mocara.lesobl(/2)
  226.         NBRCARF = mocara.lesfac(/2)
  227.       else
  228. c*dbg        write(ioimp,*) 'MATCAR : lsupca = T'
  229.         lsupca = .true.
  230.         CALL IDCARB(MELE,IFOUR,MOCARA,NBRCAR,NBRCARF)
  231.       endif
  232. c*dbg      write(ioimp,*) 'MOCARA =',mocara,lnomid(7),nbrcar,nbrcarf
  233.  
  234. C  Concatenation des MOTS attendus pour le LIRMOT discriminant
  235.       JC4 = NBRMAT + NBRMATF + NBRCAR + NBRCARF
  236.       IF (JC4 .GT. NMOT1) THEN
  237.         WRITE(ioimp,*) 'AUGMENTER LA TAILLE DE CMOTS1 DANS MATCAR.ESO'
  238.         CALL ERREUR(5)
  239.         RETURN
  240.       ENDIF
  241.       MJC4  = -JC4
  242.  
  243.       DO IC = 1, NBRMAT
  244.         CMOTS1(IC) = momatr.LESOBL(IC)
  245.       ENDDO
  246.       JC1 = NBRMAT
  247.       DO IC = 1, NBRMATF
  248.         CMOTS1(JC1+IC) = momatr.LESFAC(IC)
  249.       ENDDO
  250.       JC3 = JC1 + NBRMATF
  251.       DO IC = 1, NBRCAR
  252.         CMOTS1(JC3+IC) = mocara.LESOBL(IC)
  253.       ENDDO
  254.       JC2 = JC3 + NBRCAR
  255.       DO IC = 1, NBRCARF
  256.         CMOTS1(JC2+IC) = mocara.LESFAC(IC)
  257.       ENDDO
  258. **      JC4 = JC2 + NBRCARF
  259. c*dbg      write(ioimp,*) 'JC4 = ',MJC4,JC1,JC2,JC3,JC4
  260. c*dbg      write(ioimp,*) ('=',cmots1(ic),'=',ic=1,nmot1)
  261.  
  262.       MOCHOI = ' '
  263.  
  264.       IMIL   = 1
  265.  
  266.  10   CONTINUE
  267.       IF (IMIL.EQ.0) CALL MESLIR(-175)
  268.       INCM1  = 0
  269.       INCM2  = 0
  270.       INCM3  = 0
  271.       INCM4  = 0
  272.  
  273.       MOBUF = ' '
  274.       IRBUF  = 0
  275.       IRCHOI = 0
  276.  
  277. C     LIRMOT appele avec MJC4<0 => on utilise des abreviations
  278.       CALL LIRMOT(CMOTS1,MJC4,IPLACE,0)
  279.       IF (IERR.NE.0) GOTO 99
  280. c*dbg      write(ioimp,*) 'matcar apres lirmot ',iplace
  281.  
  282.       IF (IPLACE .EQ. 0) THEN
  283.         CALL LIRCHA(MOBUF,0,IRBUF)
  284.         IF (IERR .NE.0) GOTO 99
  285.         IF (IRBUF.EQ.0) GOTO 20
  286.         MOBUF=MOBUF(1:LOCOMP)
  287.         MOCHOI=MOBUF(1:4)
  288.         IRCHOI=MIN(IRBUF,4)
  289.  
  290. *     On desire lire une composante "quelconque" :
  291.         IF      (MOCHOI.EQ.'PARA') THEN
  292.           NUDIR2=1
  293.           GOTO 10
  294.         ELSE IF (MOCHOI.EQ.'PERP') THEN
  295.           NUDIR2=2
  296.           GOTO 10
  297.         ENDIF
  298.  
  299.       ELSE
  300.         IF      (IPLACE.GT.0   .AND. IPLACE.LE.JC1) THEN
  301.           INCM1 = IPLACE
  302.         ELSE IF (IPLACE.GT.JC1 .AND. IPLACE.LE.JC3) THEN
  303.           INCM3 = IPLACE - JC1
  304.         ELSE IF (IPLACE.GT.JC3 .AND. IPLACE.LE.JC2) THEN
  305.           INCM2 = IPLACE - JC3
  306.         ELSE
  307.           INCM4 = IPLACE - JC2
  308.         ENDIF
  309.         MOBUF=CMOTS1(IPLACE)
  310.         IRBUF=LONG(MOBUF)
  311.       ENDIF
  312.       if (mobuf(1:4).eq.'VECT') IVECT = 1
  313. c*dbg      write(ioimp,*) 'mochoi & irchoi',mochoi,irchoi,iplace
  314.  
  315.       IMIL=0
  316. *
  317. *    PETIT TEST POUR COQ3 NON EXCENTRABLE    MILL 21 / 2 /92
  318. *
  319.       IF (MELE.EQ.27.AND.MFR1.EQ.3) THEN
  320.         IF (MOBUF.EQ.'EXCE') THEN
  321.           CALL ERREUR(474)
  322.           GOTO 99
  323.         ENDIF
  324.       ENDIF
  325.  
  326. **    write(ioimp,*) 'mobuf & irbuf',mobuf,irbuf
  327.  
  328. * kich test mot cle
  329.       IF (MOBUF.EQ.'REND') RFLAG = .TRUE.
  330. *
  331. *     Lecture eventuelle d'un flottant
  332. *
  333.       CALL LIRREE(RECOM,0,IRET2)
  334.       IF (IRET2.EQ.1) THEN
  335. *
  336. *       kich rendement cas isotrope
  337. *
  338.         IF (RFLAG.AND.MOBUF.EQ.'REND') RFLAG = .FALSE.
  339. *
  340. *  Dans le cas ou on lit le mot incline on peut eventuellement trouver
  341. *  en plus de l'angle un point donnant la direction de la normale
  342. *  exterieure a la coque
  343. *
  344.         IF (MOCHOI.EQ.'INCL'.AND.IRCHOI.NE.0) THEN
  345.            NUDIR2=3
  346.            ANG=RECOM*XPI/180.D0
  347.            IF ((IDIM.EQ.3.AND.MFR1.EQ.3) .OR. MFR1.EQ.9 .OR.
  348.      &         MFR1.EQ.5 .OR. (IDIM.EQ.3.AND.MFR1.EQ.35)) THEN
  349.               CALL LIROBJ('POINT',NUMP3,0,IRET)
  350.               IF (IERR.NE.0) GOTO 99
  351.            ENDIF
  352. *          en 2D, 2eme angle possible pour rotation hors plan
  353.            IF (IFOUR.EQ.1) THEN
  354.               CALL LIRREE(RECOM2,0,IRET)
  355.               IF (IRET.NE.0) ANG2=RECOM2*XPI/180.D0
  356.            ENDIF
  357.            GOTO 10
  358.         ENDIF
  359.         IF (IFLAG.NE.2) THEN
  360.            IF (INCM1.NE.0) MLMOT1.MOTS(**) = momatr.LESOBL(INCM1)
  361.            IF (INCM3.NE.0) MLMOT1.MOTS(**) = momatr.LESFAC(INCM3)
  362.         ELSE
  363.            IF (INCM1.NE.0) THEN
  364.               MOTERR = momatr.LESOBL(INCM1)
  365.               CALL ERREUR (197)
  366.               GOTO 99
  367.            ENDIF
  368.            IF (INCM3.NE.0) THEN
  369.              MOTERR = momatr.LESFAC(INCM3)
  370.              CALL ERREUR (197)
  371.              GOTO 99
  372.            ENDIF
  373.         ENDIF
  374.  
  375.         IF (INCM2.NE.0) MLMOT1.MOTS(**) = mocara.LESOBL(INCM2)
  376.         IF (INCM4.NE.0) MLMOT1.MOTS(**) = mocara.LESFAC(INCM4)
  377.  
  378.         IF (IFLAG.EQ.0) THEN
  379.            IF (IRCHOI.NE.0) MLMOT1.MOTS(**) = MOCHOI
  380.         ELSE
  381.            IF (IRCHOI.NE.0) THEN
  382.               MOTERR = MOCHOI
  383.               CALL ERREUR(197)
  384.               GOTO 99
  385.            ENDIF
  386.         ENDIF
  387.  
  388.         JG=MLREE1.PROG(/1)+1
  389.         SEGADJ MLREE1
  390.         MLREE1.PROG(JG)=RECOM
  391.  
  392.       ELSE
  393.         CALL QUETYP(CAR,0,IRET1)
  394.         IF (IERR.NE.0) GO TO 99
  395.         IF (RFLAG)THEN
  396.           IF (CAR.EQ.'MOT ')THEN
  397.             GOTO 10
  398.           ELSE
  399. * kich matrice rendement
  400.             IF (MOCHOI.EQ.'REND'.AND.IRCHOI.NE.0) RFLAG = .FALSE.
  401.           ENDIF
  402.         ENDIF
  403.         CALL LIROBJ(CAR,IPTRUC,0,IRET)
  404.         IF (IRET .EQ. 1) CALL ACTOBJ(CAR,IPTRUC,1)
  405.         IF (IERR.NE.0) GO TO 99
  406. *
  407. *       On a lu un objet de type autre que flottant
  408. *
  409.         IF (IRACOR.EQ.1.AND.MOCHOI.EQ.'LIQU'.AND.IRCHOI.NE.0) THEN
  410.           IF (CAR.NE.'MAILLAGE') THEN
  411.             MOTERR ='MAILLAGE'
  412.             CALL ERREUR(37)
  413.             GOTO 99
  414.            ELSE
  415.             IPLIQU=IPTRUC
  416.             GOTO 10
  417.           ENDIF
  418.  
  419.         ELSEIF (MOCHOI.EQ.'DIRE'.AND.IRCHOI.NE.0) THEN
  420.           IF (MATE.NE.1.AND.MATE.NE.2.AND.MATE.NE.3.AND.MATE.NE.4.AND.
  421.      &           .NOT.RFLAG)THEN
  422.             CALL ERREUR(728)
  423.             GOTO 99
  424.           ENDIF
  425.           IF (CAR.NE.'POINT')THEN
  426.             MOTERR ='POINT'
  427.             CALL ERREUR(37)
  428.             GOTO 99
  429.           ELSE
  430.             NUDIR1=1
  431.             NUMP1=IPTRUC
  432.           ENDIF
  433. *
  434. *       DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
  435. *
  436.           IF ((MFR1.EQ.1  .OR. MFR1.EQ.31 .OR.
  437.      &         MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
  438.      S        .AND. IDIM.EQ.3)THEN
  439.             CALL LIROBJ(CAR,NUMP2,0,IRET)
  440.             IF (IERR.NE.0.OR.IRET.EQ.0) GOTO 99
  441.           ENDIF
  442.           GOTO 10
  443.  
  444.         ELSEIF (MOCHOI.EQ.'RADI'.AND.IRCHOI.NE.0) THEN
  445.           IF(CAR.NE.'POINT')THEN
  446.             MOTERR ='POINT'
  447.             CALL ERREUR(37)
  448.             GOTO 99
  449.           ELSE
  450.             NUDIR1=2
  451.             NUMP1=IPTRUC
  452.           ENDIF
  453. *
  454. *       DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS
  455. *
  456.           IF ((MFR1.EQ.1  .OR. MFR1.EQ.31 .OR.
  457.      &         MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75)
  458.      S         .AND. IDIM.EQ.3)THEN
  459.             CALL LIROBJ(CAR,NUMP2,0,IRET)
  460.             IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99
  461.           ENDIF
  462.           GOTO 10
  463.         ENDIF
  464. *
  465.         IF(IFLAG.NE.2)THEN
  466.            IF(INCM1.NE.0)  MLMOT2.MOTS(**) = momatr.LESOBL(INCM1)
  467.            IF(INCM3.NE.0)  MLMOT2.MOTS(**) = momatr.LESFAC(INCM3)
  468.         ELSE
  469.            IF (INCM1.NE.0)THEN
  470.              MOTERR = momatr.LESOBL(INCM1)
  471.              CALL ERREUR (197)
  472.              GOTO 99
  473.            ENDIF
  474.            IF (INCM3.NE.0)THEN
  475.              MOTERR =LESFAC(INCM3)
  476.              CALL ERREUR (197)
  477.              GOTO 99
  478.            ENDIF
  479.         ENDIF
  480.  
  481.         IF (INCM2.NE.0) MLMOT2.MOTS(**) = mocara.LESOBL(INCM2)
  482.         IF (INCM4.NE.0) MLMOT2.MOTS(**) = mocara.LESFAC(INCM4)
  483.  
  484.         IF (IFLAG.EQ.0)THEN
  485.            IF (IRCHOI.NE.0) MLMOT2.MOTS(**) = MOCHOI
  486.         ELSE
  487.            IF (IRCHOI.NE.0) THEN
  488.               MOTERR =MOCHOI
  489.               CALL ERREUR (197)
  490.               GOTO 99
  491.            ENDIF
  492.         ENDIF
  493.  
  494.         JGM = MLMOT3.MOTS(/2)
  495.         MLMOT3.MOTS(**)=CAR(1:4)
  496.         MOTS(**)       =CAR(5:8)
  497.         JG=MLENT2.LECT(/1)+1
  498.         SEGADJ MLENT2
  499.         MLENT2.LECT(JG)=IPTRUC
  500.       ENDIF
  501.       GOTO 10
  502. *     END DO
  503.  
  504.  20   CONTINUE
  505.  
  506. *  DANS LE CAS DES TUYAUX 3D ,ON REGARDE SI LES CARACTERISTIQUES
  507. *  GEOMETRIQUES ONT ETE DONNEES ,SI OUI ON VERIFIE SI ON EST
  508. *  DANS LE CAS DES COUDES
  509. *
  510.       IF (MFR1.EQ.13.AND.IDIM.EQ.3) THEN
  511.         CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'RAYO')
  512.         IF (IGEO.NE.0) THEN
  513.           CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICOUD,'RACO')
  514.         ENDIF
  515.       ENDIF
  516. *
  517. *  DANS LE CAS DES POUTRES 3D ,ON REGARDE SI LES CARACTERISTIQUES
  518. *  GEOMETRIQUES ONT ETE DONNEES
  519. *
  520.       IF(MFR1.EQ.7)THEN
  521.         CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'SECT')
  522.       ENDIF
  523. *
  524. *  TRAITEMENT MODELE DDI
  525. *
  526.       IF(INAT.EQ.63)THEN
  527.         JC = MLMOT1.MOTS(/2)
  528.         CALL PLACE(MLMOT1.MOTS,JC,IDP1,'DP1')
  529.         CALL PLACE(MLMOT1.MOTS,JC,IDP2,'DP2')
  530.         CALL PLACE(MLMOT1.MOTS,JC,IDV1,'DV1')
  531.         CALL PLACE(MLMOT1.MOTS,JC,IDV2,'DV2')
  532.         CALL PLACE(MLMOT1.MOTS,JC,ICP1,'CP1')
  533.         CALL PLACE(MLMOT1.MOTS,JC,ICP2,'CP2')
  534.         CALL PLACE(MLMOT1.MOTS,JC,ICV1,'CV1')
  535.         CALL PLACE(MLMOT1.MOTS,JC,ICV2,'CV2')
  536.  
  537.         IF((MLREE1.PROG(ICP1).EQ.0.D0).AND.(MLREE1.PROG(IDP1).NE.0.D0))
  538.      &   THEN
  539.           CALL ERREUR(906)
  540.           RETURN
  541.         ENDIF
  542.         IF((MLREE1.PROG(ICP2).EQ.0.D0).AND.(MLREE1.PROG(IDP2).NE.0.D0))
  543.      &   THEN
  544.           CALL ERREUR(906)
  545.           RETURN
  546.         ENDIF
  547.         IF((MLREE1.PROG(ICV1).EQ.0.D0).AND.(MLREE1.PROG(IDV1).NE.0.D0))
  548.      &   THEN
  549.           CALL ERREUR(906)
  550.           RETURN
  551.         ENDIF
  552.         IF((MLREE1.PROG(ICV2).EQ.0.D0).AND.(MLREE1.PROG(IDV2).NE.0.D0))
  553.      &   THEN
  554.           CALL ERREUR(906)
  555.           RETURN
  556.         ENDIF
  557.       ENDIF
  558.  
  559. *  VERIFICATIONS CAS D'UN MODELE MODAL
  560.       IF(MFR1.EQ.27.AND.MELE.EQ.45)THEN
  561.         CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'FREQ')
  562.         IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN
  563.           IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN
  564.             MOTERR ='FREQ    '
  565.             CALL ERREUR(549)
  566.             RETURN
  567.           ENDIF
  568.         ENDIF
  569.         CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'MASS')
  570.         IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN
  571.           IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN
  572.             MOTERR ='MASS    '
  573.             CALL ERREUR(549)
  574.             RETURN
  575.           ENDIF
  576.         ENDIF
  577.       ENDIF
  578.  
  579. * tri redondance mlmot1
  580.       JGM=mlmot1.mots(/2)
  581.       JG = mlree1.prog(/1)
  582.       IF(jgm.ge.2)THEN
  583.       segini mlmot5
  584.       mlmot5.mots(1) = mlmot1.mots(1)
  585.       ik5 = 1
  586.       do 151 jj = 2, jgm
  587.        do jj5 = 1, ik5
  588.         IF(mlmot1.mots(jj).eq.mlmot5.mots(jj5))THEN
  589.          call erreur(674)
  590.          return
  591.         endif
  592.        enddo
  593.        ik5 = ik5 + 1
  594.        mlmot5.mots(ik5) = mlmot1.mots(jj)
  595.  151  continue
  596.       segsup mlmot5
  597.       endif
  598.  
  599. C     Traitement particulier pour le modele de Gurson2
  600.       IF (INAT.EQ.64) THEN
  601.         JC = MLMOT1.MOTS(/2)
  602.         CALL PLACE(MLMOT1.MOTS, JC, IQ1, 'Q   ')
  603.         CALL PLACE(MLMOT1.MOTS, JC, IQ2, 'Q2  ')
  604.         CALL PLACE(MLMOT1.MOTS, JC, IQ3, 'Q3  ')
  605.         IF (IQ2.EQ.0) THEN
  606.           JG = MLREE1.PROG(/1) + 1
  607.           SEGADJ MLREE1
  608.           MLREE1.PROG(JG) = 1.D0
  609.           JGM = MLMOT1.MOTS(/2) + 1
  610.           SEGADJ MLMOT1
  611.           MLMOT1.MOTS(JGM) = 'Q2  '
  612.         ENDIF
  613.         IF (IQ3.EQ.0) THEN
  614.           IF (IQ1.EQ.0) THEN
  615.             MOTERR = 'MATCAR : INAT=64 Gurson2 - Q et Q3 non fournis'
  616.             CALL ERREUR(-385)
  617.             CALL ERREUR(21)
  618.             GOTO 99
  619.           ENDIF
  620.           JG = MLREE1.PROG(/1) + 1
  621.           SEGADJ MLREE1
  622.           MLREE1.PROG(JG) = (MLREE1.PROG(IQ1))**2
  623.           JGM = MLMOT1.MOTS(/2) + 1
  624.           SEGADJ MLMOT1
  625.           MLMOT1.MOTS(JGM) = 'Q3  '
  626.         ENDIF
  627.       ENDIF
  628.  
  629.       IF ((IRACOR.EQ.0.AND.IPLIQU.EQ.0.and.nefmod.ne.45).OR.
  630.      &     MLMOT1.MOTS(/2) .NE. 0 .OR. MLMOT2.MOTS(/2).NE.0) THEN
  631.  
  632.         IF (ITHER.NE.0 .OR. IDIFF.NE.0 .OR. IMETA.NE.0) THEN
  633.           IF (MFR1 .EQ. 75) THEN
  634. C           Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES
  635. C           ====================
  636.             ISUPCA =1
  637.  
  638.           ELSE
  639.             CALL PLACE(matmod,NMAT,iray,'RAYONNEMENT')
  640. C           Support 6 SAUF pour le RAYONNEMENT...
  641. C           Les cas-tests de RAYONNEMENT sont en erreur sans ca...
  642.             IF(iray.EQ.0)THEN
  643.               ISUPCA = 6
  644.             ELSE
  645.               ISUPCA = 3
  646.             ENDIF
  647.           ENDIF
  648.  
  649.         ELSEIF(ICONT.NE.0 .OR. ICHPH.NE.0)THEN
  650.           ISUPCA=1
  651.  
  652.         ELSE
  653.           ISUPCA=3
  654.         ENDIF
  655.  
  656.         itart = 0
  657.         CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1,
  658.      &              MLENT2,LETYP,JER1,ISUPCA,ICARA,itart)
  659.         IF (IERR.NE.0) GOTO 99
  660.       ENDIF
  661.  
  662. *     TRAITEMENT POUR LES ELEMENTS RACCORDS FLUIDE/STRUCTURE
  663. *
  664.       IF (IRACOR.NE.0.AND.IPLIQU.NE.0) THEN
  665.         CALL VRACOR(IPMODE,IPLIQU,IFLAG,ICARA)
  666.         IF (IERR.NE.0) GOTO 99
  667.       ENDIF
  668.  
  669. *  TRAITEMENT PARTICULIER POUR LES POUTRES ET TUYAUX
  670. *  PB DU VECTEUR LOCAL   - MILL FEV 92
  671. **    write(6,*) 'matcar avant pouvlo',mfr1,icoud,igeo
  672. **    IF((MFR1.EQ.7.OR.(MFR1.EQ.13.AND.ICOUD.EQ.0))
  673.       IF((MFR1.EQ.7.OR.(MFR1.EQ.13               ))
  674.      &  .and.(IVECT.ne.0.or.IGEO.NE.0).AND.IDIM.EQ.3)THEN
  675. **   &                               .AND.IDIM.EQ.3)THEN
  676.         CALL POUVLO(IPMODE,MLMOT2,ISUPCA,ICARA)
  677.         IF (IERR.NE.0) GOTO 99
  678.       ENDIF
  679. *
  680. *     Traitement pour les materiaux orthotropes
  681. *
  682. C= Dans le cas IDIM=1, on ne traite pas les mots cles PARA,DIRE,PERP...
  683. C= car les directions d'orthotropie correspondent au repere global
  684.       d_mela = formod(1).ne.'MELANGE'
  685.       d_nast = formod(1).ne.'NAVIER_STOKES'
  686.       IF(IFLAG.NE.2.and.nefmod.ne.45.and.d_mela.and.d_nast.and.
  687.      &   IMETA.eq.0.AND.ICHPH.EQ.0)  THEN
  688.         IF (IDIM.NE.1) THEN
  689.           CALL IDMAT2(IPMODE,ICARA,NUDIR1,NUMP1,NUMP2,NUDIR2,
  690.      &                NUMP3,ANG,ANG2,IPCARA,RFLAG)
  691.           IF (IERR.NE.0) GO TO 99
  692.           IF (IPCARA.NE.0) THEN
  693.             CALL DTCHAM(ICARA)
  694.             ICARA=IPCARA
  695.           ENDIF
  696.         ENDIF
  697.  
  698. *  romain  gontero & sellier
  699. *  preconditionnement pour modele de fibres dans FLDO3D
  700. *  tester si on a un modele de fibre
  701. *  extraire variable prefibr dans fluendo si=1
  702.  
  703.       IF((IFLAG.NE.2).and.(formod(1).eq.'MECANIQUE').and.(INAT.eq.187))
  704.      #   THEN
  705.          CALL CPREFIB (IPMODE,MLMOT2,ISUPCA,ICARA)
  706.          IF (IERR.NE.0) GOTO 99
  707.       ENDIF
  708.  
  709. *  fin Romain & sellier
  710.       ENDIF
  711. *
  712. *  MODAL - traitement direct a partir de la table BASE MODALE
  713. *
  714.       IF (nefmod.eq.45.and.MFR1.EQ.27.and.icara.eq.0)THEN
  715.         IF(itbas.eq.0)THEN
  716.           CALL LIRTAB('BASE_MODALE',ITBAS,0,IRETOU)
  717.           IF(IRETOU.NE.0)THEN
  718.             CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',Log0,IP0,
  719.      &                      'TABLE',I1,X1,CHARRE,Log1,ITMOD)
  720.             itbas = itmod
  721.  
  722.           ELSE
  723.             CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU)
  724.           ENDIF
  725.         endif
  726.  
  727.         jg = 0
  728.         segini mlreel,mlree1,mlree2,mlenti,mlent2
  729.         n1 = 1
  730.         segini mmode1
  731.  
  732.         do ii = 1, kmodel(/1)
  733.           IMODEL = KMODEL(ii)
  734.           mmode1.kmodel(1) = imodel
  735. c*          segact imodel
  736.           nobmod = ivamod(/1)
  737.           if (nobmod.gt.0) then
  738.             if (tymode(1).eq.'TABLE   ') then
  739.               itbas = ivamod(1)
  740.               CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',Log0,IP0,
  741.      &                      'TABLE',I1,X1,CHARRE,Log1,ITMOD)
  742.               itbas = itmod
  743.             endif
  744.           endif
  745.           meleme = imamod
  746. c*          segact meleme
  747.           do 48 jj = 1,num(/2)
  748.             ipoi1 = num(1,jj)
  749.  
  750. *           de quel mode s agit-il ?
  751.             mtable = itbas
  752.             segact mtable
  753.             mlo = mlotab
  754.             IM = 0
  755.  40         CONTINUE
  756.             IM = IM + 1
  757.             TYPRET = ' '
  758.             CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',Log0,IP0,
  759.      &                          TYPRET,I1,X1,CHARRE,Log1,ITMOD)
  760.             IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE   ') THEN
  761.               CALL ACCTAB(ITMOD,'MOT'  ,I0,X0,'POINT_REPERE',Log0,IP0,
  762.      &                          'POINT',I1,X1,' '           ,Log1,IPTS)
  763.               IF (ipts.eq.ipoi1) goto 45
  764.             ENDIF
  765.             IF (im.lt.mlo) goto 40
  766.             interr(1) = ipoi1
  767. *           pas trouve de caracteristiques pour le point support
  768.             call erreur(3)
  769.             return
  770.  
  771.  45         continue
  772.             CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',Log0,IP0,
  773.      &                      'FLOTTANT',I1,XFREQ,' ',Log1,IP1)
  774.             if (xfreq.lt.0.D0) THEN
  775.               MOTERR ='FREQ    '
  776.               CALL ERREUR(549)
  777.               RETURN
  778.             endif
  779.             mlree1.prog(**)= xfreq
  780.             CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',Log0,IP0,
  781.      &                        'FLOTTANT',I1,XMGEN,' ',Log1,IP1)
  782.             mlree2.prog(**)= xmgen
  783.             CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',Log0,IP0,
  784.      &                        'CHPOINT ',I1,X1,' ',Log1,ITDEPL)
  785.             mlenti.lect(**) = itdepl
  786.  48       continue
  787.         ENDDO
  788.  
  789.         MLMOT2.MOTS(**) = 'FREQ'
  790.         MLMOT2.MOTS(**) = 'MASS'
  791.         MLMOT2.MOTS(**) = 'DEFO'
  792.         JG = MLENT2.LECT(/1)+3
  793.         SEGADJ MLENT2
  794.         MLENT2.LECT(JG-2) = mlree1
  795.         MLENT2.LECT(JG-1) = mlree2
  796.         MLENT2.LECT(JG)   = mlenti
  797.  
  798.         MLMOT3.MOTS(**)='LIST'
  799.         MOTS(**)       ='REEL'
  800.         MLMOT3.MOTS(**)='LIST'
  801.         MOTS(**)       ='REEL'
  802.         MLMOT3.MOTS(**)='CHPO'
  803.         MOTS(**)       ='INT '
  804.  
  805.         ISUPCA = 3
  806.         itart = 1
  807.         CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREEL,
  808.      &              MLENT2,LETYP,JER1,ISUPCA, ICARA, itart)
  809.         segsup mlreel,mlent2
  810.         IF (IERR.NE.0) GOTO 99
  811.       ENDIF
  812.  
  813. C=DEB==== FORMULATION HHO ==== Ajout de composantes ====================
  814.       CALL HHOMAT(IPMODE,ICARA,iret)
  815.       IF (iret.ne.0) GOTO 99
  816. C=FIN==== FORMULATION HHO ==============================================
  817.  
  818.       IF (IERR.EQ.0) THEN
  819.         CALL ACTOBJ('MCHAML  ',ICARA,1)
  820.         CALL ECROBJ('MCHAML  ',ICARA)
  821.       ENDIF
  822.  
  823.   99  CONTINUE
  824. *     Suppression des segments
  825.       SEGSUP,MLMOTS,MLMOT1,MLMOT2,MLMOT3,MLREE1,MLENT2
  826.       IF (lsupca) SEGSUP,mocara
  827.  
  828. c      RETURN
  829.       END
  830.  
  831.  
  832.  
  833.  

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