1 : C SOLS1 SOURCE AM 08/02/14 21:30:46 6050 2 : SUBROUTINE SOLS1(KSOSTU,KSOLE1,KSOLUT) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C======================================================================= 7 : C SOUS-PROGRAMME APPELE PAR L'OPERATEUR SOLS 8 : C IL FABRIQUE LES SOLUTIONS STATIQUES POUR LES LIAISONS L 9 : C DE LA STRUCTURE S 10 : C 11 : C KSOLUT : OBJET SOLUTION (SOUS TYPE SOLU-STAT) 12 : C KSOSTU : STRUCTURE ELEMENTAIRE, SEGMENT MSOSTU 13 : C KSOLE1 : LISTE DES LIAISONS ELEMENTAIRES (MJONCT), SEGMENT MSOLEN 14 : C 15 : C ECRIT PAR FARVACQUE 16 : C APPELLE ECCHPO RESOU1 ECSOLU ERREUR(108) 17 : C INTRODUCTION DES RESOLUTIONS SIMULTANEES : M.PETIT 10/3/88 18 : C======================================================================= 19 : C 20 : -INC CCOPTIO 21 : -INC SMSTRUC 22 : -INC SMATTAC 23 : -INC SMSOLUT 24 : -INC CCHAMP 25 : -INC SMCHPOI 26 : -INC SMELEME 27 : SEGMENT IDEMEN(0) 28 : C 29 : CHARACTER*4 MOLX,IDDL 30 : DATA MOLX/'LX '/ 31 : C 32 : KSOLUT=0 33 : MSOSTU=KSOSTU 34 : MSOLE1=KSOLE1 35 : SEGACT MSOSTU,MSOLE1 36 : KRIGI=ISRAID 37 : SEGDES MSOSTU 38 : C 39 : NJONC=MSOLE1.ISOLEN(/1) 40 : N=NJONC 41 : SEGINI MSOLEN 42 : NBELEM=NJONC 43 : NBNN=1 44 : NBSOUS=0 45 : NBREF=0 46 : SEGINI MELEME 47 : ITYPEL=1 48 : C 49 : C **** BOUCLE SUR LES MJONCT PRIS DANS MSOLE1 50 : C 51 : DO 72 IB=1,NJONC 52 : MJONCT=MSOLE1.ISOLEN(IB) 53 : SEGACT MJONCT 54 : IPT1=MJOPOI 55 : SEGACT IPT1 56 : NUM(1,IB)=IPT1.NUM(1,1) 57 : C WRITE(6,4444) NUM(1,IB) 58 : C4444 FORMAT(' POINT DU MJONCT ',I5) 59 : SEGDES IPT1 60 : IF(MJOTYP.EQ.'DEPI') THEN 61 : ISOLEN(IB)=IPCHJO(1) 62 : ELSE 63 : NCCC=ISTRJO(/1) 64 : DO 73 IC=1,NCCC 65 : IF(ISTRJO(IC).EQ.MSOSTU) GOTO 74 66 : 73 CONTINUE 67 : GOTO 71 68 : 74 CONTINUE 69 : MCHPOI=IPCHJO(IC) 70 : SEGACT MCHPOI*MOD 71 : NSOUPO=IPCHP(/1) 72 : NAT=1 73 : C **** ON VA CALCULER LA REPONSE A MCHPO1 QU ON VA METTRE DANS ISOLEN(I 74 : SEGINI MCHPO1 75 : C dans les objets solutions il n'y a que des champs diffus 76 : JATTRI(1) = 1 77 : DO 80 IS=1,NSOUPO 78 : MSOUPO=IPCHP(IS) 79 : SEGACT MSOUPO 80 : NC=NOCOMP(/2) 81 : SEGINI MSOUP1 82 : MSOUP1.IGEOC=IGEOC 83 : IF(MJODDL.NE.'LX ') GO TO 87 84 : C 85 : C **** SI LIAISON LIBRE(MJODDL=LX) REPONSE A -Pt 86 : C 87 : MPOVAL=IPOVAL 88 : SEGACT MPOVAL 89 : N=VPOCHA(/1) 90 : SEGINI MPOVA1 91 : DO 86 ICOMP=1,NC 92 : DO 86 I1=1,N 93 : MPOVA1.VPOCHA(I1,ICOMP)=-VPOCHA(I1,ICOMP) 94 : 86 CONTINUE 95 : SEGDES MPOVAL,MPOVA1 96 : MSOUP1.IPOVAL=MPOVA1 97 : GO TO 88 98 : 87 CONTINUE 99 : MSOUP1.IPOVAL=IPOVAL 100 : 88 CONTINUE 101 : DO 81 ICOMP=1,NC 102 : DO 82 ICOMP1=1,LNOMDD 103 : IF(NOMDD(ICOMP1).NE.NOCOMP(ICOMP)) GO TO 82 104 : MSOUP1.NOCOMP(ICOMP)=NOMDU(ICOMP1) 105 : MSOUP1.NOHARM(ICOMP)=NOHARM(ICOMP) 106 : GO TO 81 107 : 82 CONTINUE 108 : MOTERR(1:4)=NOCOMP(ICOMP) 108 : CALL ERREUR(108) 109 : GO TO 5000 110 : 81 CONTINUE 111 : SEGDES MSOUP1,MSOUPO 112 : MCHPO1.IPCHP(IS)=MSOUP1 113 : MCHPO1.IFOPOI=IFOPOI 114 : 80 CONTINUE 115 : C 116 : SEGDES MCHPOI,MCHPO1 117 : ISOLEN(IB)=MCHPO1 118 : IF(MJODDL.EQ.'LX ') ISOLEN(IB)=-ISOLEN(IB) 119 : 71 CONTINUE 120 : ENDIF 121 : SEGDES MJONCT 122 : 72 CONTINUE 123 : SEGDES MELEME 124 : C 125 : C 126 : N=NJONC 127 : SEGINI MSOLE2 128 : NIPO=10 129 : SEGINI MSOLUT 130 : ITYSOL='SOLUSTAT' 131 : DO 56 I=1,NIPO 132 : MSOLIS(I)=0 133 : MSOLIT(I)=0 134 : 56 CONTINUE 135 : MSOLIS(3)=MELEME 136 : MSOLIS(4)=MSOLE2 137 : MSOLIS(5)=MSOLEN 138 : MSOLIT(5)=2 139 : MSOLIT(10)=14 140 : MSOLIS(10)=MSOLE1 141 : C 142 : SEGINI IDEMEN 143 : KDEMEN=IDEMEN 144 : DO 50 IB=1,NJONC 145 : ISEC=ABS(ISOLEN(IB)) 146 : IF(IIMPI.EQ.0) GOTO 52 147 : IF(ISOLEN(IB).GT.0)WRITE(IOIMP,4441)IB 148 : IF(ISOLEN(IB).LT.0)WRITE(IOIMP,4442)IB 149 : 4441 FORMAT(' SOLUTION STATIQUE NUMERO :',I4,' BLOQUEE.') 150 : 4442 FORMAT(' SOLUTION STATIQUE NUMERO :',I4,' LIBRE .') 151 : WRITE(IOIMP,4446) 152 : 4446 FORMAT(' ***** CHPOINT D''EXCITATION ') 152 : CALL ECCHPO(ISEC,0) 153 : 52 CONTINUE 154 : IDEMEN(**)=ISEC 154 : call ecrobj('CHPOINT ',isec) 155 : 50 CONTINUE 155 : call ecrcha('NOID') 155 : call ecrcha('NOUN') 155 : call ecrobj('RIGIDITE',krigi) 156 : C 157 : C ON RESOUD SIMULTANEMENT POUR LES NJONC LIAISONS 158 : C 159 : NOID=0 160 : NOEN=1 160 : CALL RESOU 161 : IF(IERR.NE.0) GO TO 5000 162 : C 163 : C 164 : IDEMEN=KDEMEN 165 : SEGACT IDEMEN*mod 166 : do 541 ib=njonc,1,-1 166 : call lirobj('CHPOINT ',iprem,1,iretou) 167 : idemen(ib)=iprem 168 : 541 continue 169 : DO 54 IB=1,NJONC 170 : LVALM=5 171 : NIMOD=3 172 : SEGINI MMODE 173 : IMODE=MMODE 174 : FMMODD(1)=0.D0 175 : FMMODD(2)=0.D0 176 : FMMODD(2)=0.D0 177 : FMMODD(4)=0.D0 178 : FMMODD(5)=0.D0 179 : IMMODD(1)=IB 180 : MCHPOI=IDEMEN(IB) 181 : SEGACT MCHPOI 182 : IRT=MCHPOI 183 : IF(IFOPOI.NE.1) GOTO 57 183 : CALL NUHARM(IRT,IFO,IHARM) 184 : IF(IFO.NE.1) THEN 185 : IMMODD(2)=0 186 : IMMODD(3)=0 187 : ELSE 188 : IMMODD(2)=IHARM 189 : IF(IHARM.LT.0) IMMODD(3)=1 190 : IF(IHARM.GE.0) IMMODD(3)=2 191 : ENDIF 192 : 57 CONTINUE 193 : MCHPOI=IRT 194 : SEGDES MMODE,MCHPOI 195 : IF(IIMPI.EQ.0)GOTO 53 196 : WRITE(IOIMP,4447) 197 : 4447 FORMAT(' ***** CHPOINT REPONSE SOLUTION STATIQUE ') 197 : CALL ECCHPO(IRT,0) 198 : 53 CONTINUE 199 : IF(IRT.EQ.0) GO TO 5000 200 : MJONCT=MSOLE1.ISOLEN(IB) 201 : SEGACT MJONCT 202 : IF(MJOTYP.NE.'DEPI') THEN 203 : MCHPOI=ABS(ISOLEN(IB)) 204 : SEGACT MCHPOI 205 : NSOUP=IPCHP(/1) 206 : DO 51 I=1,NSOUP 207 : MSOUPO=IPCHP(I) 208 : IF(ISOLEN(IB).GT.0) GO TO 55 209 : SEGACT MSOUPO 210 : MPOVAL=IPOVAL 211 : SEGSUP MPOVAL 212 : 55 CONTINUE 213 : SEGSUP MSOUPO 214 : 51 CONTINUE 215 : SEGSUP MCHPOI 216 : ENDIF 217 : SEGDES MJONCT 218 : ISOLEN(IB)=IRT 219 : MSOLE2.ISOLEN(IB)=IMODE 220 : 54 CONTINUE 221 : SEGSUP IDEMEN 222 : SEGDES MSOLEN,MSOLE1,MSOLE2 223 : C 224 : C 225 : SEGDES MSOLUT 225 : IF(IIMPI.NE.0) CALL ECSOLU(MSOLUT,0) 226 : KSOLUT=MSOLUT 227 : 5000 CONTINUE 228 : RETURN 229 : END 230 : 231 : 232 : 233 : 234 : 235 : 236 : 237 :
© Cast3M 2003 - All rights reserved.
Disclaimer