Télécharger fefp.eso

Retour à la liste

Numérotation des lignes :

  1. C FEFP SOURCE CB215821 16/12/05 21:39:26 9237
  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. IF (IERR.NE.0) RETURN
  61.  
  62. * deformacion plastica inicial
  63. CALL LIROBJ('MCHAML',IPIN,1,IRT)
  64. IF (IERR.NE.0) RETURN
  65. CALL REDUAF(IPIN,IPMODL,IPCHE1,0,IR,KER)
  66. IF(IR .NE. 1) CALL ERREUR(KER)
  67. IF(IERR .NE. 0) RETURN
  68.  
  69. MCHELM=IPCHE1
  70. SEGACT MCHELM
  71. c Usa L1, N1, N3
  72. IF(MCHELM.TITCHE.NE.'DEFORMATIONS INELASTIQUES')THEN
  73. MOTERR(1:8)='DEFINELA'
  74. CALL ERREUR(109)
  75. SEGDES MCHELM
  76. RETURN
  77. ENDIF
  78. SEGDES MCHELM
  79.  
  80. * variables internas iniciales
  81. CALL LIROBJ('MCHAML',IPIN,1,IRT)
  82. IF(IERR .NE. 0) RETURN
  83. CALL REDUAF(IPIN,IPMODL,IPCHE2,0,IR,KER)
  84. IF(IR .NE. 1) CALL ERREUR(KER)
  85. IF(IERR .NE. 0) RETURN
  86.  
  87. MCHELM=IPCHE2
  88. SEGACT MCHELM
  89. IF(TITCHE.NE.'VARIABLES INTERNES')THEN
  90. MOTERR(1:8)='VARINTER'
  91. CALL ERREUR(109)
  92. SEGDES MCHELM
  93. RETURN
  94. ENDIF
  95. SEGDES MCHELM
  96.  
  97. * incremento de desplazamientos
  98. CALL LIROBJ('CHPOINT',IPCHP1,1,IRT)
  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. IF(IERR .NE. 0) RETURN
  108. CALL REDUAF(IPIN,IPMODL,IPCAR,0,IR,KER)
  109. IF(IR .NE. 1) CALL ERREUR(KER)
  110. IF(IERR .NE. 0) RETURN
  111.  
  112. MCHELM=IPCAR
  113. SEGACT MCHELM
  114. IF(TITCHE.NE.'CARACTERISTIQUES')THEN
  115. MOTERR(1:8)='CARACTER'
  116. CALL ERREUR(109)
  117. SEGDES MCHELM
  118. RETURN
  119. ENDIF
  120. SEGDES MCHELM
  121.  
  122. * precision para iteraciones internas
  123. CALL LIRREE(PRECIS,0,IRT)
  124. IF(IRT.EQ.0) PRECIS=1.D-10
  125.  
  126. * num max de iteraciones internas
  127. CALL LIRENT(NITMAX,0,IRT)
  128. IF (IRT.EQ.0) NITMAX=25
  129.  
  130. * Update or total (default) lagrangian formulation
  131. CALL LIRENT(NUPDATE,0,IRT)
  132. IF (IRT.EQ.0) NUPDATE=0
  133.  
  134. * deformacion plana o axisimetrico
  135. IF ((IFOUR.gt.0).or.(IFOUR.lt.-1)) then
  136. write(*,*) ' Formulacion no disponible'
  137. return
  138. endif
  139.  
  140. ************************
  141. * calcular
  142. ************************
  143. CALL FEFP1(IPMODL,IPCHE1,IPCHE2,IPCHE3,IPCAR,
  144. . IPCHE7,IPCHE8,IPCHE9,IPRIGI,
  145. . PRECIS,NITMAX,NUPDATE)
  146. IF(IERR .NE. 0) RETURN
  147.  
  148. ************************
  149. * escribir resultados
  150. ************************
  151.  
  152. CALL ECROBJ('MCHAML',IPCHE9)
  153. CALL ECROBJ('MCHAML',IPCHE8)
  154. CALL ECROBJ('MCHAML',IPCHE7)
  155. CALL ECROBJ('RIGIDITE',IPRIGI)
  156.  
  157. * borrar los desplazamientos en campo elemental
  158. CALL DTCHAM(IPCHE3)
  159. RETURN
  160. END
  161.  
  162.  
  163.  

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