1 : C MAKPR2 SOURCE MAGN 09/07/30 21:19:13 6458 2 : SUBROUTINE MAKPR2(MELPRI,KRINCP, 3 : $ MELDUA,NPODUA,KJSPGD,KRSPGD,KRINCD, 4 : $ KMINCT,KRSPGT, 5 : $ LDDLDU,PMCOU, 6 : $ IMPR,IRET) 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : C*********************************************************************** 10 : C NOM : MAKPR2 11 : C PROJET : Noyau linéaire NLIN 12 : C DESCRIPTION : Matrice élémentaire + repérage => profil Morse de la 13 : C matrice assemblée (les colonnes ne sont pas 14 : C ordonnées). 15 : C 16 : C LANGAGE : ESOPE 17 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 18 : C mél : gounand@semt2.smts.cea.fr 19 : C*********************************************************************** 20 : C APPELES : PONBL2, POELM2, PONBPO, POPOIN, MKPMOR 21 : C APPELE PAR : PRASEM 22 : C*********************************************************************** 23 : C ENTREES : tout sauf PMCOU 24 : C SORTIES : PMCOU 25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 26 : C*********************************************************************** 27 : C VERSION : v1, 13/12/99, création 28 : C HISTORIQUE : v1, 13/12/99, création 29 : C HISTORIQUE : 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCOPTIO 37 : -INC SMELEME 38 : POINTEUR MELPRI.MELEME 39 : POINTEUR MELDUA.MELEME 40 : POINTEUR KJSPGD.MELEME 41 : -INC SMMATRIK 42 : POINTEUR KMINCT.MINC 43 : POINTEUR PMCOU.PMORS 44 : -INC SMLENTI 45 : POINTEUR KRINCP.MLENTI 46 : POINTEUR KRSPGD.MLENTI 47 : POINTEUR KRINCD.MLENTI 48 : POINTEUR KRSPGT.MLENTI 49 : POINTEUR PONBLD.MLENTI 50 : POINTEUR PODPOP.MLENTI 51 : POINTEUR LDDLDU.MLENTI 52 : INTEGER NPODUA 53 : * 54 : * Includes perso 55 : * 56 : *STAT -INC SMSTAT 57 : *-INC SLSTIND 58 : * 59 : * Segment LSTIND (liste séquentielle indexée) 60 : * 61 : SEGMENT LSTIND 62 : INTEGER IDX(NBM+1) 63 : INTEGER IVAL(NBTVAL) 64 : ENDSEGMENT 65 : * 66 : * LISTE SEQUENTIELLE INDEXEE D'ENTIERS 67 : * 68 : * NBM : NOMBRE DE MULTIPLETS 69 : * NBTVAL : NOMBRE TOTAL DE VALEURS 70 : * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME 71 : * MULTIPLET DANS LE TABLEAU IVAL 72 : * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET 73 : POINTEUR P2ELDU.LSTIND 74 : POINTEUR LPDPP.LSTIND 75 : * 76 : INTEGER IMPR,IRET 77 : * 78 : * Executable statements 79 : * 80 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans makpr2' 80 : *STAT CALL INMSTA(MSTAT,0) 81 : C - Construire la liste indexée suivante (P2ELDU) : 82 : C * Nombre de multiplets = nb points P1 de MELDUA ; 83 : C * chaque multiplet : numéro des éléments de MELDUA 84 : C contenant P1. 85 : * SEGPRT,MELPRI 86 : * SEGPRT,MELDUA 87 : * SEGPRT,KRSPGD 88 : * In PONBL2 : SEGINI PONBLD 88 : CALL PONBL2(MELDUA,KRSPGD,NPODUA, 89 : $ PONBLD, 90 : $ IMPR,IRET) 91 : IF (IRET.NE.0) GOTO 9999 92 : * SEGPRT,PONBLD 92 : *STAT CALL PRMSTA(' sub. ponbl2',MSTAT,IMPR) 93 : * In POELM2 : SEGINI P2ELDU 93 : CALL POELM2(MELDUA,KRSPGD,PONBLD, 94 : $ P2ELDU, 95 : $ IMPR,IRET) 96 : IF (IRET.NE.0) GOTO 9999 97 : SEGSUP PONBLD 98 : * SEGPRT,P2ELDU 98 : *STAT CALL PRMSTA(' sub. poelm2',MSTAT,IMPR) 99 : C - Construire la liste d'entiers suivante (PODPOP) : 100 : C * Nombre d'entiers = nb points P1 de MELDUA ; 101 : C * pour chaque P1 : nb. de points P2 de MELPRI avec lesquels il 102 : C a une liaison. 103 : * In PONBPO : SEGINI PODPOP 103 : CALL PONBPO(P2ELDU,MELPRI, 104 : $ PODPOP, 105 : $ IMPR,IRET) 106 : IF (IRET.NE.0) GOTO 9999 107 : * SEGPRT,PODPOP 107 : *STAT CALL PRMSTA(' sub. ponbpo',MSTAT,IMPR) 108 : C - Construire la liste indexée suivante (LPDPP) : 109 : C * Nombre de multiplets = nb points P1 de MELDUA 110 : C * pour chaque P1 : numéro des points P2 de MELPRI avec 111 : C lesquels il a une liaison. 112 : * In POPOIN : SEGINI LPDPP 112 : CALL POPOIN(P2ELDU,MELPRI,PODPOP, 113 : $ LPDPP, 114 : $ IMPR,IRET) 115 : IF (IRET.NE.0) GOTO 9999 116 : SEGSUP P2ELDU 117 : SEGSUP PODPOP 118 : IF (IMPR.GT.4) THEN 119 : WRITE(IOIMP,*) 'Liste des points duaux :' 120 : SEGPRT,KJSPGD 121 : WRITE(IOIMP,*) 'Liste indexée de correspondance ', 122 : $ 'point dual-points primaux :' 123 : SEGPRT,LPDPP 124 : ENDIF 124 : *STAT CALL PRMSTA(' sub. popoin',MSTAT,IMPR) 125 : C 126 : C - Initialisation et remplissage du profil de la matrice morse 127 : C 127 : CALL MKPMO2(LPDPP,KJSPGD,KRINCP,KRINCD, 128 : $ KRSPGT,KMINCT, 129 : $ LDDLDU,PMCOU, 130 : $ IMPR,IRET) 131 : IF (IRET.NE.0) GOTO 9999 132 : IF (IMPR.GT.4) THEN 133 : WRITE(IOIMP,*) 'Profil Morse non ordonné :' 134 : SEGPRT,PMCOU 135 : ENDIF 136 : SEGSUP LPDPP 137 : * 138 : * Normal termination 139 : * 140 : IRET=0 141 : RETURN 142 : * 143 : * Format handling 144 : * 145 : * 146 : * Error handling 147 : * 148 : 9999 CONTINUE 149 : IRET=1 150 : WRITE(IOIMP,*) 'An error was detected in subroutine makpr2' 151 : RETURN 152 : * 153 : * End of subroutine MAKPR2 154 : * 155 : END 156 : 157 : 158 : 159 : 160 :
© Cast3M 2003 - All rights reserved.
Disclaimer