C CHAMPO SOURCE FD218221 25/03/14 21:15:03 12200 SUBROUTINE CHAMPO(IPCHAM,IMOY1,IPCHPO,IRET) 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 = 0 si somme C 1 si moyenne sur les elements C 2 si valeur maximale C -2 si valeur minimale 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 PPARAM -INC CCOPTIO -INC SMCHAML -INC SMCHPOI -INC SMELEME -INC SMCOORD -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) IRET=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 MCHELM=IPCHAM L1=TITCHE(/1) N1=INFCHE(/1) N3=INFCHE(/2) IF (N3.NE.6) then write(ioimp,*) 'CHAMPO : INFCHE(/2) != 6' call erreur(5) endif 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 INCO(IOP)=ICOMP(IOP) NHAR(IOP)=MHAR(IOP) 112 CONTINUE 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) NBNN=NUM(/1) NBELEM=NUM(/2) C C BOUCLE SUR LES ELEMENTS, LES NOEUDS ET LES COMPOSANTES DU CHAMPS C DO 320 IB=1,NBELEM DO 3201 IC=1,NBNN 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 C REMPLISSAGE DE BB POUR LES MCHAML AUX NOEUDS IF (JFLAG.EQ.1) THEN BVALT=0.D0 DO 331 ICEL=1,NBPTEL BVALT=BVALT+VELCHE(ICEL,IBMN) 331 CONTINUE BVALT=BVALT/NBPTEL C SI ON VEUT LA VALEUR MAXI IF (IMOY.EQ.2) THEN IF (IBIN(IE,IPT).EQ.0) THEN BB(IE,IPT)=BB(IE,IPT)+BVALT ELSE BB(IE,IPT)=MAX(BB(IE,IPT),BVALT) ENDIF C SI ON VEUT LA VALEUR MINI ELSEIF (IMOY.EQ.-2) THEN IF (IBIN(IE,IPT).EQ.0) THEN BB(IE,IPT)=BB(IE,IPT)+BVALT ELSE BB(IE,IPT)=MIN(BB(IE,IPT),BVALT) ENDIF C SI ON VEUT LA SOMME OU LA MOYENNE ELSE BB(IE,IPT)=BB(IE,IPT)+BVALT ENDIF ELSE C SI ON VEUT LA VALEUR MAXI IF (IMOY.EQ.2) THEN IF (IBIN(IE,IPT).EQ.0) THEN BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN) ELSE BB(IE,IPT)=MAX(BB(IE,IPT),VELCHE(IGMN,IBMN)) ENDIF C SI ON VEUT LA VALEUR MINI ELSEIF (IMOY.EQ.-2) THEN IF (IBIN(IE,IPT).EQ.0) THEN BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN) ELSE BB(IE,IPT)=MIN(BB(IE,IPT),VELCHE(IGMN,IBMN)) ENDIF C SI ON VEUT LA SOMME OU LA MOYENNE ELSE BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN) ENDIF 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 * C Et enfin on cree le CHPOINT CALL CRECHP(MTRAV,IPCHPO) C Petit nettoyage SEGSUP MTRAV,ICPR,MTRA1,MTRA2 C Objet CHPOINT, option IFOUR, titre MCHPOI=IPCHPO IFOPOI=IFACHE MTYPOI=TITCHE C Si on fait la somme des contributions de chaque element : nature discret IF (IMOY.EQ.0) THEN JATTRI(1)=2 ELSE * Dans les autres cas : nature diffus JATTRI(1)=1 ENDIF C RETURN END