C MKMPOS SOURCE CHAT 05/01/13 01:46:19 5004 SUBROUTINE MKMPOS(NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN, $ KRINC,MELEME,KRSPGT, $ MPOS, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : MKMPOS C PROJET : Noyau linéaire NLIN C DESCRIPTION : On complète un tableau de correspondance (point support, C nom d'inconnue scalaire) <-> (numéro de ddl) C C On complète le tableau de repérage des inconnues KMINCT C (segment de type MPOS dans le programme appelant) avec C les informations données en entrée : C KRINC : indices des composantes ds le tableau des C composantes. C MELEME : liste des numéros globaux de points sur C lesquels il y a des inconnues. C KRSPGT : repérage des points ds le tableau des points. C C C LANGAGE : FORTRAN 77 (sauf E/S) C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELE PAR : PRASEM C*********************************************************************** C ENTREES : NBINC, NPOMEL, NTOGPO,NTOTPO,NTOTIN C KRINC, MELEME, KRSPGT C ENTREES/SORTIES : MPOS C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 05/10/99, version initiale C HISTORIQUE : v1, 05/10/99, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO INTEGER NBINC,NPOMEL,NTOGPO,NTOTPO,NTOTIN INTEGER KRINC(NBINC) INTEGER MELEME(NPOMEL) INTEGER KRSPGT(NTOGPO) INTEGER MPOS(NTOTPO,NTOTIN+1) * INTEGER IMPR,IRET * LOGICAL LEXIST INTEGER IPOMEL,IINC INTEGER IPOMCT,IINCCT INTEGER NPOINC * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans mkmpos' DO 1 IPOMEL=1,NPOMEL IPOMCT=KRSPGT(MELEME(IPOMEL)) IF (IPOMCT.EQ.0) THEN WRITE(IOIMP,*) $ 'Un point de KSPGP ou KSPGD n''existe pas ' $ ,'dans KSPGT...' ENDIF * On cherche si l'inconnue n'existe pas déjà dans MPOS DO 12 IINC=1,NBINC IINCCT=KRINC(IINC) LEXIST=(MPOS(IPOMCT,IINCCT).NE.0) * Sinon, on la rajoute... IF (.NOT.LEXIST) THEN NPOINC=MPOS(IPOMCT,NTOTIN+1)+1 MPOS(IPOMCT,NTOTIN+1)=NPOINC MPOS(IPOMCT,IINCCT) =NPOINC ENDIF 12 CONTINUE 1 CONTINUE * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine mkmpos' RETURN * * End of subroutine MKMPOS * END