C QUEPO1 SOURCE CB215821 20/11/25 13:38:07 10792 SUBROUTINE QUEPO1(ICHP1,IPSG,LMOT) C----------------------------------------------------------------------- C On teste le champoint ICHP1 afin de vérifier : C 1) qu'il est non partitionné C 2) qu'il a le bon nombre de composantes et/ou les bonnes composantes C 3) que son support géométrique est IPSG C----------------------------------------------------------------------- C C--------------------------- C Parametres Entree/Sortie : C--------------------------- C C E/ ICHP1 : Champoint à tester C E/ IPSG : Maillage de référence, en général de type POI1 C Si IPSG = 0: pas de test sur le maiilage C E/S LMOT : En entrée (si LMOT > 0), C noms des composantes à tester C En sortie (si LMOT <= 0), C noms des composantes du CHPO C----------------------------------------------------------------------- C C Langage : ESOPE + FORTRAN77 C C Auteurs : A. BECCANTINI C C----------------------------------------------------------------------- IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C -INC PPARAM -INC CCOPTIO -INC SMELEME -INC SMCHPOI -INC SMLMOTS -INC SMLENTI C C**** Variables de COOPTIO C C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES C & ,IECHO, IIMPI, IOSPI C & ,IDIM C & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV CC POINTEUR MLEORD.MLENTI, MLEPOI.MLENTI C INTEGER ICHP1, IPSG, LMOT, NSOUPO, NBCOMP, JGN, JGM & , IC, JG, NBCOM1, IC2, NBSOUS, N, NC, ICOLD, NGP & , NLP, NLPOLD CHARACTER*(LOCOMP) MOT1 LOGICAL LOGORD C C- Test si le CHPO est partitionné C MCHPOI = ICHP1 SEGACT MCHPOI NSOUPO = MCHPOI.IPCHP(/1) IF (NSOUPO.NE.1) THEN MOTERR='CHPOINT ' CALL ERREUR(132) GOTO 9999 ENDIF C C- Test/Récupération/Imposition du nom des composantes C MSOUPO = MCHPOI.IPCHP(1) SEGDES MCHPOI SEGACT MSOUPO*MOD NBCOMP = MSOUPO.NOCOMP(/2) IF(LMOT .LE. 0)THEN LOGORD = .TRUE. JG = NBCOMP SEGINI MLEORD C C******** Recuperation C JGN = LOCOMP JGM = NBCOMP SEGINI MLMOTS LMOT = MLMOTS DO IC = 1, NBCOMP, 1 MLMOTS.MOTS(IC) = MSOUPO.NOCOMP(IC) MLEORD.LECT(IC) = IC ENDDO ELSE C C******** Test/imposition C MLMOTS = LMOT SEGACT MLMOTS NBCOM1 = MLMOTS.MOTS(/2) IF (NBCOM1.NE.NBCOMP) THEN MOTERR(1:8) = ' QUEPOI ' MOTERR(9:16) = 'CHAMPOIN' INTERR(1) = NBCOM1 INTERR(2) = NBCOMP C C********** Message d'erreur standard C 699 2 C routine %m1:8 : On voulait un %m9:16 à %i1 composantes au lieu de %i2 . C CALL ERREUR(699) GOTO 9999 ENDIF JG = NBCOMP LOGORD = .TRUE. SEGINI MLEORD DO IC = 1, NBCOMP, 1 C C********** On cherche la position de chaque composante en MLMOTS C MOT1 = MSOUPO.NOCOMP(IC) DO IC2 = 1, NBCOMP, 1 IF(MLMOTS.MOTS(IC2) .EQ. MOT1) THEN IF(IC2 .NE. IC) LOGORD= .FALSE. MLEORD.LECT(IC2) = IC GOTO 1 ENDIF ENDDO C C********** On est la car on n'as pas de MOT1 MOTERR=MOT1 CALL ERREUR(197) GOTO 9999 C 1 CONTINUE ENDDO ENDIF C C- Transforme le maillage en POI1 si maillage quelconque C- Le maillage POI1 de pointeur IPT1 est actif au retour de CHANGE C IPT1 = MSOUPO.IGEOC IF(IPSG .EQ. 0)THEN MELEME = IPT1 ELSE MELEME = IPSG ENDIF SEGACT MELEME NBSOUS = MELEME.LISOUS(/1) IF ((NBSOUS.NE.0).OR.(ITYPEL.NE.1)) THEN CALL CHANGE(MELEME,1) IF (IERR.NE.0) GOTO 9999 ENDIF C C- Si égalité des pointeurs et LOGORD -> OK, sinon C IF (LOGORD .AND. (MELEME .EQ. IPT1)) THEN SEGDES MELEME SEGDES MLMOTS SEGSUP MLEORD SEGDES MSOUPO IF(MLEORD .GT. 0) SEGSUP MLEORD RETURN ELSE C C- Dans le cas d'un MELEME de POI1 création d'un CHPO de support C- géométrique le POI1 en question. C N = MELEME.NUM(/2) NC = NBCOMP SEGINI MPOVA1 MPOVAL = MSOUPO.IPOVAL SEGACT MPOVAL C C- Recherche si les points du MELEME de type POI1 sont dans le CHPO C- et ordonnencement C CALL KRIPAD(IPT1,MLEPOI) C SEGACT MLEPOI DO IC = 1, NC, 1 ICOLD = MLEORD.LECT(IC) MSOUPO.NOCOMP(IC) = MLMOTS.MOTS(IC) DO NLP = 1, N, 1 NGP = MELEME.NUM(1,NLP) NLPOLD = MLEPOI.LECT(NGP) IF(NLPOLD .EQ. 0)THEN MOTERR(1:8) = 'CHAMPOIN' MOTERR(9:16) = 'MAILLAGE' INTERR(1) = 1 CALL ERREUR(698) GOTO 9999 C C**************** Message d'erreur standard C 698 2 C Incohérence entre les pointeurs géométriques des objets %m1:8 et %m9:16 C 698 2 C pour la zone élémentaire numéro %i1. C ELSE MPOVA1.VPOCHA(NLP,IC)=MPOVAL.VPOCHA(NLPOLD,ICOLD) ENDIF ENDDO ENDDO SEGDES MPOVA1 MSOUPO.IGEOC=MELEME MSOUPO.IPOVAL=MPOVA1 SEGDES MSOUPO SEGSUP MLEORD SEGSUP MLEPOI ENDIF 9999 CONTINUE RETURN END