1 : C INCCOM SOURCE GOUNAND 12/12/06 21:15:10 7593 2 : SUBROUTINE INCCOM(ICPRIB,ICPRIC,ICPRID,NIUNIQ, 3 : $ ICOPRI, 4 : $ IMPR,IRET) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : C*********************************************************************** 8 : C NOM : INCCOM 9 : C DESCRIPTION : Construction de ICOPRI (LISTENTI), liste des inconnues 10 : C appartenant à la fois à ICPRIB,ICPRIC et ICPRID 11 : C 12 : C 13 : C 14 : C LANGAGE : ESOPE 15 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 16 : C mél : gounand@semt2.smts.cea.fr 17 : C*********************************************************************** 18 : C APPELE PAR : PROMAT 19 : C*********************************************************************** 20 : C ENTREES : ICPRIB, ICPRIC, ICPRID, NIUNIQ 21 : C SORTIES : ICOPRI 22 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 23 : C*********************************************************************** 24 : C VERSION : v1, 31/01/2000, version initiale 25 : C HISTORIQUE : v1, 31/01/2000, création 26 : C HISTORIQUE : 27 : C HISTORIQUE : 28 : C*********************************************************************** 29 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 30 : C en cas de modification de ce sous-programme afin de faciliter 31 : C la maintenance ! 32 : C*********************************************************************** 33 : -INC CCOPTIO 34 : -INC SMLENTI 35 : INTEGER JG 36 : POINTEUR ICPRIB.MLENTI 37 : POINTEUR ICPRIC.MLENTI 38 : POINTEUR ICPRID.MLENTI 39 : POINTEUR ICOPRI.MLENTI 40 : POINTEUR MLEWRK.MLENTI 41 : * POINTEUR KRPRI.MLENTI 42 : SEGMENT KRPRI 43 : LOGICAL LPRI(NINCO,NSEG) 44 : ENDSEGMENT 45 : * Liste de MLENTI 46 : INTEGER NBMLEN 47 : SEGMENT MLENTS 48 : POINTEUR LISMLE(NBMLEN).MLENTI 49 : ENDSEGMENT 50 : POINTEUR GPMLES.MLENTS 51 : * 52 : INTEGER IMPR,IRET 53 : LOGICAL LTEST 54 : * 55 : INTEGER IBMLEN,IGWRK,IIUNIQ 56 : INTEGER NGWRK,NIUNIQ 57 : INTEGER NUPRI,NBPRI 58 : * 59 : * Executable statements 60 : * 61 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans inccom.eso' 62 : * Initialisation de la liste de MLENTI (ici, il y en a trois) 63 : NBMLEN=2 64 : IF (ICPRID.NE.0) THEN 65 : NBMLEN=NBMLEN+1 66 : ENDIF 67 : SEGINI GPMLES 68 : GPMLES.LISMLE(1)=ICPRIB 69 : GPMLES.LISMLE(2)=ICPRIC 70 : IF (ICPRID.NE.0) THEN 71 : GPMLES.LISMLE(3)=ICPRID 72 : ENDIF 73 : * NIUNIQ est la dimension de l'espace des noms d'inconnues 74 : * JG=NIUNIQ 75 : * SEGINI KRPRI 76 : NINCO=NIUNIQ 77 : NSEG=NBMLEN 78 : SEGINI KRPRI 79 : DO 2 IBMLEN=1,NBMLEN 80 : MLEWRK=GPMLES.LISMLE(IBMLEN) 81 : SEGACT MLEWRK 82 : NGWRK=MLEWRK.LECT(/1) 83 : DO 22 IGWRK=1,NGWRK 84 : NUPRI=MLEWRK.LECT(IGWRK) 85 : * KRPRI.LECT(NUPRI)=KRPRI.LECT(NUPRI)+1 86 : KRPRI.LPRI(NUPRI,IBMLEN)=.TRUE. 87 : 22 CONTINUE 88 : SEGDES MLEWRK 89 : 2 CONTINUE 90 : SEGSUP GPMLES 91 : JG=0 92 : SEGINI ICOPRI 93 : DO 3 IIUNIQ=1,NIUNIQ 94 : LTEST=.TRUE. 95 : DO ISEG=1,NSEG 96 : LTEST=LTEST.AND.KRPRI.LPRI(IIUNIQ,ISEG) 97 : ENDDO 98 : * NBPRI=KRPRI.LECT(IIUNIQ) 99 : * IF (NBPRI.EQ.NBMLEN) THEN 100 : IF (LTEST) ICOPRI.LECT(**)=IIUNIQ 101 : * ENDIF 102 : 3 CONTINUE 103 : SEGDES ICOPRI 104 : SEGSUP KRPRI 105 : * 106 : * Normal termination 107 : * 108 : IRET=0 109 : RETURN 110 : * 111 : * Format handling 112 : * 113 : * 114 : * Error handling 115 : * 116 : 9999 CONTINUE 117 : IRET=1 118 : WRITE(IOIMP,*) 'An error was detected in subroutine inccom' 119 : RETURN 120 : * 121 : * End of subroutine INCCOM 122 : * 123 : END 124 : 125 : 126 : 127 : 128 :
© Cast3M 2003 - All rights reserved.
Disclaimer