C RCODP1 SOURCE CB215821 20/11/25 13:38:37 10792 SUBROUTINE RCODP1(ICHP1,KDEPL,KMEL1,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C======================================================================= C APPELE PAR L OPERATEUR RECO: C RECOMBINE LES DEPLACEMENTS RANGES DANS LE MSOLEN KDEPL C LE RESULTAT EST MIS DANS IRET ------------ C C PROGRAMME PAR FARVACQUE C APPELE PAR RECOMB C APPELLE :ECCHPO ERREUR(169-170) C======================================================================= -INC PPARAM -INC CCOPTIO -INC SMSOLUT -INC SMCHPOI -INC SMELEME -INC SMCOORD SEGMENT ICPR(nbpts) SEGMENT TRAV(NPOIN)*D IRET=0 MSOLEN=KDEPL C C **** ON MET LES CONTRIBUTIONS MODALES ICHP1 DANS ICPR ET TRAV C MCHPOI=ICHP1 IF(MCHPOI.NE.0) GO TO 11 C LE CHPOINT DES CONTRIBUTIONS MODALES EST NUL MOTERR(1:8)='RCODP1' CALL ERREUR(170) GO TO 5000 11 CONTINUE SEGINI ICPR SEGACT MCHPOI NSOU=IPCHP(/1) IKI=0 DO 1 ISOU=1,NSOU MSOUPO=IPCHP(ISOU) SEGACT MSOUPO MELEME=IGEOC SEGACT MELEME N2=NUM(/2) DO 2 I=1,N2 IKI=IKI+1 ICPR(NUM(1,I))=IKI 2 CONTINUE SEGDES MELEME,MSOUPO 1 CONTINUE NPOIN=IKI SEGINI TRAV IKI=0 DO 3 ISOU=1,NSOU MSOUPO=IPCHP(ISOU) SEGACT MSOUPO MPOVAL=IPOVAL SEGACT MPOVAL N2=VPOCHA(/1) DO 4 I=1,N2 IKI=IKI+1 TRAV(IKI)=VPOCHA(I,1) 4 CONTINUE SEGDES MPOVAL,MSOUPO 3 CONTINUE SEGDES MCHPOI C C **** INITIALISATION DE MCHPOI: ON PREND LA STRUCTURE DU 1ER CHPOINT C **** DU MSOLEN KDEPL C SEGACT MSOLEN MCHPO1=ISOLEN(1) SEGACT MCHPO1 NSOUPO=MCHPO1.IPCHP(/1) NAT=MCHPO1.JATTRI(/1) SEGINI MCHPOI DO 6 ISOU=1,NSOUPO MSOUP1=MCHPO1.IPCHP(ISOU) SEGACT MSOUP1 NC=MSOUP1.NOCOMP(/2) SEGINI MSOUPO DO 7 IC=1,NC NOCOMP(IC)=MSOUP1.NOCOMP(IC) 7 CONTINUE IGEOC=MSOUP1.IGEOC MELEME=IGEOC SEGACT MELEME N=NUM(/2) SEGDES MELEME,MSOUP1 SEGINI MPOVAL SEGDES MPOVAL IPOVAL=MPOVAL SEGDES MSOUPO IPCHP(ISOU)=MSOUPO 6 CONTINUE SEGDES MCHPO1 C C **** BOUCLE SUR LES DEPLACEMENTS DE DEPL C MELEME=KMEL1 SEGACT MELEME LDEPL=ISOLEN(/1) DO 20 I=1,LDEPL IJ=NUM(1,I) J=ICPR(IJ) IF(J.NE.0) GO TO 21 C ON NE TROUVE PAS LA CONTRIBUTION MODALE CORRESPONDANT A L INDICE MOTERR(1:8)='RCODP1' INTERR(1)=IJ CALL ERREUR(169) GO TO 5000 21 CONTINUE XVAL=TRAV(J) MCHPO1=ISOLEN(I) SEGACT MCHPO1 DO 25 ISOU=1,NSOUPO MSOUP1=MCHPO1.IPCHP(ISOU) MSOUPO=IPCHP(ISOU) SEGACT MSOUP1,MSOUPO MPOVA1=MSOUP1.IPOVAL MPOVAL=IPOVAL SEGDES MSOUP1 SEGACT MPOVA1 SEGACT MPOVAL*MOD N=MPOVA1.VPOCHA(/1) NC=MPOVA1.VPOCHA(/2) DO 27 IC=1,NC DO 27 I2=1,N VPOCHA(I2,IC)=VPOCHA(I2,IC)+XVAL*MPOVA1.VPOCHA(I2,IC) 27 CONTINUE SEGDES MPOVA1,MPOVAL SEGDES MSOUPO 25 CONTINUE SEGDES MCHPO1 20 CONTINUE SEGDES MSOLEN,MELEME SEGSUP TRAV SEGSUP ICPR SEGDES MCHPOI IRET=MCHPOI IF(IIMPI.EQ.3)CALL ECCHPO(IRET,0) 5000 CONTINUE RETURN END