Esope source files

   1 : C CP2TR2    SOURCE    GOUNAND   09/09/03    21:15:02     6481           
   2 :       SUBROUTINE CP2TR2(LISCOM,MELTOT,MYCHPO,
   3 :      $     MYMTRA,IRET)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)
   5 :       IMPLICIT INTEGER (I-N)
   6 : C***********************************************************************
   7 : C NOM         : CP2TR2
   8 : C DESCRIPTION : Transformation d'un chpoint MYCHPO
   9 : C               en un objet MTRAV MYMTRA plus commode
  10 : C               LISCOM et MELEME sont les composantes et points 
  11 : C               qui nous intéressent.
  12 : C
  13 : C
  14 : C LANGAGE     : ESOPE
  15 : C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  16 : C               mél : gounand@semt2.smts.cea.fr
  17 : C***********************************************************************
  18 : C VERSION    : v1, 11/04/2008, version initiale
  19 : C HISTORIQUE : v1, 11/04/2008, création
  20 : C HISTORIQUE :
  21 : C HISTORIQUE :
  22 : C***********************************************************************
  23 : C Prière de PRENDRE LE TEMPS de compléter les commentaires
  24 : C en cas de modification de ce sous-programme afin de faciliter
  25 : C la maintenance !
  26 : C***********************************************************************
  27 : -INC CCOPTIO
  28 : -INC SMCOORD
  29 : *
  30 : -INC SMCHPOI
  31 :       POINTEUR MYCHPO.MCHPOI
  32 :       POINTEUR MYMSOU.MSOUPO
  33 :       POINTEUR MYMPOV.MPOVAL
  34 :       INTEGER N,NC
  35 : -INC TMTRAV
  36 :       POINTEUR MYMTRA.MTRAV
  37 :       INTEGER NNIN,NNNOE
  38 : -INC SMLMOTS
  39 :       POINTEUR LISCOM.MLMOTS
  40 :       INTEGER JGN,JGM
  41 : -INC SMELEME
  42 :       POINTEUR MYMEL.MELEME
  43 :       POINTEUR MELTOT.MELEME
  44 : -INC SMLENTI      
  45 :       POINTEUR KRINCO.MLENTI
  46 :       POINTEUR KRIGEO.MLENTI
  47 :       INTEGER JG
  48 : *     
  49 : * Includes persos
  50 : *     
  51 : * Liste de MELEME
  52 :       INTEGER NBMEL
  53 :       SEGMENT MELS
  54 :       POINTEUR LISMEL(NBMEL).MELEME
  55 :       ENDSEGMENT
  56 :       POINTEUR GPMELS.MELS
  57 : *
  58 :       LOGICAL LVIDE
  59 :       INTEGER IMPR,IRET
  60 : *
  61 :       INTEGER I,IC,IGM,JGM2,ININ,INNOE,IGLOB
  62 :       INTEGER NTOTPO,NTOGPO
  63 : *     
  64 : * Executable statements
  65 : *
  66 :       IMPR=0
  67 :       IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans cp2tr2.eso' 
  68 : *
  69 :       SEGACT LISCOM
  70 :       JGN=LISCOM.MOTS(/1)
  71 :       JGM=LISCOM.MOTS(/2)
  72 :       IF (JGN.NE.4) THEN
  73 :          WRITE(IOIMP,*) 'Erreur de programmation'
  74 :          GOTO 9999
  75 :       ENDIF
  76 : *
  77 : * Initialisation de l'objet MTRAV
  78 : *
  79 :       SEGACT MELTOT
  80 :       NTOTPO=MELTOT.NUM(/2)
  81 :       NNIN=JGM
  82 :       NNNOE=NTOTPO
  83 :       SEGINI MYMTRA
  84 :       DO ININ=1,NNIN
  85 :          MYMTRA.INCO(ININ)=LISCOM.MOTS(ININ)
  86 :       ENDDO
  87 :       SEGDES LISCOM
  88 :       DO INNOE=1,NNNOE
  89 :          MYMTRA.IGEO(INNOE)=MELTOT.NUM(1,INNOE)
  90 :       ENDDO
  91 :       SEGDES MELTOT
  92 : *
  93 : * Remplissage de l'objet MTRAV
  94 : *
  95 : *  Création du segment de répérage dans IGEO
  96 :       NTOGPO=XCOOR(/1)/(IDIM+1)
  97 :       JG=NTOGPO
  98 :       SEGINI,KRIGEO
  98 :       CALL RSETEE(MYMTRA.IGEO,NNNOE,
  99 :      $     KRIGEO.LECT,NTOGPO,
 100 :      $     IMPR,IRET)
 101 :       IF (IRET.NE.0) GOTO 9999
 102 : *  Parcours de l'objet champoint
 103 :       SEGACT MYCHPO
 104 :       NSOUPO=MYCHPO.IPCHP(/1)
 105 :       DO ISOUPO=1,NSOUPO
 106 :          MYMSOU=MYCHPO.IPCHP(ISOUPO)
 107 :          SEGACT MYMSOU
 108 :          NC=MYMSOU.NOCOMP(/2)
 109 : *   Création du segment de repérage dans les noms d'inconnues
 110 :          JG=NC
 111 :          SEGINI KRINCO
 111 :          CALL CREPE2(JGN,NC,NNIN,
 112 :      $        MYMSOU.NOCOMP,MYMTRA.INCO,
 113 :      $        KRINCO.LECT,
 114 :      $        IMPR,IRET)
 115 :          IF (IRET.NE.0) GOTO 9999
 116 :          MYMEL=MYMSOU.IGEOC
 117 :          MYMPOV=MYMSOU.IPOVAL
 118 :          SEGACT MYMEL
 119 :          SEGACT MYMPOV
 120 :          N=MYMPOV.VPOCHA(/1)
 121 :          DO IC=1,NC
 122 :             ININ=KRINCO.LECT(IC)
 123 :             IF (ININ.NE.0) THEN
 124 :                DO I=1,N
 125 :                   IGLOB=MYMEL.NUM(1,I)
 126 :                   INNOE=KRIGEO.LECT(IGLOB)
 127 :                   IF (INNOE.NE.0) THEN
 128 :                      MYMTRA.IBIN(ININ,INNOE)=1
 129 :                      MYMTRA.BB(ININ,INNOE)=MYMPOV.VPOCHA(I,IC)
 130 :                   ENDIF
 131 :                ENDDO
 132 :             ENDIF   
 133 :          ENDDO
 134 :          SEGDES MYMPOV
 135 :          SEGDES MYMEL
 136 :          SEGSUP KRINCO
 137 :          SEGDES MYMSOU
 138 :       ENDDO
 139 :       SEGSUP KRIGEO
 140 :       SEGDES MYCHPO
 141 :       SEGDES MYMTRA
 142 : *
 143 : * Normal termination
 144 : *
 145 :       IRET=0
 146 :       RETURN
 147 : *
 148 : * Format handling
 149 : *
 150 : *
 151 : * Error handling
 152 : *
 153 :  9999 CONTINUE
 154 :       IRET=1
 155 :       WRITE(IOIMP,*) 'An error was detected in subroutine cp2tr2'
 156 :       RETURN
 157 : *
 158 : * End of subroutine CP2TR2
 159 : *
 160 :       END
 161 : 
 162 :  
 163 :  
 164 :  
 165 :