Télécharger la plaquette Cast3M


fr en

Télécharger ldmt1.eso

Retour à la liste

Numérotation des lignes : 

ldmt1

  1. C LDMT1     SOURCE    MB234859  26/07/30    21:15:07     12609          
  2.       SUBROUTINE LDMT1(KRIGI,PREC,IGRADJ)
  3. C=======================================================================
  4. C   ASSEMBLE LES PETITES MATRICES de RIGIDITE ET LES MET SOUS LA FORME
  5. C        t
  6. C   L.D.M
  7. C   IL LE POINTEUR DE LA MATRICE RESULTANTE DANS ICHOLE (segment MRIGID)
  8. C
  9. C   Cette subroutine est équivalente à TRIANG dans le cas de
  10. C   l'inversion des matrices symétrique
  11. C
  12. C   Appelée par : LDMT
  13. C
  14. C   Auteur : Michel BULIK
  15. C
  16. C   Date : Printemps '95
  17. C
  18. C   Langage : ESOPE + FORTRAN77
  19. C
  20. C=======================================================================
  21. C
  22.       IMPLICIT INTEGER(I-N)
  23.       IMPLICIT REAL*8 (A-H,O-Z)
  24. -INC SMRIGID
  25. -INC SMELEME
  26. -INC SMMATRI
  27. -INC PPARAM
  28. -INC CCOPTIO
  29.  
  30. C ... Ces variables ont pour but, de diriger le comportement de LDMT2 ...
  31. C       TRSUP  - TRiangle SUPérieur
  32. C       MENAGE - évident
  33. C       LDIAG  - initialisation et remplissage de MDIAG et MDNOR demandés
  34.  
  35.       LOGICAL TRSUP,MENAGE,LDIAG
  36.  
  37.       IF (IIMPI.EQ.1)THEN
  38.         CALL GIBTEM(XKT)
  39.         INTERR(1)=INT(XKT)
  40.         CALL ERREUR(-259)
  41.         WRITE(IOIMP,10)
  42.  10     FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT ASNS1 ')
  43.       ENDIF
  44. C
  45. C ... MMATRI est initialisé dans ASSEM1 et renvoyé en tant que résultat
  46. C     dans la variable MMATRX, il est désactivé à la sortie ...
  47.       CALL ASNS1(KRIGI,MMATRX,INUINX,ITOPOX,IMINIX,IPOX,INCTRX,INCTRZ,
  48.      &     IITOPX,ITOPOD,IITOPD,IPODD)
  49.       IF(IERR.NE.0) RETURN
  50.  
  51.       IF (IIMPI.EQ.1) THEN
  52.         CALL GIBTEM(XKT)
  53.         INTERR(1)=INT(XKT)
  54.         CALL ERREUR(-259)
  55.         WRITE(IOIMP,11)
  56.    11   FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT LDMT2')
  57.       ENDIF
  58.  
  59. C ... On initialise IJMAX ici et non dans LDMT2, car celui-ci est
  60. C     appelé deux fois ...
  61.       MMATRI=MMATRX
  62.       SEGACT,MMATRI*MOD
  63.       IJMAX=0
  64.       MFACT=IGRADJ
  65.       SEGDES,MMATRI
  66. C
  67.       TRSUP =.FALSE.
  68.       MENAGE=.FALSE.
  69.       LDIAG =.TRUE.
  70.       njtot=0
  71. C      write(6,*) ' premier appel'
  72.       CALL LDMT2(KRIGI,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX,INCTRZ,
  73.      &           IITOPX,TRSUP,MENAGE,LDIAG,IITOPD,ITOPOD,IPODD,njtot,1)
  74.       IF(IERR.NE.0) GOTO 5000
  75. C
  76.       TRSUP =.TRUE.
  77.       MENAGE=.TRUE.
  78.       LDIAG =.FALSE.
  79. C      write(6,*) ' deuxieme appel'
  80.       CALL LDMT2(KRIGI,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX,INCTRZ,
  81.      &           IITOPX,TRSUP,MENAGE,LDIAG,IITOPD,ITOPOD,IPODD,njtot,1)
  82.       IF(IERR.NE.0) GOTO 5000
  83. C
  84.       IF (IIMPI.EQ.1)THEN
  85.         CALL GIBTEM(XKT)
  86.         INTERR(1)=INT(XKT)
  87.         CALL ERREUR(-259)
  88.         WRITE(IOIMP,12)
  89.   12    FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT LDMT3')
  90.       ENDIF
  91. C
  92.       nbnnma=0
  93.       nligra=0
  94.       xmatri=0
  95.       istab =0
  96. C
  97.       CALL SHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATRI,1)
  98. CC    CALL LDMTS(MMATRX,PREC,istab,nbnnma,nligra,xmatri)
  99. CC    CALL LDMT3(MMATRX,PREC)
  100.       IF(IERR.NE.0) GOTO 5000
  101.  
  102.       IF (IIMPI.EQ.1)THEN
  103.         CALL GIBTEM(XKT)
  104.         INTERR(1)=INT(XKT)
  105.         CALL ERREUR(-259)
  106.         WRITE(IOIMP,13)
  107.    13   FORMAT(' L''IMPRESSION PRECEDENTE EST APRES LDMT3')
  108.       ENDIF
  109. C
  110.       MRIGID=KRIGI
  111.       SEGACT,MRIGID*MOD
  112.       ICHOLE=MMATRX
  113.       SEGDES MRIGID
  114. C
  115.  5000 CONTINUE
  116.       RETURN
  117.       END
  118.  
  119.  
  120.  

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