1 : C PROFI2 SOURCE MAGN 09/07/30 21:20:44 6458 2 : SUBROUTINE PROFI2(PROMOR, 3 : $ VALPRO, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : PROFI2 9 : C DESCRIPTION : Valeur du profil d'un profil Morse (non ordonné). 10 : C 11 : C LANGAGE : ESOPE 12 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 13 : C mél : gounand@semt2.smts.cea.fr 14 : C*********************************************************************** 15 : C APPELE PAR : PRASEM 16 : C*********************************************************************** 17 : C ENTREES : PROMOR 18 : C SORTIES : VALPRO 19 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 20 : C*********************************************************************** 21 : C VERSION : v1, 08/11/99, version initiale 22 : C HISTORIQUE : v1, 08/11/99, création 23 : C HISTORIQUE : 24 : C HISTORIQUE : 25 : C*********************************************************************** 26 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 27 : C en cas de modification de ce sous-programme afin de faciliter 28 : C la maintenance ! 29 : C*********************************************************************** 30 : -INC CCOPTIO 31 : -INC SMMATRIK 32 : POINTEUR PROMOR.PMORS 33 : INTEGER IMPR,IRET 34 : INTEGER VALPRO,VALMIN,I,J,JSTRT,JSTOP 35 : * 36 : * Executable statements 37 : * 38 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans profi2' 39 : * 40 : VALPRO=0 41 : SEGACT PROMOR 42 : DO 20 I=1,PROMOR.IA(/1)-1 43 : JSTRT=PROMOR.IA(I) 44 : JSTOP=PROMOR.IA(I+1)-1 45 : VALMIN=PROMOR.JA(JSTRT) 46 : * 47 : * Find lowest numbered neighbour of node I 48 : * 49 : DO 10 J=JSTRT+1,JSTOP 50 : VALMIN=MIN(VALMIN,PROMOR.JA(J)) 51 : 10 CONTINUE 52 : * 53 : * Update profiles 54 : * 55 : VALPRO=VALPRO+DIM(I,VALMIN) 56 : 20 CONTINUE 57 : * 58 : * Add diagonal terms to profiles 59 : * 60 : VALPRO=VALPRO+PROMOR.IA(/1)-1 61 : SEGDES PROMOR 62 : * 63 : * Normal termination 64 : * 65 : IRET=0 66 : RETURN 67 : * 68 : * Format handling 69 : * 70 : * 71 : * Error handling 72 : * 73 : 9999 CONTINUE 74 : IRET=1 75 : WRITE(IOIMP,*) 'An error was detected in subroutine profi2' 76 : RETURN 77 : * 78 : * End of subroutine PROFI2 79 : * 80 : END 81 : 82 : 83 : 84 :
© Cast3M 2003 - All rights reserved.
Disclaimer