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