C MATCAR SOURCE PV090527 25/10/07 21:15:01 12350 *--------------------------------------------------------------------* * * * Sous-programme associe a l'operateur MATE et CARA * * __________________________________________________ * * * * Creation d'un champ de caracteristiques materielles et/ou * * geometriques. * * * * Commentaire : * * * * - En utilisant MATE : On est autorise a donner des caracteris- * * tiques materielles et geometriques. * * MONCAS = 'MATERIAU' * * Toutes les autres composantes ne seront * * pas prises en compte. * * * * - En utilisant CARA : On est autorise a donner des caracteris- * * tiques geometriques. * * MONCAS = 'CARACTER' * * Toutes les autres composantes ne seront * * pas prises en compte. * * * * Remarque importante: * * * * Un certain nombre de composantes par defaut est requis lors * * d'un processus de calcul. Il est possible d'en definir d'autres * * a la convenance de l'utilisateur. L'appel a MATCAR devra alors * * se faire avec MONCAS <> 'CARACTER' et MONCAS <> 'MATERIAU'. * * * * Auteur, date de creation: * * ------------------------- * * * * Denis ROBERT-MOUGIN, le 21 decembre 1987. * * * * - Mise a niveau avec MATE pour les materiaux ORTHOTROPES par : * * jm CAMPENON le 29 08 90 * * * * - Autoriser uniquement la prise en compte des : * * - carac. geom. quand provenance de CARB (MONCAS = 'CARACTER') * * - carac. geom. et mater. quand provenance de MATR * * (MONCAS = 'MATERIAU') * * jm CAMPENON le 23 10 90 * * * * -MISE A NIVEAU POUR L'ANISOTROPIE ET L'ORTHOTROPIE DANS LES * * ELEMENTS MASSIFS PAR P. DOWLATYARI OCT. 90 * *--------------------------------------------------------------------* SUBROUTINE MATCAR(MONCAS) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC CCHAMP -INC SMLMOTS -INC SMLREEL -INC SMLENTI -INC SMMODEL POINTEUR MOMATR.NOMID, MOCARA.NOMID -INC SMTABLE -INC SMELEME -INC SMCHAML * MOMATR pointera sur la liste des caracteristiques materielles * MOCARA pointera sur la liste des caracteristiques geometriques CHARACTER*(*) MONCAS REAL*8 RECOM,RECOM2 LOGICAL RFLAG,lsupca,d_mela,d_nast CHARACTER*(LOCOMP) MOBUF CHARACTER*(4) MOCHOI CHARACTER*8 CAR,CMATE CHARACTER*16 LETYP LOGICAL Log0,Log1 CHARACTER*8 TYPRET,CHARRE C Tableau fixe pour appel a LIRMOT sans ARGUMENT ELEMENT DE SEGMENT PARAMETER ( NMOT1=500 ) CHARACTER*(LOCOMP) CMOTS1(NMOT1) EXTERNAL LONG * MONCAS='MATERIAU' --> IFLAG=1 (SEULEMENT LES CARAC. GEOM. ET * MATER. : MATE) * MONCAS='CARACTER' --> IFLAG=2 (SEULEMENT LES CARAC. GEOM. : CARA) * IFLAG=0 tous les noms composantes voulues IFLAG=0 IF (MONCAS(1:8).EQ.'CARACTER') IFLAG=2 IF (MONCAS(1:8).EQ.'MATERIAU') IFLAG=1 * * Lecture d'un MODELE : * TYPRET = 'MMODEL ' MOTERR = ' MODELE ' CALL MESLIR(-137) CALL LIROBJ(TYPRET,IPMODE,1,IRET) IF (IERR.NE.0) RETURN CALL ACTOBJ(TYPRET,IPMODE,1) IF (IERR.NE.0) RETURN MMODEL = IPMODE N1 = mmodel.KMODEL(/1) JER1 = 16 LETYP = 'CARACTERISTIQUES' * Cas particulier du mmodel VIDE (N1 = 0) IF (N1.EQ.0) THEN N1 = 0 N3 = 6 L1 = JER1 SEGINI,MCHELM mchelm.IFOCHE = IFOUR mchelm.TITCHE = LETYP ICARA = mchelm CALL ACTOBJ('MCHAML ',ICARA,1) CALL ECROBJ('MCHAML ',ICARA) RETURN * CALL ERREUR(xx) * GOTO 99 * ELSE IF (N1.GT.1) THEN * write(ioimp,*) '(WARNING) MATCAR : N1 > 1 !!' ENDIF * * Initialisation des segments * JG =0 JGN=LOCOMP JGM=0 SEGINI,MLMOTS SEGINI,MLMOT1 SEGINI,MLMOT2 SEGINI,MLMOT3 SEGINI,MLREE1 SEGINI,MLENT2 ICARA = 0 IVECT = 0 NUDIR1 = 0 NUDIR2 = 0 NUMP1 = 0 NUMP2 = 0 NUMP3 = 0 ANG = 0.D0 ANG2 = 0.D0 IPLIQU = 0 IRACOR = 0 ITHER = 0 IDIFF = 0 IMETA = 0 ICHPH = 0 ICONT = 0 IMELA = 0 ** ILIMA = 0 IGEO = 0 ICOUD = 0 RFLAG = .FALSE. ITBAS = 0 ITMOD = 0 MOMATR = 0 MOCARA = 0 lsupca = .false. * Ici on ne travaille que sur le 1er sous-modele ! * Ce qui suppose que tous les autres sont identiques au 1er !!! IMODEL = mmodel.KMODEL(1) NFOR = imodel.FORMOD(/2) NMAT = imodel.MATMOD(/2) CMATE = imodel.CMATEE MATE = imodel.IMATEE INAT = imodel.INATUU * Normalement ici, pas de souci ? IF (CMATE.EQ.' ')THEN CALL ERREUR(251) GOTO 99 ENDIF IF (NFOR.EQ.2) THEN IF ( (FORMOD(1).EQ.'MECANIQUE '.AND. 1 FORMOD(2).EQ.'LIQUIDE ') .OR. 2 (FORMOD(1).EQ.'LIQUIDE '.AND. 3 FORMOD(2).EQ.'MECANIQUE ') ) IRACOR=1 ENDIF CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE') CALL PLACE(FORMOD,NFOR,IDIFF,'DIFFUSION') CALL PLACE(FORMOD,NFOR,ICONT,'CONTACT') CALL PLACE(FORMOD,NFOR,IMELA,'MELANGE') CALL PLACE(FORMOD,NFOR,IMETA,'METALLURGIE') CALL PLACE(FORMOD,NFOR,ICHPH,'CHANGEMENT_PHASE') * CALL PLACE(FORMOD,NFOR,ILIMA,'LIAISON_MATERIELLE') C= Element fini et formulation associee C= En DIMEnsion 1, on force formulation MASSIVE pour les elements POI1 C= (utilises en convection et en rayonnement). MELE = imodel.NEFMOD MFR1 = NUMMFR(MELE) IF (IDIM.EQ.1.AND.MELE.EQ.45) MFR1 = 1 MOMATR = imodel.lnomid(6) NBRMAT = momatr.lesobl(/2) NBRMATF = momatr.lesfac(/2) IF (nbrmat+nbrmatf .EQ. 0) THEN MOTERR = 'MATE ' MOTERR(5:8) = NOMTP(MELE) CALL ERREUR(76) GO TO 99 ENDIF c*dbg write(ioimp,*) 'MOMATR =',momatr,nbrmat,nbrmatf MOCARA = imodel.lnomid(7) if (mocara.ne.0) THEN lsupca = .false. NBRCAR = mocara.lesobl(/2) NBRCARF = mocara.lesfac(/2) else c*dbg write(ioimp,*) 'MATCAR : lsupca = T' lsupca = .true. CALL IDCARB(MELE,IFOUR,MOCARA,NBRCAR,NBRCARF) endif c*dbg write(ioimp,*) 'MOCARA =',mocara,lnomid(7),nbrcar,nbrcarf C Concatenation des MOTS attendus pour le LIRMOT discriminant JC4 = NBRMAT + NBRMATF + NBRCAR + NBRCARF IF (JC4 .GT. NMOT1) THEN WRITE(ioimp,*) 'AUGMENTER LA TAILLE DE CMOTS1 DANS MATCAR.ESO' CALL ERREUR(5) RETURN ENDIF MJC4 = -JC4 DO IC = 1, NBRMAT CMOTS1(IC) = momatr.LESOBL(IC) ENDDO JC1 = NBRMAT DO IC = 1, NBRMATF CMOTS1(JC1+IC) = momatr.LESFAC(IC) ENDDO JC3 = JC1 + NBRMATF DO IC = 1, NBRCAR CMOTS1(JC3+IC) = mocara.LESOBL(IC) ENDDO JC2 = JC3 + NBRCAR DO IC = 1, NBRCARF CMOTS1(JC2+IC) = mocara.LESFAC(IC) ENDDO ** JC4 = JC2 + NBRCARF c*dbg write(ioimp,*) 'JC4 = ',MJC4,JC1,JC2,JC3,JC4 c*dbg write(ioimp,*) ('=',cmots1(ic),'=',ic=1,nmot1) MOCHOI = ' ' IMIL = 1 10 CONTINUE IF (IMIL.EQ.0) CALL MESLIR(-175) INCM1 = 0 INCM2 = 0 INCM3 = 0 INCM4 = 0 MOBUF = ' ' IRBUF = 0 IRCHOI = 0 C LIRMOT appele avec MJC4<0 => on utilise des abreviations CALL LIRMOT(CMOTS1,MJC4,IPLACE,0) IF (IERR.NE.0) GOTO 99 c*dbg write(ioimp,*) 'matcar apres lirmot ',iplace IF (IPLACE .EQ. 0) THEN CALL LIRCHA(MOBUF,0,IRBUF) IF (IERR .NE.0) GOTO 99 IF (IRBUF.EQ.0) GOTO 20 MOBUF=MOBUF(1:LOCOMP) MOCHOI=MOBUF(1:4) IRCHOI=MIN(IRBUF,4) * On desire lire une composante "quelconque" : IF (MOCHOI.EQ.'PARA') THEN NUDIR2=1 GOTO 10 ELSE IF (MOCHOI.EQ.'PERP') THEN NUDIR2=2 GOTO 10 ENDIF ELSE IF (IPLACE.GT.0 .AND. IPLACE.LE.JC1) THEN INCM1 = IPLACE ELSE IF (IPLACE.GT.JC1 .AND. IPLACE.LE.JC3) THEN INCM3 = IPLACE - JC1 ELSE IF (IPLACE.GT.JC3 .AND. IPLACE.LE.JC2) THEN INCM2 = IPLACE - JC3 ELSE INCM4 = IPLACE - JC2 ENDIF MOBUF=CMOTS1(IPLACE) IRBUF=LONG(MOBUF) ENDIF if (mobuf(1:4).eq.'VECT') IVECT = 1 c*dbg write(ioimp,*) 'mochoi & irchoi',mochoi,irchoi,iplace IMIL=0 * * PETIT TEST POUR COQ3 NON EXCENTRABLE MILL 21 / 2 /92 * IF (MELE.EQ.27.AND.MFR1.EQ.3) THEN IF (MOBUF.EQ.'EXCE') THEN CALL ERREUR(474) GOTO 99 ENDIF ENDIF ** write(ioimp,*) 'mobuf & irbuf',mobuf,irbuf * kich test mot cle IF (MOBUF.EQ.'REND') RFLAG = .TRUE. * * Lecture eventuelle d'un flottant * CALL LIRREE(RECOM,0,IRET2) IF (IRET2.EQ.1) THEN * * kich rendement cas isotrope * IF (RFLAG.AND.MOBUF.EQ.'REND') RFLAG = .FALSE. * * Dans le cas ou on lit le mot incline on peut eventuellement trouver * en plus de l'angle un point donnant la direction de la normale * exterieure a la coque * IF (MOCHOI.EQ.'INCL'.AND.IRCHOI.NE.0) THEN NUDIR2=3 ANG=RECOM*XPI/180.D0 IF ((IDIM.EQ.3.AND.MFR1.EQ.3) .OR. MFR1.EQ.9 .OR. & MFR1.EQ.5 .OR. (IDIM.EQ.3.AND.MFR1.EQ.35)) THEN CALL LIROBJ('POINT',NUMP3,0,IRET) IF (IERR.NE.0) GOTO 99 ENDIF * en 2D, 2eme angle possible pour rotation hors plan IF (IFOUR.EQ.1) THEN CALL LIRREE(RECOM2,0,IRET) IF (IRET.NE.0) ANG2=RECOM2*XPI/180.D0 ENDIF GOTO 10 ENDIF IF (IFLAG.NE.2) THEN IF (INCM1.NE.0) MLMOT1.MOTS(**) = momatr.LESOBL(INCM1) IF (INCM3.NE.0) MLMOT1.MOTS(**) = momatr.LESFAC(INCM3) ELSE IF (INCM1.NE.0) THEN MOTERR = momatr.LESOBL(INCM1) CALL ERREUR (197) GOTO 99 ENDIF IF (INCM3.NE.0) THEN MOTERR = momatr.LESFAC(INCM3) CALL ERREUR (197) GOTO 99 ENDIF ENDIF IF (INCM2.NE.0) MLMOT1.MOTS(**) = mocara.LESOBL(INCM2) IF (INCM4.NE.0) MLMOT1.MOTS(**) = mocara.LESFAC(INCM4) IF (IFLAG.EQ.0) THEN IF (IRCHOI.NE.0) MLMOT1.MOTS(**) = MOCHOI ELSE IF (IRCHOI.NE.0) THEN MOTERR = MOCHOI CALL ERREUR(197) GOTO 99 ENDIF ENDIF JG=MLREE1.PROG(/1)+1 SEGADJ MLREE1 MLREE1.PROG(JG)=RECOM ELSE CALL QUETYP(CAR,0,IRET1) IF (IERR.NE.0) GO TO 99 IF (RFLAG)THEN IF (CAR.EQ.'MOT ')THEN GOTO 10 ELSE * kich matrice rendement IF (MOCHOI.EQ.'REND'.AND.IRCHOI.NE.0) RFLAG = .FALSE. ENDIF ENDIF CALL LIROBJ(CAR,IPTRUC,0,IRET) IF (IRET .EQ. 1) CALL ACTOBJ(CAR,IPTRUC,1) IF (IERR.NE.0) GO TO 99 * * On a lu un objet de type autre que flottant * IF (IRACOR.EQ.1.AND.MOCHOI.EQ.'LIQU'.AND.IRCHOI.NE.0) THEN IF (CAR.NE.'MAILLAGE') THEN MOTERR ='MAILLAGE' CALL ERREUR(37) GOTO 99 ELSE IPLIQU=IPTRUC GOTO 10 ENDIF ELSEIF (MOCHOI.EQ.'DIRE'.AND.IRCHOI.NE.0) THEN IF (MATE.NE.1.AND.MATE.NE.2.AND.MATE.NE.3.AND.MATE.NE.4.AND. & .NOT.RFLAG)THEN CALL ERREUR(728) GOTO 99 ENDIF IF (CAR.NE.'POINT')THEN MOTERR ='POINT' CALL ERREUR(37) GOTO 99 ELSE NUDIR1=1 NUMP1=IPTRUC ENDIF * * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS * IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR. & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75) S .AND. IDIM.EQ.3)THEN CALL LIROBJ(CAR,NUMP2,0,IRET) IF (IERR.NE.0.OR.IRET.EQ.0) GOTO 99 ENDIF GOTO 10 ELSEIF (MOCHOI.EQ.'RADI'.AND.IRCHOI.NE.0) THEN IF(CAR.NE.'POINT')THEN MOTERR ='POINT' CALL ERREUR(37) GOTO 99 ELSE NUDIR1=2 NUMP1=IPTRUC ENDIF * * DANS LE CAS DES ELEMENTS MASSIFS 3D IL FAUT DEUX POINTS * IF ((MFR1.EQ.1 .OR. MFR1.EQ.31 .OR. & MFR1.EQ.33 .OR. MFR1.EQ.45.OR. MFR1.EQ.75) S .AND. IDIM.EQ.3)THEN CALL LIROBJ(CAR,NUMP2,0,IRET) IF(IERR.NE.0.OR.IRET.EQ.0)GO TO 99 ENDIF GOTO 10 ENDIF * IF(IFLAG.NE.2)THEN IF(INCM1.NE.0) MLMOT2.MOTS(**) = momatr.LESOBL(INCM1) IF(INCM3.NE.0) MLMOT2.MOTS(**) = momatr.LESFAC(INCM3) ELSE IF (INCM1.NE.0)THEN MOTERR = momatr.LESOBL(INCM1) CALL ERREUR (197) GOTO 99 ENDIF IF (INCM3.NE.0)THEN MOTERR =LESFAC(INCM3) CALL ERREUR (197) GOTO 99 ENDIF ENDIF IF (INCM2.NE.0) MLMOT2.MOTS(**) = mocara.LESOBL(INCM2) IF (INCM4.NE.0) MLMOT2.MOTS(**) = mocara.LESFAC(INCM4) IF (IFLAG.EQ.0)THEN IF (IRCHOI.NE.0) MLMOT2.MOTS(**) = MOCHOI ELSE IF (IRCHOI.NE.0) THEN MOTERR =MOCHOI CALL ERREUR (197) GOTO 99 ENDIF ENDIF JGM = MLMOT3.MOTS(/2) MLMOT3.MOTS(**)=CAR(1:4) MOTS(**) =CAR(5:8) JG=MLENT2.LECT(/1)+1 SEGADJ MLENT2 MLENT2.LECT(JG)=IPTRUC ENDIF GOTO 10 * END DO 20 CONTINUE * DANS LE CAS DES TUYAUX 3D ,ON REGARDE SI LES CARACTERISTIQUES * GEOMETRIQUES ONT ETE DONNEES ,SI OUI ON VERIFIE SI ON EST * DANS LE CAS DES COUDES * IF (MFR1.EQ.13.AND.IDIM.EQ.3) THEN CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'RAYO') IF (IGEO.NE.0) THEN CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICOUD,'RACO') ENDIF ENDIF * * DANS LE CAS DES POUTRES 3D ,ON REGARDE SI LES CARACTERISTIQUES * GEOMETRIQUES ONT ETE DONNEES * IF(MFR1.EQ.7)THEN CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'SECT') ENDIF * * TRAITEMENT MODELE DDI * IF(INAT.EQ.63)THEN JC = MLMOT1.MOTS(/2) CALL PLACE(MLMOT1.MOTS,JC,IDP1,'DP1') CALL PLACE(MLMOT1.MOTS,JC,IDP2,'DP2') CALL PLACE(MLMOT1.MOTS,JC,IDV1,'DV1') CALL PLACE(MLMOT1.MOTS,JC,IDV2,'DV2') CALL PLACE(MLMOT1.MOTS,JC,ICP1,'CP1') CALL PLACE(MLMOT1.MOTS,JC,ICP2,'CP2') CALL PLACE(MLMOT1.MOTS,JC,ICV1,'CV1') CALL PLACE(MLMOT1.MOTS,JC,ICV2,'CV2') IF((MLREE1.PROG(ICP1).EQ.0.D0).AND.(MLREE1.PROG(IDP1).NE.0.D0)) & THEN CALL ERREUR(906) RETURN ENDIF IF((MLREE1.PROG(ICP2).EQ.0.D0).AND.(MLREE1.PROG(IDP2).NE.0.D0)) & THEN CALL ERREUR(906) RETURN ENDIF IF((MLREE1.PROG(ICV1).EQ.0.D0).AND.(MLREE1.PROG(IDV1).NE.0.D0)) & THEN CALL ERREUR(906) RETURN ENDIF IF((MLREE1.PROG(ICV2).EQ.0.D0).AND.(MLREE1.PROG(IDV2).NE.0.D0)) & THEN CALL ERREUR(906) RETURN ENDIF ENDIF * VERIFICATIONS CAS D'UN MODELE MODAL IF(MFR1.EQ.27.AND.MELE.EQ.45)THEN CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'FREQ') IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN MOTERR ='FREQ ' CALL ERREUR(549) RETURN ENDIF ENDIF CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IPLA1,'MASS') IF(IPLA1.gt.0.and.IPLA1.le.MLREE1.PROG(/1))THEN IF(MLREE1.PROG(IPLA1).LT.0.D0)THEN MOTERR ='MASS ' CALL ERREUR(549) RETURN ENDIF ENDIF ENDIF * tri redondance mlmot1 JGM=mlmot1.mots(/2) JG = mlree1.prog(/1) IF(jgm.ge.2)THEN segini mlmot5 mlmot5.mots(1) = mlmot1.mots(1) ik5 = 1 do 151 jj = 2, jgm do jj5 = 1, ik5 IF(mlmot1.mots(jj).eq.mlmot5.mots(jj5))THEN call erreur(674) return endif enddo ik5 = ik5 + 1 mlmot5.mots(ik5) = mlmot1.mots(jj) 151 continue segsup mlmot5 endif C Traitement particulier pour le modele de Gurson2 IF (INAT.EQ.64) THEN JC = MLMOT1.MOTS(/2) CALL PLACE(MLMOT1.MOTS, JC, IQ1, 'Q ') CALL PLACE(MLMOT1.MOTS, JC, IQ2, 'Q2 ') CALL PLACE(MLMOT1.MOTS, JC, IQ3, 'Q3 ') IF (IQ2.EQ.0) THEN JG = MLREE1.PROG(/1) + 1 SEGADJ MLREE1 MLREE1.PROG(JG) = 1.D0 JGM = MLMOT1.MOTS(/2) + 1 SEGADJ MLMOT1 MLMOT1.MOTS(JGM) = 'Q2 ' ENDIF IF (IQ3.EQ.0) THEN IF (IQ1.EQ.0) THEN MOTERR = 'MATCAR : INAT=64 Gurson2 - Q et Q3 non fournis' CALL ERREUR(-385) CALL ERREUR(21) GOTO 99 ENDIF JG = MLREE1.PROG(/1) + 1 SEGADJ MLREE1 MLREE1.PROG(JG) = (MLREE1.PROG(IQ1))**2 JGM = MLMOT1.MOTS(/2) + 1 SEGADJ MLMOT1 MLMOT1.MOTS(JGM) = 'Q3 ' ENDIF ENDIF IF ((IRACOR.EQ.0.AND.IPLIQU.EQ.0.and.nefmod.ne.45).OR. & MLMOT1.MOTS(/2) .NE. 0 .OR. MLMOT2.MOTS(/2).NE.0) THEN IF (ITHER.NE.0 .OR. IDIFF.NE.0 .OR. IMETA.NE.0) THEN IF (MFR1 .EQ. 75) THEN C Cas des JOI1 (MFR=75) ==> Ressorts THERMIQUES C ==================== ISUPCA =1 ELSE CALL PLACE(matmod,NMAT,iray,'RAYONNEMENT') C Support 6 SAUF pour le RAYONNEMENT... C Les cas-tests de RAYONNEMENT sont en erreur sans ca... IF(iray.EQ.0)THEN ISUPCA = 6 ELSE ISUPCA = 3 ENDIF ENDIF ELSEIF(ICONT.NE.0 .OR. ICHPH.NE.0)THEN ISUPCA=1 ELSE ISUPCA=3 ENDIF itart = 0 CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1, & MLENT2,LETYP,JER1,ISUPCA,ICARA,itart) IF (IERR.NE.0) GOTO 99 ENDIF * TRAITEMENT POUR LES ELEMENTS RACCORDS FLUIDE/STRUCTURE * IF (IRACOR.NE.0.AND.IPLIQU.NE.0) THEN CALL VRACOR(IPMODE,IPLIQU,IFLAG,ICARA) IF (IERR.NE.0) GOTO 99 ENDIF * TRAITEMENT PARTICULIER POUR LES POUTRES ET TUYAUX * PB DU VECTEUR LOCAL - MILL FEV 92 ** write(6,*) 'matcar avant pouvlo',mfr1,icoud,igeo ** IF((MFR1.EQ.7.OR.(MFR1.EQ.13.AND.ICOUD.EQ.0)) IF((MFR1.EQ.7.OR.(MFR1.EQ.13 )) & .and.(IVECT.ne.0.or.IGEO.NE.0).AND.IDIM.EQ.3)THEN ** & .AND.IDIM.EQ.3)THEN CALL POUVLO(IPMODE,MLMOT2,ISUPCA,ICARA) IF (IERR.NE.0) GOTO 99 ENDIF * * Traitement pour les materiaux orthotropes * C= Dans le cas IDIM=1, on ne traite pas les mots cles PARA,DIRE,PERP... C= car les directions d'orthotropie correspondent au repere global d_mela = formod(1).ne.'MELANGE' d_nast = formod(1).ne.'NAVIER_STOKES' IF(IFLAG.NE.2.and.nefmod.ne.45.and.d_mela.and.d_nast.and. & IMETA.eq.0.AND.ICHPH.EQ.0) THEN IF (IDIM.NE.1) THEN CALL IDMAT2(IPMODE,ICARA,NUDIR1,NUMP1,NUMP2,NUDIR2, & NUMP3,ANG,ANG2,IPCARA,RFLAG) IF (IERR.NE.0) GO TO 99 IF (IPCARA.NE.0) THEN CALL DTCHAM(ICARA) ICARA=IPCARA ENDIF ENDIF * romain gontero & sellier * preconditionnement pour modele de fibres dans FLDO3D * tester si on a un modele de fibre * extraire variable prefibr dans fluendo si=1 IF((IFLAG.NE.2).and.(formod(1).eq.'MECANIQUE').and.(INAT.eq.187)) # THEN CALL CPREFIB (IPMODE,MLMOT2,ISUPCA,ICARA) IF (IERR.NE.0) GOTO 99 ENDIF * fin Romain & sellier ENDIF * * MODAL - traitement direct a partir de la table BASE MODALE * IF (nefmod.eq.45.and.MFR1.EQ.27.and.icara.eq.0)THEN IF(itbas.eq.0)THEN CALL LIRTAB('BASE_MODALE',ITBAS,0,IRETOU) IF(IRETOU.NE.0)THEN CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',Log0,IP0, & 'TABLE',I1,X1,CHARRE,Log1,ITMOD) itbas = itmod ELSE CALL LIRTAB('BASE_DE_MODES',ITBAS,0,IRETOU) ENDIF endif jg = 0 segini mlreel,mlree1,mlree2,mlenti,mlent2 n1 = 1 segini mmode1 do ii = 1, kmodel(/1) IMODEL = KMODEL(ii) mmode1.kmodel(1) = imodel c* segact imodel nobmod = ivamod(/1) if (nobmod.gt.0) then if (tymode(1).eq.'TABLE ') then itbas = ivamod(1) CALL ACCTAB(ITBAS,'MOT',IM,X0,'MODES',Log0,IP0, & 'TABLE',I1,X1,CHARRE,Log1,ITMOD) itbas = itmod endif endif meleme = imamod c* segact meleme do 48 jj = 1,num(/2) ipoi1 = num(1,jj) * de quel mode s agit-il ? mtable = itbas segact mtable mlo = mlotab IM = 0 40 CONTINUE IM = IM + 1 TYPRET = ' ' CALL ACCTAB(ITBAS,'ENTIER',IM,X0,' ',Log0,IP0, & TYPRET,I1,X1,CHARRE,Log1,ITMOD) IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN CALL ACCTAB(ITMOD,'MOT' ,I0,X0,'POINT_REPERE',Log0,IP0, & 'POINT',I1,X1,' ' ,Log1,IPTS) IF (ipts.eq.ipoi1) goto 45 ENDIF IF (im.lt.mlo) goto 40 interr(1) = ipoi1 * pas trouve de caracteristiques pour le point support call erreur(3) return 45 continue CALL ACCTAB(ITMOD,'MOT',I0,X0,'FREQUENCE',Log0,IP0, & 'FLOTTANT',I1,XFREQ,' ',Log1,IP1) if (xfreq.lt.0.D0) THEN MOTERR ='FREQ ' CALL ERREUR(549) RETURN endif mlree1.prog(**)= xfreq CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',Log0,IP0, & 'FLOTTANT',I1,XMGEN,' ',Log1,IP1) mlree2.prog(**)= xmgen CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',Log0,IP0, & 'CHPOINT ',I1,X1,' ',Log1,ITDEPL) mlenti.lect(**) = itdepl 48 continue ENDDO MLMOT2.MOTS(**) = 'FREQ' MLMOT2.MOTS(**) = 'MASS' MLMOT2.MOTS(**) = 'DEFO' JG = MLENT2.LECT(/1)+3 SEGADJ MLENT2 MLENT2.LECT(JG-2) = mlree1 MLENT2.LECT(JG-1) = mlree2 MLENT2.LECT(JG) = mlenti MLMOT3.MOTS(**)='LIST' MOTS(**) ='REEL' MLMOT3.MOTS(**)='LIST' MOTS(**) ='REEL' MLMOT3.MOTS(**)='CHPO' MOTS(**) ='INT ' ISUPCA = 3 itart = 1 CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREEL, & MLENT2,LETYP,JER1,ISUPCA, ICARA, itart) segsup mlreel,mlent2 IF (IERR.NE.0) GOTO 99 ENDIF C=DEB==== FORMULATION HHO ==== Ajout de composantes ==================== CALL HHOMAT(IPMODE,ICARA,iret) IF (iret.ne.0) GOTO 99 C=FIN==== FORMULATION HHO ============================================== IF (IERR.EQ.0) THEN CALL ACTOBJ('MCHAML ',ICARA,1) CALL ECROBJ('MCHAML ',ICARA) ENDIF 99 CONTINUE * Suppression des segments SEGSUP,MLMOTS,MLMOT1,MLMOT2,MLMOT3,MLREE1,MLENT2 IF (lsupca) SEGSUP,mocara c RETURN END