Download chmids.eso

Back to the list

   1 : C CHMIDS    SOURCE    CHAT      05/01/12    21:59:10     5004           
   2 :       SUBROUTINE CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,
   3 :      * MLDECY,MLNAME,MLIONZ,IDSCHI,MLNESP)
   4 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   5 : C
   6 : C               OPERATEUR CHI2
   7 : C    ON CHARGE LE SEGMENT IDSCHI
   8 : C    TOUS LES SEGMENTS SONT ACTIFS AVANT L APPEL
   9 : C
  10 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  11 :       IMPLICIT INTEGER(I-N)
  12 :       IMPLICIT REAL*8(A-H,O-Z)
  13 : -INC CCOPTIO
  14 : -INC SMLENTI
  15 : -INC SMLREEL
  16 : -INC SMLMOTS
  17 :       SEGMENT IDSCHI
  18 :            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  19 :            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  20 :            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  21 :            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  22 :       ENDSEGMENT
  23 : C
  24 :       MLREEL=MLAA
  25 :       JG=PROG(/1)
  25 :       CALL RSETD(AA,PROG,JG)
  26 :       MLREEL=MLFF
  27 :       JG=PROG(/1)
  27 :       CALL RSETD(FF,PROG,JG)
  28 :       MLENTI=MLIDX
  29 :       NXDIM=LECT(/1)
  29 :       CALL RSETI(IDX,LECT,NXDIM)
  30 :       MLENTI=MLIDY
  31 :       NYDIM=LECT(/1)
  31 :       CALL RSETI(IDY,LECT,NYDIM)
  32 :       MLENTI=MLIDZ
  33 :       NZDIM=LECT(/1)
  33 :       CALL RSETI(IDZ,LECT,NZDIM)
  34 :       MLENTI=MLIDP
  35 :       NPDIM=LECT(/1)
  35 :       CALL RSETI(IDP,LECT,NPDIM)
  36 :       MLREEL=MLOGK
  36 :       CALL RSETD(GK,PROG,NYDIM)
  37 :       MLENTI=MLNN
  37 :       CALL RSETI(NN,LECT,6)
  38 :       MLENTI=MLDECY
  38 :       CALL RSETI(IDECY,LECT,NYDIM)
  39 :       MLENTI=MLIONZ
  39 :       CALL RSETI(IONZ,LECT,NXDIM)
  40 :       MLMOTS=MLNAME
  41 :       DO 50 I=1,NXDIM
  42 :           NAME(I)=MOTS(I)
  43 :    50 CONTINUE
  44 :       MLMOTS=MLNESP
  45 :       DO 60 I=1,NYDIM
  46 :           NAMESP(I)=MOTS(I)
  47 :    60 CONTINUE
  48 : CCCCC
  49 : c      WRITE(6,*)'FIN CHMIDS.ESO'
  50 : c      WRITE(6,*)'IDX',(IDX(J),J=1,NXDIM)
  51 : c      write(6,*)'IDY',(IDY(i),i=1,nydim)
  52 : c      write(6,*)'IDZ',(idz(k),k=1,nzdim)
  53 : c      write(6,*)'IDP',(idp(n),n=1,npdim)
  54 : c      DO 60 I=1,NYDIM
  55 : c        WRITE(6,*)'IDY',IDY(I),'AA',(AA(I,J),J=1,NXDIM)
  56 : c   60 CONTINUE
  57 : c      DO 70 K=1,NZDIM
  58 : c        WRITE(6,*)'IDZ',IDZ(K),'FF',(FF(K,I),I=1,NPDIM)
  59 : c   70 CONTINUE 
  60 : CCCCC
  61 :       RETURN
  62 :       END
  63 :  
  64 :  
  65 :  
  66 :  

© Cast3M 2003 - All rights reserved.
Disclaimer