C LIMTAK SOURCE PV 17/12/05 21:16:29 9646 SUBROUTINE LIMTAK(IFRES,ITLACC,IMAX1,IRET,IFORM) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) C*********************************************************************** C NOM : LIMTAK C DESCRIPTION : Lecture d'un objet de type MATRAK sur le C fichier IFRES C (appelé par lipil.eso) C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/TTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES (E/S) : LFCDIE (lecture d'un tableau d'entiers) C LFCDI2 (lecture d'un tableau de REAL*8) C*********************************************************************** C SYNTAXE GIBIANE : RESTITUER C ENTREES : IFRES, numéro du fichier de lecture C IMAX1, nombre d'objets MATRAK à lire C IFORM, le fichier à lire est formaté ou C non. C ENTREES/SORTIES : ITLACC, la pile des objets MATRAK à C laquelle on ajoute les objets lus C CODE RETOUR (IRET) : 0, ok C 1, erreur dans la lecture de l'objet C*********************************************************************** C VERSION : v1, 15/07/98, version initiale C HISTORIQUE : v1, 15/07/98, création C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC PPARAM -INC CCOPTIO C-INC SMMATRAKANC C************************************************************************* C C REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES puis assemblees C * LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange * (points CENTRE ) pour chaque operateur de contrainte * KGEOC SPG pour la totalite des points CENTRE. * KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse) * KLEMC Connectivites de l'ensemble des contraintes * LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones SEGMENT MATRAK INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP) INTEGER LIZAFM(NBSOUS) INTEGER IKAM0 (NBSOUS) INTEGER IMEM (NBELC) INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC ENDSEGMENT SEGMENT IZAFM REAL*8 AM(NNELP,NP,IESP),RPGI(NELAX) ENDSEGMENT C************************************************************************* -INC SMMATRK1 -INC TMCOLAC SEGMENT IZA REAL*8 A(NBVA) ENDSEGMENT C INTEGER NDTAB INTEGER IEL,I INTEGER ILENA(7) C====================================================================== * * Executable statements * IRET=0 IRETOU=0 C ... BOUCLE SUR LES MATRAK DE LA PILE DO 1 IEL=1,IMAX1 C Restitution du chapeau MATRAK=0 C Dimensions NDTAB=3 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NBOP =ILENA(1) NBSOUS=ILENA(2) NBELC =ILENA(3) SEGINI MATRAK C Rigidités élémentaires NDTAB = NBOP CALL LFCDIE(IFRES,NDTAB,LGEOC,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB = NBOP CALL LFCDIE(IFRES,NDTAB,IDEBS,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB = NBOP CALL LFCDIE(IFRES,NDTAB,IFINS,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB = NBSOUS CALL LFCDIE(IFRES,NDTAB,LIZAFM,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB = NBSOUS CALL LFCDIE(IFRES,NDTAB,IKAM0,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB = NBELC CALL LFCDIE(IFRES,NDTAB,IMEM,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB = 7 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 KLEMC=ILENA( 1) KGEOS=ILENA( 2) KGEOC=ILENA( 3) KDIAG=ILENA( 4) KCAC =ILENA( 5) KIZCL=ILENA( 6) KIZGC=ILENA( 7) C Restitution des IZAFM DO 11 I=1,NBSOUS IZAFM=LIZAFM(I) IF (IZAFM.NE.0) THEN NDTAB=4 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NNELP=ILENA(1) NP =ILENA(2) IESP =ILENA(3) NELAX=ILENA(4) SEGINI IZAFM NDTAB=NNELP*NP*IESP CALL LFCDI2(IFRES,NDTAB,AM,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB=NELAX CALL LFCDI2(IFRES,NDTAB,RPGI,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 SEGDES IZAFM LIZAFM(I)=IZAFM ENDIF 11 CONTINUE C Restitution du IZL IF (KIZCL.NE.0) THEN C Dimensions NDTAB=4 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NJA =ILENA(1) NJAN=ILENA(2) NJAB=ILENA(3) SEGINI IZL KZA1=ILENA(4) C Contenu des tableaux NDTAB=NJA CALL LFCDIE(IFRES,NDTAB,KZA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB=NJAN CALL LFCDIE(IFRES,NDTAB,NUAN,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB=NJAN CALL LFCDIE(IFRES,NDTAB,NUNA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB=NJAN CALL LFCDIE(IFRES,NDTAB,IMEL,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB=NJAN CALL LFCDIE(IFRES,NDTAB,IMJ,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB=NJAB CALL LFCDI2(IFRES,NDTAB,B,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 C Restitution du IDMAT IF (KZA1.NE.0) THEN C Dimension NDTAB=2 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NBLK =ILENA(1) SEGINI IDMAT IDIAG=ILENA(2) NDTAB=NBLK CALL LFCDIE(IFRES,NDTAB,IDESCR,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NDTAB=NBLK+1 CALL LFCDIE(IFRES,NDTAB,NLDBLK,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 IF (IDIAG.NE.0) THEN NDTAB=1 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NBVA=ILENA(1) SEGINI IZA NDTAB=NBVA CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 SEGDES IZA IDIAG=IZA ENDIF C Restitution des IDBLK DO 211 INBLK=1,NBLK IDBLK=IDESCR(INBLK) IF (IDBLK.NE.0) THEN C Dimension NDTAB=3 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NLBLK=ILENA(1) SEGINI IDBLK IMAT =ILENA(2) ILON =ILENA(3) NDTAB=NLBLK+1 CALL LFCDIE(IFRES,NDTAB,IDEBLK,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 IF (IMAT.NE.0) THEN NDTAB=1 CALL LFCDIE(IFRES,NDTAB,ILENA,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 NBVA=ILENA(1) SEGINI IZA NDTAB=NBVA CALL LFCDI2(IFRES,NDTAB,A,IRETOU,IFORM) IF (IRETOU.NE.0) GOTO 9999 SEGDES IZA IMAT=IZA ENDIF SEGDES IDBLK IDESCR(INBLK)=IDBLK ENDIF 211 CONTINUE SEGDES IDMAT KZA1=IDMAT ENDIF SEGDES IZL KIZCL=IZL ENDIF SEGDES MATRAK ITLAC(**)=MATRAK 1 CONTINUE * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE WRITE(IOIMP,*) 'An error was detected in subroutine limtak' IRET=1 RETURN * * End of subroutine LIMTAK * END