1 : C MAKPRM SOURCE MAGN 09/07/30 21:19:14 6458 2 : SUBROUTINE MAKPRM(MELPRI,KRINCP, 3 : $ MELDUA,NPODUA,KJSPGD,KRSPGD,KRINCD, 4 : $ KMINCT,KRSPGT, 5 : $ PMCOU, 6 : $ IMPR,IRET) 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8 (A-H,O-Z) 9 : C*********************************************************************** 10 : C NOM : MAKPRM 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 : INTEGER NPODUA 52 : * 53 : * Includes perso 54 : * 55 : *STAT -INC SMSTAT 56 : *-INC SLSTIND 57 : * 58 : * Segment LSTIND (liste séquentielle indexée) 59 : * 60 : SEGMENT LSTIND 61 : INTEGER IDX(NBM+1) 62 : INTEGER IVAL(NBTVAL) 63 : ENDSEGMENT 64 : * 65 : * LISTE SEQUENTIELLE INDEXEE D'ENTIERS 66 : * 67 : * NBM : NOMBRE DE MULTIPLETS 68 : * NBTVAL : NOMBRE TOTAL DE VALEURS 69 : * IDX(I) : INDICE DE LA PREMIERE VALEUR DU IEME 70 : * MULTIPLET DANS LE TABLEAU IVAL 71 : * IVAL(IDX(I) -> IDX(I+1)-1) : VALEURS DU IEME MULTIPLET 72 : POINTEUR P2ELDU.LSTIND 73 : POINTEUR LPDPP.LSTIND 74 : * 75 : INTEGER IMPR,IRET 76 : * 77 : * Executable statements 78 : * 79 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans makprm' 79 : *STAT CALL INMSTA(MSTAT,0) 80 : C - Construire la liste indexée suivante (P2ELDU) : 81 : C * Nombre de multiplets = nb points P1 de MELDUA ; 82 : C * chaque multiplet : numéro des éléments de MELDUA 83 : C contenant P1. 84 : * SEGPRT,MELPRI 85 : * SEGPRT,MELDUA 86 : * SEGPRT,KRSPGD 87 : * In PONBL2 : SEGINI PONBLD 87 : CALL PONBL2(MELDUA,KRSPGD,NPODUA, 88 : $ PONBLD, 89 : $ IMPR,IRET) 90 : IF (IRET.NE.0) GOTO 9999 91 : * SEGPRT,PONBLD 91 : *STAT CALL PRMSTA(' sub. ponbl2',MSTAT,IMPR) 92 : * In POELM2 : SEGINI P2ELDU 92 : CALL POELM2(MELDUA,KRSPGD,PONBLD, 93 : $ P2ELDU, 94 : $ IMPR,IRET) 95 : IF (IRET.NE.0) GOTO 9999 96 : SEGSUP PONBLD 97 : * SEGPRT,P2ELDU 97 : *STAT CALL PRMSTA(' sub. poelm2',MSTAT,IMPR) 98 : C - Construire la liste d'entiers suivante (PODPOP) : 99 : C * Nombre d'entiers = nb points P1 de MELDUA ; 100 : C * pour chaque P1 : nb. de points P2 de MELPRI avec lesquels il 101 : C a une liaison. 102 : * In PONBPO : SEGINI PODPOP 102 : CALL PONBPO(P2ELDU,MELPRI, 103 : $ PODPOP, 104 : $ IMPR,IRET) 105 : IF (IRET.NE.0) GOTO 9999 106 : * SEGPRT,PODPOP 106 : *STAT CALL PRMSTA(' sub. ponbpo',MSTAT,IMPR) 107 : C - Construire la liste indexée suivante (LPDPP) : 108 : C * Nombre de multiplets = nb points P1 de MELDUA 109 : C * pour chaque P1 : numéro des points P2 de MELPRI avec 110 : C lesquels il a une liaison. 111 : * In POPOIN : SEGINI LPDPP 111 : CALL POPOIN(P2ELDU,MELPRI,PODPOP, 112 : $ LPDPP, 113 : $ IMPR,IRET) 114 : IF (IRET.NE.0) GOTO 9999 115 : SEGSUP P2ELDU 116 : SEGSUP PODPOP 117 : IF (IMPR.GT.4) THEN 118 : WRITE(IOIMP,*) 'Liste des points duaux :' 119 : SEGPRT,KJSPGD 120 : WRITE(IOIMP,*) 'Liste indexée de correspondance ', 121 : $ 'point dual-points primaux :' 122 : SEGPRT,LPDPP 123 : ENDIF 123 : *STAT CALL PRMSTA(' sub. popoin',MSTAT,IMPR) 124 : C 125 : C - Initialisation et remplissage du profil de la matrice morse 126 : C 126 : CALL MKPMOR(LPDPP,KJSPGD,KRINCP,KRINCD, 127 : $ KRSPGT,KMINCT, 128 : $ PMCOU, 129 : $ IMPR,IRET) 130 : IF (IRET.NE.0) GOTO 9999 131 : IF (IMPR.GT.4) THEN 132 : WRITE(IOIMP,*) 'Profil Morse non ordonné :' 133 : SEGPRT,PMCOU 134 : ENDIF 135 : SEGSUP LPDPP 136 : * 137 : * Normal termination 138 : * 139 : IRET=0 140 : RETURN 141 : * 142 : * Format handling 143 : * 144 : * 145 : * Error handling 146 : * 147 : 9999 CONTINUE 148 : IRET=1 149 : WRITE(IOIMP,*) 'An error was detected in subroutine makprm' 150 : RETURN 151 : * 152 : * End of subroutine MAKPRM 153 : * 154 : END 155 : 156 : 157 : 158 :
© Cast3M 2003 - All rights reserved.
Disclaimer