1 : C SYNTHE SOURCE CHAT 05/01/13 03:28:58 5004 2 : SUBROUTINE SYNTHE 3 : C******************************************************************** 4 : C 5 : C OPERATEUR SYNTHESE MODALE 6 : C 7 : C TRANSFORME UN OBJET SOLUTION CONTENANT DES COMPOSANTES SUR LES 8 : C MODES DES SOUS-STRUCTURES EN UN OBJET SOLUTION CONTENANT DES 9 : C COMPOSANTES SUR LA BASE ELEMENTS FINIS PAR RECOMBINAISON MODALE 10 : C 11 : C SYNTAXE : SOLEF = SYNT BASET SOLMO ; 12 : C 13 : C BASET : OBJET DE TYPE BASE MODALE CONTENANT LES MODES 14 : C DES SOUS-STRUCTURES, LES SOLUTIONS STATIQUES 15 : C DEDUITES DES LIAISONS ET L OBJET ATTACHE 16 : C DECRIVANT CES LIAISONS 17 : C 18 : C SOLMO : OBJET DE TYPE SOLUTION CONTENANT LES CHAMPS 19 : C DECOMPOSES SUR LA BASE DES MODES 20 : C 21 : C SOLRE : OBJET DE TYPE SOLUTION CONTENANT LES CHAMPS 22 : C DECOMPOSES SUR LA BASE ELEMENTS FINIS 23 : C 24 : C M. PETIT SEPTEMBRE 88 25 : C 26 : C******************************************************************** 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8 (A-H,O-Z) 29 : -INC CCOPTIO 30 : -INC SMSOLUT 31 : -INC SMCHPOI 32 : -INC SMLMOTS 33 : CHARACTER*4 MOT(3),MOTCLE 34 : DATA MOT /'ALFA','BETA','FBET'/ 35 : DATA NMOT/3/ 36 : C 36 : CALL LIROBJ ('BASEMODA',IPBASE,1,IRETOU) 37 : IF (IRETOU.EQ.0) GO TO 999 37 : CALL LIROBJ ('SOLUTION',IPSOLU,1,IRETOU) 38 : IF (IRETOU.EQ.0) GO TO 999 39 : C 40 : C ON VERIFIE QU ON A DES MODES 41 : C 42 : MSOLUT=IPSOLU 43 : SEGACT MSOLUT 44 : IF (ITYSOL.NE.'MODE') THEN 45 : MOTERR(1:8) ='SOLUTION' 46 : MOTERR(9:16)='MODE' 46 : CALL ERREUR(79) 47 : GO TO 999 48 : ENDIF 49 : C 50 : C LISTMOTS POUR LA NORMALISATION 51 : C 51 : CALL MOTS1(IPLMOT,MOTCLE) 52 : C 53 : C BOUCLE 100 SUR LES MODES 54 : C 55 : MSOLEN=MSOLIS(5) 56 : MSOLE1=MSOLIS(4) 57 : SEGDES MSOLUT 58 : SEGACT MSOLEN,MSOLE1 59 : NMOD=ISOLEN(/1) 60 : DO 100 IMOD=1,NMOD 61 : MCHPOI=ISOLEN(IMOD) 62 : SEGACT MCHPOI 63 : C 64 : C ON VERIFIE QUE LE CHPOINT CONTIENT LES CONTRIBUTIONS MODALES 65 : C 66 : NSOUPO=IPCHP(/1) 67 : DO 1 ISOU=1,NSOUPO 68 : MSOUPO=IPCHP(ISOU) 69 : SEGACT MSOUPO 70 : IF(NOCOMP(/2).NE.1) THEN 70 : CALL ERREUR(188) 71 : GO TO 999 72 : ENDIF 73 : DO 3 I=1,NMOT 74 : IF(NOCOMP(1).EQ.MOT(I)) GO TO 4 75 : 3 CONTINUE 75 : CALL ERREUR(188) 76 : GO TO 999 77 : 4 SEGDES MSOUPO 78 : 1 CONTINUE 79 : ICHPOI=MCHPOI 80 : C 81 : C RECOMBINAISON DES DEPLACEMENTS . CHPOINT RESULTAT DANS IRET 82 : C 82 : CALL RECDEP(IPBASE,ICHPOI,IRET) 83 : IF(IERR.NE.0) GO TO 999 84 : C 85 : C ON NORMALISE LES CHAMPS DE DEPLACEMENT 86 : C ET ON MET A JOUR LA MASSE GENERALISEE 87 : C 88 : VALMAX=1.D0 88 : CALL MAXIM1(IRET,IPLMOT,MOTCLE,0,VALMAX) 88 : CALL NORMA1(IRET,IPLMOT,MOTCLE,ICHPO1) 88 : CALL DTCHPO(IRET) 89 : C 90 : C CREATION DU MODE ET RANGEMENT DANS L OBJET SOLUTION 91 : C 92 : MMODE=MSOLE1.ISOLEN(IMOD) 93 : SEGACT MMODE 94 : XMAS=FMMODD(2)/VALMAX/VALMAX 95 : IMMO1=IMMODD(1) 96 : FMMO1=FMMODD(1) 97 : FMMO3=FMMODD(3) 98 : FMMO4=FMMODD(4) 99 : FMMO5=FMMODD(5) 99 : CALL MANUSO('MODE ',IMMO1,FMMO1,XMAS,FMMO3, 100 : &FMMO4,FMMO5,ICHPO1,0,0,IPMODE) 101 : SEGDES MMODE 102 : C 103 : IF(IMOD.EQ.1) THEN 104 : IMO1=IPMODE 105 : ISOL=IPMODE 106 : GOTO 100 107 : ENDIF 107 : CALL FUSOLU(IMO1,IPMODE,ISOL) 108 : IF(IERR.NE.0) GOTO 999 108 : CALL DESOLU(IMO1) 108 : CALL DESOLU(IPMODE) 109 : IMO1=ISOL 110 : 100 CONTINUE 111 : SEGDES MSOLEN,MSOLE1 112 : MLMOTS=IPLMOT 113 : SEGSUP MLMOTS 114 : C 114 : CALL ECROBJ ('SOLUTION',ISOL) 115 : C 116 : 999 CONTINUE 117 : RETURN 118 : END 119 :
© Cast3M 2003 - All rights reserved.
Disclaimer