C MAKPRM SOURCE PV 20/09/26 21:18:44 10724 SUBROUTINE MAKPRM(MELPRI,KRINCP, $ MELDUA,NPODUA,KJSPGD,KRSPGD,KRINCD, $ KMINCT,KRSPGT, $ PMCOU, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : MAKPRM C PROJET : Noyau linéaire NLIN C DESCRIPTION : Matrice élémentaire + repérage => profil Morse de la C matrice assemblée (les colonnes ne sont pas C ordonnées). C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : PONBL2, POELM2, PONBPO, POPOIN, MKPMOR C APPELE PAR : PRASEM C*********************************************************************** C ENTREES : tout sauf PMCOU C SORTIES : PMCOU C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 13/12/99, création C HISTORIQUE : v1, 13/12/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 -INC SMELEME POINTEUR MELPRI.MELEME POINTEUR MELDUA.MELEME POINTEUR KJSPGD.MELEME -INC SMMATRIK POINTEUR KMINCT.MINC POINTEUR PMCOU.PMORS -INC SMLENTI POINTEUR KRINCP.MLENTI POINTEUR KRSPGD.MLENTI POINTEUR KRINCD.MLENTI POINTEUR KRSPGT.MLENTI POINTEUR PONBLD.MLENTI POINTEUR PODPOP.MLENTI INTEGER NPODUA * * Includes perso * *STAT -INC SMSTAT *-INC SLSTIND * * Segment LSTIND (liste séquentielle indexée) * SEGMENT LSTIND INTEGER IDX(NBM+1) INTEGER IVAL(NBTVAL) ENDSEGMENT * * LISTE SEQUENTIELLE INDEXEE D'ENTIERS * * NBM : NOMBRE DE MULTIPLETS * NBTVAL : NOMBRE TOTAL DE VALEURS * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME * MULTIPLET DANS LE TABLEAU IVAL * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET POINTEUR P2ELDU.LSTIND POINTEUR LPDPP.LSTIND * INTEGER IMPR,IRET * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans makprm' *STAT CALL INMSTA(MSTAT,0) C - Construire la liste indexée suivante (P2ELDU) : C * Nombre de multiplets = nb points P1 de MELDUA ; C * chaque multiplet : numéro des éléments de MELDUA C contenant P1. * SEGPRT,MELPRI * SEGPRT,MELDUA * SEGPRT,KRSPGD * In PONBL2 : SEGINI PONBLD CALL PONBL2(MELDUA,KRSPGD,NPODUA, $ PONBLD, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * SEGPRT,PONBLD *STAT CALL PRMSTA(' sub. ponbl2',MSTAT,IMPR) * In POELM2 : SEGINI P2ELDU CALL POELM2(MELDUA,KRSPGD,PONBLD, $ P2ELDU, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGSUP PONBLD * SEGPRT,P2ELDU *STAT CALL PRMSTA(' sub. poelm2',MSTAT,IMPR) C - Construire la liste d'entiers suivante (PODPOP) : C * Nombre d'entiers = nb points P1 de MELDUA ; C * pour chaque P1 : nb. de points P2 de MELPRI avec lesquels il C a une liaison. * In PONBPO : SEGINI PODPOP CALL PONBPO(P2ELDU,MELPRI, $ PODPOP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * SEGPRT,PODPOP *STAT CALL PRMSTA(' sub. ponbpo',MSTAT,IMPR) C - Construire la liste indexée suivante (LPDPP) : C * Nombre de multiplets = nb points P1 de MELDUA C * pour chaque P1 : numéro des points P2 de MELPRI avec C lesquels il a une liaison. * In POPOIN : SEGINI LPDPP CALL POPOIN(P2ELDU,MELPRI,PODPOP, $ LPDPP, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 SEGSUP P2ELDU SEGSUP PODPOP IF (IMPR.GT.4) THEN WRITE(IOIMP,*) 'Liste des points duaux :' SEGPRT,KJSPGD WRITE(IOIMP,*) 'Liste indexée de correspondance ', $ 'point dual-points primaux :' SEGPRT,LPDPP ENDIF *STAT CALL PRMSTA(' sub. popoin',MSTAT,IMPR) C C - Initialisation et remplissage du profil de la matrice morse C CALL MKPMOR(LPDPP,KJSPGD,KRINCP,KRINCD, $ KRSPGT,KMINCT, $ PMCOU, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 IF (IMPR.GT.4) THEN WRITE(IOIMP,*) 'Profil Morse non ordonné :' SEGPRT,PMCOU ENDIF SEGSUP LPDPP * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine makprm' RETURN * * End of subroutine MAKPRM * END