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

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