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    PV090527  25/02/28    21:15:07     12169          
  2.       SUBROUTINE WRCONF (IOSAUX,ITLACC,IMAX1,IFORM,IDEB,IDIMX,MCOORX)
  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. -INC PPARAM  
  15. -INC CCOPTIO 
  16.        DIMENSION ILENA(4)
  17.        SEGMENT ICPR(NBPTS*(IDIM+1))
  18. C       IF(IONIVE.GT.9) THEN
  19. C       ITLAC1=KCOLA(32)
  20. C       SEGACT ITLAC1
  21. C       IMA= ITLAC1.ITLAC(/1)
  22. C       write(6,*) ' ima ' , ima
  23.        IDIM1=IDIM+1
  24. C       SEGINI ICPR
  25. C       DO 10 K=1,IMA
  26. C       ICPR(ITLAC1.ITLAC(K))=K
  27. C   10  CONTINUE
  28. C       ENDIF
  29.         MCINI = MCOORD
  30.         MCOORD = MCOORX
  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
  38.          CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
  39.        else
  40.        SEGACT MCOOR1
  41.        NBPTS=MCOOR1.XCOOR(/1)/IDIM1
  42. C       IF(IONIVE.GT.9) THEN
  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   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.        CALL ECDIFE( IOSAU,ITOTO,ILENA,IFORM)
  56.        CALL ECDIFR( IOSAU,ILONG,MCOOR1.XCOOR(1),IFORM)
  57.        if (ionive.gt.26) then
  58.         mrota1=mcoor1.mrota
  59. *       write(6,*) 'mrota dans wrconf ',mrota1
  60.         if(mrota1.ne.0) then
  61.          segact mrota1
  62.          idimr=mrota1.xrota(/1)
  63.          segadj mrota1
  64.          ilena(1)=idimr
  65.          ilena(2)=nbpts
  66.          CALL ECDIFE( IOSAU,2,ILENA,IFORM)
  67.          ilong=idimr*nbpts
  68.          CALL ECDIFR( IOSAU,ILONG,Mrota1.xrota,IFORM)
  69.         else
  70.          ilena(1)=0
  71.          ilena(2)=0
  72.          CALL ECDIFE( IOSAU,2,ILENA,IFORM)
  73.         endif
  74.        endif
  75.        SEGDES MCOOR1
  76.        endif
  77.  
  78.  
  79.    1   CONTINUE
  80.        MCOORD=MCINI
  81.        SEGACT MCOORD*MOD
  82.        nbpts=xcoor(/1)/idim1
  83.        RETURN
  84.        END
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  
  100.  

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