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

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