Télécharger la plaquette Cast3M


fr en

Télécharger recdep.eso

Retour à la liste

Numérotation des lignes : 

recdep

  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 PPARAM
  13. -INC CCOPTIO
  14. -INC SMBASEM
  15. -INC SMSOLUT
  16. C
  17.       MBASEM=IPBASE
  18.       SEGACT MBASEM
  19.       NBAS=LISBAS(/1)
  20. C
  21. C     BOUCLE 100 SUR LES SOUS- BASES
  22. C
  23.       DO 100 IBAS=1,NBAS
  24.       MSOBAS=LISBAS(IBAS)
  25.       SEGACT MSOBAS
  26.       IBMODE=IBSTRM(2)
  27.       IBSOLS=IBSTRM(3)
  28.       SEGDES MSOBAS
  29. C
  30.       IRET1=0
  31.       IRET2=0
  32. C
  33. C     ON RECOMBINE LES MODES   RESULTAT DANS IRET1
  34. C
  35.       IF(IBMODE.EQ.0) GO TO 11
  36.       MSOLUT=IBMODE
  37.       SEGACT MSOLUT
  38.       KDEPL=MSOLIS(5)
  39.       KMEL1=MSOLIS(3)
  40.       SEGDES MSOLUT
  41.       IF(KDEPL.NE.0) GO TO 15
  42.       MOTERR(1:8)=ITYSOL
  43.       CALL ERREUR(61)
  44.       GO TO 999
  45.  15   CONTINUE
  46.       CALL RCODP1(ICH1,KDEPL,KMEL1,IRET1)
  47.       IF(IERR.NE.0) GO TO 999
  48. C
  49. C     ON RECOMBINE LES SOLUTIONS STATIQUES    RESULTAT DANS IRET2
  50. C
  51.  11   IF(IBSOLS.EQ.0) GO TO 12
  52.       MSOLUT=IBSOLS
  53.       SEGACT MSOLUT
  54.       KDEPL=MSOLIS(5)
  55.       KMEL1=MSOLIS(3)
  56.       SEGDES MSOLUT
  57.       IF(KDEPL.NE.0) GO TO 16
  58.       MOTERR(1:8)=ITYSOL
  59.       CALL ERREUR(61)
  60.       GO TO 999
  61.  16   CONTINUE
  62.       CALL RCODP1(ICH1,KDEPL,KMEL1,IRET2)
  63.       IF(IERR.NE.0) GO TO 999
  64. C
  65.  12   CONTINUE
  66.       IF(IRET1.NE.0. AND .IRET2.NE.0) GO TO 13
  67.       IF(IRET1.NE.0) IRET3=IRET1
  68.       IF(IRET2.NE.0) IRET3=IRET2
  69.       GO TO 14
  70. C
  71.  13   CALL ADCHPO(IRET1,IRET2,IRET3,1D0,1D0)
  72.       CALL DTCHPO(IRET1)
  73.       CALL DTCHPO(IRET2)
  74. C
  75.  14   CONTINUE
  76.       IF(IBAS.EQ.1) THEN
  77.          IRE1=IRET3
  78.          IRET=IRET3
  79.          GO TO 100
  80.       ENDIF
  81.       CALL ADCHPO(IRE1,IRET3,IRET,1D0,1D0)
  82.       IF(IERR.NE.0) GO TO 999
  83.       CALL DTCHPO(IRE1)
  84.       CALL DTCHPO(IRET3)
  85.       IRE1=IRET
  86.  100  CONTINUE
  87.       SEGDES MBASEM
  88. C
  89.  999  CONTINUE
  90.       RETURN
  91.       END
  92.  
  93.  

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