Télécharger la plaquette Cast3M


fr en

Télécharger kres10.eso

Retour à la liste

Numérotation des lignes : 

kres10

  1. C KRES10    SOURCE    PV        20/09/26    21:18:16     10724          
  2.       SUBROUTINE KRES10(MRIGID,KMORS,KIZA)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : KRES10
  7. C DESCRIPTION : - Conversion au format Morse de la matrice
  8. C                 assemblée (MMATRI)
  9. C
  10. C
  11. C LANGAGE     : ESOPE
  12. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  13. C               mél : gounand@semt2.smts.cea.fr
  14. C***********************************************************************
  15. C VERSION    : v1, 24/08/2011, version initiale
  16. C HISTORIQUE : v1, 24/08/2011, création
  17. C HISTORIQUE :
  18. C HISTORIQUE :
  19. C***********************************************************************
  20.       REAL*8 XKT,PREC
  21. -INC SMRIGID
  22. -INC SMMATRI
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMLENTI
  27.       POINTEUR IWORK.MLENTI
  28.       SEGMENT PMORS
  29.       INTEGER IA (NTT+1)
  30.       INTEGER JA (NJA)
  31.       ENDSEGMENT
  32.       SEGMENT IZA
  33.       REAL*8  A(NBVA)
  34.       ENDSEGMENT
  35.       POINTEUR KMORU.PMORS,KMORUT.PMORS,KMORL.PMORS,KMORS.PMORS
  36.       POINTEUR KIZAU.IZA,KIZAUT.IZA,KIZAL.IZA,KIZA.IZA
  37. *
  38.       SEGACT MRIGID
  39.       MMATRI=ICHOLE
  40.       SEGDES MRIGID
  41.       SEGACT MMATRI
  42. *
  43. *      WRITE(IOIMP,*) 'COUCOU KRES10'
  44. *
  45. * Transformation au format Morse du triangle inférieur IPASS=1
  46. * et supérieur IPASS=2
  47. *
  48.       DO IPASS=1,2
  49.          IF (IPASS.EQ.1) THEN
  50.             MILIGN=IILIGN
  51.          ELSE
  52.             MILIGN=IILIGS
  53.          ENDIF
  54. *         WRITE(IOIMP,*) 'MILIGN=',MILIGN
  55.          SEGACT MILIGN
  56.          NNOE=ILIGN(/1)
  57.          INC=IPNO(/1)
  58. * On active toutes les lignes et on compte le nombre
  59. * total de termes non nuls
  60.          NJA=0
  61.          DO INOE=1,NNOE
  62.             LLIGN=ILIGN(INOE)
  63.             SEGACT LLIGN
  64.             LLVVA=XXVA(/1)
  65.             NJA=NJA+LLVVA
  66.          ENDDO
  67. *
  68. *dbg         WRITE(IOIMP,*) ' KRES10 INC=',INC
  69.          NTT=INC
  70.          NBVA=NJA
  71.          SEGINI PMORS
  72.          SEGINI IZA
  73.          ITT=0
  74.          IJA=0
  75.          IA(ITT+1)=1
  76.          DO INOE=1,NNOE
  77.             LLIGN=ILIGN(INOE)
  78.             NA=LDEB(/1)
  79.             DO INA=1,NA
  80.                IVVD=IPPO(INA)
  81.                IVVL=IPPO(INA+1)-IPPO(INA)
  82.                ITT=ITT+1
  83.                IA(ITT+1)=IA(ITT)+IVVL
  84.                DO ICOP=1,IVVL
  85.                   IJA=IJA+1
  86.                   JA(IJA)=LINC(IVVD+ICOP)
  87.                   A(IJA)=XXVA(IVVD+ICOP)
  88.                ENDDO
  89.             ENDDO
  90.          ENDDO
  91.          SEGDES PMORS
  92.          SEGDES IZA
  93.          DO INOE=1,NNOE
  94.             LLIGN=ILIGN(INOE)
  95.             SEGDES LLIGN
  96.          ENDDO
  97. *         WRITE(IOIMP,*) 'MILIGN2=',MILIGN
  98.          SEGDES MILIGN
  99.          IF (IPASS.EQ.1) THEN
  100.             KMORL=PMORS
  101.             KIZAL=IZA
  102. C            WRITE(IOIMP,*) 'Triangle inferieur'
  103. C            CALL ECMORS(PMORS,IZA,4)
  104.          ELSE
  105.             KMORUT=PMORS
  106.             KIZAUT=IZA
  107. C            WRITE(IOIMP,*) 'Triangle superieur'
  108. C            CALL ECMORS(PMORS,IZA,4)
  109.          ENDIF
  110.       ENDDO
  111. * On transpose le triangle supérieur
  112.       SEGACT KMORUT
  113.       SEGACT KIZAUT
  114.       NTT=KMORUT.IA(/1)-1
  115.       NJA=KMORUT.JA(/1)
  116.       NBVA=NJA
  117.       SEGINI KMORU
  118.       SEGINI KIZAU
  119.       CALL TRMORS(NTT,NJA,KIZAUT.A,KMORUT.JA,KMORUT.IA,
  120.      $     KIZAU.A,KMORU.JA,KMORU.IA)
  121.       SEGSUP KMORUT
  122.       SEGSUP KIZAUT
  123.       SEGDES KMORU
  124.       SEGDES KIZAU
  125. C      WRITE(IOIMP,*) 'Triangle superieur transpose'
  126. C      CALL ECMORS(KMORU,KIZAU,4)
  127. *
  128. * Maintenant, on peut créer la matrice Morse total
  129. *
  130.       MDIAG=IDIAG
  131.       SEGACT MDIAG
  132.       SEGACT KMORL
  133.       SEGACT KMORU
  134.       SEGACT KIZAL
  135.       SEGACT KIZAU
  136.       NTT=KMORU.IA(/1)-1
  137.       NJAL=KMORL.JA(/1)
  138.       NJAU=KMORU.JA(/1)
  139.       NJA=NJAL+NTT+NJAU
  140.       NBVA=NJA
  141.       SEGINI PMORS
  142.       SEGINI IZA
  143.       NJA=0
  144.       IA(1)=1
  145.       DO ITT=1,NTT
  146.          IAL=KMORL.IA(ITT)
  147.          IALP=KMORL.IA(ITT+1)-1
  148.          DO IJA=IAL,IALP
  149.             IF (KMORL.JA(IJA).LT.ITT) THEN
  150.                NJA=NJA+1
  151.                JA(NJA)=KMORL.JA(IJA)
  152.                A(NJA)=KIZAL.A(IJA)
  153.             ENDIF
  154.          ENDDO
  155.          NJA=NJA+1
  156.          JA(NJA)=ITT
  157.          A(NJA)=DIAG(ITT)
  158.          IAU=KMORU.IA(ITT)
  159.          IAUP=KMORU.IA(ITT+1)-1
  160.          DO IJA=IAU,IAUP
  161.             IF (KMORU.JA(IJA).GT.ITT) THEN
  162.                NJA=NJA+1
  163.                JA(NJA)=KMORU.JA(IJA)
  164.                A(NJA)=KIZAU.A(IJA)
  165.             ENDIF
  166.          ENDDO
  167.          IA(ITT+1)=NJA+1
  168.       ENDDO
  169. *inutile      NBJA=NJA
  170.       SEGADJ IZA
  171.       SEGADJ PMORS
  172.       SEGDES IZA
  173.       SEGDES PMORS
  174.       KMORS=PMORS
  175.       KIZA=IZA
  176. C      WRITE(IOIMP,*) 'Matrice Morse non ordonnée'
  177. C      CALL ECMORS(KMORS,KIZA,4)
  178.       SEGSUP KIZAU
  179.       SEGSUP KMORU
  180.       SEGSUP KIZAL
  181.       SEGSUP KMORL
  182.       SEGDES MDIAG
  183. *
  184. * Et on ordonne les colonnes si besoin
  185. *  Les colonnes sont-elles ordonnées ?
  186. * Réponse : pas toujours !
  187.       PMORS=KMORS
  188.       IZA=KIZA
  189.       SEGACT PMORS
  190.       SEGACT IZA
  191.       NTT=IA(/1)-1
  192.       DO ITT=1,NTT
  193.          IAD=IA(ITT)
  194.          IAF=IA(ITT+1)-1
  195.          JINI=0
  196.          DO IJA=IAD,IAF
  197.             JCOU=JA(IJA)
  198.             IF (JCOU.LT.JINI) GOTO 30
  199.             JINI=JCOU
  200.          ENDDO
  201.       ENDDO
  202.       SEGDES PMORS
  203.       SEGDES IZA
  204. *      WRITE(IOIMP,*) 'Les colonnes sont ordonnees'
  205.       GOTO 40
  206. *
  207.  30   CONTINUE
  208. *      WRITE(IOIMP,*) 'Les colonnes ne sont pas ordonnees'
  209.       SEGACT PMORS*MOD
  210.       SEGACT IZA*MOD
  211.       NTT=IA(/1)-1
  212.       NJA=JA(/1)
  213.       JG=MAX(NTT+1,2*NJA)
  214.       SEGINI IWORK
  215.       CALL CSORT(IA(/1)-1,A,JA,IA,
  216.      $     IWORK.LECT,.TRUE.)
  217.       SEGSUP IWORK
  218.       SEGDES PMORS
  219.       SEGDES IZA
  220. C      WRITE(IOIMP,*) 'Matrice Morse  ordonnée'
  221. C      CALL ECMORS(PMORS,IZA,4)
  222.  40   CONTINUE
  223.       RETURN
  224.       END
  225.  
  226.  
  227.  
  228.  
  229.  
  230.  
  231.  

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