C KPRO SOURCE PV 22/01/04 06:13:28 11250 SUBROUTINE KPRO IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C************************************************************************* C C Operateur KPRO C C OBJET : to project CHAMPOINT C SYNTAXE : CHR = KPRO CHP GEO ; C C CHP : CHPOINT C CHR : CHPOINT C GEO : MAILLAGE (SEG2 or SEG3) C C CHR is the projection of CHP following the connectivities GEO. C The value of CHP at point 1 of each element of GEO (if exists) C is projected to the point 2 of the same element of GEO thus to C constitute CHR. C C************************************************************************* CHARACTER*8 TYPE -INC PPARAM -INC CCOPTIO -INC SMCOORD -INC SMCHPOI POINTEUR MCHP.MCHPOI,MSPO.MSOUPO,MVAL.MPOVAL POINTEUR NCHP.MCHPOI,NSPO.MSOUPO,NVAL.MPOVAL -INC SMELEME POINTEUR MGEO.MELEME,MSPG.MELEME,NSPG.MELEME SEGMENT LOCSGM INTEGER ICHP(NPART) ENDSEGMENT C*** C Reading the CHPOINT TYPE='CHPOINT ' CALL LIROBJ(TYPE,MCHP,0,IRET) IF(IRET.EQ.0) THEN WRITE(6,*)'On attend un CHAMPOINT' RETURN ENDIF C Reading the MAILLAGE TYPE='MAILLAGE' CALL LIROBJ(TYPE,MGEO,0,IRET) IF(IRET.EQ.0) THEN WRITE(6,*)'On attend un MAILLAGE' RETURN ENDIF C Veryfing the MAILLAGE inoeu = 2 SEGACT MGEO ITIPO=MGEO.ITYPEL IF(ITIPO.LT.2.OR.ITIPO.GT.3) THEN WRITE(6,*)'On attend un MAILLAGE compose de SEG2 ou SEG3' RETURN ENDIF if(itipo.eq.3) inoeu = 3 NELGEO=MGEO.NUM(/2) NBNN =1 NBSOUS=0 NBREF =0 SEGACT MCHP NPART=MCHP.IPCHP(/1) NAT =MCHP.JATTRI(/1) SEGINI LOCSGM IPART=0 DO I=1,NPART MSPO=MCHP.IPCHP(I) SEGACT MSPO MSPG=MSPO.IGEOC MVAL=MSPO.IPOVAL SEGACT MSPG,MVAL NC =MVAL.VPOCHA(/2) NELSPG=MSPG.NUM(/2) N =NELGEO NBELEM=NELGEO SEGINI NSPG,NVAL NSPG.ITYPEL=1 NPUNTO=0 DO J=1,NELGEO DO K=1,NELSPG IELGEO=MGEO.NUM(1,J) IELSPG=MSPG.NUM(1,K) IF(IELGEO.EQ.IELSPG) THEN NPUNTO=NPUNTO+1 NSPG.NUM(1,NPUNTO)=MGEO.NUM(inoeu,J) DO L=1,NC NVAL.VPOCHA(NPUNTO,L)=MVAL.VPOCHA(K,L) ENDDO GO TO 100 ENDIF ENDDO 100 CONTINUE ENDDO IF(NPUNTO.EQ.0) THEN SEGSUP NSPG,NVAL SEGDES MSPG,MVAL,MSPO GO TO 200 ELSEIF(NPUNTO.NE.NBELEM) THEN NBELEM=NPUNTO N =NPUNTO SEGADJ NSPG,NVAL ENDIF SEGINI NSPO NSPO.IGEOC =NSPG NSPO.IPOVAL=NVAL DO L=1,NC NSPO.NOCOMP(L)=MSPO.NOCOMP(L) NSPO.NOHARM(L)=MSPO.NOHARM(L) ENDDO NSOUPO=1 SEGINI NCHP NCHP.MTYPOI =MCHP.MTYPOI NCHP.MOCHDE =MCHP.MOCHDE NCHP.IFOPOI =MCHP.IFOPOI NCHP.IPCHP(1)=NSPO DO L=1,NAT NCHP.JATTRI(L)=MCHP.JATTRI(L) ENDDO IPART=IPART+1 ICHP(IPART)=NCHP SEGDES NCHP,NSPO,NSPG,NVAL,MSPG,MVAL,MSPO 200 CONTINUE ENDDO SEGDES MCHP IF(IPART.EQ.0) THEN WRITE(ioimp,*) 'Le CHPOINT et le MAILLAGE n''ont pas ', & 'de point commun' SEGSUP LOCSGM RETURN ENDIF NCHP=ICHP(1) CALL ECROBJ('CHPOINT ',NCHP) IF(IPART.GT.1) THEN DO I=2,IPART NCHP=ICHP(I) CALL ECROBJ('CHPOINT ',NCHP) CALL PRFUSE ENDDO ENDIF SEGSUP LOCSGM RETURN END