champo
C CHAMPO SOURCE JK148537 23/08/21 21:15:05 11723 C======================================================================= C C TRANSFORME UN MCHAML EN CHPOINT C C C ATTENTION LES COMPOSANTES DE IPCHAM NE DOIVENT PAS ETRE ' ' C ( DES MOT BLANCS ) C C ENTREES C C IPCHAM=Pointeur sur un MCHAML C IMOY =1 si moyenne sur les elements, 0 si somme C C SORTIES C C IPCHPO=Pointeur sur un CHPOINT C IRET=1 OU 0 suivant succes ou non C Message d'erreur imprime si IRET=0 C C C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC SMCHAML -INC SMCHPOI -INC SMELEME -INC SMCOORD -INC PPARAM -INC CCOPTIO -INC TMTRAV * SEGMENT ICPR(nbpts) SEGMENT MTRA1 CHARACTER*(LOCOMP) ICOMP(0) ENDSEGMENT SEGMENT MTRA2 INTEGER MHAR(0) ENDSEGMENT C Pour de l'optimisation CHARACTER*(LOCOMP) MO4a,MO4b * write(ioimp,*) 'coucou champo' * call ecrobj('MCHAML ',IPCHAM) * call prlist * CALL ACTOBJ('MCHAML ',IPCHAM,1) C POUR LE CHAPEAU DU CHPOINT C Certaines SUBROUTINES envoie IMOY1 en CONSTANT EXPRESSION donc le modifier ne fait pas bon menage C Je le recopie IMOY <-- IMOY1 IMOY=IMOY1 JFLAG=0 IF (IMOY.GE.10) THEN JFLAG=1 IMOY=IMOY-10 ENDIF * * ACTIVATION DU MCHAML * IRET=1 MCHELM=IPCHAM * COMME ON UTILISE INFCHE(??,3) ON S'ASSURE QU'IL EXISTE BIEN L1=TITCHE(/1) N1=INFCHE(/1) N3=MAX(INFCHE(/2),3) IF (N3.NE.INFCHE(/2)) SEGADJ MCHELM IFACHE=IFOCHE NSOUS =ICHAML(/1) C----------------------------------------------------------------------- C C BOUCLE SUR LES SOUS REFERENCES DU CHAMELEM C MISE EN PLACE DES NOMS DE COMPOSANTES DANS ICOMP C C----------------------------------------------------------------------- CALL oooprl(1) SEGINI MTRA1,MTRA2,ICPR CALL oooprl(0) NNNOE=0 * * BOUCLE SUR LES SOUS ZONES * DO 100 ISOUS=1,NSOUS * * ACTIVATION DU MELEME * IVACHE = INFCHE(ISOUS,3) MELEME = IMACHE(ISOUS) MCHAML = ICHAML(ISOUS) if (mchaml.le.0) goto 100 * * RECOPIE DES NOMS DE COMPOSANTES * DO 110 IB=1,NOMCHE(/2) MO4a = NOMCHE(IB) DO 120 IC=1,ICOMP(/2) MO4b=ICOMP(IC) IF(MO4a.EQ.MO4b .AND. MHAR(IC).EQ.IVACHE) GOTO 110 120 CONTINUE ICOMP(**)=MO4a MHAR(**) =IVACHE 110 CONTINUE * * RECUPERATION DES NUMEROS DE NOEUDS * DO 111 JOP= 1,NUM(/2) DO 113 IOP = 1,NUM(/1) IPT= NUM(IOP,JOP) IF(ICPR(IPT).EQ.0) THEN NNNOE=NNNOE+1 ICPR(IPT)=NNNOE ENDIF 113 CONTINUE 111 CONTINUE 100 CONTINUE * NNIN=ICOMP(/2) SEGINI MTRAV DO 112 IOP=1,NNIN NHAR(IOP)=MHAR(IOP) 112 CONTINUE C C INITIALISATION DE CC STOCKANT LES VALEURS DU CHPOINT C C C C----------------------------------------------------------------------- C C BOUCLE SUR LES SOUS REFERENCES DU CHAMP PAR ELEMENT C C----------------------------------------------------------------------- DO 300 ISOUS=1,NSOUS * IVACHE=INFCHE(ISOUS,3) MELEME=IMACHE(ISOUS) MCHAML=ICHAML(ISOUS) if (mchaml.le.0) goto 300 NCP=NOMCHE(/2) C NBNN =NUM(/1) NBELEM=NUM(/2) C C BOUCLE SUR LES COMPOSANTES LES ELEMENTS ET LES NOEUDS C DO 320 IB=1,NBELEM DO 3201 IC=1,NBNN C C REPERAGE D UN POINT IPT=ICPR(NUM(IC,IB)) DO 330 ID=1,NCP MELVAL=IELVAL(ID) NBPTEL=VELCHE(/1) NEL =VELCHE(/2) IBMN=MIN(IB,NEL) IGMN=MIN(IC,NBPTEL) MO4a=NOMCHE(ID) DO 3301 IE=1,NNIN MO4b=ICOMP(IE) IF(MO4a.NE.MO4b .OR. IVACHE.NE.MHAR(IE)) GOTO 3301 BVALT=0.D0 * IF (JFLAG.EQ.1) THEN DO 331 ICEL=1,NBPTEL C C ADDITION DANS BB POUR LES MCHAML AUX NOEUDS C BVALT=BVALT+VELCHE(ICEL,IBMN) 331 CONTINUE BVALT=BVALT/NBPTEL BB(IE,IPT)=BB(IE,IPT)+BVALT ELSE BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN) ENDIF IBIN(IE,IPT)=IBIN(IE,IPT)+1 3301 CONTINUE 330 CONTINUE * IGEO(IPT)=NUM(IC,IB) 3201 CONTINUE 320 CONTINUE 300 CONTINUE * * IF (IMOY.EQ.1) THEN DO 340 IPT=1,NNNOE DO 3401 IE=1,NNIN IF (IBIN(IE,IPT).NE.0) THEN BB(IE,IPT)=BB(IE,IPT)/IBIN(IE,IPT) ELSE BB(IE,IPT)=0.D0 ENDIF 3401 CONTINUE 340 CONTINUE ENDIF * SEGSUP MTRAV,ICPR,MTRA1,MTRA2 MCHPOI=IPCHPO IFOPOI=IFACHE MTYPOI=TITCHE IF ( IMOY .EQ. 0) THEN * on somme les participations des elements: discret JATTRI(1) = 2 ELSE * on prend la moyenne entre les éléments: diffus JATTRI(1) = 1 ENDIF END
© Cast3M 2003 - Tous droits réservés.
Mentions légales