1 : C RCODP1 SOURCE DC 05/09/05 21:15:01 5164 2 : SUBROUTINE RCODP1(ICHP1,KDEPL,KMEL1,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C======================================================================= 6 : C APPELE PAR L OPERATEUR RECO: 7 : C RECOMBINE LES DEPLACEMENTS RANGES DANS LE MSOLEN KDEPL 8 : C LE RESULTAT EST MIS DANS IRET ------------ 9 : C 10 : C PROGRAMME PAR FARVACQUE 11 : C APPELE PAR RECOMB 12 : C APPELLE :ECCHPO ERREUR(169-170) 13 : C======================================================================= 14 : -INC CCOPTIO 15 : -INC SMSOLUT 16 : -INC SMCHPOI 17 : -INC SMELEME 18 : -INC SMCOORD 19 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 20 : SEGMENT TRAV(NPOIN)*D 21 : IRET=0 22 : MSOLEN=KDEPL 23 : C 24 : C **** ON MET LES CONTRIBUTIONS MODALES ICHP1 DANS ICPR ET TRAV 25 : C 26 : MCHPOI=ICHP1 27 : IF(MCHPOI.NE.0) GO TO 11 28 : C LE CHPOINT DES CONTRIBUTIONS MODALES EST NUL 29 : MOTERR(1:8)='RCODP1' 29 : CALL ERREUR(170) 30 : GO TO 5000 31 : 11 CONTINUE 32 : SEGINI ICPR 33 : SEGACT MCHPOI 34 : NSOU=IPCHP(/1) 35 : IKI=0 36 : DO 1 ISOU=1,NSOU 37 : MSOUPO=IPCHP(ISOU) 38 : SEGACT MSOUPO 39 : MELEME=IGEOC 40 : SEGACT MELEME 41 : N2=NUM(/2) 42 : DO 2 I=1,N2 43 : IKI=IKI+1 44 : ICPR(NUM(1,I))=IKI 45 : 2 CONTINUE 46 : SEGDES MELEME,MSOUPO 47 : 1 CONTINUE 48 : NPOIN=IKI 49 : SEGINI TRAV 50 : IKI=0 51 : DO 3 ISOU=1,NSOU 52 : MSOUPO=IPCHP(ISOU) 53 : SEGACT MSOUPO 54 : MPOVAL=IPOVAL 55 : SEGACT MPOVAL 56 : N2=VPOCHA(/1) 57 : DO 4 I=1,N2 58 : IKI=IKI+1 59 : TRAV(IKI)=VPOCHA(I,1) 60 : 4 CONTINUE 61 : SEGDES MPOVAL,MSOUPO 62 : 3 CONTINUE 63 : SEGDES MCHPOI 64 : C 65 : C **** INITIALISATION DE MCHPOI: ON PREND LA STRUCTURE DU 1ER CHPOINT 66 : C **** DU MSOLEN KDEPL 67 : C 68 : SEGACT MSOLEN 69 : MCHPO1=ISOLEN(1) 70 : SEGACT MCHPO1 71 : NSOUPO=MCHPO1.IPCHP(/1) 72 : NAT=MCHPO1.JATTRI(/1) 73 : SEGINI MCHPOI 74 : DO 6 ISOU=1,NSOUPO 75 : MSOUP1=MCHPO1.IPCHP(ISOU) 76 : SEGACT MSOUP1 77 : NC=MSOUP1.NOCOMP(/2) 78 : SEGINI MSOUPO 79 : DO 7 IC=1,NC 80 : NOCOMP(IC)=MSOUP1.NOCOMP(IC) 81 : 7 CONTINUE 82 : IGEOC=MSOUP1.IGEOC 83 : MELEME=IGEOC 84 : SEGACT MELEME 85 : N=NUM(/2) 86 : SEGDES MELEME,MSOUP1 87 : SEGINI MPOVAL 88 : SEGDES MPOVAL 89 : IPOVAL=MPOVAL 90 : SEGDES MSOUPO 91 : IPCHP(ISOU)=MSOUPO 92 : 6 CONTINUE 93 : SEGDES MCHPO1 94 : C 95 : C **** BOUCLE SUR LES DEPLACEMENTS DE DEPL 96 : C 97 : MELEME=KMEL1 98 : SEGACT MELEME 99 : LDEPL=ISOLEN(/1) 100 : DO 20 I=1,LDEPL 101 : IJ=NUM(1,I) 102 : J=ICPR(IJ) 103 : IF(J.NE.0) GO TO 21 104 : C ON NE TROUVE PAS LA CONTRIBUTION MODALE CORRESPONDANT A L INDICE 105 : MOTERR(1:8)='RCODP1' 106 : INTERR(1)=IJ 106 : CALL ERREUR(169) 107 : GO TO 5000 108 : 21 CONTINUE 109 : XVAL=TRAV(J) 110 : MCHPO1=ISOLEN(I) 111 : SEGACT MCHPO1 112 : DO 25 ISOU=1,NSOUPO 113 : MSOUP1=MCHPO1.IPCHP(ISOU) 114 : MSOUPO=IPCHP(ISOU) 115 : SEGACT MSOUP1,MSOUPO 116 : MPOVA1=MSOUP1.IPOVAL 117 : MPOVAL=IPOVAL 118 : SEGDES MSOUP1 119 : SEGACT MPOVA1 120 : SEGACT MPOVAL*MOD 121 : N=MPOVA1.VPOCHA(/1) 122 : NC=MPOVA1.VPOCHA(/2) 123 : DO 27 IC=1,NC 124 : DO 27 I2=1,N 125 : VPOCHA(I2,IC)=VPOCHA(I2,IC)+XVAL*MPOVA1.VPOCHA(I2,IC) 126 : 27 CONTINUE 127 : SEGDES MPOVA1,MPOVAL 128 : SEGDES MSOUPO 129 : 25 CONTINUE 130 : SEGDES MCHPO1 131 : 20 CONTINUE 132 : SEGDES MSOLEN,MELEME 133 : SEGSUP TRAV 134 : SEGSUP ICPR 135 : SEGDES MCHPOI 136 : IRET=MCHPOI 136 : IF(IIMPI.EQ.3)CALL ECCHPO(IRET,0) 137 : 5000 CONTINUE 138 : RETURN 139 : END 140 : 141 : 142 :
© Cast3M 2003 - All rights reserved.
Disclaimer