Esope source files

   1 : C TRPMO2    SOURCE    MAGN      09/07/30    21:21:04     6458           
   2 :       SUBROUTINE TRPMO2(LDDLDU,PMCOU,NTTDDL,
   3 :      $     LDDLDT,PMCOT,
   4 :      $     IMPR,IRET)
   5 :       IMPLICIT INTEGER(I-N)
   6 :       IMPLICIT REAL*8 (A-H,O-Z)
   7 : C***********************************************************************
   8 : C NOM         : TRPMO2
   9 : C PROJET      : Noyau linéaire NLIN
  10 : C DESCRIPTION : Construction du profil Morse (non ordonné) de (C + Ct) à
  11 : C               partir du profil Morse (non ordonné) de C.  
  12 : C
  13 : C LANGAGE     : ESOPE
  14 : C AUTEUR      : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  15 : C               mél : gounand@semt2.smts.cea.fr
  16 : C***********************************************************************
  17 : C APPELES          : TRPMOR, FUSPRM
  18 : C APPELE PAR       : PRASEM
  19 : C***********************************************************************
  20 : C ENTREES            : PMC
  21 : C SORTIES            : PMCCT
  22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  23 : C***********************************************************************
  24 : C VERSION    : v1, 17/03/06, version 1
  25 : C HISTORIQUE : v1, 17/03/06, création
  26 : C HISTORIQUE :
  27 : C***********************************************************************
  28 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  29 : C en cas de modification de ce sous-programme afin de faciliter
  30 : C la maintenance !
  31 : C***********************************************************************
  32 : -INC CCOPTIO
  33 : -INC SMMATRIK
  34 :       POINTEUR PMCOU.PMORS
  35 :       POINTEUR PMCOT.PMORS
  36 : -INC SMLENTI
  37 :       POINTEUR LDDLDU.MLENTI
  38 :       POINTEUR LDDLDT.MLENTI
  39 :       POINTEUR KDDLDT.MLENTI
  40 :       POINTEUR ITRAV.MLENTI
  41 : *
  42 :       INTEGER IMPR,IRET
  43 : *
  44 : * Executable statements
  45 : *
  46 :       IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans trpmo2'
  47 : *      SEGPRT,LDDLDU
  48 : *      SEGPRT,PMCOU
  49 :       SEGACT LDDLDU
  50 :       NDDLDU=LDDLDU.LECT(/1)
  51 :       SEGACT,PMCOU
  52 :       NJA=PMCOU.JA(/1)
  53 : *
  54 : * Trouvons la liste des ddl duaux de la transposée
  55 : *
  56 :       JG=NTTDDL
  57 :       SEGINI ITRAV
  58 :       DO IJA=1,NJA
  59 :          ICOL=PMCOU.JA(IJA)
  60 :          ITRAV.LECT(ICOL)=ITRAV.LECT(ICOL)+1
  61 :       ENDDO
  62 : * Dimension
  63 :       NDDLDT=0
  64 :       DO ITTDDL=1,NTTDDL
  65 :          IF (ITRAV.LECT(ITTDDL).GT.0) THEN
  66 :             NDDLDT=NDDLDT+1
  67 :          ENDIF
  68 :       ENDDO
  69 : * Remplissage
  70 :       JG=NDDLDT
  71 :       SEGINI LDDLDT
  72 :       IDDLDT=0
  73 :       DO ITTDDL=1,NTTDDL
  74 :          IF (ITRAV.LECT(ITTDDL).GT.0) THEN
  75 :             IDDLDT=IDDLDT+1
  76 :             LDDLDT.LECT(IDDLDT)=ITTDDL
  77 :          ENDIF
  78 :       ENDDO
  79 : *
  80 : * Remplissage du segment IA de la transposée
  81 : *
  82 :       NTT=NDDLDT
  83 :       SEGINI,PMCOT
  84 :       PMCOT.IA(1)=1
  85 :       DO IDDLDT=1,NDDLDT
  86 :          ICOL=LDDLDT.LECT(IDDLDT)
  87 :          PMCOT.IA(IDDLDT+1)=PMCOT.IA(IDDLDT)+ITRAV.LECT(ICOL)
  88 :       ENDDO
  89 : *      SEGSUP ITRAV
  90 : * Repérage dans LDDLDT en réutilisant ITRAV
  91 : *      JG=NTTDDL
  92 : *      SEGINI KDDLDT
  93 :       KDDLDT=ITRAV
  93 :       CALL RSETXI(KDDLDT.LECT,LDDLDT.LECT,NDDLDT)
  94 :       SEGDES LDDLDT
  95 : *
  96 : * Remplissage de JA en se servant de IA comme liste de pointeurs
  97 : * courant dans JA
  98 : *
  99 :       DO IDDLDU=1,NDDLDU
 100 :          JSTRT=PMCOU.IA(IDDLDU)
 101 :          JSTOP=PMCOU.IA(IDDLDU+1)-1
 102 :          DO J=JSTRT,JSTOP
 103 : *            WRITE(IOIMP,*) 'J=',J
 104 :             JCOL=PMCOU.JA(J)
 105 : *            WRITE(IOIMP,*) 'JCOL=',JCOL
 106 :             ICOL=KDDLDT.LECT(JCOL)
 107 : *            WRITE(IOIMP,*) 'ICOL=',ICOL
 108 :             I=PMCOT.IA(ICOL)
 109 : *            WRITE(IOIMP,*) 'I=',I
 110 :             PMCOT.JA(I)=LDDLDU.LECT(IDDLDU)
 111 :             PMCOT.IA(ICOL)=I+1
 112 :          ENDDO
 113 :       ENDDO
 114 :       SEGSUP KDDLDT
 115 :       SEGDES PMCOU
 116 :       SEGDES LDDLDU
 117 : *
 118 : * Restauration de IA
 119 : *
 120 :       DO IDDLDT=NDDLDT,2,-1
 121 :          PMCOT.IA(IDDLDT)=PMCOT.IA(IDDLDT-1)
 122 :       ENDDO
 123 :       PMCOT.IA(1)=1
 124 :       SEGDES PMCOT
 125 : *      SEGPRT,LDDLDT
 126 : *      SEGPRT,PMCOT
 127 : *
 128 : * Normal termination
 129 : *
 130 :       IRET=0
 131 :       RETURN
 132 : *
 133 : * Format handling
 134 : *
 135 : *
 136 : * Error handling
 137 : *
 138 :  9999 CONTINUE
 139 :       IRET=1
 140 :       WRITE(IOIMP,*) 'An error was detected in subroutine trpmo2'
 141 :       RETURN
 142 : *
 143 : * End of subroutine TRPMO2
 144 : *
 145 :       END
 146 : 
 147 :  
 148 :  
 149 :  
 150 :  
 151 :