1 : C PROJBA SOURCE AM 08/02/14 21:27:55 6050 2 : SUBROUTINE PROJBA(IP1,IP2,IP4,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C======================================================================= 6 : C SUBROUTINE APPELE PAR L OPERATEUR PJBA : PROJECTION DU CHPOINT IP1 SUR 7 : C LES ELEMENTS DE LA BASE MODALE IP2, SOUS BASE IP4. 8 : C LE RESULTAT EST MIS DANS IRET (CHPOINT). 9 : C POUR DEBOGUER IMPEC=10 10 : C 11 : C PROGRAMME PAR FARVACQUE 12 : C APPELE PAR PJBA 13 : C APPELLE : ETALPR,ETALCH,ERREUR(108,302,303) 14 : C======================================================================= 15 : -INC CCOPTIO 16 : -INC CCREEL 17 : -INC SMCHPOI 18 : -INC SMELEME 19 : -INC SMATTAC 20 : -INC SMBASEM 21 : -INC SMSOLUT 22 : -INC CCHAMP 23 : SEGMENT ITRAV(2) 24 : SEGMENT ITTT(0) 25 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 26 : SEGMENT IINC 27 : CHARACTER*4 CIINC(0) 28 : ENDSEGMENT 29 : SEGMENT IIDU 30 : CHARACTER*4 CIIDU(NNI1) 31 : ENDSEGMENT 32 : SEGMENT/MVA/(VA(NNI1,IPR1)*D),MVA1.MVA 33 : SEGMENT IPB(IPR1) 34 : SEGMENT MCONTR(NNI1,IPR1) 35 : SEGMENT/IWRK/(ITRAVV(LDEPL1,2),TRAV(LDEPL)*D) 36 : CHARACTER*4 IDDL 37 : DATA IMPEC/10/ 38 : DATA KZERO/0/ 39 : C 40 : IRET=0 41 : C 42 : C DEPLACEMENT IMPOSE => IDEPI=1 43 : C FORCE IMPOSEE => IDEPI=0 44 : C 45 : IDEPI=0 46 : C IDEPI=-1 47 : KDEPI=0 48 : MCHPOI=IP1 49 : SEGACT MCHPOI 50 : IF(MTYPOI.EQ.'FLX ') IDEPI=1 51 : C IF(MTYPOI(1).EQ.MOFORC(1).AND.MTYPOI(2).EQ.MOFORC(2)) IDEPI=0 52 : SEGDES MCHPOI 53 : C IF(IDEPI.LT.0) THEN 54 : C MOTERR(1:8)='CHPOINT' 54 : C CALL ERREUR(302) 55 : C RETURN 56 : C ENDIF 57 : C 58 : NBNN=1 59 : NBREF=0 60 : NBSOUS=0 61 : MBASEM=IP2 62 : SEGACT MBASEM 63 : SEGINI ITRAV 64 : SEGINI ITTT 65 : MSOBAS=LISBAS(IP4) 66 : SEGDES MBASEM 67 : SEGACT MSOBAS 68 : ITRAV(1)=IBSTRM(2) 69 : ITRAV(2)=IBSTRM(3) 70 : SEGDES MSOBAS 71 : C 72 : DO 1 IT=1,2 73 : MSOLUT=ITRAV(IT) 74 : IF(MSOLUT.EQ.0) GO TO 1 75 : SEGACT MSOLUT 76 : MSOLEN=MSOLIS(5) 77 : IF(IT.EQ.2) MSOLE1=MSOLIS(10) 78 : MELEME=MSOLIS(3) 79 : SEGDES MSOLUT 80 : SEGACT MSOLEN 81 : LDEPL=ISOLEN(/1) 82 : LDEPL1=LDEPL+1 83 : IF(IT.EQ.2) SEGINI IWRK 84 : IF(IIMPI.EQ.IMPEC)WRITE(6,8000) IT,MSOLEN,MSOLE1,LDEPL 85 : 8000 FORMAT(' *****IT=',I4,' MSOLEN=',I5,' MSOLE1=',I5,' LDEPL=',I5) 86 : C 87 : C **** ETALPR DU CHPOINT DE LA SOLUTION 88 : C 89 : IPM=ISOLEN(1) 89 : CALL ETALPR(IPM,KIINC,KICPR,KCONTR) 90 : IF(IERR.NE.0) GO TO 5000 91 : MCONTR=KCONTR 92 : SEGACT MCONTR 93 : NNI1=MCONTR(/1) 94 : IPR1=MCONTR(/2) 95 : SEGDES MCONTR 96 : SEGINI MVA 97 : KMVA=MVA 98 : SEGDES MVA 99 : SEGINI MVA 100 : KMVB=MVA 101 : SEGDES MVA 102 : SEGINI IPB 103 : KIPB=IPB 104 : SEGDES IPB 105 : IINC=KIINC 106 : SEGACT IINC 107 : SEGINI IIDU 108 : DO 6 I=1,NNI1 109 : IDDL=CIINC(I) 110 : DO 7 J=1,LNOMDD 111 : IF(IDDL.NE.NOMDD(J))GO TO 7 112 : CIIDU(I)=NOMDU(J) 113 : GO TO 6 114 : 7 CONTINUE 115 : MOTERR(1:4)=IDDL 115 : CALL ERREUR(108) 116 : C ON NE TROUVE PAS IDDL DANS CCHAMP 117 : GO TO 5000 118 : 6 CONTINUE 119 : SEGDES IINC,IIDU 120 : KINCDU=IIDU 121 : IF(IIMPI.EQ.IMPEC)WRITE(6,8002)(CIINC(I),CIIDU(I),I=1,NNI1) 122 : 8002 FORMAT(20(1X,A4)) 123 : C 124 : C **** ON REGARDE SI LES POINTS DE F CORRESPONDENT 125 : C **** ON MET F DANS KMVB 126 : C 126 : CALL ETALCH(IP1,KINCDU,KICPR,KCONTR,KMVB,KIPB,NPR2) 127 : IF(IERR.NE.0) GO TO 5000 128 : C 129 : C **** SI IT=1 ON INITIALISE MSOUPO,MPOVAL,MELEME 130 : C 131 : IF(IT.NE.1) GO TO 100 132 : NC=1 133 : SEGINI MSOUPO 134 : NOCOMP(1)='FALF' 135 : N=LDEPL 136 : SEGINI MPOVAL 137 : IPOVAL=MPOVAL 138 : IGEOC=MELEME 139 : SEGDES MSOUPO 140 : IF(IDEPI.EQ.1) MSOLE2=MSOLIS(4) 141 : 100 CONTINUE 142 : IF(IT.EQ.2) SEGACT MSOLE1 143 : ICON1=0 144 : ICON2=0 145 : SEGACT MSOLEN,MELEME 146 : C 147 : C ****BOUCLE SUR LES CHPOINTS DE DEPL 148 : C 149 : DO 11 IM=1,LDEPL 150 : XRET=0.D0 151 : IPP1=ISOLEN(IM) 152 : IPOIN=NUM(1,IM) 153 : IF(IIMPI.EQ.IMPEC)WRITE(6,8003) IPP1,IPOIN 154 : 8003 FORMAT(' IPP1=',I6,' IPOIN=',I6) 155 : IF(IT.EQ.1.OR.IDEPI.NE.1) THEN 155 : CALL ETALCH(IPP1,KIINC,KICPR,KCONTR,KMVA,KZERO,IBID) 156 : IF(IERR.NE.0) GO TO 5000 157 : C 158 : MVA=KMVA 159 : IPB=KIPB 160 : MVA1=KMVB 161 : SEGACT MVA,MVA1,IPB 162 : DO 80 J1=1,NPR2 163 : JJ1=IPB(J1) 164 : DO 80 I1=1,NNI1 165 : XRET=XRET+VA(I1,JJ1)*MVA1.VA(I1,JJ1) 166 : 80 CONTINUE 167 : SEGDES MVA,MVA1,IPB 168 : ENDIF 169 : C 170 : IF(IT.EQ.1) THEN 171 : IF(IDEPI.EQ.1) THEN 172 : MMODE=MSOLE2.ISOLEN(IM) 173 : SEGACT MMODE 174 : OM=FMMODD(1) 175 : SEGDES MMODE 176 : OM=2.D0*XPI*OM 177 : OM=OM*OM 178 : XRET=-XRET/OM 179 : ENDIF 180 : VPOCHA(IM,1)=XRET 181 : ELSE 182 : MJONCT=MSOLE1.ISOLEN(IM) 183 : IF(IIMPI.EQ.IMPEC)WRITE(6,8004) MJONCT 184 : 8004 FORMAT(' MJONCT=',I6) 185 : SEGACT MJONCT 186 : IF(MJODDL.EQ.'LX') THEN 187 : ITRAVV(IM,1)=IPOIN 188 : ICON1=ICON1+1 189 : ELSE 190 : ITRAVV(IM,2)=IPOIN 191 : ICON2=ICON2+1 192 : IF(IP1.EQ.IPCHJO(1)) THEN 193 : XRET=1.D0 194 : KDEPI=1 195 : ENDIF 196 : ENDIF 197 : SEGDES MJONCT 198 : TRAV(IM)=XRET 199 : ENDIF 200 : 11 CONTINUE 201 : SEGDES MSOLEN,MELEME 202 : SEGSUP MVA,MVA1,IPB 203 : ICPR=KICPR 204 : SEGSUP ICPR,IINC,IIDU 205 : C 206 : GO TO(31,32),IT 207 : C 208 : 31 SEGDES MPOVAL,MELEME 209 : ITTT(**)=MSOUPO 210 : GO TO 30 211 : 32 CONTINUE 212 : ITRAVV(LDEPL1,1)=ICON1 213 : ITRAVV(LDEPL1,2)=ICON2 214 : DO 40 I=1,2 215 : NBELEM=ITRAVV(LDEPL1,I) 216 : IF(NBELEM.EQ.0) GO TO 40 217 : SEGINI MELEME 218 : NC=1 219 : SEGINI MSOUPO 220 : IF(I.EQ.1) NOCOMP(1)='FBET' 221 : IF(I.EQ.2) NOCOMP(1)='BETA' 222 : N=NBELEM 223 : SEGINI MPOVAL 224 : IPOVAL=MPOVAL 225 : IGEOC=MELEME 226 : SEGDES MSOUPO 227 : ITTT(**)=MSOUPO 228 : IK=0 229 : DO 41 J=1,LDEPL 230 : IF(ITRAVV(J,I).EQ.0) GO TO 41 231 : IK=IK+1 232 : NUM(1,IK)=ITRAVV(J,I) 233 : VPOCHA(IK,1)=TRAV(J) 234 : 41 CONTINUE 235 : SEGDES MPOVAL,MELEME 236 : 40 CONTINUE 237 : SEGDES MSOLE1 238 : SEGSUP IWRK 239 : C 240 : 30 CONTINUE 241 : 1 CONTINUE 242 : C 243 : C **** CREATION DU CHPOINT 244 : C 245 : NSOUPO=ITTT(/1) 246 : NAT=1 247 : SEGINI MCHPOI 248 : DO 60 I=1,NSOUPO 249 : IPCHP(I)=ITTT(I) 250 : 60 CONTINUE 251 : MOCHDE=' J''AI ETE FABRIQUE PAR L''OPERATEUR PROJBA' 252 : * Champ de forces nodales: nature discrete 253 : JATTRI(1)=2 254 : SEGDES MCHPOI 255 : IRET=MCHPOI 256 : IF(IDEPI.NE.KDEPI) THEN 257 : C *** LA BASE NE CONTIENT PAS LA SOLUTION STATIQUE NECESSAIRE AU 258 : C *** CALCUL DE LA REPONSE AU DEPLACEMENT IMPOSE 258 : CALL ERREUR(303) 258 : CALL ECRCHA('GEOM') 258 : CALL DTCHPO(MCHPOI) 259 : IRET=0 260 : ENDIF 261 : 5000 CONTINUE 262 : SEGSUP ITTT,ITRAV 263 : RETURN 264 : END 265 : 266 : 267 : 268 : 269 :
© Cast3M 2003 - All rights reserved.
Disclaimer