C PROFI2 SOURCE PV 20/09/26 21:19:36 10724 SUBROUTINE PROFI2(PROMOR, $ VALPRO, $ IMPR,IRET) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C*********************************************************************** C NOM : PROFI2 C DESCRIPTION : Valeur du profil d'un profil Morse (non ordonné). C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELE PAR : PRASEM C*********************************************************************** C ENTREES : PROMOR C SORTIES : VALPRO C CODE RETOUR (IRET) : = 0 si tout s'est bien passé C*********************************************************************** C VERSION : v1, 08/11/99, version initiale C HISTORIQUE : v1, 08/11/99, 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 SMMATRIK POINTEUR PROMOR.PMORS INTEGER IMPR,IRET INTEGER VALPRO,VALMIN,I,J,JSTRT,JSTOP * * Executable statements * IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans profi2' * VALPRO=0 SEGACT PROMOR DO 20 I=1,PROMOR.IA(/1)-1 JSTRT=PROMOR.IA(I) JSTOP=PROMOR.IA(I+1)-1 VALMIN=PROMOR.JA(JSTRT) * * Find lowest numbered neighbour of node I * DO 10 J=JSTRT+1,JSTOP VALMIN=MIN(VALMIN,PROMOR.JA(J)) 10 CONTINUE * * Update profiles * VALPRO=VALPRO+DIM(I,VALMIN) 20 CONTINUE * * Add diagonal terms to profiles * VALPRO=VALPRO+PROMOR.IA(/1)-1 SEGDES PROMOR * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine profi2' RETURN * * End of subroutine PROFI2 * END