1 : C DDL2PI SOURCE MAGN 09/07/30 21:16:29 6458 2 : SUBROUTINE DDL2PI(IDDL,MYMINC, 3 : $ IPT,IBI, 4 : $ IMPR,IRET) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : IMPLICIT INTEGER (I-N) 7 : C*********************************************************************** 8 : C NOM : DDL2PI 9 : C DESCRIPTION : numéro de ddl -> 10 : C (numéro de point, numéro d'inconnue) 11 : C 12 : C 13 : C 14 : C LANGAGE : ESOPE 15 : C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF) 16 : C mél : gounand@semt2.smts.cea.fr 17 : C*********************************************************************** 18 : C APPELES : 19 : C APPELES (E/S) : 20 : C APPELES (BLAS) : 21 : C APPELES (CALCUL) : 22 : C APPELE PAR : 23 : C*********************************************************************** 24 : C SYNTAXE GIBIANE : 25 : C ENTREES : 26 : C ENTREES/SORTIES : 27 : C SORTIES : 28 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 29 : C*********************************************************************** 30 : C VERSION : v1, 24/05/2004, version initiale 31 : C HISTORIQUE : v1, 24/05/2004, création 32 : C HISTORIQUE : 33 : C HISTORIQUE : 34 : C*********************************************************************** 35 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 36 : C en cas de modification de ce sous-programme afin de faciliter 37 : C la maintenance ! 38 : C*********************************************************************** 39 : -INC CCOPTIO 40 : -INC SMMATRIK 41 : POINTEUR MYMINC.MINC 42 : * 43 : INTEGER IMPR,IRET 44 : * 45 : * Executable statements 46 : * 47 : IF (IMPR.GT.5) WRITE(IOIMP,*) 'Entrée dans ddl2pi.eso' 48 : SEGACT MYMINC 49 : NPT=MYMINC.MPOS(/1) 50 : NBI=MYMINC.MPOS(/2)-1 51 : * Find IPT 52 : DO IPT=2,NPT+1 53 : IF (MYMINC.NPOS(IPT).GT.IDDL) GOTO 2 54 : ENDDO 55 : WRITE(IOIMP,*) 'Erreur grave 1' 56 : 2 CONTINUE 57 : IPT=IPT-1 58 : * Find IBI 59 : DO IBI=1,NBI 60 : IINC=MYMINC.MPOS(IPT,IBI) 61 : IF (IINC.NE.0) THEN 62 : IDDL2=MYMINC.NPOS(IPT)+IINC-1 63 : IF (IDDL2.EQ.IDDL) GOTO 3 64 : ENDIF 65 : ENDDO 66 : WRITE(IOIMP,*) 'Erreur grave 2' 67 : 3 CONTINUE 68 : * 69 : * Normal termination 70 : * 71 : IRET=0 72 : RETURN 73 : * 74 : * Format handling 75 : * 76 : * 77 : * Error handling 78 : * 79 : 9999 CONTINUE 80 : IRET=1 81 : WRITE(IOIMP,*) 'An error was detected in subroutine ddl2pi' 82 : RETURN 83 : * 84 : * End of subroutine DDL2PI 85 : * 86 : END 87 : 88 : 89 :
© Cast3M 2003 - All rights reserved.
Disclaimer