C PRE411 SOURCE CB215821 20/11/25 13:36:30 10792 SUBROUTINE PRE411(ICEN,IFACE,IFACEL,MLMCOM,IROC,IROF, & LOGAN,MESERR) C************************************************************************ C C PROJET : CASTEM 2000 C C NOM : PRE411 C C DESCRIPTION : Voir PRE41 C C Cas 2D/3D C 1er ordre en espace, 1re ordre en temps C C Creations des objets MCHAML IROF C C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) C C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF C C************************************************************************ C C C APPELES (Outils) : KRIPAD, LICHT C C APPELES (Calcul) : AUCUN C C C************************************************************************ C C ENTREES C C 1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE C C ICEN : MELEME de 'POI1' SPG des CENTRES C C IFACE : MELEME de 'POI1' SPG des FACES C C IFACEL : MELEME de 'SEG3' avec C CENTRE d'Elt "gauche" C CENTRE de Face C CENTRE d'Elt "droite" C C N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2) C C 2) Pointeurs des CHPOINTs C C IROC : CHPOINT "CENTRE" contenant les scalaires C C SORTIES C C C IROF : MCHAML defini sur le MELEME de pointeur IFACEL, C contenant les scalaires C C LOGAN : anomalie detectee (changement de la convention dans C la table domaine) C C MESERR : pour les messages d'erreur C C************************************************************************ C C HISTORIQUE (Anomalies et modifications éventuelles) C C HISTORIQUE : Créée le 28.12.01. C C************************************************************************ C 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 CC & ,MCOORD C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU C & ,NORINC,NORVAL,NORIND,NORVAD C & ,NUCROU, IPSAUV C C**** Les variables C IMPLICIT INTEGER(I-N) INTEGER ICEN, IFACE, IFACEL, IROC & , IROF & , IGEOM, NFAC & , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1 & , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1, I1 REAL*8 ROG, ROD CHARACTER*(40) MESERR CHARACTER*(8) TYPE LOGICAL LOGAN C C**** Les Includes C -INC SMCOORD -INC PPARAM -INC CCOPTIO -INC SMCHPOI POINTEUR MPROC.MPOVAL -INC SMCHAML -INC SMLENTI -INC SMELEME -INC SMLMOTS POINTEUR MLMCOM.MLMOTS C C**** Initialisation des parametres d'erreur déjà faite, i.e. C C MESERR = ' ' C MOTERR(1:40) = MESERR(1:40) C C C**** KRIPAD pour la correspondance global/local de centre C CALL KRIPAD(ICEN,MLENT1) C C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements C C Si i est le numero global d'un noeud de ICEN, C MLENT1.LECT(i) contient sa position, i.e. C C I = numero global du noeud centre C MLENT1.LECT(i) = numero local du noeud centre C C MLENT1 déjà activé, i.e. C C SEGACT MLENT1 C C**** Activation de CHPOINTs C CALL LICHT(IROC, MPROC, TYPE, IGEOM) C SEGACT MPROC C C**** Le MELEME FACEL C IPT1 = IFACEL IPT2 = IFACE SEGACT IPT1 SEGACT IPT2 NFAC = IPT1.NUM(/2) C SEGACT MLMCOM C C**** Creation de MCHAMLs contenant les etats gauche et droite, C C**** Densité C N1 = 1 N3 = 6 L1 = 15 SEGINI MCHEL2 IROF = MCHEL2 MCHEL2.IMACHE(1) = IFACEL MCHEL2.TITCHE = ' ' MCHEL2.CONCHE(1) = ' ' C C**** Valeurs independente du repére, i.e. C MCHEL2.INFCHE(1,1) = 0 MCHEL2.INFCHE(1,3) = NIFOUR MCHEL2.INFCHE(1,4) = 0 MCHEL2.INFCHE(1,5) = 0 MCHEL2.INFCHE(1,6) = 0 MCHEL2.IFOCHE = IFOUR N2 = MLMCOM.MOTS(/2) SEGINI MCHAM1 MCHEL2.ICHAML(1) = MCHAM1 SEGDES MCHEL2 N1EL = NFAC N1PTEL = 3 N2EL = 0 N2PTEL = 0 DO I1=1,N2,1 MCHAM1.NOMCHE(I1) = MLMCOM.MOTS(I1) MCHAM1.TYPCHE(I1) = 'REAL*8 ' SEGINI MELVA1 MCHAM1.IELVAL(I1) = MELVA1 ENDDO C C**** Boucle sur le faces C DO NLCF = 1, NFAC C C******* NLCF = numero local du centre de face C NGCF = numero global du centre de face C NGCEG = numero global du centre ELT "gauche" C NLCEG = numero local du centre ELT "gauche" C NGCED = numero global du centre ELT "droite" C NLCED = numero local du centre ELT "droite" C NGCEG = IPT1.NUM(1,NLCF) NGCF = IPT1.NUM(2,NLCF) NGCED = IPT1.NUM(3,NLCF) NLCEG = MLENT1.LECT(NGCEG) NLCED = MLENT1.LECT(NGCED) C C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF) C NGCF1 = IPT2.NUM(1,NLCF) IF(NGCF1 .NE. NGCF) THEN LOGAN = .TRUE. MESERR(1:40) = 'PRET, subroutine pre411.eso ' GOTO 9999 ENDIF DO I1 = 1, N2, 1 IF(NGCEG .EQ. NGCED)THEN ROG = MPROC.VPOCHA(NLCEG , I1) C C********** Son etat droite C ROD = ROG ELSE C C************* Etat gauche C ROG = MPROC.VPOCHA(NLCEG, I1) C C********** Etat droit C ROD = MPROC.VPOCHA(NLCED, I1) ENDIF MELVA1=MCHAM1.IELVAL(I1) MELVA1.VELCHE(1,NLCF) = ROG MELVA1.VELCHE(3,NLCF) = ROD ENDDO ENDDO C C**** Desactivation des SEGMENTs C SEGDES IPT1 SEGDES IPT2 DO I1 = 1, N2, 1 MELVA1=MCHAM1.IELVAL(I1) SEGDES MELVA1 ENDDO SEGDES MCHAM1 C SEGDES MPROC C SEGSUP MLENT1 SEGDES MLMCOM C 9999 CONTINUE C RETURN END