C RELR1A SOURCE GOUNAND 11/05/24 21:15:58 6976 SUBROUTINE RELR1A(MINCD,KRSPGD,KRINCD, $ MEL,DES, $ DDDNUL, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : RELR1A C DESCRIPTION : * construction de la correspondance : * ieme ddl dual de la matrice assemblée <-> * (numéro d'élément, numéro ddl dual local) * de la rigidité dans lesquels il apparait C C C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELES (E/S) : C APPELES (BLAS) : C APPELES (CALCUL) : C APPELE PAR : RELR14 C*********************************************************************** C SYNTAXE GIBIANE : C ENTREES : C ENTREES/SORTIES : C SORTIES : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 30/06/2003, version initiale C HISTORIQUE : v1, 30/06/2003, 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 -INC SMRIGID POINTEUR DES.DESCR -INC SMELEME POINTEUR MEL.MELEME * Includes persos CBEGININCLUDE SMMINC SEGMENT MINC INTEGER NPOS(NPT+1) INTEGER MPOS(NPT,NBI+1) ENDSEGMENT SEGMENT IMINC INTEGER LNUPO (NDDL) INTEGER LNUINC(NDDL) ENDSEGMENT CENDINCLUDE SMMINC POINTEUR MINCD.MINC * Segment LSTIND (liste séquentielle indexée) SEGMENT LSTIND INTEGER IDX(NBM+1) INTEGER IELRIG(NBTVAL) INTEGER ILIGR (NBTVAL) ENDSEGMENT POINTEUR DDDNUL.LSTIND * -INC SMLENTI POINTEUR KRSPGD.MLENTI POINTEUR KRINCD.MLENTI POINTEUR DDDNOL.MLENTI POINTEUR DDDIUL.MLENTI * INTEGER IMPR,IRET * * Executable statements * IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans relr1a.eso' NPODUA=MINCD.NPOS(/1)-1 NDDLDU=MINCD.NPOS(NPODUA+1)-1 NEL=MEL.NUM(/2) NDDLOD=DES.NOELED(/1) * * Passe 1 : construction de la correspondance : * ieme ddl dual <-> nombre de fois qu'il * apparait dans MEL * DDDNOL * JG=NDDLDU SEGINI DDDNOL DO IEL=1,NEL DO IDDLOD=1,NDDLOD IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL)) IINC=KRINCD.LECT(IDDLOD) IPOS=MINCD.MPOS(IPO,IINC) IF (IPOS.EQ.0) THEN WRITE(IOIMP,*) 'Erreur grave no1' GOTO 9999 ENDIF IDDLDU=MINCD.NPOS(IPO)+IPOS-1 DDDNOL.LECT(IDDLDU)=DDDNOL.LECT(IDDLDU)+1 ENDDO ENDDO * * Passe 2 : construction de la correspondance : * ieme ddl dual <-> (numéro d'élément de MEL) * DDDNUL JG=NDDLDU SEGINI DDDIUL IDEPA=1 DO IDDLDU=1,NDDLDU DDDIUL.LECT(IDDLDU)=IDEPA IDEPA=IDEPA+DDDNOL.LECT(IDDLDU) ENDDO SEGSUP DDDNOL NBM=NDDLDU NBTVAL=IDEPA-1 SEGINI DDDNUL DO IDDLDU=1,NDDLDU DDDNUL.IDX(IDDLDU)=DDDIUL.LECT(IDDLDU) ENDDO DDDNUL.IDX(NDDLDU+1)=IDEPA DO IEL=1,NEL DO IDDLOD=1,NDDLOD IPO=KRSPGD.LECT(MEL.NUM(DES.NOELED(IDDLOD),IEL)) IINC=KRINCD.LECT(IDDLOD) IPOS=MINCD.MPOS(IPO,IINC) IF (IPOS.EQ.0) THEN WRITE(IOIMP,*) 'Erreur grave no2' GOTO 9999 ENDIF IDDLDU=MINCD.NPOS(IPO)+IPOS-1 IDXCOU=DDDIUL.LECT(IDDLDU) DDDNUL.IELRIG(IDXCOU)=IEL DDDNUL.ILIGR (IDXCOU)=IDDLOD DDDIUL.LECT(IDDLDU)=IDXCOU+1 ENDDO ENDDO SEGSUP DDDIUL SEGDES DDDNUL * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine relr1a' RETURN * * End of subroutine RELR1A * END