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

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