1 : C SOLS SOURCE CHAT 05/01/13 03:21:44 5004 2 : SUBROUTINE SOLS 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C 6 : C======================================================================= 7 : C OPERATEUR SOLS : FABRIQUE LES SOLUTIONS STATIQUES POUR LES LIAISON L 8 : C DE LA STRUCTURE S 9 : C 10 : C SYNTAXE : SS = SOLS L S ; 11 : C SS : OBJET SOLUTION (SOUS TYPE SOLU-STAT) 12 : C S : OBJET STRUCTURE ELEMENTAIRE 13 : C L : OBJET ATTACHE 14 : C 15 : C ECRIT PAR FARVACQUE 16 : C APPELLE LIROBJ SOLS1 ERREUR(132,139) ECROBJ 17 : C======================================================================= 18 : C 19 : -INC CCOPTIO 20 : -INC SMSTRUC 21 : -INC SMATTAC 22 : -INC SMSOLUT 23 : C 24 : C 24 : CALL LIROBJ('ATTACHE ',IMAT,1,IRETOU) 25 : IF(IERR.NE.0) GO TO 5000 25 : CALL LIROBJ('STRUCTUR',ISTR,1,IRETOU) 26 : IF(IERR.NE.0) GO TO 5000 27 : C 28 : MSTRUC=ISTR 29 : SEGACT MSTRUC 30 : IF(LISTRU(/1).EQ.1) GOTO 1 31 : SEGDES MSTRUC 32 : MOTERR(1:8)='STRUCTUR' 32 : CALL ERREUR(132) 33 : GO TO 5000 34 : 1 CONTINUE 35 : MSOSTU=LISTRU(1) 36 : SEGDES MSTRUC 37 : SEGACT MSOSTU 38 : KRIGI=ISRAID 39 : SEGDES MSOSTU 40 : C 41 : C **** ON COMPTE LES MJONCT QUI AGISSENT SUR MSOSTU ET QUI INTERVIENNEN 42 : C **** AU PREMIER MEMBRE. ON LES MET DANS MSOLE1 43 : C 44 : MATTAC=IMAT 45 : SEGACT MATTAC 46 : N=0 47 : SEGINI MSOLE1 48 : DO 170 IA=1,LISATT(/1) 49 : MSOUMA=LISATT(IA) 50 : SEGACT MSOUMA 51 : IF(ITYATT.EQ.'MECA') GO TO 169 52 : IF(ITYATT.EQ.'FLUI') GO TO 169 53 : IF(ITYATT.EQ.'DEPI') GO TO 169 54 : GOTO 171 55 : 169 CONTINUE 56 : NL=IATREL(/1) 57 : DO 172 IB=1,NL 58 : MJONCT=IATREL(IB) 59 : SEGACT MJONCT 60 : NCCC=ISTRJO(/1) 61 : DO 173 IC=1,NCCC 62 : IF(ISTRJO(IC).NE.MSOSTU) GO TO 173 63 : N=N+1 64 : SEGADJ MSOLE1 65 : MSOLE1.ISOLEN(N)=MJONCT 66 : GO TO 174 67 : 173 CONTINUE 68 : 174 CONTINUE 69 : SEGDES MJONCT 70 : 172 CONTINUE 71 : 171 CONTINUE 72 : SEGDES MSOUMA 73 : 170 CONTINUE 74 : SEGDES MATTAC 75 : IF(N.NE.0) GO TO 2 76 : INTERR(1)=MSOSTU 76 : CALL ERREUR(139) 77 : C ON NE TROUVE PAS DE LIAISON CORRESPONDANT A LA STRUCTURE 78 : SEGSUP MSOLE1 79 : GO TO 5000 80 : 2 CONTINUE 81 : C 82 : KSOSTU=MSOSTU 83 : KSOLE1=MSOLE1 83 : CALL SOLS1(KSOSTU,KSOLE1,KSOLUT) 84 : IF(IERR.NE.0) GOTO 5000 84 : CALL ECROBJ('SOLUTION',KSOLUT) 85 : 5000 CONTINUE 86 : RETURN 87 : END 88 :
© Cast3M 2003 - All rights reserved.
Disclaimer