Télécharger fefp.eso

Retour à la liste

Numérotation des lignes :

  1. C FEFP SOURCE CB215821 19/08/20 21:17:40 10287
  2. *---------------------------------------------------------------------
  3. * Integration of FeFp models
  4. *---------------------------------------------------------------------
  5. c SUBROUTINE FEFP
  6. c SUBROUTINE FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR,
  7. c . IPCHE7,IPCHE8,IPCHE9,IPRIGI,
  8. c . PRECIS,NITMAX,NUPDATE)
  9. c SUBROUTINE FEFP2(MATE,INPLAS,MELE,MELEME,MINTE,IMATRI,
  10. c . NBELEM,NBPTEL,NBNN,LRE,MFR,
  11. c . IVADESP,IVADPI,IVARI,IVAMAT,
  12. c . IVASTF,IVARIF,IVADPF,LHOOK,IRIGE7,
  13. c . NDEP,NDEF,NSTRS,NVARI,NMATT,PRECIS,NITMAX,NUPDATE,
  14. c . KERRE)
  15. c subroutine apf_driver_fefp(BE,VARF,SIGF,DDHOOK,
  16. c . NDEF,NVARI,NSTRS,LHOOK,
  17. c . XMAT,xdensi,PRECIS,NITMAX,KERRE,
  18. c . nescri,nues,nmodel,nnumer,deltax,
  19. c . level,kmax,iaugla,caugla)
  20. c subroutine pushf35(a,f,a1)
  21. c subroutine prin35(b,bpr,qen,q6,q6t)
  22. c subroutine eig35(v,d,rot)
  23. *---------------------------------------------------------------------
  24. *---------------------------------------------------------------------
  25. *---------------------------------------------------------------------
  26. SUBROUTINE FEFP
  27. *---------------------------------------------------------------------
  28. * Integration of FeFp models
  29. *---------------------------------------------------------------------
  30. * SYNTAXE=
  31. * SIGF VARF DEPPFI RI1 = 'ECFEFP' MODL DEPPL0 VAR0 ZDEPT CARAC
  32. * (PRECIS) (NITMAX) (NUPDATE);
  33. * IN=
  34. * MMODEL | MODL OBJET MODELE
  35. * MCHAML | DEPPL0 DEFORMATIONS INELASTIQUES AU DEBUT DU PAS
  36. * MCHAML | VAR0 VARIABLES INTERNES AU DEBUT DU PAS
  37. * CHAMPOINT | ZDEPT deplacements entre conf de depart et arrivee
  38. * MCHAML | CARAC CARACTERISTIQUES GEOMETRIQUES
  39. * FLOTTANT | PRECIS PRECISION POUR ITERATIONS INTERNES
  40. * INTEGER | NITMAX maximum number of iterations at local level
  41. * INTEGER | NUPDATE =1 UPDATE ; =0 TOTAL - LAGRANGIAN
  42. *
  43. * OUT=
  44. * MCHAML | SIGF CONTRAINTES A LA FIN DU PAS
  45. * MCHAML | VARF VARIABLES INTERNES A LA FIN DU PAS
  46. * MCHAML | DEPIN DEFORMATIONS INELASTIQUES A LA FIN DU PAS
  47. * MRIGI | RI1 CONSISTENT TANGENT MATRIX
  48. *---------------------------------------------------------------------
  49. IMPLICIT INTEGER(I-N)
  50. IMPLICIT REAL*8(A-H,O-Z)
  51.  
  52. -INC CCOPTIO
  53. -INC SMCHAML
  54.  
  55. ************************
  56. * Lectura de datos
  57. ************************
  58. * modelo
  59. CALL LIROBJ('MMODEL ',IPMODL,1,IRT)
  60. CALL ACTOBJ('MMODEL ',IPMODL,1)
  61. IF (IERR.NE.0) RETURN
  62.  
  63. * deformacion plastica inicial
  64. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  65. CALL ACTOBJ('MCHAML ',IPIN,1)
  66. IF (IERR.NE.0) RETURN
  67. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  68. IF(IR .NE. 1) CALL ERREUR(KER)
  69. IF(IERR .NE. 0) RETURN
  70.  
  71. MCHELM=IPCHE1
  72. SEGACT MCHELM
  73. c Usa L1, N1, N3
  74. IF(MCHELM.TITCHE.NE.'DEFORMATIONS INELASTIQUES')THEN
  75. MOTERR(1:8)='DEFINELA'
  76. CALL ERREUR(109)
  77. RETURN
  78. ENDIF
  79.  
  80. * variables internas iniciales
  81. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  82. CALL ACTOBJ('MCHAML ',IPIN,1)
  83. IF(IERR .NE. 0) RETURN
  84. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  85. IF(IR .NE. 1) CALL ERREUR(KER)
  86. IF(IERR .NE. 0) RETURN
  87.  
  88. MCHELM=IPCHE2
  89. SEGACT MCHELM
  90. IF(TITCHE.NE.'VARIABLES INTERNES')THEN
  91. MOTERR(1:8)='VARINTER'
  92. CALL ERREUR(109)
  93. RETURN
  94. ENDIF
  95.  
  96. * incremento de desplazamientos
  97. CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT)
  98. CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  99. IF(IERR .NE. 0) RETURN
  100.  
  101. * paso de campo nodal a campo elemental en nodos (ct=1)
  102. CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE3,1)
  103. IF(IERR .NE. 0) RETURN
  104.  
  105. * caracteristicas materiales y geometricas
  106. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  107. CALL ACTOBJ('MCHAML ',IPIN,1)
  108. IF(IERR .NE. 0) RETURN
  109. CALL REDUAF(IPIN,IPMODL,IPCAR,0,IR,KER)
  110. IF(IR .NE. 1) CALL ERREUR(KER)
  111. IF(IERR .NE. 0) RETURN
  112.  
  113. MCHELM=IPCAR
  114. SEGACT MCHELM
  115. IF(TITCHE.NE.'CARACTERISTIQUES')THEN
  116. MOTERR(1:8)='CARACTER'
  117. CALL ERREUR(109)
  118. RETURN
  119. ENDIF
  120.  
  121. * precision para iteraciones internas
  122. CALL LIRREE(PRECIS,0,IRT)
  123. IF(IRT.EQ.0) PRECIS=1.D-10
  124.  
  125. * num max de iteraciones internas
  126. CALL LIRENT(NITMAX,0,IRT)
  127. IF (IRT.EQ.0) NITMAX=25
  128.  
  129. * Update or total (default) lagrangian formulation
  130. CALL LIRENT(NUPDATE,0,IRT)
  131. IF (IRT.EQ.0) NUPDATE=0
  132.  
  133. * deformacion plana o axisimetrico
  134. IF ((IFOUR.gt.0).or.(IFOUR.lt.-1)) then
  135. write(*,*) ' Formulacion no disponible'
  136. return
  137. endif
  138.  
  139. ************************
  140. * calcular
  141. ************************
  142. CALL FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR,
  143. . IPCHE7,IPCHE8,IPCHE9,IPRIGI,
  144. . PRECIS,NITMAX,NUPDATE)
  145. IF(IERR .NE. 0) RETURN
  146.  
  147. ************************
  148. * escribir resultados
  149. ************************
  150. CALL ACTOBJ('MCHAML ',IPCHE9,1)
  151. CALL ACTOBJ('MCHAML ',IPCHE8,1)
  152. CALL ACTOBJ('MCHAML ',IPCHE7,1)
  153.  
  154. CALL ECROBJ('MCHAML ',IPCHE9)
  155. CALL ECROBJ('MCHAML ',IPCHE8)
  156. CALL ECROBJ('MCHAML ',IPCHE7)
  157.  
  158. CALL ECROBJ('RIGIDITE',IPRIGI)
  159.  
  160. * borrar los desplazamientos en campo elemental
  161. CALL DTCHAM(IPCHE3)
  162. END
  163.  
  164.  
  165.  

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