C MATCAR SOURCE FANDEUR 13/01/29 21:16:03 7683 SUBROUTINE MATCAR(MONCAS) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) *--------------------------------------------------------------------* * * * Sous-programme associ{ @ l'op{rateur MATR et CARB * * __________________________________________________ * * * * Creation d'un champ de caract{ristiques mat{rielles et/ou * * g{om{triques. * * * * Commentaire : * * * * - En utilisant MATR : On est autorise a donner des caract{risti-* * ques materielles et geom{triques. * * MONCAS = 'MATERIAU' * * Toutes les autres composantes ne seront * * pas prises en comptes. * * * * - En utilisant CARB : On est autorise a donner des caract{risti-* * ques g{om{triques. * * MONCAS = 'CARACTER' * * Toutes les autres composantes ne seront * * pas prise en comptes. * * * * Remarque importante: * * * * Un certain nombre de composantes par d{faut est requis lors * * d'un processus de calcul. Il est possible d'en d{finir d'autres * * @ la convenance de l'utilisateur.(l'appel a matcar devra alors * * se faire avec MONCAS <> 'CARACTER' et MONCAS <> 'MATERIAU' * * * * Auteur, date de cr{ation: * * ------------------------- * * * * Denis ROBERT-MOUGIN, le 21 d{cembre 1987. * * * * - Mise a niveau avec MATE pour les mat{riaux 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 mat{r. quand provenance de MATR * * (MONCAS = 'MATERIAU') * * jm CAMPENON le 23 10 90 * * if (im.lt.mlo) goto 10 * -MISE A NIVEAU POUR L'ANISOTROPIE ET L'ORTHOTROPIE DANS LES * * ELEMENTS MASSIFS PAR P. DOWLATYARI OCT. 90 * *--------------------------------------------------------------------* * -INC CCOPTIO *- -INC CCREEL -INC CCHAMP -INC SMLMOTS -INC SMLREEL -INC SMLENTI -INC SMMODEL -INC SMLCHPO -INC SMTABLE -INC SMELEME * MOMATR pointera sur la liste des caract{ristiques mat{rielles * MOCARA pointera sur la liste des caract{ristiques g{om{triques * PARAMETER ( JER1=16 ) REAL*8 RECOM LOGICAL RFLAG,lsupma,lsupca CHARACTER*4 MOPER,MOCHOI CHARACTER*8 CMO,CAR,MONCAS,MOBUF,CMATE CHARACTER*16 LETYP LOGICAL L0,L1 CHARACTER*8 TYPRET,CHARRE * * * MONCAS='MATERIAU' --> IFLAG=1 (SEULEMENT LES CARAC. G{OM. ET * MAT{R. : MATR) * MONCAS='CARACTER' --> IFLAG=2 (SEULEMENT LES CARAC. G{OM. : CARB) * IFLAG=0 tous les noms composantes voulues * IFLAG=0 IF (MONCAS.EQ.'CARACTER') IFLAG=2 IF (MONCAS.EQ.'MATERIAU') IFLAG=1 * * Lecture d'un MODELE (comme c'est un nouveau, le type est MMODEL) * MOTERR(1:8)=' MODELE ' CALL MESLIR(-137) CALL LIROBJ('MMODEL',IPMODE,1,IRET) IF (IERR.NE.0) RETURN * * Initialisation des segments * JG=0 JGN=4 JGM=0 SEGINI,MLMOTS SEGINI,MLMOT1 SEGINI,MLMOT2 SEGINI,MLMOT3 SEGINI,MLREE1 SEGINI,MLENT2 * NUDIR1=0 NUDIR2=0 NUMP1=0 NUMP2=0 NUMP3=0 ANG=0.D0 IPLIQU=0 IRACOR=0 ICARA=0 ITHER=0 ICONV=0 ICONTA=0 IMELA = 0 ILIMA = 0 ICOUD=0 RFLAG = .FALSE. ITBAS = 0 ITMOD = 0 * MMODEL=IPMODE SEGACT,MMODEL N1=KMODEL(/1) * IMODEL=KMODEL(1) SEGACT IMODEL*NOMOD NFOR=FORMOD(/2) NMAT=MATMOD(/2) IF (FORMOD(1).NE.'CONVECTION') THEN CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) IF (CMATE.EQ.' ') THEN CALL ERREUR(251) RETURN ENDIF ELSE MATE=1 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,ICONV,'CONVECTION') CALL PLACE(FORMOD,NFOR,ICONTA,'CONTACT') CALL PLACE(FORMOD,NFOR,IMELA,'MELANGE') 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=NEFMOD MFR1=NUMMFR(MELE) IF (IDIM.EQ.1.AND.MELE.EQ.45) MFR1=1 * if(lnomid(6).ne.0.and.imela.eq.0) then nomid=lnomid(6) segact nomid momatr=nomid nbrmat=lesobl(/2) nbrmatf=lesfac(/2) lsupma=.false. * write(6,*) ' matcar ' , (lesobl(iou),iou=1,nbrmat) * CALL IDMATR(MFR1,IMODEL,MOMATR,NBRMAT,NBRMATF) * nomid = momatr * segact nomid * write(6,*) ' matcar bis ' , (lesobl(iou),iou=1,nbrmat) else lsupma=.true. CALL IDMATR(MFR1,IMODEL,MOMATR,NBRMAT,NBRMATF) endif IF(MOMATR.EQ.0) THEN MOTERR(1:4)='MATE' MOTERR(5:8)=NOMTP(MELE) CALL ERREUR(76) GO TO 99 ENDIF * NOMID=MOMATR SEGACT NOMID if(lnomid(7).ne.0) then nomid=lnomid(7) segact nomid mocara=nomid nbrcar=lesobl(/2) nbrcarf=lesfac(/2) lsupca=.false. else lsupca=.true. CALL IDCARB(MELE,IFOUR,MOCARA,NBRCAR,NBRCARF) endif NOMID=MOCARA SEGACT NOMID * IMIL = 1 10 CONTINUE IF (IMIL.EQ.0) CALL MESLIR(-175) INCM1 = 0 INCM2 = 0 INCM3 = 0 INCM4 = 0 * IRBUF = 0 IRCHOI = 0 * CALL LIRCHA(MOBUF,0,IRBUF) MOBUF=MOBUF(1:4) IF (IRBUF.EQ.0) GOTO 20 * NOMID=MOMATR CALL PLACE(LESOBL,LESOBL(/2),INCM1,MOBUF) IF (INCM1.NE.0) GOTO 120 * NOMID=MOMATR CALL PLACE(LESFAC,LESFAC(/2),INCM3,MOBUF) IF (INCM3.NE.0) GOTO 120 * NOMID=MOCARA CALL PLACE(LESOBL,LESOBL(/2),INCM2,MOBUF) IF (INCM2.NE.0) GOTO 120 * NOMID=MOCARA CALL PLACE(LESFAC,LESFAC(/2),INCM4,MOBUF) IF (INCM4.NE.0) GOTO 120 * MOCHOI=MOBUF IRCHOI=IRBUF * * 120 CONTINUE IF (IERR.NE.0) GO TO 99 IMIL=0 * * PETIT TEST POUR COQ3 NON EXCENTRABLE MILL 21 / 2 /92 * IF((MELE.EQ.27.AND.MFR1.EQ.3).AND.MOBUF.EQ.'EXCE') THEN CALL ERREUR(474) GO TO 99 ENDIF * * On d{sire lire une composante "quelconque": * IF(INCM1.EQ.0.AND.INCM2.EQ.0.AND.INCM3.EQ.0.AND.INCM4.EQ.0)THEN IF (MOCHOI.EQ.'PARA'.AND.IRCHOI.NE.0) THEN NUDIR2=1 GOTO 10 ENDIF IF (MOCHOI.EQ.'PERP'.AND.IRCHOI.NE.0) THEN NUDIR2=2 GOTO 10 ENDIF ENDIF * * kich test mot cle * IF (MOBUF.EQ.'REND'.AND.IRBUF.NE.0) THEN RFLAG = .TRUE. ENDIF * * Lecture {ventuelle d'un flottant * CALL LIRREE(RECOM,0,IRET2) IF (IRET2.EQ.1) THEN * * kich rendement cas isotrope * IF (RFLAG.AND.MOBUF.EQ.'REND'.AND.IRBUF.NE.0) 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 normal * exterieur @ 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,1,IRET) IF (IERR.NE.0) GOTO 99 ENDIF GOTO 10 ENDIF IF (IFLAG.NE.2) THEN NOMID=MOMATR IF (INCM1.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM1) IF (INCM3.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM3) ELSE IF (INCM1.NE.0) THEN MOTERR(1:4)=LESOBL(INCM1) CALL ERREUR (197) GOTO 99 ELSE IF (INCM3.NE.0) THEN MOTERR(1:4)=LESFAC(INCM3) CALL ERREUR (197) GOTO 99 ENDIF ENDIF ENDIF * NOMID=MOCARA IF (INCM2.NE.0) MLMOT1.MOTS(**) = LESOBL(INCM2) IF (INCM4.NE.0) MLMOT1.MOTS(**) = LESFAC(INCM4) * IF (IFLAG.EQ.0) THEN IF (IRCHOI.NE.0) MLMOT1.MOTS(**) = MOCHOI ELSE IF (IRCHOI.NE.0) THEN MOTERR(1:4)=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,IRET1) IF (IERR.NE.0) GO TO 99 * * On a lu un objet de type autre qu' un flottant * IF(IRACOR.EQ.1.AND.MOCHOI.EQ.'LIQU' 1 .AND.IRCHOI.NE.0)THEN IF(CAR.NE.'MAILLAGE')THEN MOTERR(1:8)='MAILLAGE' CALL ERREUR(37) GOTO 99 ELSE IPLIQU=IPTRUC GOTO 10 ENDIF ELSEIF (MOCHOI.EQ.'DIRE'.AND.IRCHOI.NE.0) THEN IF (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(1:8)='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)GO TO 99 ENDIF GOTO 10 ELSEIF (MOCHOI.EQ.'RADI'.AND.IRCHOI.NE.0) THEN IF(CAR.NE.'POINT')THEN MOTERR(1:8)='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 NOMID=MOMATR IF (INCM1.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM1) IF (INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3) ELSE IF (INCM1.NE.0) THEN MOTERR(1:4)=LESOBL(INCM1) CALL ERREUR (197) GOTO 99 ELSE IF (INCM3.NE.0) THEN MOTERR(1:4)=LESFAC(INCM3) CALL ERREUR (197) GOTO 99 ENDIF ENDIF ENDIF * NOMID=MOCARA IF (INCM2.NE.0) MLMOT2.MOTS(**) = LESOBL(INCM2) IF (INCM4.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM4) * IF (IFLAG.EQ.0) THEN IF (IRCHOI.NE.0) MLMOT2.MOTS(**) = MOCHOI ELSE IF (IRCHOI.NE.0) THEN MOTERR(1:4)=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.AND.((IDIM.EQ.3).OR.(IDIM.EQ.2)))THEN CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IGEO,'SECT') ENDIF * * TRAITEMENT MODELE DDI * IF(INAT.EQ.63) THEN CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP1,'DP1') CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDP2,'DP2') CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV1,'DV1') CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),IDV2,'DV2') CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP1,'CP1') CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICP2,'CP2') CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),ICV1,'CV1') CALL PLACE(MLMOT1.MOTS,MLMOT1.MOTS(/2),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 * IF((IRACOR.EQ.0.AND.IPLIQU.EQ.0.and.nefmod.ne.45).OR. 1 MLMOT1.MOTS(/2).NE.0.OR.MLMOT2.MOTS(/2).NE.0)THEN * IF(ITHER.EQ.0.AND.ICONV.EQ.0.AND.ICONTA.EQ.0) THEN ISUP=3 ELSE IF(ICONTA.NE.0) THEN ISUP=1 ELSE ISUP=6 ENDIF LETYP ='CARACTERISTIQUES' itart=0 CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREE1, & MLENT2,LETYP,JER1,ISUP,ICARA,itart) IF (IERR.NE.0) GO TO 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 * IF((MFR1.EQ.7.OR.(MFR1.EQ.13.AND.ICOUD.EQ.0)) & .AND.IGEO.NE.0.AND.IDIM.EQ.3)THEN CALL POUVLO(IPMODE,MLMOT2,ISUP,ICARA) IF(IERR.NE.0) GO TO 99 ENDIF * * Traitement pour les mat{riaux 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 IF (IFLAG.NE.2.and.formod(1).ne.'MELANGE'.and.nefmod.ne.45) &THEN IF (IDIM.NE.1) THEN CALL IDMAT2(IPMODE,ICARA,NUDIR1,NUMP1,NUMP2,NUDIR2, . NUMP3,ANG,IPCARA,RFLAG) IF (IERR.NE.0) GO TO 99 IF (IPCARA.NE.0) THEN CALL DTCHAM(ICARA) ICARA=IPCARA ENDIF ENDIF ENDIF * * MODAL - traitement direct à 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',L0,IP0, & 'TABLE',I1,X1,CHARRE,L1,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 mlchpo,mmode1 do 49 ii = 1, kmodel(/1) IMODEL=KMODEL(ii) mmode1.kmodel(1) = imodel segact imodel meleme = imamod 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,' ',L0,IP0, & TYPRET,I1,X1,CHARRE,L1,ITMOD) IF (ITMOD.NE.0 .AND. TYPRET.EQ.'TABLE ') THEN CALL ACCTAB(ITMOD,'MOT',I0,X0,'POINT_REPERE',L0,IP0, & 'POINT',I1,X1,' ',L1,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',L0,IP0, & 'FLOTTANT',I1,XFREQ,' ',L1,IP1) mlree1.prog(**)= xfreq CALL ACCTAB(ITMOD,'MOT',I0,X0,'MASSE_GENERALISEE',L0,IP0, & 'FLOTTANT',I1,XMGEN,' ',L1,IP1) mlree2.prog(**)= xmgen CALL ACCTAB(ITMOD,'MOT',I0,X0,'DEFORMEE_MODALE',L0,IP0, & 'CHPOINT ',I1,X1,' ',L1,ITDEPL) lect(**) = itdepl 48 continue segdes imodel,meleme 49 continue NOMID=MOMATR * voir aussi idmatr MLMOT2.MOTS(**) = 'FREQ' MLMOT2.MOTS(**) = 'MASS' MLMOT2.MOTS(**) = 'DEFO' * IF (INCM3.NE.0) MLMOT2.MOTS(**) = LESFAC(INCM3) 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 ' ISUP=3 LETYP ='CARACTERISTIQUES' itart=1 CALL MANUC6(IPMODE,MLMOT1,MLMOT2,MLMOT3,MLMOTS,MLREEL, & MLENT2,LETYP,JER1,ISUP,ICARA,itart) IF (IERR.NE.0) GO TO 99 segsup mlreel,mlent2 ENDIF * 99 CONTINUE * Suppression des segments * SEGSUP,MLMOTS SEGSUP,MLMOT1 SEGSUP,MLMOT2 SEGSUP,MLMOT3 SEGSUP,MLREE1 SEGSUP,MLENT2 * IF(IERR.EQ.0)CALL ECROBJ('MCHAML',ICARA) * NOMID=MOMATR IF(NOMID.NE.0.and.lsupma) SEGSUP NOMID NOMID=MOCARA IF(NOMID.NE.0.and.lsupca) SEGSUP NOMID * * D{sactivation des segments * DO 68 I=1,N1 IMODEL=KMODEL(I) SEGDES,IMODEL * END DO 68 CONTINUE SEGDES,MMODEL * RETURN END