1 : C LIMTAK SOURCE CHAT 05/01/13 01:18:22 5004 2 : SUBROUTINE LIMTAK(IFRES,ITLACC,IMAX1,IRET,IFORM) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : C*********************************************************************** 6 : C NOM : LIMTAK 7 : C DESCRIPTION : Lecture d'un objet de type MATRAK sur le 8 : C fichier IFRES 9 : C (appelé par lipil.eso) 10 : C 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELES (E/S) : LFCDIE (lecture d'un tableau d'entiers) 16 : C LFCDI2 (lecture d'un tableau de REAL*8) 17 : C*********************************************************************** 18 : C SYNTAXE GIBIANE : RESTITUER 19 : C ENTREES : IFRES, numéro du fichier de lecture 20 : C IMAX1, nombre d'objets MATRAK à lire 21 : C IFORM, le fichier à lire est formaté ou 22 : C non. 23 : C ENTREES/SORTIES : ITLACC, la pile des objets MATRAK à 24 : C laquelle on ajoute les objets lus 25 : C CODE RETOUR (IRET) : 0, ok 26 : C 1, erreur dans la lecture de l'objet 27 : C*********************************************************************** 28 : C VERSION : v1, 15/07/98, version initiale 29 : C HISTORIQUE : v1, 15/07/98, création 30 : C HISTORIQUE : 31 : C HISTORIQUE : 32 : C*********************************************************************** 33 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 34 : C en cas de modification de ce sous-programme afin de faciliter 35 : C la maintenance ! 36 : C*********************************************************************** 37 : -INC CCOPTIO 38 : C-INC SMMATRAKANC 39 : C************************************************************************* 40 : C 41 : C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees 42 : C 43 : 44 : * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange 45 : * (points CENTRE ) pour chaque operateur de contrainte 46 : * KGEOC SPG pour la totalite des points CENTRE. 47 : * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse) 48 : * KLEMC Connectivites de l'ensemble des contraintes 49 : * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones 50 : 51 : SEGMENT MATRAK 52 : INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP) 53 : INTEGER LIZAFM(NBSOUS) 54 : INTEGER IKAM0 (NBSOUS) 55 : INTEGER IMEM (NBELC) 56 : INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC 57 : ENDSEGMENT 58 : 59 : SEGMENT IZAFM 60 : REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX) 61 : ENDSEGMENT 62 : C************************************************************************* 63 : -INC SMMATRK1 64 : -INC TMCOLAC 65 : SEGMENT IZA 66 : REAL*8 A(NBVA) 67 : ENDSEGMENT 68 : C 69 : INTEGER NDTAB 70 : INTEGER IEL,I 71 : INTEGER ILENA(7) 72 : C====================================================================== 73 : * 74 : * Executable statements 75 : * 76 : IRET=0 77 : IRETOU=0 78 : C ... BOUCLE SUR LES MATRAK DE LA PILE 79 : DO 1 IEL=1,IMAX1 80 : C Restitution du chapeau 81 : MATRAK=0 82 : C Dimensions 83 : NDTAB=3 83 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 84 : IF (IRETOU.NE.0) GOTO 9999 85 : NBOP =ILENA(1) 86 : NBSOUS=ILENA(2) 87 : NBELC =ILENA(3) 88 : SEGINI MATRAK 89 : C Rigidités élémentaires 90 : NDTAB = NBOP 90 : CALL LFCDIE(IFRES,NDTAB,LGEOC,IRETOU,IFORM) 91 : IF (IRETOU.NE.0) GOTO 9999 92 : NDTAB = NBOP 92 : CALL LFCDIE(IFRES,NDTAB,IDEBS,IRETOU,IFORM) 93 : IF (IRETOU.NE.0) GOTO 9999 94 : NDTAB = NBOP 94 : CALL LFCDIE(IFRES,NDTAB,IFINS,IRETOU,IFORM) 95 : IF (IRETOU.NE.0) GOTO 9999 96 : NDTAB = NBSOUS 96 : CALL LFCDIE(IFRES,NDTAB,LIZAFM,IRETOU,IFORM) 97 : IF (IRETOU.NE.0) GOTO 9999 98 : NDTAB = NBSOUS 98 : CALL LFCDIE(IFRES,NDTAB,IKAM0,IRETOU,IFORM) 99 : IF (IRETOU.NE.0) GOTO 9999 100 : NDTAB = NBELC 100 : CALL LFCDIE(IFRES,NDTAB,IMEM,IRETOU,IFORM) 101 : IF (IRETOU.NE.0) GOTO 9999 102 : NDTAB = 7 102 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 103 : IF (IRETOU.NE.0) GOTO 9999 104 : KLEMC=ILENA( 1) 105 : KGEOS=ILENA( 2) 106 : KGEOC=ILENA( 3) 107 : KDIAG=ILENA( 4) 108 : KCAC =ILENA( 5) 109 : KIZCL=ILENA( 6) 110 : KIZGC=ILENA( 7) 111 : C Restitution des IZAFM 112 : DO 11 I=1,NBSOUS 113 : IZAFM=LIZAFM(I) 114 : IF (IZAFM.NE.0) THEN 115 : NDTAB=4 115 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 116 : IF (IRETOU.NE.0) GOTO 9999 117 : NNELP=ILENA(1) 118 : NP =ILENA(2) 119 : IESP =ILENA(3) 120 : NELAX=ILENA(4) 121 : SEGINI IZAFM 122 : NDTAB=NNELP*NP*IESP 122 : CALL LFCDI2(IFRES,NDTAB,AM,IRETOU,IFORM) 123 : IF (IRETOU.NE.0) GOTO 9999 124 : NDTAB=NELAX 124 : CALL LFCDI2(IFRES,NDTAB,RPGI,IRETOU,IFORM) 125 : IF (IRETOU.NE.0) GOTO 9999 126 : SEGDES IZAFM 127 : LIZAFM(I)=IZAFM 128 : ENDIF 129 : 11 CONTINUE 130 : C Restitution du IZL 131 : IF (KIZCL.NE.0) THEN 132 : C Dimensions 133 : NDTAB=4 133 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 134 : IF (IRETOU.NE.0) GOTO 9999 135 : NJA =ILENA(1) 136 : NJAN=ILENA(2) 137 : NJAB=ILENA(3) 138 : SEGINI IZL 139 : KZA1=ILENA(4) 140 : C Contenu des tableaux 141 : NDTAB=NJA 141 : CALL LFCDIE(IFRES,NDTAB,KZA,IRETOU,IFORM) 142 : IF (IRETOU.NE.0) GOTO 9999 143 : NDTAB=NJAN 143 : CALL LFCDIE(IFRES,NDTAB,NUAN,IRETOU,IFORM) 144 : IF (IRETOU.NE.0) GOTO 9999 145 : NDTAB=NJAN 145 : CALL LFCDIE(IFRES,NDTAB,NUNA,IRETOU,IFORM) 146 : IF (IRETOU.NE.0) GOTO 9999 147 : NDTAB=NJAN 147 : CALL LFCDIE(IFRES,NDTAB,IMEL,IRETOU,IFORM) 148 : IF (IRETOU.NE.0) GOTO 9999 149 : NDTAB=NJAN 149 : CALL LFCDIE(IFRES,NDTAB,IMJ,IRETOU,IFORM) 150 : IF (IRETOU.NE.0) GOTO 9999 151 : NDTAB=NJAB 151 : CALL LFCDI2(IFRES,NDTAB,B,IRETOU,IFORM) 152 : IF (IRETOU.NE.0) GOTO 9999 153 : C Restitution du IDMAT 154 : IF (KZA1.NE.0) THEN 155 : C Dimension 156 : NDTAB=2 156 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 157 : IF (IRETOU.NE.0) GOTO 9999 158 : NBLK =ILENA(1) 159 : SEGINI IDMAT 160 : IDIAG=ILENA(2) 161 : NDTAB=NBLK 161 : CALL LFCDIE(IFRES,NDTAB,IDESCR,IRETOU,IFORM) 162 : IF (IRETOU.NE.0) GOTO 9999 163 : NDTAB=NBLK+1 163 : CALL LFCDIE(IFRES,NDTAB,NLDBLK,IRETOU,IFORM) 164 : IF (IRETOU.NE.0) GOTO 9999 165 : IF (IDIAG.NE.0) THEN 166 : NDTAB=1 166 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 167 : IF (IRETOU.NE.0) GOTO 9999 168 : NBVA=ILENA(1) 169 : SEGINI IZA 170 : NDTAB=NBVA 170 : CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM) 171 : IF (IRETOU.NE.0) GOTO 9999 172 : SEGDES IZA 173 : IDIAG=IZA 174 : ENDIF 175 : C Restitution des IDBLK 176 : DO 211 INBLK=1,NBLK 177 : IDBLK=IDESCR(INBLK) 178 : IF (IDBLK.NE.0) THEN 179 : C Dimension 180 : NDTAB=3 180 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 181 : IF (IRETOU.NE.0) GOTO 9999 182 : NLBLK=ILENA(1) 183 : SEGINI IDBLK 184 : IMAT =ILENA(2) 185 : ILON =ILENA(3) 186 : NDTAB=NLBLK+1 186 : CALL LFCDIE(IFRES,NDTAB,IDEBLK,IRETOU,IFORM) 187 : IF (IRETOU.NE.0) GOTO 9999 188 : IF (IMAT.NE.0) THEN 189 : NDTAB=1 189 : CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) 190 : IF (IRETOU.NE.0) GOTO 9999 191 : NBVA=ILENA(1) 192 : SEGINI IZA 193 : NDTAB=NBVA 193 : CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM) 194 : IF (IRETOU.NE.0) GOTO 9999 195 : SEGDES IZA 196 : IMAT=IZA 197 : ENDIF 198 : SEGDES IDBLK 199 : IDESCR(INBLK)=IDBLK 200 : ENDIF 201 : 211 CONTINUE 202 : SEGDES IDMAT 203 : KZA1=IDMAT 204 : ENDIF 205 : SEGDES IZL 206 : KIZCL=IZL 207 : ENDIF 208 : SEGDES MATRAK 209 : ITLAC(**)=MATRAK 210 : 1 CONTINUE 211 : * 212 : * Normal termination 213 : * 214 : IRET=0 215 : RETURN 216 : * 217 : * Format handling 218 : * 219 : * 220 : * Error handling 221 : * 222 : 9999 CONTINUE 223 : WRITE(IOIMP,*) 'An error was detected in subroutine limtak' 224 : IRET=1 225 : RETURN 226 : * 227 : * End of subroutine LIMTAK 228 : * 229 : END 230 : 231 : 232 : 233 : 234 : 235 :
© Cast3M 2003 - All rights reserved.
Disclaimer