1 : C RECDEP SOURCE CHAT 05/01/13 02:46:37 5004 2 : SUBROUTINE RECDEP(IPBASE,ICH1,IRET) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C*********************************************************************** 6 : C RECOMBINAISON DES DEPLACEMENTS POUR LA BASE IPBASE 7 : C LE CHAMPOINT DES CONTIBUTIONS MODALES EST ICH1 8 : C LE CHAMPOINT RESULTAT EST DANS IRET 9 : C 10 : C M. PETIT JUILLET 88 11 : C*********************************************************************** 12 : -INC CCOPTIO 13 : -INC SMBASEM 14 : -INC SMSOLUT 15 : C 16 : MBASEM=IPBASE 17 : SEGACT MBASEM 18 : NBAS=LISBAS(/1) 19 : C 20 : C BOUCLE 100 SUR LES SOUS- BASES 21 : C 22 : DO 100 IBAS=1,NBAS 23 : MSOBAS=LISBAS(IBAS) 24 : SEGACT MSOBAS 25 : IBMODE=IBSTRM(2) 26 : IBSOLS=IBSTRM(3) 27 : SEGDES MSOBAS 28 : C 29 : IRET1=0 30 : IRET2=0 31 : C 32 : C ON RECOMBINE LES MODES RESULTAT DANS IRET1 33 : C 34 : IF(IBMODE.EQ.0) GO TO 11 35 : MSOLUT=IBMODE 36 : SEGACT MSOLUT 37 : KDEPL=MSOLIS(5) 38 : KMEL1=MSOLIS(3) 39 : SEGDES MSOLUT 40 : IF(KDEPL.NE.0) GO TO 15 41 : MOTERR(1:8)=ITYSOL 41 : CALL ERREUR(61) 42 : GO TO 999 43 : 15 CONTINUE 43 : CALL RCODP1(ICH1,KDEPL,KMEL1,IRET1) 44 : IF(IERR.NE.0) GO TO 999 45 : C 46 : C ON RECOMBINE LES SOLUTIONS STATIQUES RESULTAT DANS IRET2 47 : C 48 : 11 IF(IBSOLS.EQ.0) GO TO 12 49 : MSOLUT=IBSOLS 50 : SEGACT MSOLUT 51 : KDEPL=MSOLIS(5) 52 : KMEL1=MSOLIS(3) 53 : SEGDES MSOLUT 54 : IF(KDEPL.NE.0) GO TO 16 55 : MOTERR(1:8)=ITYSOL 55 : CALL ERREUR(61) 56 : GO TO 999 57 : 16 CONTINUE 57 : CALL RCODP1(ICH1,KDEPL,KMEL1,IRET2) 58 : IF(IERR.NE.0) GO TO 999 59 : C 60 : 12 CONTINUE 61 : IF(IRET1.NE.0. AND .IRET2.NE.0) GO TO 13 62 : IF(IRET1.NE.0) IRET3=IRET1 63 : IF(IRET2.NE.0) IRET3=IRET2 64 : GO TO 14 65 : C 65 : 13 CALL ADCHPO(IRET1,IRET2,IRET3,1D0,1D0) 65 : CALL DTCHPO(IRET1) 65 : CALL DTCHPO(IRET2) 66 : C 67 : 14 CONTINUE 68 : IF(IBAS.EQ.1) THEN 69 : IRE1=IRET3 70 : IRET=IRET3 71 : GO TO 100 72 : ENDIF 72 : CALL ADCHPO(IRE1,IRET3,IRET,1D0,1D0) 73 : IF(IERR.NE.0) GO TO 999 73 : CALL DTCHPO(IRE1) 73 : CALL DTCHPO(IRET3) 74 : IRE1=IRET 75 : 100 CONTINUE 76 : SEGDES MBASEM 77 : C 78 : 999 CONTINUE 79 : RETURN 80 : END 81 :
© Cast3M 2003 - All rights reserved.
Disclaimer