Télécharger calcgb.eso

Retour à la liste

Numérotation des lignes :

  1. C CALCGB SOURCE GOUNAND 11/04/29 21:15:01 6947
  2. SUBROUTINE CALCGB(IVCOM,LCOF,METRIQ,
  3. $ FC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CALCGB
  9. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss
  10. C
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES :
  17. C APPELE PAR :
  18. C***********************************************************************
  19. C ENTREES :
  20. C ENTREES/SORTIES :
  21. C SORTIES : -
  22. C TRAVAIL :
  23. C***********************************************************************
  24. C VERSION : v1, 11/05/04, version initiale
  25. C HISTORIQUE : v1, 11/05/04, création
  26. C HISTORIQUE :
  27. C HISTORIQUE :
  28. C***********************************************************************
  29. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  30. C en cas de modification de ce sous-programme afin de faciliter
  31. C la maintenance !
  32. C***********************************************************************
  33. -INC CCOPTIO
  34. CBEGININCLUDE SMCHAEL
  35. SEGMENT MCHAEL
  36. POINTEUR IMACHE(N1).MELEME
  37. POINTEUR ICHEVA(N1).MCHEVA
  38. ENDSEGMENT
  39. SEGMENT MCHEVA
  40. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  41. ENDSEGMENT
  42. SEGMENT LCHEVA
  43. POINTEUR LISCHE(NBCHE).MCHEVA
  44. ENDSEGMENT
  45. CENDINCLUDE SMCHAEL
  46. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  47. POINTEUR FC.MCHEVA
  48. POINTEUR LCOF.LCHEVA
  49. POINTEUR MYCOF.MCHEVA
  50. * les MCHEVA des coefficient
  51. CBEGININCLUDE SLCOMP
  52. SEGMENT COMP
  53. CHARACTER*8 NOMCOM
  54. INTEGER DERCOF(NCOCOF)
  55. LOGICAL LTREF
  56. ENDSEGMENT
  57. SEGMENT COMPS
  58. POINTEUR LISCOM(NBCOMP).COMP
  59. ENDSEGMENT
  60. CENDINCLUDE SLCOMP
  61. POINTEUR IVCOM.COMP
  62. CBEGININCLUDE TMPREC
  63. SEGMENT MPREC
  64. POINTEUR DAT(NDAT).MCHEVA
  65. POINTEUR PREC(NPREC).MCHEVA
  66. ENDSEGMENT
  67. CENDINCLUDE TMPREC
  68. POINTEUR METRIQ.MPREC
  69. INTEGER IMPR,IRET
  70. CHARACTER*8 NOMLOI
  71. REAL*8 MAXVAL
  72. *
  73. * Executable statements
  74. *
  75. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcgb'
  76. NOMLOI=IVCOM.NOMCOM
  77. * WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
  78. *
  79. * Dispatching
  80. *
  81. IF (NOMLOI.EQ.'RIEN ') THEN
  82. FC.VELCHE(1,1,1,1,1,1)=1.D0
  83. ELSEIF (NOMLOI.EQ.'IDEN ') THEN
  84. NLFC=FC.VELCHE(/6)
  85. NPFC=FC.VELCHE(/5)
  86. MYCOF=LCOF.LISCHE(1)
  87. NLC=MYCOF.VELCHE(/6)
  88. NPC=MYCOF.VELCHE(/5)
  89. N2C=MYCOF.VELCHE(/4)
  90. IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  91. WRITE(IOIMP,*) 'Erreur grave 1'
  92. GOTO 9999
  93. ENDIF
  94. DO ILFC=1,NLFC
  95. DO IPFC=1,NPFC
  96. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  97. $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC)
  98. ENDDO
  99. ENDDO
  100. ELSEIF (NOMLOI.EQ.'1/X ') THEN
  101. NLFC=FC.VELCHE(/6)
  102. NPFC=FC.VELCHE(/5)
  103. MYCOF=LCOF.LISCHE(1)
  104. NLC=MYCOF.VELCHE(/6)
  105. NPC=MYCOF.VELCHE(/5)
  106. N2C=MYCOF.VELCHE(/4)
  107. IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  108. WRITE(IOIMP,*) 'Erreur grave 2'
  109. GOTO 9999
  110. ENDIF
  111. DO ILFC=1,NLFC
  112. DO IPFC=1,NPFC
  113. FC.VELCHE(1,1,1,1,IPFC,ILFC)=1.D0/
  114. $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC)
  115. ENDDO
  116. ENDDO
  117. ELSEIF (NOMLOI.EQ.'MAXI ') THEN
  118. NLFC=FC.VELCHE(/6)
  119. NPFC=FC.VELCHE(/5)
  120. MYCOF=LCOF.LISCHE(1)
  121. NLC=MYCOF.VELCHE(/6)
  122. NPC=MYCOF.VELCHE(/5)
  123. N2C=MYCOF.VELCHE(/4)
  124. IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  125. WRITE(IOIMP,*) 'Erreur grave 3'
  126. GOTO 9999
  127. ENDIF
  128. DO ILFC=1,NLFC
  129. MAXVAL=FC.VELCHE(1,1,1,1,1,ILFC)
  130. DO IPFC=2,NPFC
  131. MAXVAL=MAX(MAXVAL,FC.VELCHE(1,1,1,1,IPFC,ILFC))
  132. ENDDO
  133. DO IPFC=1,NPFC
  134. FC.VELCHE(1,1,1,1,IPFC,ILFC)=MAXVAL
  135. ENDDO
  136. ENDDO
  137. ELSEIF (NOMLOI.EQ.'RAYS ') THEN
  138. CALL CCGRAS(LCOF,FC,IMPR,IRET)
  139. IF (IRET.NE.0) GOTO 9999
  140. ELSEIF (NOMLOI.EQ.'MUR ') THEN
  141. CALL CCGMUR(LCOF,FC,IMPR,IRET)
  142. IF (IRET.NE.0) GOTO 9999
  143. ELSEIF (NOMLOI.EQ.'SUTH ') THEN
  144. CALL CCGSUT(LCOF,FC,IMPR,IRET)
  145. IF (IRET.NE.0) GOTO 9999
  146. ELSEIF (NOMLOI.EQ.'DIV ') THEN
  147. CALL CCGDIV(LCOF,FC,IMPR,IRET)
  148. IF (IRET.NE.0) GOTO 9999
  149. ELSEIF (NOMLOI.EQ.'TAU ') THEN
  150. CALL CCGTAU(LCOF,FC,1,IMPR,IRET)
  151. IF (IRET.NE.0) GOTO 9999
  152. ELSEIF (NOMLOI.EQ.'SIGMA ') THEN
  153. CALL CCGTAU(LCOF,FC,2,IMPR,IRET)
  154. IF (IRET.NE.0) GOTO 9999
  155. ELSEIF (NOMLOI.EQ.'MADSMID ') THEN
  156. CALL CCGMMD(LCOF,NOMLOI,FC,IMPR,IRET)
  157. IF (IRET.NE.0) GOTO 9999
  158. ELSEIF (NOMLOI.EQ.'VOLORI ') THEN
  159. CALL CCGADV(LCOF,NOMLOI,FC,IMPR,IRET)
  160. IF (IRET.NE.0) GOTO 9999
  161. ELSEIF (NOMLOI(1:3).EQ.'AHU') THEN
  162. CALL CCGAHU(LCOF,NOMLOI,FC,IMPR,IRET)
  163. IF (IRET.NE.0) GOTO 9999
  164. * ELSEIF (NOMLOI(1:3).EQ.'AHP') THEN
  165. * CALL CCGAHP(LCOF,NOMLOI,METRIQ,FC,IMPR,IRET)
  166. * IF (IRET.NE.0) GOTO 9999
  167. ELSEIF ((NOMLOI(1:4).EQ.'QEQU').OR.(NOMLOI(1:4).EQ.'QALI')) THEN
  168. CALL CCGQME(LCOF,NOMLOI,FC,IMPR,IRET)
  169. IF (IRET.NE.0) GOTO 9999
  170. ELSEIF (NOMLOI(1:4).EQ.'D/DX') THEN
  171. CALL CCGRAD(LCOF,NOMLOI,FC,IMPR,IRET)
  172. IF (IRET.NE.0) GOTO 9999
  173. ELSEIF (NOMLOI.EQ.'TAILDIRE') THEN
  174. CALL CCGTDI(LCOF,FC,IMPR,IRET)
  175. IF (IRET.NE.0) GOTO 9999
  176. ELSEIF (NOMLOI(1:6).EQ.'MUSTAB') THEN
  177. CALL CCGMUS(LCOF,NOMLOI,FC,IMPR,IRET)
  178. IF (IRET.NE.0) GOTO 9999
  179. ELSEIF (NOMLOI(1:3).EQ.'TSU') THEN
  180. CALL CCGTSU(LCOF,NOMLOI,FC,IMPR,IRET)
  181. IF (IRET.NE.0) GOTO 9999
  182. ELSEIF (NOMLOI(1:3).EQ.'VNO') THEN
  183. CALL CCGNOR(LCOF,NOMLOI,FC,IMPR,IRET)
  184. IF (IRET.NE.0) GOTO 9999
  185. ELSEIF (NOMLOI(1:4).EQ.'IMET') THEN
  186. CALL CCGIME(LCOF,NOMLOI,FC,IMPR,IRET)
  187. IF (IRET.NE.0) GOTO 9999
  188. ELSE
  189. WRITE(IOIMP,*) 'Loi de comportement ',NOMLOI
  190. WRITE(IOIMP,*) 'non définie dans calcgb'
  191. GOTO 9999
  192. ENDIF
  193. *
  194. * Normal termination
  195. *
  196. IRET=0
  197. RETURN
  198. *
  199. * Format handling
  200. *
  201. *
  202. * Error handling
  203. *
  204. 9999 CONTINUE
  205. IRET=1
  206. WRITE(IOIMP,*) 'An error was detected in subroutine calcgb'
  207. RETURN
  208. *
  209. * End of subroutine CALCGB
  210. *
  211. END
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  

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