1 : C SORE SOURCE CHAT 11/03/16 21:31:42 6902 2 : 3 : SUBROUTINE SORE 4 : ************************************************************************ 5 : * 6 : * SORE 7 : * ---- 8 : * 9 : * FONCTION: 10 : * --------- 11 : * CREATION D UNE MATRICE DE CONDUCTIVITE ASSOCIEE A L EFFET SORET 12 : * INTEGRATION DE N DIV(GRAD T) 13 : * ELEMENTS MASSIFS UNIQUEMENT 14 : * 15 : * PHRASE D'APPEL (EN GIBIANE): 16 : * ---------------------------- 17 : * 18 : * CND1 = SORE MOD1 MAT1 MCHAM1 CHPO1 ; 19 : * 20 : * OPERANDES ET RESULTAT: 21 : * ---------------------- 22 : * 23 : * CND1 'RIGIDITE' MATRICE DE CONDUCTIVITE 24 : * 25 : * MOD1 'MODELE' STRUCTURE MODELISEE 26 : * MAT1 'MCHAML' PROPRIETES DU MATERIAU 27 : * MCHAM1 'MCHAML' CHAMP DES FACTEURS DU POTENTIEL 28 : * CHPO1 'CHPOINT' POTENTIEL DONT LE GRADIENT EST LA 'FORCE MOTRICE' 29 : * 30 : * 31 : * AUTEUR,DATE DE CREATION: 32 : * ------------------------ 33 : * 34 : * J.M.BAZE AVRIL 97 35 : * 36 : * LANGAGE: 37 : * -------- 38 : * 39 : * ESOPE + FORTRAN77 40 : * 41 : ************************************************************************ 42 : * 43 : IMPLICIT INTEGER(I-N) 44 : -INC CCOPTIO 45 : -INC SMCHAML 46 : -INC SMMODEL 47 : -INC SMCHPOI 48 : CHARACTER*8 LETYPE 49 : PARAMETER ( LINUM=14,LINUC=12) 50 : INTEGER INUMA(LINUM) 51 : 52 : * TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 53 : DATA INUMA/ 4, 6, 8, 10, 14, 15, 16, 17, 54 : * TET4 TET10 PYR5 PY13 T1D2 T1D3 55 : 1 23, 24, 25, 26, 191, 192 / 56 : 57 : 58 : * SEGMENT INFO 59 : * INTEGER INFELE(JG) 60 : * END SEGMENT 61 : 62 : MOTERR(1:8)=' MODELE ' 62 : CALL MESLIR(-137) 62 : CALL LIROBJ('MMODEL',IPMODE,1,IRET1) 63 : IF (IERR.NE.0) RETURN 64 : * 64 : CALL MESLIR(-135) 64 : CALL LIROBJ('MCHAML',IPCHEL,1,IRET1) 65 : IF (IERR.NE.0) RETURN 66 : * * 67 : * TEST SUR LE SOUS-TYPE DE LE CHAMELEM 68 : * 69 : MCHELM=IPCHEL 70 : SEGACT,MCHELM 71 : * 72 : LETYPE = TITCHE 73 : IF (LETYPE.NE.'CARACTER') THEN 74 : SEGDES,MCHELM 75 : MOTERR='CARACTERISTIQUES' 75 : CALL ERREUR(291) 76 : RETURN 77 : ENDIF 78 : * 79 : MOTERR(1:8)='MCHAML ' 79 : CALL MESLIR(-137) 79 : CALL LIROBJ('MCHAML',IPCHE1,1,IRET1) 80 : IF (IERR.NE.0) RETURN 81 : 82 : MOTERR(1:8)='CHPOINT ' 82 : CALL MESLIR(-137) 82 : CALL LIROBJ('CHPOINT',IPCHPO,1,IRETOU) 83 : IF (IERR.NE.0) RETURN 84 : * quelque verifications . formulation pour massifs exclusivement 85 : 86 : MMODEL = IPMODE 87 : SEGACT,MMODEL 88 : NSOUS = KMODEL(/1) 89 : * 90 : DO 10 ISOUS = 1,NSOUS 91 : IMODEL = KMODEL(ISOUS) 92 : SEGACT,IMODEL 93 : NF1 = FORMOD(/2) 94 : NEF = NEFMOD 94 : CALL PLACE(FORMOD,NF1,IF1,'THERMIQUE') 94 : CALL PLACE2(INUMA,LINUM,IOK,NEF) 95 : IF (IF1.EQ.0.OR.IOK.EQ.0) THEN 96 : * OPTION INDISPONIBLE 96 : CALL ERREUR(19) 97 : SEGDES,IMODEL,MMODEL 98 : RETURN 99 : ENDIF 100 : SEGDES,IMODEL 101 : 10 CONTINUE 102 : SEGDES,MMODEL 103 : 104 : * on veut un chpoint de composante T 105 : 106 : MCHPOI = IPCHPO 107 : SEGACT,MCHPOI 108 : SEGINI,MCHPO1 = MCHPOI 109 : SEGDES,MCHPOI 110 : * 111 : IPCHP2 = MCHPO1 112 : NSOUS = MCHPO1.IPCHP(/1) 113 : DO 20 IZ = 1,NSOUS 114 : MSOUPO = MCHPO1.IPCHP(IZ) 115 : SEGACT,MSOUPO*MOD 116 : NOCOMP(1) = 'T ' 117 : SEGDES,MSOUPO 118 : 20 CONTINUE 119 : SEGDES,MCHPO1 120 : 120 : CALL SORE1(IPMODE,IPCHEL,IPCHE1,IPCHPO,IPRIGI) 121 : IF (IERR.NE.0) RETURN 122 : * 122 : CALL ECROBJ('RIGIDITE',IPRIGI) 123 : RETURN 124 : END 125 : 126 : 127 : 128 : 129 : 130 : 131 : 132 : 133 : 134 : 135 :
© Cast3M 2003 - All rights reserved.
Disclaimer