1 : C MODNUM SOURCE MAGN 09/07/30 21:19:36 6458 2 : SUBROUTINE MODNUM(LILAG,KMINCT,PMTOT, 3 : $ NEWNUM, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : MODNUM 9 : C PROJET : Noyau linéaire NLIN 10 : C DESCRIPTION : Modification de la nouvelle numérotation 11 : C pour placer les multiplicateurs de Lagrange 12 : C après les inconnues auxquelles ils se rapportent. 13 : C En gros, dans la nouvelle numérotation, on permute le numéro du 14 : C multiplicateur avec le numéro le plus grand des inconnues associés 15 : C s'il est supérieur au numéro du multiplicateur. 16 : C 17 : C 18 : C LANGAGE : ESOPE 19 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 20 : C mél : gounand@semt2.smts.cea.fr 21 : C*********************************************************************** 22 : C APPELE PAR : PRASEM 23 : C*********************************************************************** 24 : C ENTREES : LILAG, KMINCT, PMTOT 25 : C ENTREES/SORTIES : NEWNUM 26 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 27 : C*********************************************************************** 28 : C VERSION : v1, 02/12/99, version initiale 29 : C HISTORIQUE : v1, 02/12/99, création 30 : C HISTORIQUE : 17/01/2000 : Correction d'un bug sévère de programmation 31 : C qui entrainait un fonctionnement de la subroutine non conforme à 32 : C sa description. 33 : C 34 : C HISTORIQUE : 35 : C*********************************************************************** 36 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 37 : C en cas de modification de ce sous-programme afin de faciliter 38 : C la maintenance ! 39 : C*********************************************************************** 40 : -INC CCOPTIO 41 : *-INC SMLLOGI 42 : SEGMENT MLLOGI 43 : LOGICAL LOGI(JG) 44 : ENDSEGMENT 45 : POINTEUR LILAG.MLLOGI 46 : POINTEUR KRDLAG.MLLOGI 47 : -INC SMMATRIK 48 : POINTEUR KMINCT.MINC 49 : POINTEUR PMTOT.PMORS 50 : -INC SMLENTI 51 : INTEGER JG 52 : POINTEUR NEWNUM.MLENTI 53 : POINTEUR NUINLA.MLENTI 54 : POINTEUR LDDLAG.MLENTI 55 : INTEGER IMPR,IRET 56 : * 57 : INTEGER IDDLAG,ITOTIN,ITOTLA,ITOTPO 58 : INTEGER NDDLAG,NTOTIN,NTOTLA,NTOTPO,NTTDDL 59 : INTEGER NTOTI2,NTTDD2 60 : INTEGER NUMDDL,NUMLAG,NNUDDL,NNULAG 61 : INTEGER MANNDL,MANUDL 62 : INTEGER POSI 63 : INTEGER J,JSTOP,JSTRT 64 : * 65 : * Executable statements 66 : * 67 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans modnum' 68 : * 69 : * Construction de NUINLA : la liste d'entiers telle que : 70 : * KMINCT.LISINC(NUINLA.LECT(imulag)), imulag=1..nbulag 71 : * sont des noms d'inconnues "mult. lag." 72 : * 73 : JG=0 74 : SEGINI NUINLA 75 : SEGACT LILAG 76 : NTOTIN=LILAG.LOGI(/1) 77 : DO 1 ITOTIN=1,NTOTIN 78 : IF (LILAG.LOGI(ITOTIN)) THEN 79 : NUINLA.LECT(**)=ITOTIN 80 : ENDIF 81 : 1 CONTINUE 82 : SEGDES LILAG 83 : NTOTLA=NUINLA.LECT(/1) 84 : IF (NTOTLA.GT.0) THEN 85 : * 86 : * Construction de LDDLAG : liste d'entiers telle que : \forall i 87 : * LDDLAG.LECT(i) est un numéro de ddl "multiplicateur de lagrange" (ML) 88 : * 89 : SEGACT KMINCT 90 : NTOTI2=KMINCT.LISINC(/2) 91 : IF (NTOTI2.NE.NTOTIN) GOTO 9998 92 : NTOTPO=KMINCT.NPOS(/1)-1 93 : NTTDDL=KMINCT.NPOS(NTOTPO+1)-1 94 : JG=NTTDDL 95 : SEGINI LDDLAG 96 : NDDLAG=0 97 : *! 98 : *! La boucle est dans le mauvais ordre mais comme ca LDDLAG est dans 99 : *! l'ordre croissant. 100 : *! (En fait, c'est plutôt) MPOS qui a ses indices 101 : *! dans l'ordre inverse par rapport au naturel 102 : *! 103 : *! 104 : DO 3 ITOTLA=1,NTOTLA 105 : ITOTIN=NUINLA.LECT(ITOTLA) 106 : DO 32 ITOTPO=1,NTOTPO 107 : POSI=KMINCT.MPOS(ITOTPO,ITOTIN) 108 : IF (POSI.NE.0) THEN 109 : NDDLAG=NDDLAG+1 110 : LDDLAG.LECT(NDDLAG)=KMINCT.NPOS(ITOTPO)+POSI-1 111 : ENDIF 112 : 32 CONTINUE 113 : 3 CONTINUE 114 : SEGDES KMINCT 115 : JG=NDDLAG 116 : SEGADJ,LDDLAG 117 : JG=NTTDDL 118 : SEGINI KRDLAG 119 : DO 4 IDDLAG=1,NDDLAG 120 : KRDLAG.LOGI(LDDLAG.LECT(IDDLAG))=.TRUE. 121 : 4 CONTINUE 122 : * 123 : * Maintenant, pour chaque ML de LDDLAG : on regarde si les ddl 124 : * associés dans PMTOT ont des numéros plus grand dans la nouvelle 125 : * numérotation... Si oui, on permute le numéro le plus grand et celui 126 : * du ML 127 : * 128 : SEGACT PMTOT 129 : NTTDD2=PMTOT.IA(/1)-1 130 : IF (NTTDD2.NE.NTTDDL) GOTO 9998 131 : * SEGPRT,LDDLAG 132 : * SEGPRT,NEWNUM 133 : SEGACT NEWNUM*MOD 134 : NTTDD2=NEWNUM.LECT(/1) 135 : IF (NTTDD2.NE.NTTDDL) GOTO 9998 136 : DO 5 IDDLAG=1,NDDLAG 137 : NUMLAG=LDDLAG.LECT(IDDLAG) 138 : NNULAG=NEWNUM.LECT(NUMLAG) 139 : MANUDL=NUMLAG 140 : MANNDL=NNULAG 141 : JSTRT=PMTOT.IA(NUMLAG) 142 : JSTOP=PMTOT.IA(NUMLAG+1)-1 143 : DO 52 J=JSTRT,JSTOP 144 : NUMDDL=PMTOT.JA(J) 145 : IF (.NOT.KRDLAG.LOGI(NUMDDL)) THEN 146 : NNUDDL=NEWNUM.LECT(NUMDDL) 147 : IF (NNUDDL.GT.MANNDL) THEN 148 : MANNDL=NNUDDL 149 : MANUDL=NUMDDL 150 : ENDIF 151 : ENDIF 152 : 52 CONTINUE 153 : * On a trouvé un numéro plus grand, on permute 154 : IF (NUMLAG.NE.MANNDL) THEN 155 : NEWNUM.LECT(NUMLAG)=MANNDL 156 : NEWNUM.LECT(MANUDL)=NNULAG 157 : ENDIF 158 : 5 CONTINUE 159 : * SEGPRT,NEWNUM 160 : SEGDES NEWNUM 161 : SEGDES PMTOT 162 : SEGSUP KRDLAG 163 : SEGSUP LDDLAG 164 : ENDIF 165 : SEGSUP NUINLA 166 : * 167 : * Normal termination 168 : * 169 : IRET=0 170 : RETURN 171 : * 172 : * Format handling 173 : * 174 : * 175 : * Error handling 176 : * 177 : 9998 CONTINUE 178 : WRITE(IOIMP,*) 'Pb. compatibilité d''objets (dimensions)' 179 : 9999 CONTINUE 180 : IRET=1 181 : WRITE(IOIMP,*) 'An error was detected in subroutine modnum' 182 : RETURN 183 : * 184 : * End of subroutine MODNUM 185 : * 186 : END 187 : 188 : 189 : 190 : 191 :
© Cast3M 2003 - All rights reserved.
Disclaimer