Download wrconf.eso

Back to the list

   1 : C WRCONF    SOURCE    CHAT      10/06/30    21:15:32     6706           
   2 :       SUBROUTINE WRCONF (IOSAU,ITLACC,IMAX1,IFORM,IDEB,IDIM,MCOORD)
   3 : C     $ , IONIVE,ICOLAC)
   4 :       IMPLICIT INTEGER(I-N)
   5 :       IMPLICIT REAL*8(A-H,O-Z)
   6 : C=======================================================================
   7 : C
   8 : C        ECRITURE DES CONFIGURATIONS
   9 : C
  10 : C    APPELLE PAR  :  WRPIL
  11 : C
  12 : -INC SMCOORD
  13 : -INC TMCOLAC
  14 :        POINTEUR MCOOR1.MCOORD,MCOOR2.MCOORD,MCOOR3.MCOORD
  15 :        DIMENSION ILENA(4)
  16 :        SEGMENT ICPR(NBPTS*(IDIM+1))
  17 : C       IF(IONIVE.GT.9) THEN
  18 : C       ITLAC1=KCOLA(32)
  19 : C       SEGACT ITLAC1
  20 : C       IMA= ITLAC1.ITLAC(/1)
  21 : C       write(6,*) ' ima ' , ima
  22 : C       MCINI = MCOORD
  23 :        IDIM1=IDIM+1  
  24 : C       NBPTS=XCOOR(/1)/IDIM1
  25 : C       SEGINI ICPR    
  26 : C       DO 10 K=1,IMA
  27 : C       ICPR(ITLAC1.ITLAC(K))=K 
  28 : C   10  CONTINUE   
  29 : C       ENDIF
  30 :         MCINI = MCOORD
  31 :        DO 1 IEL=IDEB,IMAX1
  32 :        MCOOR1=ITLAC(IEL)
  33 : *       write(6,*) ' wrconf iel mcoor1 ' , iel, mcoor1
  34 :        IF(MCOOR1.EQ.0) THEN
  35 :          ilong=0
  36 :          ILENA(1)=ILONG
  37 :          itoto=1
  37 :          CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
  38 :        else
  39 :        SEGACT MCOOR1
  40 :        NBPTS=MCOOR1.XCOOR(/1)/IDIM1
  41 : C       IF(IONIVE.GT.9) THEN
  42 : C       SEGINI MCOOR2
  43 : C       DO 2 K=1,IMA
  44 : C       IA = (ICPR(K)-1)*IDIM1
  45 : C       KI=(K-1)*IDIM1
  46 : C       DO 3 KO = 1,IDIM1
  47 : C       MCOOR2.XCOOR(KI+KO)=MCOOR1.XCOOR(KO+IA)
  48 : C   3   CONTINUE
  49 : C   2   CONTINUE
  50 : C       ILONG=IMA*IDIM1
  51 : C       ELSE
  52 :        ILONG=MCOOR1.XCOOR(/1)
  53 : C       ENDIF
  54 :        ILENA(1)=ILONG
  55 :        ITOTO=1
  56 : C       MCOOR3=MCOOR1
  57 : C       IF(IONIVE.GT.9) MCOOR3=MCOOR2
  57 :        CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
  57 :        CALL ECDIFR( IOSAU,ILONG,MCOOR1.XCOOR(1),IFORM)
  58 : C       IF(IONIVE.GT.9) SEGSUP MCOOR2
  59 :        SEGDES MCOOR1
  60 :        endif
  61 :    1   CONTINUE
  62 :        MCOORD=MCINI
  63 :        SEGACT MCOORD*MOD 
  64 :        RETURN
  65 :        END
  66 :  
  67 :  
  68 :  
  69 :  
  70 :  
  71 :  
  72 :  
  73 :  

© Cast3M 2003 - All rights reserved.
Disclaimer