Télécharger la plaquette Cast3M


fr en

Télécharger resour.eso

Retour à la liste

Numérotation des lignes : 

resour

  1. C RESOUR    SOURCE    MB234859  25/01/03    21:15:27     12105          
  2.       SUBROUTINE RESOUR(idemem,ideme0,ideme1,mrigid,if,ipt8,
  3.      >   isouci,iverif)
  4. C----------------------------------------------------------------------
  5. C Subroutine dont le role est de reconstruire la solution complete en
  6. C reintroduisant les inconnues eliminees.
  7. C
  8. C Entrees :
  9. C ---------
  10. C  idemem : tableau contenant le(s) second(s) membre(s) apres la 
  11. C           passe d'elimiation if
  12. C  ideme0 : tableau contenant pour le(s) second(s) membre(s) les
  13. C           valeurs des secondes membres a la passe d'elimination if
  14. C  ideme1 : tableau contenant pour le(s) second(s) membre(s) les
  15. C           valeurs de chaque condition eliminee a la passe d'elimination if
  16. C  mrigid : pointeur sur la rigidite totale
  17. C      if : passe d'elimination
  18. C  iverif : vaut 1 si verification de la solution. 
  19. C           Pas de verification si option noid car on n'a pas ku=f 
  20. C
  21. C Sortie  :
  22. C ---------
  23. C  idemem : tableau contenant le(s) solution(s) obtenue(s)
  24. C
  25. C----------------------------------------------------------------------
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8 (A-H,O-Z)
  28. C
  29. -INC SMRIGID
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMCHPOI
  33. -INC SMELEME
  34. C
  35.       SEGMENT IDEMEM(0)
  36.       segment ideme0(idemem(/1),30)
  37.       segment ideme1(idemem(/1),30)
  38. C
  39.       SEGACT IDEMEM*mod
  40.       N=IDEMEM(/1)
  41.       segact mrigid
  42.       lagdua=imlag
  43.       ri6=jrdepp
  44.       ri2=jrgard
  45.       ri1=jrelim
  46. C     -----------------------------------------------------------------
  47. C     Traitement de(s) second(s) membre(s)
  48.       DO 3 I=1,N
  49.         mchpoi=idemem(i)
  50. C
  51. C       Reintroduction des inconnues supprimees
  52.         call mucpri(mchpoi,ri6,ichp3)
  53.         call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
  54.         mchpo1=ideme1(I,if)
  55.         call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
  56.         call dtchpo(mchpoi)
  57.         call dtchpo(ichp3)
  58.         call dtchpo(ichp2)
  59.         mchpo1=iret
  60. C
  61. C       Calcul de KU
  62.         call mucpri(mchpo1,ri2,ichp5)
  63. C
  64. C       Calcul de KU - F
  65.         ichp6= ideme0(I,if)
  66.         call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
  67. C
  68. C       Ajout des valeurs des multiplicateurs des conditions eliminees
  69.         call remplx(ri1,iret,ichp7)
  70. C
  71. C       Verifier qu'on a bien l'equilibre
  72.         if (if.eq.1.and.iverif.eq.1) then
  73. C
  74. C         separer les conditions aux limites pour etablir la reference sans condition aux limites
  75.           segact ri2
  76.           nrigel=ri2.irigel(/2)
  77. **        write(6,*) ' nrigel dans resour ',nrigel
  78.           segini ri3
  79.           ri3.mtymat = ri2.mtymat
  80.           ri3.iforig = ri2.iforig
  81.           irn=0
  82.           do ir=1,nrigel
  83.             meleme=ri2.irigel(1,ir)
  84.             segact meleme
  85.             if(itypel.eq.49) then
  86.               irn=irn+1
  87.               ri3.coerig(irn)=ri2.coerig(ir)
  88.               do ii=1,ri2.irigel(/1)
  89.                ri3.irigel(ii,irn)=ri2.irigel(ii,ir)
  90.               enddo
  91.             endif
  92.           enddo
  93. ***       call prrigi(ri2,0)
  94.           nrigel=irn
  95. ***       write(6,*) ' irn dans resour ',irn
  96.           segadj ri3
  97.           call mucpri(mchpo1,ri3,ichp8)
  98.           segsup ri3
  99.           if (ierr.ne.0) return
  100. C
  101.           call mucpri(ichp7,ri1,ichp3)
  102.           if (ierr.ne.0) return
  103.           call adchpo(iret,ichp3,ichp4,1D0,1D0)
  104.           call dtchpo(iret)
  105. **        write(6,*) 'ichp5 ichp6 ichp8 ichp4 ',ichp5,ichp6,ichp8,ichp4
  106. **        call vechpo(ichp5,ichp6,ichp8,ichp4,ipt8,isouci)
  107.           call dtchpo(ichp3)
  108.           call dtchpo(ichp4)
  109.           call dtchpo(ichp8)
  110.         endif
  111. C
  112.         call dtchpo(ichp5)
  113. *       call dtchpo(ichp6)
  114.         if (ierr.ne.0) return
  115.  
  116. C       Les CHPOINTs qui sortent sont de nature diffuse
  117.         segact mchpo1*mod
  118.         mchpo1.jattri(1)=1
  119.         call fuchpo(ichp7,mchpo1,mchpoi)
  120.         if(ierr.ne.0) return
  121. C
  122. C       Suppression les multiplicateurs dedoubles
  123. **      write(6,*) ' appel a dbbcf lagdua ',lagdua
  124.         call dbbcf(mchpoi,lagdua)
  125. C
  126.         idemem(i)=mchpoi
  127.    3  CONTINUE
  128. C     -----------------------------------------------------------------
  129.       END
  130.  
  131.  

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