C CHACOQ SOURCE CHAT 11/03/16 21:16:45 6902 SUBROUTINE CHACOQ(IPMODE,IPCHSO,IPCHEB,IPCHAL) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) ************************************************************************ * * C H A C O Q * ----------- * * FONCTION: * --------- * CAS DES SOURCES VOLUMIQUES, ELEMENTS COQUES * * MODULES UTILISES: * ----------------- * -INC CCOPTIO -INC SMCHAML -INC SMMODEL * * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) * ----------- * * IPMODE (E) POINTEUR SUR L'OBJET MODELISE * IPCHEb (E) POINTEUR SUR LE CHAMELEM DE CARACTERISTIQUES * IPCHAL (S) POINTEUR SUR LE CHPOINT CONTENANT LES CHALEURS * NODALES EQUIVALENTES * * AUTEUR, DATE DE CREATION: * ------------------------- * * P. DOWLATYARI JUIN 90 * ADAPTATION DE CHAMAS POUR LES COQUES * * LANGAGE: * -------- * * ESOPE + FORTRAN77 * ************************************************************************ * IPCHAL=0 MMODEL=IPMODE SEGACT,MMODEL NSOU=KMODEL(/1) * MCHEL1=IPCHSO SEGACT,MCHEL1 IF ( NSOU. NE.MCHEL1.IMACHE(/1) ) THEN CALL ERREUR(21) GOTO 997 ENDIF mchel2=ipcheb segact mchel2 if ( mchel2.imache(/1).ne.nsou ) then call erreur(21) GOTO 998 endif * * on cree un chamelem resultat en copiant la structure de l'entree * L1=7 N1=nsou N3=6 SEGINI,MCHELM IFOCHE=IFOUR TITCHE='CHALEUR' * * BOUCLE SUR LES ZONES DE L'OBJET MODELE * IFOI=0 IPINT1 = 0 DO 100 ISOU=1,NSOU IFOI=IFOI+1 IMODEL=KMODEL(ISOU) SEGACT,IMODEL NEF=NEFMOD * * recherche dans le chamaleem la sous zone correspondante * do 257 IOP =1,NSOU IF( MCHEL1.imache(iop).eq.imamod) go to 258 257 continue call erreur (21) goto 999 258 continue * * recherche de la sous zone des caracteristiques des coques * do 259 iup = 1,NSOU if(MCHEL2.imache(iup).eq.imamod) go to 260 259 continue call erreur (21) GOTO 999 260 continue * * RECUPERATION DES CARACTERISTIQUES D'INTEGRATION * CALL TSHAPE(NEF,'GAUSS',IPINTE) * * COQ6 COQ4 COQ8 IF(NEF.EQ.41.OR.NEF.EQ.49.OR.NEF.EQ.56)THEN CALL TSHAPE(NEF,'NOEUD',IPINT1) ENDIF * * on active la sous zone du chamelem de source qui nous interesse * position des sources sinf ... MCHAM1=MCHEL1.ICHAML(iop) SEGACT,MCHAM1 CALL PLACE(MCHAM1.NOMCHE,3,ipo1,'SINF') CALL PLACE(MCHAM1.NOMCHE,3,ipo2,'SMOY') CALL PLACE(MCHAM1.NOMCHE,3,ipo3,'SSUP') if(ipo1.eq.0.or.ipo2.eq.0.or. ipo3.eq.0) then segdes,MCHAM1 CALL ERREUR(909) GOTO 999 endif * write(6,*) MCHAM1.NOMCHE(1),MCHAM1.NOMCHE(2),MCHAM1.NOMCHE(3) IPSONO=MCHAM1.IELVAL(ipo1) IPSON1=MCHAM1.IELVAL(ipo2) IPSON2=MCHAM1.IELVAL(ipo3) SEGDES,MCHAM1 * * RECUPERATION DE L'epaisseur des coques * MCHAM3=MCHEL2.ICHAML(IUP) SEGACT,MCHAM3 NCOELE=MCHAM3.NOMCHE(/2) CALL PLACE (MCHAM3.NOMCHE,NCOELE,IPOSI,'EPAI') IF (IPOSI.EQ.0)THEN MOTERR(1:4)='EPAI' MOTERR(5:8)='CARA' CALL ERREUR(77) SEGDES,MCHAM3 GOTO 999 ENDIF IEP=MCHAM3.IELVAL(IPOSI) SEGDES,MCHAM3 * * CHAMELEM ELEMENTAIRE DES CHALEURS NODALES EQUIVALENTES * INFCHE(ISOU,3)=NIFOUR INFCHE(isou,6)=1 IMACHE(isou)=imamod N2=3 SEGINI,MCHAML ICHAML(isou)=MCHAML NOMCHE(1)='QINF' NOMCHE(2)='Q ' NOMCHE(3)='QSUP' TYPCHE(1)='REAL*8' TYPCHE(2)='REAL*8' TYPCHE(3)='REAL*8' ipogeo=imamod * * CALCUL DES FLUX NODAUX EQUIVALENTS * * COQ2 COQ3 IF (NEF.EQ.44.OR.NEF.EQ.27) THEN CALL CHACO1(IPSONO,IPSON1,IPSON2,IEP,IPOGEO,IPINTE, $ IPCHEQ,IPCHQ1,IPCHQ2) * COQ8 COQ6 COQ4 ELSEIF(NEF.EQ.41.OR.NEF.EQ.56.OR.NEF.EQ.49)THEN CALL CHACO2(IPSONO,IPSON1,IPSON2,IEP,IPOGEO,IPINTE, $ IPINT1,IPCHEQ,IPCHQ1,IPCHQ2) ELSE CALL ERREUR(19) GOTO 999 ENDIF IELVAL(1)=IPCHEQ IELVAL(2)=IPCHQ1 IELVAL(3)=IPCHQ2 SEGDES,MCHAML 100 CONTINUE * END DO IPCHAL=MCHELM SEGDES,MCHELM 999 CONTINUE DO 106 I=1,IFOI IMODEL=KMODEL(I) SEGDES,IMODEL 106 CONTINUE * END DO 998 CONTINUE SEGDES,MCHEL2 997 CONTINUE SEGDES,MCHEL1 SEGDES,MMODEL * RETURN END