1 : C RELR13 SOURCE GOUNAND 11/05/24 21:15:55 6976 2 : SUBROUTINE RELR13(MLIN,KJSPGP,KJSPGD,LINCP,LINCD, 3 : $ MINCP,MINCD, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : RELR13 9 : C DESCRIPTION : 10 : * 11 : * Construction des tableaux de correspondance ddl <-> (point, nom de 12 : * variable) : 13 : * - pour les inconnues primales : MINCP 14 : * - pour les inconnues duales : MINCD 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 : -INC SMELEME 50 : POINTEUR MEL.MELEME 51 : * Includes persos 52 : CBEGININCLUDE SMMINC 53 : SEGMENT MINC 54 : INTEGER NPOS(NPT+1) 55 : INTEGER MPOS(NPT,NBI+1) 56 : ENDSEGMENT 57 : SEGMENT IMINC 58 : INTEGER LNUPO (NDDL) 59 : INTEGER LNUINC(NDDL) 60 : ENDSEGMENT 61 : CENDINCLUDE SMMINC 62 : POINTEUR MINCP.MINC 63 : POINTEUR MINCD.MINC 64 : * 65 : -INC SMLENTI 66 : POINTEUR KJSPGP.MLENTI 67 : POINTEUR KJSPGD.MLENTI 68 : POINTEUR KRSPGP.MLENTI 69 : POINTEUR KRSPGD.MLENTI 70 : POINTEUR KRINCP.MLENTI 71 : POINTEUR KRINCD.MLENTI 72 : -INC SMLMOTS 73 : POINTEUR LINCP.MLMOTS 74 : POINTEUR LINCD.MLMOTS 75 : * 76 : INTEGER IMPR,IRET 77 : * 78 : LOGICAL LEXIST 79 : * 80 : * Executable statements 81 : * 82 : IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr13.eso' 83 : SEGACT MLIN 84 : NRIG=MLIN.IRIGEL(/2) 85 : * 86 : * Primale 87 : * 88 : * Construction du segment de repérage dans l'ensemble des points 89 : SEGACT KJSPGP 90 : NPOPRI=KJSPGP.LECT(/1) 91 : JG=XCOOR(/1)/(IDIM+1) 92 : SEGINI KRSPGP 92 : CALL RSETXI(KRSPGP.LECT,KJSPGP.LECT,NPOPRI) 93 : SEGDES KJSPGP 94 : SEGACT LINCP 95 : NINCP=LINCP.MOTS(/2) 96 : * Initialisation de MINCP 97 : NPT=NPOPRI 98 : NBI=NINCP 99 : SEGINI MINCP 100 : DO IRIG=1,NRIG 101 : MEL=MLIN.IRIGEL(1,IRIG) 102 : SEGACT MEL 103 : NEL=MEL.NUM(/2) 104 : DES=MLIN.IRIGEL(3,IRIG) 105 : SEGACT DES 106 : NDDL=DES.NOELEP(/1) 107 : * Construction du segment de repérage dans les inconnues primales 108 : JG=DES.LISINC(/2) 109 : SEGINI KRINCP 109 : CALL CREPER(DES.LISINC(/1),NDDL,NINCP, 110 : $ DES.LISINC,LINCP.MOTS, 111 : $ KRINCP.LECT, 112 : $ IMPR,IRET) 113 : IF (IRET.NE.0) GOTO 9999 114 : DO IEL=1,NEL 115 : DO IDDL=1,NDDL 116 : IPO=KRSPGP.LECT(MEL.NUM(DES.NOELEP(IDDL),IEL)) 117 : IINC=KRINCP.LECT(IDDL) 118 : * On cherche si l'inconnue n'existe pas déjà dans MPOS 119 : LEXIST=(MINCP.MPOS(IPO,IINC).NE.0) 120 : * Sinon, on la rajoute... 121 : IF (.NOT.LEXIST) THEN 122 : NPOINC=MINCP.MPOS(IPO,NINCP+1)+1 123 : MINCP.MPOS(IPO,NINCP+1)=NPOINC 124 : MINCP.MPOS(IPO,IINC) =NPOINC 125 : ENDIF 126 : ENDDO 127 : ENDDO 128 : SEGSUP KRINCP 129 : SEGDES DES 130 : SEGDES MEL 131 : ENDDO 132 : * Remplisssage de NPOS 133 : MINCP.NPOS(1)=1 134 : DO IPOPRI=1,NPOPRI 135 : MINCP.NPOS(IPOPRI+1)=MINCP.NPOS(IPOPRI) 136 : $ + MINCP.MPOS(IPOPRI,NINCP+1) 137 : ENDDO 138 : SEGDES MINCP 139 : SEGDES LINCP 140 : SEGSUP KRSPGP 141 : * 142 : * Duale (copie conforme de ci-dessus) 143 : * 144 : * Construction du segment de repérage dans l'ensemble des points 145 : SEGACT KJSPGD 146 : NPODUA=KJSPGD.LECT(/1) 147 : JG=XCOOR(/1)/(IDIM+1) 148 : SEGINI KRSPGD 148 : CALL RSETXI(KRSPGD.LECT,KJSPGD.LECT,NPODUA) 149 : SEGDES KJSPGD 150 : SEGACT LINCD 151 : NINCD=LINCD.MOTS(/2) 152 : * Initialisation de MINCP 153 : NPT=NPODUA 154 : NBI=NINCD 155 : SEGINI MINCD 156 : DO IRIG=1,NRIG 157 : MEL=MLIN.IRIGEL(1,IRIG) 158 : SEGACT MEL 159 : NEL=MEL.NUM(/2) 160 : DES=MLIN.IRIGEL(3,IRIG) 161 : SEGACT DES 162 : NDDL=DES.NOELED(/1) 163 : * Construction du segment de repérage dans les inconnues primales 164 : JG=DES.LISDUA(/2) 165 : SEGINI KRINCD 165 : CALL CREPER(DES.LISDUA(/1),NDDL,NINCD, 166 : $ DES.LISDUA,LINCD.MOTS, 167 : $ KRINCD.LECT, 168 : $ IMPR,IRET) 169 : IF (IRET.NE.0) GOTO 9999 170 : DO IEL=1,NEL 171 : DO IDDL=1,NDDL 172 : IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDL),IEL)) 173 : IINC=KRINCD.LECT(IDDL) 174 : * On cherche si l'inconnue n'existe pas déjà dans MPOS 175 : LEXIST=(MINCD.MPOS(IPO,IINC).NE.0) 176 : * Sinon, on la rajoute... 177 : IF (.NOT.LEXIST) THEN 178 : NPOINC=MINCD.MPOS(IPO,NINCD+1)+1 179 : MINCD.MPOS(IPO,NINCD+1)=NPOINC 180 : MINCD.MPOS(IPO,IINC) =NPOINC 181 : ENDIF 182 : ENDDO 183 : ENDDO 184 : SEGSUP KRINCD 185 : SEGDES DES 186 : SEGDES MEL 187 : ENDDO 188 : * Remplisssage de NPOS 189 : MINCD.NPOS(1)=1 190 : DO IPODUA=1,NPODUA 191 : MINCD.NPOS(IPODUA+1)=MINCD.NPOS(IPODUA) 192 : $ + MINCD.MPOS(IPODUA,NINCD+1) 193 : ENDDO 194 : SEGDES MINCD 195 : SEGDES LINCD 196 : SEGSUP KRSPGD 197 : SEGDES MLIN 198 : * 199 : * Normal termination 200 : * 201 : IRET=0 202 : RETURN 203 : * 204 : * Format handling 205 : * 206 : * 207 : * Error handling 208 : * 209 : 9999 CONTINUE 210 : IRET=1 211 : WRITE(IOIMP,*) 'An error was detected in subroutine relr13' 212 : RETURN 213 : * 214 : * End of subroutine RELR13 215 : * 216 : END 217 : 218 :
© Cast3M 2003 - All rights reserved.
Disclaimer