Télécharger la plaquette Cast3M


fr en

Télécharger rdscrm.eso

Retour à la liste

Numérotation des lignes : 

rdscrm

  1. C RDSCRM    SOURCE    MB234859  25/07/17    21:15:02     12328          
  2.       SUBROUTINE RDSCRM(MRIGID)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : RDSCRM
  7. C DESCRIPTION : Quelquefois, les points de IRIGEL(1,I) ne sont pas
  8. C     tous references par le segment DESCR (cas des QUAFs notamment).
  9. C     Dans ce cas, on fait une reduction du MELEME et on le stocke dans
  10. C     IRIGEL(2,I)
  11. C
  12. C
  13. C
  14. C LANGAGE     : ESOPE
  15. C AUTEUR      : Stephane GOUNAND (CEA/DES/ISAS/DM2S/SEMT/LTA)
  16. C               mel : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C VERSION    : v1, 08/11/2024, version initiale
  19. C HISTORIQUE : v1, 08/11/2024, creation
  20. C HISTORIQUE :
  21. C HISTORIQUE :
  22. C***********************************************************************
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMRIGID
  26. -INC SMELEME
  27.       SEGMENT ICNN(NBNN)
  28.       SEGMENT IBNN(NCNN)
  29. *
  30. * Executable statements
  31. *
  32.       SEGACT MRIGID*MOD
  33.       NNVA=IRIGEL(/2)
  34.       irmel=0
  35.       DO I=1,NNVA
  36.          ipt1=irigel(1,i)
  37.          segact ipt1
  38.          nbnn=ipt1.num(/1)
  39.          segini icnn
  40.          ncnn=0
  41.          descr=irigel(3,i)
  42.          segact descr
  43.          nligrp=noelep(/1)
  44.          nligrd=noeled(/1)
  45.          if ((nligrp.eq.0).or.(nligrd.eq.0)) then
  46.            nbnn=0
  47.            nbelem=0
  48.            nbref=0
  49.            nbsous=0
  50.            segini ipt2
  51.            goto 1
  52.          endif
  53.  
  54.          do iligrp=1,nligrp
  55.             if (icnn(noelep(iligrp)).eq.0) then
  56.                icnn(noelep(iligrp))=1
  57.                ncnn=ncnn+1
  58.             endif
  59.          enddo
  60.          if (irigel(7,i).ge.2) then
  61.             nligrd=noeled(/1)
  62.             do iligrd=1,nligrd
  63.                if (icnn(noeled(iligrd)).eq.0) then
  64.                   icnn(noeled(iligrd))=1
  65.                   ncnn=ncnn+1
  66.                endif
  67.             enddo
  68.          endif
  69.          if (ncnn.NE.nbnn) then
  70.             segini ibnn
  71.             ic=0
  72.             do ib=1,nbnn
  73.                if (icnn(ib).ne.0) then
  74.                   ic=ic+1
  75.                   ibnn(ic)=ib
  76.                endif
  77.             enddo
  78.             nbnn=ncnn
  79.             nbelem=ipt1.num(/2)
  80.             nbref=0
  81.             nbsous=0
  82.             segini ipt2
  83.             ipt2.itypel=28
  84.             do ibelem=1,nbelem
  85.                do ic=1,ncnn
  86.                   ipt2.num(ic,ibelem)=ipt1.num(ibnn(ic),ibelem)
  87.                enddo
  88.             enddo
  89.             segsup ibnn
  90.             irmel=irmel+1
  91.          else
  92.             ipt2=0
  93.          endif
  94.   1      continue
  95.          segsup icnn
  96.          IF (irigel(2,i).ne.0) then
  97.             moterr(1:8)='rdscrm'
  98.             call erreur(349)
  99.             return
  100.          ELSE
  101.             irigel(2,i)=ipt2
  102.          ENDIF
  103.       ENDDO
  104. *      segact mrigid*nomod
  105. *
  106. * Normal termination
  107. *
  108.       RETURN
  109. *
  110. * Format handling
  111. *
  112. *
  113. * Error handling
  114. *
  115. *
  116. * End of subroutine RDSCRM
  117. *
  118.       END
  119.  
  120.  
  121.  

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