1 : C CHACOQ SOURCE CHAT 11/03/16 21:16:45 6902 2 : SUBROUTINE CHACOQ(IPMODE,IPCHSO,IPCHEB,IPCHAL) 3 : 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : 7 : ************************************************************************ 8 : * 9 : * C H A C O Q 10 : * ----------- 11 : * 12 : * FONCTION: 13 : * --------- 14 : * CAS DES SOURCES VOLUMIQUES, ELEMENTS COQUES 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC CCOPTIO 20 : -INC SMCHAML 21 : -INC SMMODEL 22 : * 23 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 24 : * ----------- 25 : * 26 : * IPMODE (E) POINTEUR SUR L'OBJET MODELISE 27 : * IPCHEb (E) POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUES 28 : * IPCHAL (S) POINTEUR SUR LE CHPOINT CONTENANT LES CHALEURS 29 : * NODALES EQUIVALENTES 30 : * 31 : * AUTEUR, DATE DE CREATION: 32 : * ------------------------- 33 : * 34 : * P. DOWLATYARI JUIN 90 35 : * ADAPTATION DE CHAMAS POUR LES COQUES 36 : * 37 : * LANGAGE: 38 : * -------- 39 : * 40 : * ESOPE + FORTRAN77 41 : * 42 : ************************************************************************ 43 : * 44 : IPCHAL=0 45 : 46 : MMODEL=IPMODE 47 : SEGACT,MMODEL 48 : NSOU=KMODEL(/1) 49 : * 50 : MCHEL1=IPCHSO 51 : SEGACT,MCHEL1 52 : IF ( NSOU. NE.MCHEL1.IMACHE(/1) ) THEN 52 : CALL ERREUR(21) 53 : GOTO 997 54 : ENDIF 55 : 56 : mchel2=ipcheb 57 : segact mchel2 58 : if ( mchel2.imache(/1).ne.nsou ) then 58 : call erreur(21) 59 : GOTO 998 60 : endif 61 : * 62 : * on cree un chamelem resultat en copiant la structure de l'entree 63 : * 64 : L1=7 65 : N1=nsou 66 : N3=6 67 : SEGINI,MCHELM 68 : IFOCHE=IFOUR 69 : TITCHE='CHALEUR' 70 : * 71 : * BOUCLE SUR LES ZONES DE L'OBJET MODELE 72 : * 73 : IFOI=0 74 : IPINT1 = 0 75 : 76 : DO 100 ISOU=1,NSOU 77 : IFOI=IFOI+1 78 : IMODEL=KMODEL(ISOU) 79 : SEGACT,IMODEL 80 : NEF=NEFMOD 81 : * 82 : * recherche dans le chamaleem la sous zone correspondante 83 : * 84 : do 257 IOP =1,NSOU 85 : IF( MCHEL1.imache(iop).eq.imamod) go to 258 86 : 257 continue 86 : call erreur (21) 87 : goto 999 88 : 258 continue 89 : * 90 : * recherche de la sous zone des caracteristiques des coques 91 : * 92 : do 259 iup = 1,NSOU 93 : if(MCHEL2.imache(iup).eq.imamod) go to 260 94 : 259 continue 94 : call erreur (21) 95 : GOTO 999 96 : 260 continue 97 : * 98 : * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION 99 : * 99 : CALL TSHAPE(NEF,'GAUSS',IPINTE) 100 : * 101 : * COQ6 COQ4 COQ8 102 : IF(NEF.EQ.41.OR.NEF.EQ.49.OR.NEF.EQ.56)THEN 102 : CALL TSHAPE(NEF,'NOEUD',IPINT1) 103 : ENDIF 104 : * 105 : * on active la sous zone du chamelem de source qui nous interesse 106 : * position des sources sinf ... 107 : MCHAM1=MCHEL1.ICHAML(iop) 108 : SEGACT,MCHAM1 108 : CALL PLACE(MCHAM1.NOMCHE,3,ipo1,'SINF') 108 : CALL PLACE(MCHAM1.NOMCHE,3,ipo2,'SMOY') 108 : CALL PLACE(MCHAM1.NOMCHE,3,ipo3,'SSUP') 109 : 110 : if(ipo1.eq.0.or.ipo2.eq.0.or. ipo3.eq.0) then 111 : segdes,MCHAM1 111 : CALL ERREUR(909) 112 : GOTO 999 113 : endif 114 : * write(6,*) MCHAM1.NOMCHE(1),MCHAM1.NOMCHE(2),MCHAM1.NOMCHE(3) 115 : 116 : IPSONO=MCHAM1.IELVAL(ipo1) 117 : IPSON1=MCHAM1.IELVAL(ipo2) 118 : IPSON2=MCHAM1.IELVAL(ipo3) 119 : SEGDES,MCHAM1 120 : * 121 : * RECUPERATION DE L'epaisseur des coques 122 : * 123 : MCHAM3=MCHEL2.ICHAML(IUP) 124 : SEGACT,MCHAM3 125 : NCOELE=MCHAM3.NOMCHE(/2) 125 : CALL PLACE (MCHAM3.NOMCHE,NCOELE,IPOSI,'EPAI') 126 : IF (IPOSI.EQ.0)THEN 127 : MOTERR(1:4)='EPAI' 128 : MOTERR(5:8)='CARA' 128 : CALL ERREUR(77) 129 : SEGDES,MCHAM3 130 : GOTO 999 131 : ENDIF 132 : IEP=MCHAM3.IELVAL(IPOSI) 133 : SEGDES,MCHAM3 134 : * 135 : * CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES 136 : * 137 : INFCHE(ISOU,3)=NIFOUR 138 : INFCHE(isou,6)=1 139 : IMACHE(isou)=imamod 140 : N2=3 141 : SEGINI,MCHAML 142 : ICHAML(isou)=MCHAML 143 : NOMCHE(1)='QINF' 144 : NOMCHE(2)='Q ' 145 : NOMCHE(3)='QSUP' 146 : TYPCHE(1)='REAL*8' 147 : TYPCHE(2)='REAL*8' 148 : TYPCHE(3)='REAL*8' 149 : ipogeo=imamod 150 : * 151 : * CALCUL DES FLUX NODAUX EQUIVALENTS 152 : * 153 : * COQ2 COQ3 154 : IF (NEF.EQ.44.OR.NEF.EQ.27) THEN 154 : CALL CHACO1(IPSONO,IPSON1,IPSON2,IEP,IPOGEO,IPINTE, 155 : $ IPCHEQ,IPCHQ1,IPCHQ2) 156 : * COQ8 COQ6 COQ4 157 : ELSEIF(NEF.EQ.41.OR.NEF.EQ.56.OR.NEF.EQ.49)THEN 157 : CALL CHACO2(IPSONO,IPSON1,IPSON2,IEP,IPOGEO,IPINTE, 158 : $ IPINT1,IPCHEQ,IPCHQ1,IPCHQ2) 159 : ELSE 159 : CALL ERREUR(19) 160 : GOTO 999 161 : ENDIF 162 : IELVAL(1)=IPCHEQ 163 : IELVAL(2)=IPCHQ1 164 : IELVAL(3)=IPCHQ2 165 : SEGDES,MCHAML 166 : 100 CONTINUE 167 : * END DO 168 : IPCHAL=MCHELM 169 : SEGDES,MCHELM 170 : 171 : 999 CONTINUE 172 : DO 106 I=1,IFOI 173 : IMODEL=KMODEL(I) 174 : SEGDES,IMODEL 175 : 106 CONTINUE 176 : * END DO 177 : 998 CONTINUE 178 : SEGDES,MCHEL2 179 : 997 CONTINUE 180 : SEGDES,MCHEL1 181 : SEGDES,MMODEL 182 : * 183 : RETURN 184 : END 185 : 186 : 187 :
© Cast3M 2003 - All rights reserved.
Disclaimer