1 : C CP2TRA SOURCE GOUNAND 06/12/19 21:15:13 5612 2 : SUBROUTINE CP2TRA(MYCHPO, 3 : $ MYMTRA,LVIDE, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : CP2TRA 9 : C DESCRIPTION : Transformation d'un chpoint MYCHPO 10 : C en un objet MTRAV MYMTRA plus commode 11 : C LVIDE est vrai, si le chpoint était vide 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 APPELES : 19 : C APPELES (E/S) : 20 : C APPELES (BLAS) : 21 : C APPELES (CALCUL) : 22 : C APPELE PAR : CP2CV6 23 : C*********************************************************************** 24 : C SYNTAXE GIBIANE : 25 : C ENTREES : 26 : C ENTREES/SORTIES : 27 : C SORTIES : 28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 29 : C*********************************************************************** 30 : C VERSION : v1, 26/09/2002, version initiale 31 : C HISTORIQUE : v1, 26/09/2002, création 32 : C HISTORIQUE : 33 : C HISTORIQUE : 34 : C*********************************************************************** 35 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 36 : C en cas de modification de ce sous-programme afin de faciliter 37 : C la maintenance ! 38 : C*********************************************************************** 39 : -INC CCOPTIO 40 : -INC SMCOORD 41 : * 42 : -INC SMCHPOI 43 : POINTEUR MYCHPO.MCHPOI 44 : POINTEUR MYMSOU.MSOUPO 45 : POINTEUR MYMPOV.MPOVAL 46 : INTEGER N,NC 47 : -INC TMTRAV 48 : POINTEUR MYMTRA.MTRAV 49 : INTEGER NNIN,NNNOE 50 : -INC SMLMOTS 51 : POINTEUR LISCOM.MLMOTS 52 : INTEGER JGN,JGM 53 : -INC SMELEME 54 : POINTEUR MYMEL.MELEME 55 : POINTEUR MELTOT.MELEME 56 : -INC SMLENTI 57 : POINTEUR KRINCO.MLENTI 58 : POINTEUR KRIGEO.MLENTI 59 : INTEGER JG 60 : * 61 : * Includes persos 62 : * 63 : * Liste de MELEME 64 : INTEGER NBMEL 65 : SEGMENT MELS 66 : POINTEUR LISMEL(NBMEL).MELEME 67 : ENDSEGMENT 68 : POINTEUR GPMELS.MELS 69 : * 70 : LOGICAL LVIDE 71 : INTEGER IMPR,IRET 72 : * 73 : INTEGER I,IC,IGM,JGM2,ININ,INNOE,IGLOB 74 : INTEGER NTOTPO,NTOGPO 75 : * 76 : * Executable statements 77 : * 78 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans cp2tra.eso' 79 : LVIDE=.TRUE. 80 : * 81 : * Construction de la liste des composantes et de la liste des 82 : * melemes du champoint 83 : * 84 : JGN=4 85 : JGM=0 86 : IGM=0 87 : SEGINI,LISCOM 88 : NBMEL=0 89 : SEGINI,GPMELS 90 : * 91 : SEGACT MYCHPO 92 : NSOUPO=MYCHPO.IPCHP(/1) 93 : DO ISOUPO=1,NSOUPO 94 : MYMSOU=MYCHPO.IPCHP(ISOUPO) 95 : SEGACT MYMSOU 96 : NC=MYMSOU.NOCOMP(/2) 97 : JGM=JGM+NC 98 : SEGADJ,LISCOM 99 : DO IC=1,NC 100 : IGM=IGM+1 101 : LISCOM.MOTS(IGM)=MYMSOU.NOCOMP(IC) 102 : ENDDO 103 : GPMELS.LISMEL(**)=MYMSOU.IGEOC 104 : SEGDES MYMSOU 105 : ENDDO 106 : SEGDES MYCHPO 107 : * 108 : * Suppression des doublons dans la liste des composantes 109 : * et création du maillage total des points supports 110 : * 110 : CALL CUNIQ(LISCOM.MOTS,JGN,JGM, 111 : $ LISCOM.MOTS,JGM2, 112 : $ IMPR,IRET) 113 : IF (IRET.NE.0) GOTO 9999 114 : JGM=JGM2 115 : SEGADJ,LISCOM 116 : * In MLUNIQ : SEGINI MELTOT 116 : CALL MLUNIQ(GPMELS,MELTOT, 117 : $ IMPR,IRET) 118 : IF (IRET.NE.0) GOTO 9999 119 : SEGSUP GPMELS 120 : * 121 : * Initialisation de l'objet MTRAV 122 : * 123 : SEGACT MELTOT 124 : NTOTPO=MELTOT.NUM(/2) 125 : NNIN=JGM 126 : NNNOE=NTOTPO 127 : SEGINI MYMTRA 128 : DO ININ=1,NNIN 129 : MYMTRA.INCO(ININ)=LISCOM.MOTS(ININ) 130 : ENDDO 131 : SEGSUP LISCOM 132 : DO INNOE=1,NNNOE 133 : MYMTRA.IGEO(INNOE)=MELTOT.NUM(1,INNOE) 134 : ENDDO 135 : * SEGDES MELTOT 136 : SEGSUP MELTOT 137 : * 138 : * Remplissage de l'objet MTRAV 139 : * 140 : * Création du segment de répérage dans IGEO 141 : NTOGPO=XCOOR(/1)/(IDIM+1) 142 : JG=NTOGPO 143 : SEGINI,KRIGEO 143 : CALL RSETEE(MYMTRA.IGEO,NNNOE, 144 : $ KRIGEO.LECT,NTOGPO, 145 : $ IMPR,IRET) 146 : IF (IRET.NE.0) GOTO 9999 147 : * Parcours de l'objet champoint 148 : SEGACT MYCHPO 149 : NSOUPO=MYCHPO.IPCHP(/1) 150 : DO ISOUPO=1,NSOUPO 151 : MYMSOU=MYCHPO.IPCHP(ISOUPO) 152 : SEGACT MYMSOU 153 : NC=MYMSOU.NOCOMP(/2) 154 : * Création du segment de repérage dans les noms d'inconnues 155 : JG=NNIN 156 : SEGINI KRINCO 156 : CALL CREPER(JGN,NC,NNIN, 157 : $ MYMSOU.NOCOMP,MYMTRA.INCO, 158 : $ KRINCO.LECT, 159 : $ IMPR,IRET) 160 : IF (IRET.NE.0) GOTO 9999 161 : MYMEL=MYMSOU.IGEOC 162 : MYMPOV=MYMSOU.IPOVAL 163 : SEGACT MYMEL 164 : SEGACT MYMPOV 165 : N=MYMPOV.VPOCHA(/1) 166 : DO IC=1,NC 167 : ININ=KRINCO.LECT(IC) 168 : DO I=1,N 169 : IGLOB=MYMEL.NUM(1,I) 170 : INNOE=KRIGEO.LECT(IGLOB) 171 : IF (INNOE.EQ.0) THEN 172 : WRITE(IOIMP,*) 'Erreur de programmation' 173 : GOTO 9999 174 : ENDIF 175 : LVIDE=.FALSE. 176 : MYMTRA.IBIN(ININ,INNOE)=1 177 : MYMTRA.BB(ININ,INNOE)=MYMPOV.VPOCHA(I,IC) 178 : ENDDO 179 : ENDDO 180 : SEGDES MYMPOV 181 : SEGDES MYMEL 182 : SEGSUP KRINCO 183 : SEGDES MYMSOU 184 : ENDDO 185 : SEGSUP KRIGEO 186 : SEGDES MYCHPO 187 : SEGDES MYMTRA 188 : * 189 : * Normal termination 190 : * 191 : IRET=0 192 : RETURN 193 : * 194 : * Format handling 195 : * 196 : * 197 : * Error handling 198 : * 199 : 9999 CONTINUE 200 : IRET=1 201 : WRITE(IOIMP,*) 'An error was detected in subroutine cp2tra' 202 : RETURN 203 : * 204 : * End of subroutine CP2TRA 205 : * 206 : END 207 : 208 : 209 :
© Cast3M 2003 - All rights reserved.
Disclaimer