Télécharger fefp.eso

Retour à la liste

Numérotation des lignes :

  1. C FEFP SOURCE PV 20/09/12 21:15:14 10711
  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.  
  53. -INC PPARAM
  54. -INC CCOPTIO
  55. -INC SMCHAML
  56. -INC SMCOORD
  57.  
  58. segact mcoord
  59. ************************
  60. * Lectura de datos
  61. ************************
  62. * modelo
  63. CALL LIROBJ('MMODEL ',IPMODL,1,IRT)
  64. CALL ACTOBJ('MMODEL ',IPMODL,1)
  65. IF (IERR.NE.0) RETURN
  66.  
  67. * deformacion plastica inicial
  68. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  69. CALL ACTOBJ('MCHAML ',IPIN,1)
  70. IF (IERR.NE.0) RETURN
  71. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  72. IF(IR .NE. 1) CALL ERREUR(KER)
  73. IF(IERR .NE. 0) RETURN
  74.  
  75. MCHELM=IPCHE1
  76. SEGACT MCHELM
  77. c Usa L1, N1, N3
  78. IF(MCHELM.TITCHE.NE.'DEFORMATIONS INELASTIQUES')THEN
  79. MOTERR(1:8)='DEFINELA'
  80. CALL ERREUR(109)
  81. RETURN
  82. ENDIF
  83.  
  84. * variables internas iniciales
  85. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  86. CALL ACTOBJ('MCHAML ',IPIN,1)
  87. IF(IERR .NE. 0) RETURN
  88. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  89. IF(IR .NE. 1) CALL ERREUR(KER)
  90. IF(IERR .NE. 0) RETURN
  91.  
  92. MCHELM=IPCHE2
  93. SEGACT MCHELM
  94. IF(TITCHE.NE.'VARIABLES INTERNES')THEN
  95. MOTERR(1:8)='VARINTER'
  96. CALL ERREUR(109)
  97. RETURN
  98. ENDIF
  99.  
  100. * incremento de desplazamientos
  101. CALL LIROBJ('CHPOINT ',IPCHP1,1,IRT)
  102. CALL ACTOBJ('CHPOINT ',IPCHP1,1)
  103. IF(IERR .NE. 0) RETURN
  104.  
  105. * paso de campo nodal a campo elemental en nodos (ct=1)
  106. CALL CHAME1(0,IPMODL,IPCHP1,' ',IPCHE3,1)
  107. IF(IERR .NE. 0) RETURN
  108.  
  109. * caracteristicas materiales y geometricas
  110. CALL LIROBJ('MCHAML ',IPIN,1,IRT)
  111. CALL ACTOBJ('MCHAML ',IPIN,1)
  112. IF(IERR .NE. 0) RETURN
  113. CALL REDUAF(IPIN,IPMODL,IPCAR,0,IR,KER)
  114. IF(IR .NE. 1) CALL ERREUR(KER)
  115. IF(IERR .NE. 0) RETURN
  116.  
  117. MCHELM=IPCAR
  118. SEGACT MCHELM
  119. IF(TITCHE.NE.'CARACTERISTIQUES')THEN
  120. MOTERR(1:8)='CARACTER'
  121. CALL ERREUR(109)
  122. RETURN
  123. ENDIF
  124.  
  125. * precision para iteraciones internas
  126. CALL LIRREE(PRECIS,0,IRT)
  127. IF(IRT.EQ.0) PRECIS=1.D-10
  128.  
  129. * num max de iteraciones internas
  130. CALL LIRENT(NITMAX,0,IRT)
  131. IF (IRT.EQ.0) NITMAX=25
  132.  
  133. * Update or total (default) lagrangian formulation
  134. CALL LIRENT(NUPDATE,0,IRT)
  135. IF (IRT.EQ.0) NUPDATE=0
  136.  
  137. * deformacion plana o axisimetrico
  138. IF ((IFOUR.gt.0).or.(IFOUR.lt.-1)) then
  139. write(*,*) ' Formulacion no disponible'
  140. return
  141. endif
  142.  
  143. ************************
  144. * calcular
  145. ************************
  146. CALL FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR,
  147. . IPCHE7,IPCHE8,IPCHE9,IPRIGI,
  148. . PRECIS,NITMAX,NUPDATE)
  149. IF(IERR .NE. 0) RETURN
  150.  
  151. ************************
  152. * escribir resultados
  153. ************************
  154. CALL ACTOBJ('MCHAML ',IPCHE9,1)
  155. CALL ACTOBJ('MCHAML ',IPCHE8,1)
  156. CALL ACTOBJ('MCHAML ',IPCHE7,1)
  157.  
  158. CALL ECROBJ('MCHAML ',IPCHE9)
  159. CALL ECROBJ('MCHAML ',IPCHE8)
  160. CALL ECROBJ('MCHAML ',IPCHE7)
  161.  
  162. CALL ECROBJ('RIGIDITE',IPRIGI)
  163.  
  164. * borrar los desplazamientos en campo elemental
  165. END
  166.  
  167.  
  168.  
  169.  
  170.  

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