Télécharger calcgb.eso

Retour à la liste

Numérotation des lignes :

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

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