1 : C RELR14 SOURCE GOUNAND 12/08/01 22:29:18 7454 2 : SUBROUTINE RELR14(MLIN,KJSPGP,KJSPGD,LINCP,LINCD, 3 : $ MINCP,MINCD, 4 : $ PROFM,VALM, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : RELR14 10 : C DESCRIPTION : 11 : * 12 : * Construction du profil Morse de la matrice assemblée 13 : * Celui-ci est ordonné (les numeros de colonnes 14 : * dans IA sont en ordre croissant) 15 : * 16 : C 17 : C 18 : C 19 : C LANGAGE : ESOPE 20 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 21 : C mél : gounand@semt2.smts.cea.fr 22 : C*********************************************************************** 23 : C APPELES : 24 : C APPELES (E/S) : 25 : C APPELES (BLAS) : 26 : C APPELES (CALCUL) : 27 : C APPELE PAR : 28 : C*********************************************************************** 29 : C SYNTAXE GIBIANE : 30 : C ENTREES : 31 : C ENTREES/SORTIES : 32 : C SORTIES : 33 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 34 : C*********************************************************************** 35 : C VERSION : v1, 27/06/2003, version initiale 36 : C HISTORIQUE : v1, 27/06/2003, création 37 : C HISTORIQUE : 38 : C HISTORIQUE : 39 : C*********************************************************************** 40 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 41 : C en cas de modification de ce sous-programme afin de faciliter 42 : C la maintenance ! 43 : C*********************************************************************** 44 : -INC CCOPTIO 45 : -INC SMCOORD 46 : -INC SMRIGID 47 : POINTEUR MLIN.MRIGID 48 : POINTEUR DES.DESCR 49 : * POINTEUR IMAT.IMATRI 50 : POINTEUR XMAT.XMATRI 51 : -INC SMELEME 52 : POINTEUR MEL.MELEME 53 : * Includes persos 54 : CBEGININCLUDE SMMINC 55 : SEGMENT MINC 56 : INTEGER NPOS(NPT+1) 57 : INTEGER MPOS(NPT,NBI+1) 58 : ENDSEGMENT 59 : SEGMENT IMINC 60 : INTEGER LNUPO (NDDL) 61 : INTEGER LNUINC(NDDL) 62 : ENDSEGMENT 63 : CENDINCLUDE SMMINC 64 : POINTEUR MINCP.MINC 65 : POINTEUR MINCD.MINC 66 : CBEGININCLUDE SMPMORS 67 : SEGMENT PMORS 68 : INTEGER IA (NTT+1) 69 : INTEGER JA (NJA) 70 : ENDSEGMENT 71 : CENDINCLUDE SMPMORS 72 : POINTEUR PROFM.PMORS 73 : POINTEUR PMCOU.PMORS 74 : POINTEUR PMTMP.PMORS 75 : CBEGININCLUDE SMIZA 76 : SEGMENT IZA 77 : REAL*8 A(NBVA) 78 : ENDSEGMENT 79 : CENDINCLUDE SMIZA 80 : POINTEUR VALM.IZA 81 : * Segment LSTIND (liste séquentielle indexée) 82 : SEGMENT LSTIND 83 : INTEGER IDX(NBM+1) 84 : INTEGER IELRIG(NBTVAL) 85 : INTEGER ILIGR (NBTVAL) 86 : ENDSEGMENT 87 : POINTEUR DDDNUL.LSTIND 88 : * 89 : -INC SMLENTI 90 : POINTEUR KJSPGP.MLENTI 91 : POINTEUR KJSPGD.MLENTI 92 : POINTEUR KRSPGP.MLENTI 93 : POINTEUR KRSPGD.MLENTI 94 : POINTEUR KRINCP.MLENTI 95 : POINTEUR KRINCD.MLENTI 96 : -INC SMLMOTS 97 : POINTEUR LINCP.MLMOTS 98 : POINTEUR LINCD.MLMOTS 99 : * 100 : INTEGER IMPR,IRET 101 : * 102 : LOGICAL LEXIST 103 : * 104 : * Executable statements 105 : * 106 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr14.eso' 107 : SEGACT MLIN 108 : NRIG=MLIN.IRIGEL(/2) 109 : * Construction des segments de repérage dans l'ensemble des points 110 : SEGACT KJSPGP 111 : NPOPRI=KJSPGP.LECT(/1) 112 : JG=XCOOR(/1)/(IDIM+1) 113 : SEGINI KRSPGP 113 : CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI) 114 : SEGDES KJSPGP 115 : SEGACT LINCP 116 : NINCP=LINCP.MOTS(/2) 117 : SEGACT MINCP 118 : * 119 : SEGACT KJSPGD 120 : NPODUA=KJSPGD.LECT(/1) 121 : JG=XCOOR(/1)/(IDIM+1) 122 : SEGINI KRSPGD 122 : CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA) 123 : SEGDES KJSPGD 124 : SEGACT LINCD 125 : NINCD=LINCD.MOTS(/2) 126 : SEGACT MINCD 127 : * Initialisation du profil morse total (profil vide et non diagonal) 128 : NDDLPR=MINCP.NPOS(NPOPRI+1)-1 129 : NDDLDU=MINCD.NPOS(NPODUA+1)-1 130 : NTT=NDDLDU 131 : NJA=0 132 : SEGINI PROFM 133 : DO I=1,NDDLDU+1 134 : PROFM.IA(I)=1 135 : ENDDO 136 : SEGDES PROFM 137 : DO IRIG=1,NRIG 138 : MEL=MLIN.IRIGEL(1,IRIG) 139 : SEGACT MEL 140 : * a effacer NEL=MEL.NUM(/2) 141 : DES=MLIN.IRIGEL(3,IRIG) 142 : SEGACT DES 143 : NDDLOP=DES.NOELEP(/1) 144 : NDDLOD=DES.NOELED(/1) 145 : * Construction du segment de repérage dans les inconnues primales et duales 146 : JG=NDDLOP 147 : SEGINI KRINCP 147 : CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP, 148 : $ DES.LISINC,LINCP.MOTS, 149 : $ KRINCP.LECT, 150 : $ IMPR,IRET) 151 : IF (IRET.NE.0) GOTO 9999 152 : JG=NDDLOD 153 : SEGINI KRINCD 153 : CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD, 154 : $ DES.LISDUA,LINCD.MOTS, 155 : $ KRINCD.LECT, 156 : $ IMPR,IRET) 157 : IF (IRET.NE.0) GOTO 9999 158 : * construction de la correspondance : 159 : * ieme ddl dual de la matrice assemblée <-> 160 : * (numéro d'élément, numéro ddl dual local) 161 : * de la rigidité dans lesquels il apparait 162 : * In relr1a : SEGINI DDDNUL 162 : CALL RELR1A(MINCD,KRSPGD,KRINCD, 163 : $ MEL,DES, 164 : $ DDDNUL, 165 : $ IMPR,IRET) 166 : IF (IRET.NE.0) GOTO 9999 167 : * a effacer SEGPRT,DDDNUL 168 : * construction de la correspondance : 169 : * ieme ddl dual de la matrice assemblée <-> 170 : * (numéros des ddl primaux avec lesquels il est 171 : * en relation). C'est le profil morse (non ordonné) 172 : * In relr1b : SEGINI PMCOU 172 : CALL RELR1B(DDDNUL, 173 : $ MINCP,KRSPGP,KRINCP, 174 : $ MEL,DES, 175 : $ PMCOU, 176 : $ IMPR,IRET) 177 : IF (IRET.NE.0) GOTO 9999 178 : * WRITE(IOIMP,*) ' ',IRIG 179 : * WRITE(IOIMP,*) 'IRIG=',IRIG 180 : * WRITE(IOIMP,*) ' ',IRIG 180 : * CALL ECMORS(PMCOU,0,3) 181 : * a effacer SEGPRT,PMCOU 182 : * In FUSPRM : SEGINI PMTMP 182 : CALL FUSPR2(PROFM,PMCOU,NDDLPR, 183 : $ PMTMP, 184 : $ IMPR,IRET) 185 : IF (IRET.NE.0) GOTO 9999 185 : * CALL ECMORS(PMTMP,0,3) 186 : SEGSUP PMCOU 187 : SEGSUP PROFM 188 : PROFM=PMTMP 189 : SEGSUP DDDNUL 190 : SEGSUP KRINCD 191 : SEGSUP KRINCP 192 : SEGDES DES 193 : SEGDES MEL 194 : ENDDO 195 : * 196 : * Ordonnancement du profil morse 197 : * 197 : CALL RELR1C(PROFM,NDDLPR, 198 : $ IMPR,IRET) 199 : IF (IRET.NE.0) GOTO 9999 200 : * SEGPRT,PROFM 201 : * 202 : * Remplissage des valeurs de la matrice Morse 203 : * 204 : SEGACT PROFM 205 : NNZ=PROFM.JA(/1) 206 : NBVA=NNZ 207 : SEGINI VALM 208 : DO IRIG=1,NRIG 209 : COEF=MLIN.COERIG(IRIG) 210 : MEL=MLIN.IRIGEL(1,IRIG) 211 : SEGACT MEL 212 : * a effacer NEL=MEL.NUM(/2) 213 : DES=MLIN.IRIGEL(3,IRIG) 214 : SEGACT DES 215 : NDDLOP=DES.NOELEP(/1) 216 : NDDLOD=DES.NOELED(/1) 217 : * Construction du segment de repérage dans les inconnues primales et duales 218 : JG=NDDLOP 219 : SEGINI KRINCP 219 : CALL CREPER(DES.LISINC(/1),NDDLOP,NINCP, 220 : $ DES.LISINC,LINCP.MOTS, 221 : $ KRINCP.LECT, 222 : $ IMPR,IRET) 223 : IF (IRET.NE.0) GOTO 9999 224 : JG=NDDLOD 225 : SEGINI KRINCD 225 : CALL CREPER(DES.LISDUA(/1),NDDLOD,NINCD, 226 : $ DES.LISDUA,LINCD.MOTS, 227 : $ KRINCD.LECT, 228 : $ IMPR,IRET) 229 : IF (IRET.NE.0) GOTO 9999 230 : * IMAT=MLIN.IRIGEL(4,IRIG) 231 : * SEGACT IMAT 232 : XMAT=MLIN.IRIGEL(4,IRIG) 233 : SEGACT XMAT 234 : * Compléter les valeurs de la matrice morse avec celles 235 : * de XMAT 235 : CALL RELR1D(MINCP,KRSPGP,KRINCP, 236 : $ MINCD,KRSPGD,KRINCD, 237 : $ COEF,MEL,DES,XMAT, 238 : $ PROFM, 239 : $ VALM, 240 : $ IMPR,IRET) 241 : IF (IRET.NE.0) GOTO 9999 242 : * WRITE(IOIMP,*) 'IRIG=',IRIG 242 : * CALL ECMORS(PROFM,VALM,3) 243 : * stop 16 244 : 245 : * SEGDES IMAT 246 : SEGDES XMAT 247 : SEGSUP KRINCD 248 : SEGSUP KRINCP 249 : SEGDES DES 250 : SEGDES MEL 251 : ENDDO 252 : SEGDES VALM 253 : SEGDES PROFM 254 : SEGDES MINCD 255 : SEGDES LINCD 256 : SEGSUP KRSPGD 257 : SEGDES MINCP 258 : SEGDES LINCP 259 : SEGSUP KRSPGP 260 : SEGDES MLIN 261 : * 262 : * Normal termination 263 : * 264 : IRET=0 265 : RETURN 266 : * 267 : * Format handling 268 : * 269 : * 270 : * Error handling 271 : * 272 : 9999 CONTINUE 273 : IRET=1 274 : WRITE(IOIMP,*) 'An error was detected in subroutine relr14' 275 : RETURN 276 : * 277 : * End of subroutine RELR14 278 : * 279 : END 280 : 281 : 282 :
© Cast3M 2003 - All rights reserved.
Disclaimer