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/31    21:15:03     12613          
  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. C
  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. C
  37.       INSYM=1
  38. C
  39.       IF (IIMPI.EQ.1)THEN
  40.         CALL GIBTEM(XKT)
  41.         INTERR(1)=INT(XKT)
  42.         CALL ERREUR(-259)
  43.         WRITE(IOIMP,10)
  44.  10     FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT ASNS1 ')
  45.       ENDIF
  46. C
  47. C ... MMATRI est initialisé dans ASSEM1 et renvoyé en tant que résultat
  48. C     dans la variable MMATRX, il est désactivé à la sortie ...
  49.       CALL ASSEM1(KRIGI,INSYM,MMATRX,INUINX,
  50.      &            ITOPOX,IPOX,IITOPX,INCTRX,
  51.      &            ITOPOZ,IPOZ,IITOPZ,INCTRZ)
  52.       IF(IERR.NE.0) RETURN
  53.  
  54.       IF (IIMPI.EQ.1) THEN
  55.         CALL GIBTEM(XKT)
  56.         INTERR(1)=INT(XKT)
  57.         CALL ERREUR(-259)
  58.         WRITE(IOIMP,11)
  59.    11   FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT LDMT2')
  60.       ENDIF
  61.  
  62. C ... On initialise IJMAX ici et non dans LDMT2, car celui-ci est
  63. C     appelé deux fois ...
  64.       MMATRI=MMATRX
  65.       SEGACT,MMATRI*MOD
  66.       IJMAX=0
  67.       MFACT=IGRADJ
  68.       SEGDES,MMATRI
  69. C
  70.       TRSUP =.FALSE.
  71.       MENAGE=.FALSE.
  72.       LDIAG =.TRUE.
  73.       njtot=0
  74. C      write(6,*) ' premier appel'
  75.       CALL LDMT2(KRIGI,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX,INCTRZ,
  76.      &           IITOPX,TRSUP,MENAGE,LDIAG,IITOPZ,ITOPOZ,IPOZ,njtot,1)
  77.       IF(IERR.NE.0) GOTO 5000
  78. C
  79.       TRSUP =.TRUE.
  80.       MENAGE=.TRUE.
  81.       LDIAG =.FALSE.
  82. C     write(6,*) ' deuxieme appel'
  83.       CALL LDMT2(KRIGI,ITOPOX,INUINX,IMINIX,MMATRX,IPOX,INCTRX,INCTRZ,
  84.      &           IITOPX,TRSUP,MENAGE,LDIAG,IITOPZ,ITOPOZ,IPOZ,njtot,1)
  85.       IF(IERR.NE.0) GOTO 5000
  86. C
  87.       IF (IIMPI.EQ.1)THEN
  88.         CALL GIBTEM(XKT)
  89.         INTERR(1)=INT(XKT)
  90.         CALL ERREUR(-259)
  91.         WRITE(IOIMP,12)
  92.   12    FORMAT(' L''IMPRESSION PRECEDENTE EST AVANT LDMT3')
  93.       ENDIF
  94. C
  95.       nbnnma=0
  96.       nligra=0
  97.       xmatri=0
  98.       istab =0
  99. C
  100.       CALL SHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATRI,1)
  101. CC    CALL LDMTS(MMATRX,PREC,istab,nbnnma,nligra,xmatri)
  102. CC    CALL LDMT3(MMATRX,PREC)
  103.       IF(IERR.NE.0) GOTO 5000
  104.  
  105.       IF (IIMPI.EQ.1)THEN
  106.         CALL GIBTEM(XKT)
  107.         INTERR(1)=INT(XKT)
  108.         CALL ERREUR(-259)
  109.         WRITE(IOIMP,13)
  110.    13   FORMAT(' L''IMPRESSION PRECEDENTE EST APRES LDMT3')
  111.       ENDIF
  112. C
  113.       MRIGID=KRIGI
  114.       SEGACT,MRIGID*MOD
  115.       ICHOLE=MMATRX
  116.       SEGDES MRIGID
  117. C
  118.  5000 CONTINUE
  119.       RETURN
  120.       END
  121.  
  122.  
  123.  

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