Télécharger la plaquette Cast3M


fr en

Télécharger wrconf.eso

Retour à la liste

Numérotation des lignes : 

wrconf

  1. C WRCONF    SOURCE    PV        20/04/01    21:17:06     10569          
  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.        IDIM1=IDIM+1
  23. C       SEGINI ICPR
  24. C       DO 10 K=1,IMA
  25. C       ICPR(ITLAC1.ITLAC(K))=K
  26. C   10  CONTINUE
  27. C       ENDIF
  28.         MCINI = MCOORD
  29.        DO 1 IEL=IDEB,IMAX1
  30.        MCOOR1=ITLAC(IEL)
  31. *       write(6,*) ' wrconf iel mcoor1 ' , iel, mcoor1
  32.        IF(MCOOR1.EQ.0) THEN
  33.          ilong=0
  34.          ILENA(1)=ILONG
  35.          itoto=1
  36.          CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
  37.        else
  38.        SEGACT MCOOR1
  39.        NBPTS=MCOOR1.XCOOR(/1)/IDIM1
  40. C       IF(IONIVE.GT.9) THEN
  41. C       SEGINI MCOOR2
  42. C       DO 2 K=1,IMA
  43. C       IA = (ICPR(K)-1)*IDIM1
  44. C       KI=(K-1)*IDIM1
  45. C       DO 3 KO = 1,IDIM1
  46. C       MCOOR2.XCOOR(KI+KO)=MCOOR1.XCOOR(KO+IA)
  47. C   3   CONTINUE
  48. C   2   CONTINUE
  49. C       ILONG=IMA*IDIM1
  50. C       ELSE
  51.        ILONG=MCOOR1.XCOOR(/1)
  52. C       ENDIF
  53.        ILENA(1)=ILONG
  54.        ITOTO=1
  55. C       MCOOR3=MCOOR1
  56. C       IF(IONIVE.GT.9) MCOOR3=MCOOR2
  57.        CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
  58.        CALL ECDIFR( IOSAU,ILONG,MCOOR1.XCOOR(1),IFORM)
  59. C       IF(IONIVE.GT.9) SEGSUP MCOOR2
  60.        SEGDES MCOOR1
  61.        endif
  62.    1   CONTINUE
  63.        MCOORD=MCINI
  64.        SEGACT MCOORD*MOD
  65.        nbpts=xcoor(/1)/idim1
  66.        RETURN
  67.        END
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales