Télécharger la plaquette Cast3M


fr en

Télécharger triang.eso

Retour à la liste

Numérotation des lignes : 

triang

  1. C TRIANG    SOURCE    MB234859  26/07/30    21:15:09     12609          
  2.       SUBROUTINE TRIANG(KRIGI,PREC,istab,igradj)
  3. C=======================================================================
  4. C  ASSEMBLE LES PETITES MATRICES RIGIDITE ET LES MET SOUS LA FORME
  5. C  Lt.D.L.
  6. C  ICHOLE EST LE POINTEUR DE LA MATRICE RESULTANTE
  7. C
  8. C  IGRADJ : 0 si Factorisation de Choleski (solveur direct)
  9. C           1 si Factorisation incomplete de Choleski (solveur indirect)
  10. C=======================================================================
  11. C
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8 (A-H,O-Z)
  14. C
  15. -INC SMRIGID
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC SMMATRI
  19. C
  20.       IF(IIMPI.EQ.1)THEN
  21.         CALL GIBTEM(XKT)
  22.         INTERR(1)=INT(XKT)
  23.         CALL ERREUR(-259)
  24.         WRITE(IOIMP,10)
  25.  10     FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT ASSEM1 ')
  26.       ENDIF
  27. C
  28.       CALL ASSEM1(KRIGI,MMATRX,INUINX,ITOPOX,IMINIX,IPOX,INCTRX,IITOPX)
  29.       IF(IERR.NE.0) GOTO 5000
  30. C
  31.       IF(IIMPI.EQ.1)THEN
  32.         CALL GIBTEM(XKT)
  33.         INTERR(1)=INT(XKT)
  34.         CALL ERREUR(-259)
  35.         WRITE(IOIMP,11)
  36.    11   FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT ASSEM2')
  37.       ENDIF
  38. C
  39.       CALL ASSEM2(KRIGI,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX,IITOPX)
  40.       IF(IERR.NE.0) GOTO 5000
  41. C
  42.       IF(IIMPI.EQ.1)THEN
  43.         CALL GIBTEM(XKT)
  44.         INTERR(1)=INT(XKT)
  45.         CALL ERREUR(-259)
  46.         WRITE(IOIMP,12)
  47.   12    FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT SHOLE ')
  48.       ENDIF
  49. C
  50. C     Sauvegarde de la matrice assemblee sous forme creuse
  51.       CALL GRACO11(MMATRX)
  52.       IF(IERR.NE.0) GOTO 5000
  53. C
  54.       MMATRI=MMATRX
  55.       SEGACT,MMATRI*MOD
  56.       MMATRI.MFACT=IGRADJ
  57.       SEGDES,MMATRI
  58. C
  59.       nbnnma=0
  60.       nligra=0
  61.       xmatri=0
  62. C
  63.       CALL SHOLE(MMATRX,PREC,istab,nbnnma,nligra,xmatri,0)
  64. CC    CALL CHOLE(MMATRX,PREC,istab,nbnnma,nligra,xmatri)
  65.       IF(IERR.NE.0) GOTO 5000
  66. C
  67.       IF(IIMPI.EQ.1)THEN
  68.         CALL GIBTEM(XKT)
  69.         INTERR(1)=INT(XKT)
  70.         CALL ERREUR(-259)
  71.         WRITE(IOIMP,13)
  72.    13   FORMAT(' L''IMPRESSION PRECEDENTE EST APRES SHOLE')
  73.       ENDIF
  74. C
  75.       MRIGID=KRIGI
  76.       SEGACT,MRIGID*MOD
  77.       ICHOLE=MMATRX
  78.       SEGDES MRIGID
  79. C
  80.  5000 CONTINUE
  81.       RETURN
  82.       END
  83.  
  84.  
  85.  

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