1 : C POINB2 SOURCE CHAT 05/01/13 02:16:43 5004 2 : SUBROUTINE POINB2(MCLAS,MCONT,MCLPO1,PONBEL) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : POINB2 7 : C DESCRIPTION : Construit une liste d'entiers : PONBEL (type MLENTI) 8 : C PONBEL(i) est le nombre d'éléments de MCLAS et MCONT 9 : C contenant le ieme point du maillage MCLPO1. 10 : C MCLPO1 est un maillage de POI1. 11 : C 12 : C LANGAGE : ESOPE 13 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 14 : C mél : gounand@semt2.smts.cea.fr 15 : C*********************************************************************** 16 : C APPELES : 17 : C APPELES (Outils) : KRIPAD : MELEME -> (num. globale->locale), ERREUR 18 : C APPELES (E/S) : - 19 : C APPELES (BLAS) : - 20 : C APPELES (CALCUL) : - 21 : C*********************************************************************** 22 : C SYNTAXE GIBIANE : - 23 : C ENTREES : MCLAS (type MELEME) : maillage de classe de 24 : C points (sommet, face) par 25 : C élément (MMAIL,ELTFA) 26 : C MCONT (type MELEME) : maillage de classe de 27 : C points (face du contour) 28 : C par élément (MMAIL,ELTFA) 29 : C MCLPO1 (type MELEME) : maillage de points 30 : C correspondant à MCLAS 31 : C ENTREES/SORTIES : - 32 : C SORTIES : PONBEL (type MLENTI) 33 : C 34 : CAB 35 : CAB N.B.: dans mon cas particulier: 36 : CAB 37 : CAB MCLAS (type MELEME) : maillage "elts + sommets" 38 : CAB 39 : CAB MCONT (type MELEME) : maillage "sommets + 40 : CAB "centre de face" 41 : CAB sur le contour 42 : CAB 43 : CAB MCLPO1 (type MELEME) : maillage de points 44 : CAB "sommets" 45 : CAB 46 : CAB PONBEL(i) = nombre de voisins "centre d'elt" et 47 : CAB "centre de face de bord" du i-eme 48 : CAB sommet 49 : CAB 50 : C*********************************************************************** 51 : C VERSION : v1, 29/10/98, version initiale 52 : C HISTORIQUE : v1, 29/10/98, création 53 : C HISTORIQUE : 07/04/00, ajout de petits commentaires, A. BECCANTINI 54 : C HISTORIQUE : 55 : C*********************************************************************** 56 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 57 : C en cas de modification de ce sous-programme afin de faciliter 58 : C la maintenance ! 59 : C*********************************************************************** 60 : -INC CCOPTIO 61 : -INC SMELEME 62 : POINTEUR MCLAS.MELEME 63 : POINTEUR MCONT.MELEME 64 : POINTEUR MCLPO1.MELEME 65 : -INC SMLENTI 66 : POINTEUR PONBEL.MLENTI 67 : POINTEUR KRIPO1.MLENTI 68 : C 69 : C**** Variables de COOPTIO 70 : C 71 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 72 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 73 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 74 : C & ,IECHO, IIMPI, IOSPI 75 : C & ,IDIM 76 : C & ,MCOORD 77 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 78 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 79 : C & ,NORINC,NORVAL,NORIND,NORVAD 80 : C & ,NUCROU, IPSAUV 81 : C 82 : INTEGER NBSOUS, NBELEM, NOTYP, NBPOI1, JG, INBSOU 83 : & , INBEL, INBPO, NOPOI1, NBPOEL, NBPOM1 84 : C 85 : * 86 : * Executable statements 87 : * 88 : SEGACT MCLPO1 89 : NBSOUS=MCLPO1.LISOUS(/1) 90 : NOTYP =MCLPO1.ITYPEL 91 : IF ((NBSOUS.NE.0).OR.(NOTYP.NE.1)) THEN 92 : C 93 : C 'MCLPO1 must contain only POI1 elements' 94 : C 95 : C******* Message d'erreur standard 96 : C 5 3 97 : C Erreur anormale.contactez votre support 98 : C 99 : MOTERR(1:40) = 'Subroutine poinb2.eso ' 100 : WRITE(IOIMP,*) MOTERR(1:40) 100 : CALL ERREUR(5) 101 : GOTO 9999 102 : ENDIF 103 : C In KRIPAD : SEGINI KRIPO1 103 : CALL KRIPAD(MCLPO1,KRIPO1) 104 : NBPOI1=MCLPO1.NUM(/2) 105 : SEGDES MCLPO1 106 : JG=NBPOI1 107 : SEGINI PONBEL 108 : C 109 : C*** Dim(PONBEL) = DIM(MCLPOI1) 110 : C 111 : * 112 : * Parcourons le maillage géométrique des classes de points MCLAS 113 : * N.B. On contolle aussi la compatibilité des SPG 114 : * 115 : SEGACT MCLAS 116 : NBSOUS=MCLAS.LISOUS(/1) 117 : IF (NBSOUS.EQ.0) NBSOUS=1 118 : DO 1 INBSOU=1,NBSOUS 119 : IF (NBSOUS.GT.1) THEN 120 : IPT1=MCLAS.LISOUS(INBSOU) 121 : SEGACT IPT1 122 : ELSE 123 : IPT1=MCLAS 124 : ENDIF 125 : NBPOEL=IPT1.NUM(/1) 126 : C 127 : C******* NBPOEL = nombre de points dans l'elt 128 : C 129 : NBELEM=IPT1.NUM(/2) 130 : DO 12 INBEL=1,NBELEM 131 : DO 122 INBPO=1,NBPOEL 132 : NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) 133 : C 134 : C************* NOPOI1 = numero local de IPT1.NUM(INBPO,INBEL) 135 : C dans le maillage MCLPO1 136 : C 137 : IF (NOPOI1.NE.0) THEN 138 : PONBEL.LECT(NOPOI1)=PONBEL.LECT(NOPOI1)+1 139 : ELSE 140 : C 141 : C**************** 'Erreur grave MCLPO1 n''est pas' 142 : C 'le maillage de points correspondant' 143 : C 'à MCLAS.' 144 : C 145 : C Message d'erreur standard 146 : C 5 3 147 : C Erreur anormale.contactez votre support 148 : C 149 : MOTERR(1:40) = 150 : $ 'Subroutine poinb2.eso ' 151 : WRITE(IOIMP,*) MOTERR(1:40) 151 : CALL ERREUR(5) 152 : GOTO 9999 153 : ENDIF 154 : 122 CONTINUE 155 : 12 CONTINUE 156 : IF (NBSOUS.GT.1) SEGDES IPT1 157 : 1 CONTINUE 158 : SEGDES MCLAS 159 : * 160 : * Parcourons le maillage géométrique des classes de points MCONT 161 : * 162 : SEGACT MCONT 163 : NBSOUS=MCONT.LISOUS(/1) 164 : IF (NBSOUS.EQ.0) NBSOUS=1 165 : DO 2 INBSOU=1,NBSOUS 166 : IF (NBSOUS.GT.1) THEN 167 : IPT1=MCONT.LISOUS(INBSOU) 168 : SEGACT IPT1 169 : ELSE 170 : IPT1=MCONT 171 : ENDIF 172 : NBPOEL=IPT1.NUM(/1) 173 : NBPOM1= NBPOEL - 1 174 : NBELEM=IPT1.NUM(/2) 175 : DO 22 INBEL=1,NBELEM 176 : C 177 : C************* N.B. :IPT1.NUM(NBPOEL,INBEL) contient le centre de face 178 : C de la face de bord MCONT 179 : C 180 : C IF(KRIPO1.LECT(IPT1.NUM(NBPOEL,INBEL)) .NE. 0) 180 : C & CALL ERREUR(5) 181 : C 182 : DO 222 INBPO=1,NBPOM1 183 : NOPOI1=KRIPO1.LECT(IPT1.NUM(INBPO,INBEL)) 184 : IF (NOPOI1.NE.0) THEN 185 : PONBEL.LECT(NOPOI1)=PONBEL.LECT(NOPOI1)+1 186 : ELSE 187 : C 188 : C**************** 'Erreur grave MCLPO1 n''est pas' 189 : C 'le maillage de points correspondant' 190 : C 'à MCLAS.' 191 : C 192 : C Message d'erreur standard 193 : C 5 3 194 : C Erreur anormale.contactez votre support 195 : C 196 : MOTERR(1:40) = 197 : $ 'Subroutine poinb2.eso ' 198 : WRITE(IOIMP,*) MOTERR(1:40) 198 : CALL ERREUR(5) 199 : GOTO 9999 200 : ENDIF 201 : 222 CONTINUE 202 : C 203 : 22 CONTINUE 204 : IF (NBSOUS.GT.1) SEGDES IPT1 205 : 2 CONTINUE 206 : SEGDES MCONT 207 : SEGSUP KRIPO1 208 : C 209 : C**** Test 210 : C 211 : C WRITE(6,*) 'On a créé PONBEL=',PONBEL 212 : C WRITE(6,*) 'PONBEL',NBPOI1 213 : C WRITE(6,*) (PONBEL.LECT(I),I=1,NBPOI1) 214 : C 215 : SEGDES PONBEL 216 : C 217 : 9999 CONTINUE 218 : RETURN 219 : END 220 : 221 : 222 : 223 : 224 :
© Cast3M 2003 - All rights reserved.
Disclaimer