1 : C CHITR1 SOURCE CHAT 05/01/12 21:58:31 5004 2 : SUBROUTINE CHITR1(IDSCHI,IZIADR,IADH,LBDD) 3 : C ------------------------------------------------------------------ 4 : C 5 : C SP ISSU DE TRICHI DANS TRIOEF 6 : C APPELE PAR CHIMI1 7 : C ON CLASSE DANS IADR LES IDENTIFICATEURS DES ESPECES DE TYPE 3 8 : C 9 : C ------------------------------------------------------------------ 10 : 11 : 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8 (A-H,O-Z) 14 : 15 : SEGMENT IDSCHI 16 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 17 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 18 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 19 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 20 : ENDSEGMENT 21 : SEGMENT IZIADR 22 : INTEGER IADR(NCR) 23 : ENDSEGMENT 24 : 25 : NXDIM=IDX(/1) 26 : NYDIM=IDY(/1) 27 : NZDIM=IDZ(/1) 28 : NPDIM=IDP(/1) 29 : 30 : NCR=NN(3) 31 : IADH=0 32 : IZIADR=0 33 : IF(NCR.NE.0)THEN 34 : SEGINI IZIADR 35 : 36 : IADH=0 37 : IJ = 0 38 : IL = NN(1)+NN(2)+1 39 : IK = NN(1)+NN(2)+NN(3) 40 : IF(LBDD.EQ.0) THEN 41 : DO 20 II = IL , IK 42 : IJ = II-IL+1 43 : IADR(IJ)=IDY(II) 44 : 20 CONTINUE 45 : ELSEIF(LBDD.EQ.1) THEN 46 : 47 : DO 30 II = IL , IK 48 : CBRUNO 49 : IF(IDY(II).NE.2122) THEN 50 : IJ = IJ + 1 51 : IADR(IJ)=IDY(II) 52 : ELSE 53 : IADH=IDY(II) 54 : ENDIF 55 : 30 CONTINUE 56 : IF(IJ.NE.0)THEN 57 : NCR=IJ 58 : SEGADJ IZIADR 59 : ELSE 60 : SEGSUP IZIADR 61 : IZIADR=0 62 : ENDIF 63 : ENDIF 64 : 65 : CBRUNO 66 : * 67 : ENDIF 68 : RETURN 69 : 50 FORMAT(8(I10)) 70 : 51 FORMAT(10(1X,1PE12.5)) 71 : 72 : END 73 : 74 : 75 : 76 : 77 : 78 :
© Cast3M 2003 - All rights reserved.
Disclaimer