1 : C CHAMPO SOURCE PV 09/03/12 21:16:53 6325 2 : SUBROUTINE CHAMPO(IPCHAM,IMOY,IPCHPO,IRET) 3 : C======================================================================= 4 : C 5 : C TRANSFORME UN MCHAML EN CHPOINT 6 : C 7 : C 8 : C ATTENTION LES COMPOSANTES DE IPCHAM NE DOIVENT PAS ETRE ' ' 9 : C ( DES MOT BLANCS ) 10 : C 11 : C ENTREES 12 : C 13 : C IPCHAM=Pointeur sur un MCHAML 14 : C IMOY =1 si moyenne sur les elements, 0 si somme 15 : C 16 : C SORTIES 17 : C 18 : C IPCHPO=Pointeur sur un CHPOINT 19 : C IRET=1 OU 0 suivant succes ou non 20 : C Message d'erreur imprime si IRET=0 21 : C 22 : C 23 : C======================================================================= 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : -INC SMCHAML 27 : -INC SMCHPOI 28 : -INC SMELEME 29 : -INC SMCOORD 30 : -INC CCOPTIO 31 : -INC TMTRAV 32 : * 33 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 34 : SEGMENT MTRA1 35 : CHARACTER*4 ICOMP(0) 36 : ENDSEGMENT 37 : SEGMENT MTRA2 38 : INTEGER MHAR(0) 39 : ENDSEGMENT 40 : C POUR LE CHAPEAU DU CHPOINT 41 : JFLAG=0 42 : IF (IMOY.GE.10) THEN 43 : JFLAG=1 44 : IMOY=IMOY-10 45 : ENDIF 46 : * 47 : * ACTIVATION DU MCHAML 48 : * 49 : IRET=1 50 : MCHELM=IPCHAM 51 : SEGACT MCHELM 52 : * COMME ON UTILISE INFCHE(??,3) ON S'ASSURE QU'IL EXISTE BIEN 53 : L1=TITCHE(/1) 54 : N1=INFCHE(/1) 55 : N3=MAX(INFCHE(/2),3) 56 : IF (N3.NE.INFCHE(/2)) SEGADJ MCHELM 57 : IFACHE=IFOCHE 58 : NSOUS =ICHAML(/1) 59 : C----------------------------------------------------------------------- 60 : C 61 : C BOUCLE SUR LES SOUS REFERENCES DU CHAMELEM 62 : C MISE EN PLACE DES NOMS DE COMPOSANTES DANS ICOMP 63 : C 64 : C----------------------------------------------------------------------- 65 : SEGINI MTRA1,MTRA2 66 : SEGINI ICPR 67 : NNNOE=0 68 : * 69 : * BOUCLE SUR LES SOUS ZONES 70 : * 71 : DO 100 ISOUS=1,NSOUS 72 : * 73 : * ACTIVATION DU MELEME 74 : * 75 : MELEME = IMACHE(ISOUS) 76 : MCHAML = ICHAML(ISOUS) 77 : SEGACT MCHAML 78 : * activation des melval 79 : DO ID=1,IELVAL(/1) 80 : MELVAL=IELVAL(ID) 81 : SEGACT MELVAL 82 : ENDDO 83 : * 84 : * RECOPIE DES NOMS DE COMPOSANTES 85 : * 86 : DO 110 IB=1,NOMCHE(/2) 87 : DO 120 IC=1,ICOMP(/2) 88 : IF(ICOMP(IC).EQ.NOMCHE(IB)(1:4) 89 : 1 .AND.MHAR(IC).EQ.INFCHE(ISOUS,3)) GOTO 110 90 : 120 CONTINUE 91 : ICOMP(**)=NOMCHE(IB)(1:4) 92 : MHAR(**) =INFCHE(ISOUS,3) 93 : 110 CONTINUE 94 : * 95 : * RECUPERATION DES NUMEROS DE NOEUDS 96 : * 97 : SEGACT MELEME 98 : DO 111 IOP = 1,NUM(/1) 99 : DO 111 JOP= 1,NUM(/2) 100 : IPT= NUM(IOP,JOP) 101 : IF(ICPR(IPT).EQ.0) THEN 102 : NNNOE=NNNOE+1 103 : ICPR(IPT)=NNNOE 104 : ENDIF 105 : 111 CONTINUE 106 : 100 CONTINUE 107 : * 108 : NNIN=ICOMP(/2) 109 : SEGINI MTRAV 110 : DO 112 IOP=1,NNIN 111 : INCO(IOP)=ICOMP(IOP) 112 : NHAR(IOP)=MHAR(IOP) 113 : 112 CONTINUE 114 : C 115 : C INITIALISATION DE CC STOCKANT LES VALEURS DU CHPOINT 116 : C 117 : C 118 : C 119 : C----------------------------------------------------------------------- 120 : C 121 : C BOUCLE SUR LES SOUS REFERENCES DU CHAMP PAR ELEMENT 122 : C 123 : C----------------------------------------------------------------------- 124 : DO 300 ISOUS=1,NSOUS 125 : * 126 : MELEME=IMACHE(ISOUS) 127 : MCHAML=ICHAML(ISOUS) 128 : NCP=NOMCHE(/2) 129 : C 130 : NBNN =NUM(/1) 131 : NBELEM=NUM(/2) 132 : C 133 : C BOUCLE SUR LES COMPOSANTES LES ELEMENTS ET LES NOEUDS 134 : C 135 : DO 320 IB=1,NBELEM 136 : DO 320 IC=1,NBNN 137 : C 138 : C REPERAGE D UN POINT 139 : IPT=ICPR(NUM(IC,IB)) 140 : DO 330 ID=1,NCP 141 : DO 330 IE=1,NNIN 142 : * 143 : MELVAL=IELVAL(ID) 144 : NBPTEL=VELCHE(/1) 145 : NEL =VELCHE(/2) 146 : IBMN=MIN(IB,NEL) 147 : IGMN=MIN(IC,NBPTEL) 148 : * 149 : IF(NOMCHE(ID)(1:4).NE.ICOMP(IE) 150 : 1 .OR.INFCHE(ISOUS,3).NE.MHAR(IE)) GOTO 330 151 : BVALT=0. 152 : * 153 : IF (JFLAG.EQ.1) THEN 154 : DO 331 ICEL=1,NBPTEL 155 : C 156 : C ADDITION DANS BB POUR LES MCHAML AUX NOEUDS 157 : C 158 : BVALT=BVALT+VELCHE(ICEL,IBMN) 159 : 331 CONTINUE 160 : BVALT=BVALT/NBPTEL 161 : BB(IE,IPT)=BB(IE,IPT)+BVALT 162 : ELSE 163 : BB(IE,IPT)=BB(IE,IPT)+VELCHE(IGMN,IBMN) 164 : ENDIF 165 : IBIN(IE,IPT)=IBIN(IE,IPT)+1 166 : 330 CONTINUE 167 : * 168 : IGEO(IPT)=NUM(IC,IB) 169 : 320 CONTINUE 170 : * desactivation des melval 171 : DO ID=1,IELVAL(/1) 172 : MELVAL=IELVAL(ID) 173 : SEGDES MELVAL 174 : ENDDO 175 : SEGDES MCHAML 176 : 300 CONTINUE 177 : * 178 : DO 341 ISOUS=1,NSOUS 179 : MELEME=IMACHE(ISOUS) 180 : SEGDES MELEME 181 : 341 CONTINUE 182 : * 183 : IF (IMOY.EQ.1) THEN 184 : DO 340 IPT=1,NNNOE 185 : DO 340 IE=1,NNIN 186 : IF (IBIN(IE,IPT).NE.0) THEN 187 : BB(IE,IPT)=BB(IE,IPT)/IBIN(IE,IPT) 188 : ELSE 189 : BB(IE,IPT)=0. 190 : ENDIF 191 : 340 CONTINUE 192 : ENDIF 193 : * 193 : CALL CRECHP(MTRAV,IPCHPO) 194 : SEGSUP MTRAV,ICPR,MTRA1,MTRA2 195 : MCHPOI=IPCHPO 196 : SEGACT MCHPOI*MOD 197 : IFOPOI=IFACHE 198 : MTYPOI=TITCHE 199 : IF ( IMOY .EQ. 0) THEN 200 : * on somme les participations des elements: discret 201 : JATTRI(1) = 2 202 : ELSE 203 : * on prend la moyenne entre les éléments: diffus 204 : JATTRI(1) = 1 205 : ENDIF 206 : SEGDES MCHPOI 207 : SEGDES MCHELM 208 : RETURN 209 : END 210 : 211 : 212 : 213 : 214 :
© Cast3M 2003 - All rights reserved.
Disclaimer