Download chmchl.eso

Back to the list

   1 : C CHMCHL    SOURCE    CHAT      05/01/12    21:58:41     5004           
   2 :       SUBROUTINE CHMCHL(IDSCHI,SP2,IZTR,PE)
   3 : C
   4 : C         Issu de TRIOEF (TRCHEL)
   5 : C
   6 :       IMPLICIT INTEGER(I-N)
   7 :       IMPLICIT REAL*8 (A-H,O-Z)
   8 :       SEGMENT IDSCHI
   9 :            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  10 :            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  11 :            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  12 :            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  13 :       ENDSEGMENT
  14 :       SEGMENT SP2
  15 :            REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM)
  16 :            REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM)
  17 :            REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM)
  18 :       ENDSEGMENT
  19 :       SEGMENT IZTR
  20 :         REAL*8 A0(NXDIM)
  21 :       ENDSEGMENT
  22 :       NXDIM=IDX(/1)
  23 :       NYDIM=IDY(/1)
  24 :       NZDIM=IDZ(/1)
  25 :       NPDIM=IDP(/1)
  25 :       CALL CHIADY(IDY,NYDIM,99,IDY1)
  26 :       NN6=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
  27 :       N5F=NN6-1
  28 : 
  29 : C      SEGINI IZTR
  30 :       C0=CC(IDY1)
  31 :       GC0=GC(IDY1)
  32 :       IDYC0=IDECY(IDY1)
  33 :       DO KJ=1,NXDIM
  34 :         A0(KJ) = AA(IDY1,KJ)
  35 :       ENDDO
  36 : 
  37 :       DO I=IDY1,N5F
  38 :          IDY(I)=IDY(I+1)
  39 :          CC(I)=CC(I+1)
  40 :          GC(I)=GC(I+1)
  41 :          GK(I)=GK(I+1)
  42 :          IDECY(I)=IDECY(I+1)
  43 :          DO KJ=1,NXDIM
  44 :             AA(I,KJ)=AA(I+1,KJ)
  45 :          ENDDO
  46 :       ENDDO
  47 :       IDY(NN6)= 99
  48 :       CC(NN6)  = 10.D0**(-PE)
  49 :       GC(NN6) = -PE
  50 :       GK(NN6) =0.D0
  51 :       IDECY(NN6)=IDYC0
  52 :       DO KJ=1,NXDIM
  53 :         AA(NN6,KJ)=A0(KJ)
  54 :       ENDDO
  55 :       NN(3)=NN(3)-1
  56 :       NN(6)=NN(6)+1
  57 : C      SEGSUP IZTR
  58 : 
  59 :       RETURN
  60 :       END
  61 :  
  62 :  
  63 :  
  64 :  

© Cast3M 2003 - All rights reserved.
Disclaimer