Download chitr1.eso

Back to the list

   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