1 : C QUEPO1 SOURCE PV 09/09/11 12:12:10 6503 2 : SUBROUTINE QUEPO1(ICHP1,IPSG,LMOT) 3 : C----------------------------------------------------------------------- 4 : C On teste le champoint ICHP1 afin de vérifier : 5 : C 1) qu'il est non partitionné 6 : C 2) qu'il a le bon nombre de composantes et/ou les bonnes composantes 7 : C 3) que son support géométrique est IPSG 8 : C----------------------------------------------------------------------- 9 : C 10 : C--------------------------- 11 : C Parametres Entree/Sortie : 12 : C--------------------------- 13 : C 14 : C E/ ICHP1 : Champoint à tester 15 : C E/ IPSG : Maillage de référence, en général de type POI1 16 : C Si IPSG = 0: pas de test sur le maiilage 17 : C E/S LMOT : En entrée (si LMOT > 0), 18 : C noms des composantes à tester 19 : C En sortie (si LMOT <= 0), 20 : C noms des composantes du CHPO 21 : C----------------------------------------------------------------------- 22 : C 23 : C Langage : ESOPE + FORTRAN77 24 : C 25 : C Auteurs : A. BECCANTINI 26 : C 27 : C----------------------------------------------------------------------- 28 : IMPLICIT INTEGER(I-N) 29 : IMPLICIT REAL*8 (A-H,O-Z) 30 : C 31 : -INC CCOPTIO 32 : -INC SMELEME 33 : -INC SMCHPOI 34 : -INC SMLMOTS 35 : -INC SMLENTI 36 : C 37 : C**** Variables de COOPTIO 38 : C 39 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 40 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 41 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 42 : C & ,IECHO, IIMPI, IOSPI 43 : C & ,IDIM 44 : C & ,MCOORD 45 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 46 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 47 : C & ,NORINC,NORVAL,NORIND,NORVAD 48 : C & ,NUCROU, IPSAUV 49 : CC 50 : POINTEUR MLEORD.MLENTI, MLEPOI.MLENTI 51 : C 52 : INTEGER ICHP1, IPSG, LMOT, NSOUPO, NBCOMP, JGN, JGM 53 : & , IC, JG, NBCOM1, IC2, NBSOUS, N, NC, ICOLD, NGP 54 : & , NLP, NLPOLD 55 : CHARACTER*4 MOT1 56 : LOGICAL LOGORD 57 : C 58 : C- Test si le CHPO est partitionné 59 : C 60 : MCHPOI = ICHP1 61 : SEGACT MCHPOI 62 : NSOUPO = MCHPOI.IPCHP(/1) 63 : IF (NSOUPO.NE.1) THEN 64 : MOTERR(1:8) = 'CHAMPOIN' 65 : C 66 : C******** Message d'erreur standard 67 : C 132 2 68 : C On veut un objet %m1:8 élémentaire 69 : C 69 : CALL ERREUR(132) 70 : GOTO 9999 71 : ENDIF 72 : C 73 : C- Test/Récupération/Imposition du nom des composantes 74 : C 75 : MSOUPO = MCHPOI.IPCHP(1) 76 : SEGDES MCHPOI 77 : SEGACT MSOUPO*MOD 78 : NBCOMP = MSOUPO.NOCOMP(/2) 79 : IF(LMOT .LE. 0)THEN 80 : LOGORD = .TRUE. 81 : JG = NBCOMP 82 : SEGINI MLEORD 83 : C 84 : C******** Recuperation 85 : C 86 : JGN = 4 87 : JGM = NBCOMP 88 : SEGINI MLMOTS 89 : LMOT = MLMOTS 90 : DO IC = 1, NBCOMP, 1 91 : MLMOTS.MOTS(IC) = MSOUPO.NOCOMP(IC) 92 : MLEORD.LECT(IC) = IC 93 : ENDDO 94 : ELSE 95 : C 96 : C******** Test/imposition 97 : C 98 : MLMOTS = LMOT 99 : SEGACT MLMOTS 100 : NBCOM1 = MLMOTS.MOTS(/2) 101 : IF (NBCOM1.NE.NBCOMP) THEN 102 : MOTERR(1:8) = ' QUEPOI ' 103 : MOTERR(9:16) = 'CHAMPOIN' 104 : INTERR(1) = NBCOM1 105 : INTERR(2) = NBCOMP 106 : C 107 : C********** Message d'erreur standard 108 : C 699 2 109 : C routine %m1:8 : On voulait un %m9:16 à %i1 composantes au lieu de %i2 . 110 : C 110 : CALL ERREUR(699) 111 : GOTO 9999 112 : ENDIF 113 : JG = NBCOMP 114 : LOGORD = .TRUE. 115 : SEGINI MLEORD 116 : DO IC = 1, NBCOMP, 1 117 : C 118 : C********** On cherche la position de chaque composante en MLMOTS 119 : C 120 : MOT1 = MSOUPO.NOCOMP(IC) 121 : DO IC2 = 1, NBCOMP, 1 122 : IF(MLMOTS.MOTS(IC2) .EQ. MOT1) THEN 123 : IF(IC2 .NE. IC) LOGORD= .FALSE. 124 : MLEORD.LECT(IC2) = IC 125 : GOTO 1 126 : ENDIF 127 : ENDDO 128 : C 129 : C********** On est la car on n'as pas de MOT1 130 : C Message d'erreur standard 131 : C 197 2 132 : C Le mot %m1:4 n'est pas un nom de composante reconnu 133 : C 134 : MOTERR(1:4)=MOT1 134 : CALL ERREUR(197) 135 : GOTO 9999 136 : C 137 : 1 CONTINUE 138 : ENDDO 139 : ENDIF 140 : C 141 : C- Transforme le maillage en POI1 si maillage quelconque 142 : C- Le maillage POI1 de pointeur IPT1 est actif au retour de CHANGE 143 : C 144 : IPT1 = MSOUPO.IGEOC 145 : IF(IPSG .EQ. 0)THEN 146 : MELEME = IPT1 147 : ELSE 148 : MELEME = IPSG 149 : ENDIF 150 : SEGACT MELEME 151 : NBSOUS = MELEME.LISOUS(/1) 152 : IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN 152 : CALL CHANGE(MELEME,1) 153 : IF (IERR.NE.0) GOTO 9999 154 : ENDIF 155 : C 156 : C- Si égalité des pointeurs et LOGORD -> OK, sinon 157 : C 158 : IF (LOGORD .AND. (MELEME .EQ. IPT1)) THEN 159 : SEGDES MELEME 160 : SEGDES MLMOTS 161 : SEGSUP MLEORD 162 : SEGDES MSOUPO 163 : IF(MLEORD .GT. 0) SEGSUP MLEORD 164 : RETURN 165 : ELSE 166 : C 167 : C- Dans le cas d'un MELEME de POI1 création d'un CHPO de support 168 : C- géométrique le POI1 en question. 169 : C 170 : N = MELEME.NUM(/2) 171 : NC = NBCOMP 172 : SEGINI MPOVA1 173 : MPOVAL = MSOUPO.IPOVAL 174 : SEGACT MPOVAL 175 : C 176 : C- Recherche si les points du MELEME de type POI1 sont dans le CHPO 177 : C- et ordonnencement 178 : C 178 : CALL KRIPAD(IPT1,MLEPOI) 179 : C SEGACT MLEPOI 180 : DO IC = 1, NC, 1 181 : ICOLD = MLEORD.LECT(IC) 182 : MSOUPO.NOCOMP(IC) = MLMOTS.MOTS(IC) 183 : DO NLP = 1, N, 1 184 : NGP = MELEME.NUM(1,NLP) 185 : NLPOLD = MLEPOI.LECT(NGP) 186 : IF(NLPOLD .EQ. 0)THEN 187 : MOTERR(1:8) = 'CHAMPOIN' 188 : MOTERR(9:16) = 'MAILLAGE' 189 : INTERR(1) = 1 189 : CALL ERREUR(698) 190 : GOTO 9999 191 : C 192 : C**************** Message d'erreur standard 193 : C 698 2 194 : C Incohérence entre les pointeurs géométriques des objets %m1:8 et %m9:16 195 : C 698 2 196 : C pour la zone élémentaire numéro %i1. 197 : C 198 : ELSE 199 : MPOVA1.VPOCHA(NLP,IC)=MPOVAL.VPOCHA(NLPOLD,ICOLD) 200 : ENDIF 201 : ENDDO 202 : ENDDO 203 : SEGDES MPOVA1 204 : MSOUPO.IGEOC=MELEME 205 : MSOUPO.IPOVAL=MPOVA1 206 : SEGDES MSOUPO 207 : SEGSUP MLEORD 208 : SEGSUP MLEPOI 209 : ENDIF 210 : 9999 CONTINUE 211 : RETURN 212 : END 213 : 214 : 215 : 216 :
© Cast3M 2003 - All rights reserved.
Disclaimer