1 : C RCOSIG SOURCE FANDEUR 10/12/14 21:19:13 6812 2 : SUBROUTINE RCOSIG(ICHP1,KCON,KMEL1,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : *_______________________________________________________________________ 6 : * 7 : * APPELE PAR L OPERATEUR RECO: 8 : * RECOMBINE LES CONTRAINTES RANGEES DANS LE MSOLEN KCON 9 : * LE RESULTAT EST MIS DANS IRET ------------ 10 : * 11 : * PROGRAMME PAR BROCHARD 12 : * APPELE PAR RECOMB 13 : * APPELLE :PRCHEL ERREUR(169-170) 14 : * 15 : * PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 01/91 16 : *_______________________________________________________________________ 17 : * 18 : -INC CCOPTIO 19 : -INC SMSOLUT 20 : -INC SMCHPOI 21 : -INC SMELEME 22 : -INC SMCOORD 23 : -INC SMCHAML 24 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 25 : SEGMENT ITRA1(NSOUS,4) 26 : SEGMENT TRAV(NPOIN)*D 27 : IRET=0 28 : MSOLEN=KCON 29 : * 30 : * ON MET LES CONTRIBUTIONS MODALES ICHP1 DANS ICPR ET TRAV 31 : * 32 : MCHPOI=ICHP1 33 : IF(MCHPOI.NE.0) GO TO 11 34 : * 35 : * LE CHPOINT DES CONTRIBUTIONS MODALES EST NUL 36 : * 37 : MOTERR(1:8)='RCODP1' 37 : CALL ERREUR(170) 38 : GO TO 5000 39 : * 40 : 11 CONTINUE 41 : SEGINI ICPR 42 : SEGACT MCHPOI 43 : NSOU=IPCHP(/1) 44 : IKI=0 45 : DO 1 ISOU=1,NSOU 46 : MSOUPO=IPCHP(ISOU) 47 : SEGACT MSOUPO 48 : MELEME=IGEOC 49 : SEGACT MELEME 50 : N2=NUM(/2) 51 : DO 2 I=1,N2 52 : IKI=IKI+1 53 : ICPR(NUM(1,I))=IKI 54 : 2 CONTINUE 55 : SEGDES MELEME,MSOUPO 56 : 1 CONTINUE 57 : * 58 : NPOIN=IKI 59 : SEGINI TRAV 60 : IKI=0 61 : DO 3 ISOU=1,NSOU 62 : MSOUPO=IPCHP(ISOU) 63 : SEGACT MSOUPO 64 : MPOVAL=IPOVAL 65 : SEGACT MPOVAL 66 : N2=VPOCHA(/1) 67 : DO 4 I=1,N2 68 : IKI=IKI+1 69 : TRAV(IKI)=VPOCHA(I,1) 70 : 4 CONTINUE 71 : SEGDES MPOVAL,MSOUPO 72 : 3 CONTINUE 73 : SEGDES MCHPOI 74 : * 75 : * INITIALISATION DU CHAMELEM 76 : * 77 : SEGACT MSOLEN 78 : NBCHAM=ISOLEN(/1) 79 : IPCHE1=ISOLEN(1) 80 : * 81 : MCHEL1=IPCHE1 82 : SEGINI,MCHELM=MCHEL1 83 : NSOUS=ICHAML(/1) 84 : SEGINI ITRA1 85 : DO 120 ISOUS=1,NSOUS 86 : ITRA1(ISOUS,1)=IMACHE(ISOUS) 87 : MCHAM1=ICHAML(ISOUS) 88 : SEGINI,MCHAML=MCHAM1 89 : ICHAML(ISOUS)=MCHAML 90 : ITRA1(ISOUS,2)=MCHAML 91 : 120 CONTINUE 92 : * 93 : DO 200 ICHAM=1,NBCHAM 94 : IPCHE1=ISOLEN(ICHAM) 95 : * 96 : MCHEL1=IPCHE1 97 : SEGACT MCHEL1 98 : DO 210 ISOUS=1,NSOUS 99 : IPMAIL=ITRA1(ISOUS,1) 100 : IF ( IPMAIL.NE.MCHEL1.IMACHE(ISOUS) ) THEN 101 : SEGDES MCHEL1 101 : CALL ERREUR(21) 102 : GOTO 9990 103 : ENDIF 104 : MCHAM1=MCHEL1.ICHAML(ISOUS) 105 : SEGACT MCHAM1 106 : MCHAML=ITRA1(ISOUS,2) 107 : NCOMP=IELVAL(/1) 108 : DO 199 ICOMP=1,NCOMP 108 : CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC, 109 : & NOMCHE(ICOMP)) 110 : IF (IPLAC.EQ.0) THEN 111 : SEGDES MCHAM1 112 : SEGDES MCHEL1 112 : CALL ERREUR(21) 113 : GOTO 9990 114 : ENDIF 115 : MELVA1=MCHAM1.IELVAL(IPLAC) 116 : SEGACT MELVA1 117 : N1PTEL=MELVA1.VELCHE(/1) 118 : N1EL =MELVA1.VELCHE(/2) 119 : ITRA1(ISOUS,3)=MAX(ITRA1(ISOUS,3),N1PTEL) 120 : ITRA1(ISOUS,4)=MAX(ITRA1(ISOUS,4),N1EL ) 121 : SEGDES MELVA1 122 : 199 CONTINUE 123 : SEGDES MCHAM1 124 : 210 CONTINUE 125 : SEGDES MCHEL1 126 : 200 CONTINUE 127 : C 128 : DO 220 ISOUS=1,NSOUS 129 : MCHAML=ITRA1(ISOUS,2) 130 : NCOMP=IELVAL(/1) 131 : N1PTEL=ITRA1(ISOUS,3) 132 : N1EL =ITRA1(ISOUS,4) 133 : N2PTEL=0 134 : N2EL=0 135 : DO 221 ICOMP=1,NCOMP 136 : SEGINI MELVAL 137 : IELVAL(ICOMP)=MELVAL 138 : 221 CONTINUE 139 : 220 CONTINUE 140 : * 141 : IRET=MCHELM 142 : * 143 : * BOUCLES SUR LES CONTRAINTES MODALES 144 : * 145 : MELEME=KMEL1 146 : SEGACT MELEME 147 : LCON=ISOLEN(/1) 148 : DO 300 I=1,LCON 149 : IJ=NUM(1,I) 150 : J=ICPR(IJ) 151 : IF(J.NE.0) GOTO 310 152 : * 153 : * ON NE TROUVE PAS LA CONTRIBUTION MODALE 154 : * 155 : MOTERR(1:8)='RCODP1' 156 : INTERR(1)=IJ 156 : CALL ERREUR(169) 156 : CALL DTCHAM(IRET) 157 : GOTO 5000 158 : * 159 : 310 CONTINUE 160 : XVAL=TRAV(J) 161 : IPCHE1=ISOLEN(I) 162 : * 163 : MCHEL1=IPCHE1 164 : SEGACT MCHEL1 165 : DO 320 ISOUS=1,NSOUS 166 : MCHAML=ITRA1(ISOUS,2) 167 : MCHAM1=MCHEL1.ICHAML(ISOUS) 168 : SEGACT MCHAM1 169 : NCOMP=IELVAL(/1) 170 : DO 301 ICOMP=1,NCOMP 170 : CALL PLACE ( MCHAM1.NOMCHE,MCHAM1.NOMCHE(/1),IPLAC, 171 : & NOMCHE(ICOMP)) 172 : MELVAL=IELVAL(ICOMP) 173 : MELVA1=MCHAM1.IELVAL(IPLAC) 174 : SEGACT MELVA1 175 : DO 400 IGAU=1,VELCHE(/1) 176 : IGMN=MIN(IGAU,MELVA1.VELCHE(/1)) 177 : DO 400 IB=1,VELCHE(/2) 178 : IBMN=MIN(IB,MELVA1.VELCHE(/2)) 179 : VELCHE(IGAU,IB)=VELCHE(IGAU,IB)+ 180 : & XVAL*MELVA1.VELCHE(IGMN,IBMN) 181 : 400 CONTINUE 182 : SEGDES MELVA1 183 : 301 CONTINUE 184 : SEGDES MCHAM1 185 : 320 CONTINUE 186 : SEGDES MCHEL1 187 : 300 CONTINUE 188 : SEGDES MELEME,MSOLEN 189 : SEGSUP TRAV,ICPR 190 : DO 500 ISOUS=1,NSOUS 191 : MCHAML=ITRA1(ISOUS,2) 192 : NCOMP=IELVAL(/1) 193 : DO 501 ICOMP=1,NCOMP 194 : MELVAL=IELVAL(ICOMP) 195 : SEGDES MELVAL 196 : 501 CONTINUE 197 : SEGDES MCHAML 198 : 500 CONTINUE 199 : SEGSUP ITRA1 200 : SEGDES MCHELM 201 : IRET=MCHELM 202 : * 202 : IF(IIMPI.EQ.3) CALL ZPCHEL(IRET,0) 203 : * 204 : 5000 CONTINUE 205 : RETURN 206 : * 207 : 9990 CONTINUE 208 : DO 600 ISOUS=1,NSOUS 209 : MCHAML=ITRA1(ISOUS,2) 210 : SEGSUP MCHAML 211 : 600 CONTINUE 212 : SEGSUP MCHELM 213 : SEGSUP ITRA1 214 : RETURN 215 : 216 : END 217 : 218 :
© Cast3M 2003 - All rights reserved.
Disclaimer