Télécharger recdep.eso

Retour à la liste

Numérotation des lignes :

  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
  42. CALL ERREUR(61)
  43. GO TO 999
  44. 15 CONTINUE
  45. CALL RCODP1(ICH1,KDEPL,KMEL1,IRET1)
  46. IF(IERR.NE.0) GO TO 999
  47. C
  48. C ON RECOMBINE LES SOLUTIONS STATIQUES RESULTAT DANS IRET2
  49. C
  50. 11 IF(IBSOLS.EQ.0) GO TO 12
  51. MSOLUT=IBSOLS
  52. SEGACT MSOLUT
  53. KDEPL=MSOLIS(5)
  54. KMEL1=MSOLIS(3)
  55. SEGDES MSOLUT
  56. IF(KDEPL.NE.0) GO TO 16
  57. MOTERR(1:8)=ITYSOL
  58. CALL ERREUR(61)
  59. GO TO 999
  60. 16 CONTINUE
  61. CALL RCODP1(ICH1,KDEPL,KMEL1,IRET2)
  62. IF(IERR.NE.0) GO TO 999
  63. C
  64. 12 CONTINUE
  65. IF(IRET1.NE.0. AND .IRET2.NE.0) GO TO 13
  66. IF(IRET1.NE.0) IRET3=IRET1
  67. IF(IRET2.NE.0) IRET3=IRET2
  68. GO TO 14
  69. C
  70. 13 CALL ADCHPO(IRET1,IRET2,IRET3,1D0,1D0)
  71. CALL DTCHPO(IRET1)
  72. CALL DTCHPO(IRET2)
  73. C
  74. 14 CONTINUE
  75. IF(IBAS.EQ.1) THEN
  76. IRE1=IRET3
  77. IRET=IRET3
  78. GO TO 100
  79. ENDIF
  80. CALL ADCHPO(IRE1,IRET3,IRET,1D0,1D0)
  81. IF(IERR.NE.0) GO TO 999
  82. CALL DTCHPO(IRE1)
  83. CALL DTCHPO(IRET3)
  84. IRE1=IRET
  85. 100 CONTINUE
  86. SEGDES MBASEM
  87. C
  88. 999 CONTINUE
  89. RETURN
  90. END
  91.  
  92.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales