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    CB215821  25/04/23    21:15:39     12247          
  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 SMCOORD
  31. -INC PPARAM
  32. -INC CCOPTIO
  33. -INC SMCHPOI
  34. -INC SMELEME
  35. C
  36.       SEGMENT IDEMEM(0)
  37.       segment ideme0(idemem(/1),30)
  38.       segment ideme1(idemem(/1),30)
  39. C
  40.       SEGACT IDEMEM*mod
  41.       N=IDEMEM(/1)
  42.       segact mrigid
  43.       lagdua=imlag
  44.       ri6=jrdepp
  45.       ri2=jrgard
  46.       ri1=jrelim
  47. C     -----------------------------------------------------------------
  48. C     Traitement de(s) second(s) membre(s)
  49.       DO 3 I=1,N
  50.         mchpoi=idemem(i)
  51. C
  52. C       Reintroduction des inconnues supprimees
  53.         call mucpri(mchpoi,ri6,ichp3)
  54.         if (ierr.ne.0) return
  55.         call adchpo(mchpoi,ichp3,ichp2,1.D0,1.D0)
  56.         if (ierr.ne.0) return
  57.         mchpo1=ideme1(I,if)
  58.         call adchpo(ichp2,mchpo1,iret,1.D0,1D0)
  59.         if (ierr.ne.0) return
  60.         call dtchpo(mchpoi)
  61.         call dtchpo(ichp3)
  62.         call dtchpo(ichp2)
  63.         mchpo1=iret
  64. C
  65. C       Calcul de KU
  66.         call mucpri(mchpo1,ri2,ichp5)
  67.         if (ierr.ne.0) return
  68. C
  69. C       Calcul de KU - F
  70.         ichp6= ideme0(I,if)
  71.         call adchpo(ichp5,ichp6,IRET,1D0,-1D0)
  72.         if (ierr.ne.0) return
  73. C
  74. C       Ajout des valeurs des multiplicateurs des conditions eliminees
  75.         call remplx(ri1,iret,ichp7)
  76.         if (ierr.ne.0) return
  77. C
  78. C       Verifier qu'on a bien l'equilibre
  79.         if (if.eq.1.and.iverif.eq.1) then
  80. C
  81. C         separer les conditions aux limites pour etablir la reference sans condition aux limites
  82.           segact ri2
  83.           nrigel=ri2.irigel(/2)
  84. **        write(6,*) ' nrigel dans resour ',nrigel
  85.           segini ri3
  86.           ri3.mtymat = ri2.mtymat
  87.           ri3.iforig = ri2.iforig
  88.           irn=0
  89.           do ir=1,nrigel
  90.             meleme=ri2.irigel(1,ir)
  91.             segact meleme
  92.             if(itypel.eq.49) then
  93.               irn=irn+1
  94.               ri3.coerig(irn)=ri2.coerig(ir)
  95.               do ii=1,ri2.irigel(/1)
  96.                ri3.irigel(ii,irn)=ri2.irigel(ii,ir)
  97.               enddo
  98.             endif
  99.           enddo
  100. ***       call prrigi(ri2,0)
  101.           nrigel=irn
  102. ***       write(6,*) ' irn dans resour ',irn
  103.           segadj ri3
  104.           call mucpri(mchpo1,ri3,ichp8)
  105.           if (ierr.ne.0) return
  106.           segsup ri3
  107. C
  108.           call mucpri(ichp7,ri1,ichp3)
  109.           if (ierr.ne.0) return
  110.           call adchpo(iret,ichp3,ichp4,1D0,1D0)
  111.         if (ierr.ne.0) return
  112.           call dtchpo(iret)
  113. **        write(6,*) 'ichp5 ichp6 ichp8 ichp4 ',ichp5,ichp6,ichp8,ichp4
  114. **        call vechpo(ichp5,ichp6,ichp8,ichp4,ipt8,isouci)
  115.           call dtchpo(ichp3)
  116.           call dtchpo(ichp4)
  117.           call dtchpo(ichp8)
  118.         endif
  119. C
  120.         call dtchpo(ichp5)
  121. *       call dtchpo(ichp6)
  122.         if (ierr.ne.0) return
  123.  
  124. C       Les CHPOINTs qui sortent sont de nature diffuse
  125.         segact mchpo1*mod
  126.         mchpo1.jattri(1)=1
  127.         call fuchpo(ichp7,mchpo1,mchpoi)
  128.         if(ierr.ne.0) return
  129. C
  130. C       Suppression les multiplicateurs dedoubles
  131. **      write(6,*) ' appel a dbbcf lagdua ',lagdua
  132.         call dbbcf(mchpoi,lagdua)
  133.         if (ierr.ne.0) return
  134. C
  135.         idemem(i)=mchpoi
  136.    3  CONTINUE
  137. C     -----------------------------------------------------------------
  138.       END
  139.  
  140.  
  141.  
  142.  

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