Télécharger calcgb.eso

Retour à la liste

Numérotation des lignes :

  1. C CALCGB SOURCE GOUNAND 19/01/07 21:15:01 10065
  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. POINTEUR JPC.MCHEVA
  51. * les MCHEVA des coefficient
  52. CBEGININCLUDE SLCOMP
  53. SEGMENT COMP
  54. CHARACTER*8 NOMCOM
  55. INTEGER DERCOF(NCOCOF)
  56. LOGICAL LTREF
  57. ENDSEGMENT
  58. SEGMENT COMPS
  59. POINTEUR LISCOM(NBCOMP).COMP
  60. ENDSEGMENT
  61. CENDINCLUDE SLCOMP
  62. POINTEUR IVCOM.COMP
  63. CBEGININCLUDE TMPREC
  64. SEGMENT MPREC
  65. POINTEUR DAT(NDAT).MCHEVA
  66. POINTEUR PREC(NPREC).MCHEVA
  67. ENDSEGMENT
  68. CENDINCLUDE TMPREC
  69. POINTEUR METRIQ.MPREC
  70. INTEGER IMPR,IRET
  71. CHARACTER*8 NOMLOI
  72. REAL*8 MAXVAL
  73. *
  74. * Executable statements
  75. *
  76. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcgb'
  77. NOMLOI=IVCOM.NOMCOM
  78. * WRITE(IOIMP,*) 'NOMLOI=',NOMLOI
  79. *
  80. * Dispatching
  81. *
  82. IF (NOMLOI.EQ.'RIEN ') THEN
  83. FC.VELCHE(1,1,1,1,1,1)=1.D0
  84. ELSEIF (NOMLOI.EQ.'IDEN ') THEN
  85. NLFC=FC.VELCHE(/6)
  86. NPFC=FC.VELCHE(/5)
  87. MYCOF=LCOF.LISCHE(1)
  88. NLC=MYCOF.VELCHE(/6)
  89. NPC=MYCOF.VELCHE(/5)
  90. N2C=MYCOF.VELCHE(/4)
  91. IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  92. WRITE(IOIMP,*) 'Erreur grave 1'
  93. GOTO 9999
  94. ENDIF
  95. DO ILFC=1,NLFC
  96. DO IPFC=1,NPFC
  97. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  98. $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC)
  99. ENDDO
  100. ENDDO
  101. ELSEIF (NOMLOI.EQ.'1/X ') THEN
  102. NLFC=FC.VELCHE(/6)
  103. NPFC=FC.VELCHE(/5)
  104. MYCOF=LCOF.LISCHE(1)
  105. NLC=MYCOF.VELCHE(/6)
  106. NPC=MYCOF.VELCHE(/5)
  107. N2C=MYCOF.VELCHE(/4)
  108. IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  109. WRITE(IOIMP,*) 'Erreur grave 2'
  110. GOTO 9999
  111. ENDIF
  112. DO ILFC=1,NLFC
  113. DO IPFC=1,NPFC
  114. FC.VELCHE(1,1,1,1,IPFC,ILFC)=1.D0/
  115. $ MYCOF.VELCHE(1,1,1,1,IPFC,ILFC)
  116. ENDDO
  117. ENDDO
  118. ELSEIF (NOMLOI.EQ.'MAXI ') THEN
  119. NLFC=FC.VELCHE(/6)
  120. NPFC=FC.VELCHE(/5)
  121. MYCOF=LCOF.LISCHE(1)
  122. NLC=MYCOF.VELCHE(/6)
  123. NPC=MYCOF.VELCHE(/5)
  124. N2C=MYCOF.VELCHE(/4)
  125. IF (NLFC.NE.NLC.OR.NPFC.NE.NPC.OR.N2C.NE.1) THEN
  126. WRITE(IOIMP,*) 'Erreur grave 3'
  127. GOTO 9999
  128. ENDIF
  129. DO ILFC=1,NLFC
  130. MAXVAL=FC.VELCHE(1,1,1,1,1,ILFC)
  131. DO IPFC=2,NPFC
  132. MAXVAL=MAX(MAXVAL,FC.VELCHE(1,1,1,1,IPFC,ILFC))
  133. ENDDO
  134. DO IPFC=1,NPFC
  135. FC.VELCHE(1,1,1,1,IPFC,ILFC)=MAXVAL
  136. ENDDO
  137. ENDDO
  138. ELSEIF (NOMLOI.EQ.'RAYS ') THEN
  139. CALL CCGRAS(LCOF,FC,IMPR,IRET)
  140. IF (IRET.NE.0) GOTO 9999
  141. ELSEIF (NOMLOI.EQ.'MUR ') THEN
  142. CALL CCGMUR(LCOF,FC,IMPR,IRET)
  143. IF (IRET.NE.0) GOTO 9999
  144. ELSEIF (NOMLOI.EQ.'SUTH ') THEN
  145. CALL CCGSUT(LCOF,FC,IMPR,IRET)
  146. IF (IRET.NE.0) GOTO 9999
  147. ELSEIF (NOMLOI.EQ.'DIV ') THEN
  148. CALL CCGDIV(LCOF,FC,IMPR,IRET)
  149. IF (IRET.NE.0) GOTO 9999
  150. ELSEIF (NOMLOI.EQ.'TAU ') THEN
  151. CALL CCGTAU(LCOF,FC,1,IMPR,IRET)
  152. IF (IRET.NE.0) GOTO 9999
  153. ELSEIF (NOMLOI.EQ.'SIGMA ') THEN
  154. CALL CCGTAU(LCOF,FC,2,IMPR,IRET)
  155. IF (IRET.NE.0) GOTO 9999
  156. ELSEIF (NOMLOI.EQ.'MADSMID ') THEN
  157. CALL CCGMMD(LCOF,NOMLOI,FC,IMPR,IRET)
  158. IF (IRET.NE.0) GOTO 9999
  159. ELSEIF (NOMLOI.EQ.'VOLORI ') THEN
  160. CALL CCGADV(LCOF,NOMLOI,FC,IMPR,IRET)
  161. IF (IRET.NE.0) GOTO 9999
  162. ELSEIF (NOMLOI(1:3).EQ.'AHU') THEN
  163. CALL CCGAHU(LCOF,NOMLOI,FC,IMPR,IRET)
  164. IF (IRET.NE.0) GOTO 9999
  165. * ELSEIF (NOMLOI(1:3).EQ.'AHP') THEN
  166. * CALL CCGAHP(LCOF,NOMLOI,METRIQ,FC,IMPR,IRET)
  167. * IF (IRET.NE.0) GOTO 9999
  168. ELSEIF ((NOMLOI(1:4).EQ.'QEQU').OR.(NOMLOI(1:4).EQ.'QALI')) THEN
  169. CALL CCGQME(LCOF,NOMLOI,FC,IMPR,IRET)
  170. IF (IRET.NE.0) GOTO 9999
  171. ELSEIF (NOMLOI(1:4).EQ.'D/DX') THEN
  172. CALL CCGRAD(LCOF,NOMLOI,FC,IMPR,IRET)
  173. IF (IRET.NE.0) GOTO 9999
  174. ELSEIF (NOMLOI.EQ.'TAILDIRE') THEN
  175. CALL CCGTDI(LCOF,FC,IMPR,IRET)
  176. IF (IRET.NE.0) GOTO 9999
  177. ELSEIF (NOMLOI(1:6).EQ.'MUSTAB') THEN
  178. CALL CCGMUS(LCOF,NOMLOI,FC,IMPR,IRET)
  179. IF (IRET.NE.0) GOTO 9999
  180. ELSEIF (NOMLOI(1:3).EQ.'TSU') THEN
  181. CALL CCGTSU(LCOF,NOMLOI,FC,IMPR,IRET)
  182. IF (IRET.NE.0) GOTO 9999
  183. ELSEIF (NOMLOI(1:3).EQ.'VNO') THEN
  184. CALL CCGNOR(LCOF,NOMLOI,FC,IMPR,IRET)
  185. IF (IRET.NE.0) GOTO 9999
  186. ELSEIF (NOMLOI(1:4).EQ.'IMET') THEN
  187. CALL CCGIME(LCOF,NOMLOI,FC,IMPR,IRET)
  188. IF (IRET.NE.0) GOTO 9999
  189. ELSEIF (NOMLOI.EQ.'X1 ') THEN
  190. NLFC=FC.VELCHE(/6)
  191. NPFC=FC.VELCHE(/5)
  192. IF (IFOMOD.NE.0.AND.IFOMOD.NE.4.AND.IFOMOD.NE.5) then
  193. write(ioimp,*) 'erreur compor X1, ifomod=',ifomod
  194. goto 9999
  195. endif
  196. JPC=LCOF.LISCHE(6)
  197. NLPC=JPC.VELCHE(/6)
  198. NPPC=JPC.VELCHE(/5)
  199. IF (((NLPC.NE.1).AND.(NLPC.NE.NLFC)).OR.
  200. $ ((NPPC.NE.1).AND.(NPPC.NE.NPFC))) THEN
  201. WRITE(IOIMP,*) 'Erreur dims JPC'
  202. GOTO 9999
  203. ENDIF
  204. DO ILFC=1,NLFC
  205. IF (NLPC.EQ.1) THEN
  206. ILPC=1
  207. ELSE
  208. ILPC=ILFC
  209. ENDIF
  210. DO IPFC=1,NPFC
  211. IF (NPPC.EQ.1) THEN
  212. IPPC=1
  213. ELSE
  214. IPPC=IPFC
  215. ENDIF
  216. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  217. $ JPC.VELCHE(1,1,1,1,IPPC,ILPC)
  218. ENDDO
  219. ENDDO
  220. ELSE
  221. WRITE(IOIMP,*) 'Loi de comportement ',NOMLOI
  222. WRITE(IOIMP,*) 'non définie dans calcgb'
  223. GOTO 9999
  224. ENDIF
  225. *
  226. * Normal termination
  227. *
  228. IRET=0
  229. RETURN
  230. *
  231. * Format handling
  232. *
  233. *
  234. * Error handling
  235. *
  236. 9999 CONTINUE
  237. IRET=1
  238. WRITE(IOIMP,*) 'An error was detected in subroutine calcgb'
  239. RETURN
  240. *
  241. * End of subroutine CALCGB
  242. *
  243. END
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  

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