Télécharger ccgmmd.eso

Retour à la liste

Numérotation des lignes :

ccgmmd
  1. C CCGMMD SOURCE GOUNAND 05/12/21 21:16:32 5281
  2. SUBROUTINE CCGMMD(LCOF,NOMLOI,
  3. $ FC,
  4. $ IMPR,IRET)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. IMPLICIT INTEGER (I-N)
  7. C***********************************************************************
  8. C NOM : CCGMMD
  9. C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
  10. C max |d|/min|d| où d=det J
  11. C avec un signe moins si d change de signe
  12. C
  13. C
  14. C LANGAGE : ESOPE
  15. C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF)
  16. C mél : gounand@semt2.smts.cea.fr
  17. C***********************************************************************
  18. C APPELES :
  19. C APPELE PAR :
  20. C***********************************************************************
  21. C ENTREES :
  22. C ENTREES/SORTIES :
  23. C SORTIES : -
  24. C TRAVAIL :
  25. C***********************************************************************
  26. C VERSION : v1, 04/08/04, version initiale
  27. C HISTORIQUE : v1, 04/08/04, création
  28. C HISTORIQUE :
  29. C HISTORIQUE :
  30. C***********************************************************************
  31. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  32. C en cas de modification de ce sous-programme afin de faciliter
  33. C la maintenance !
  34. C***********************************************************************
  35.  
  36. -INC PPARAM
  37. -INC CCOPTIO
  38. -INC CCREEL
  39. CBEGININCLUDE SMCHAEL
  40. SEGMENT MCHAEL
  41. POINTEUR IMACHE(N1).MELEME
  42. POINTEUR ICHEVA(N1).MCHEVA
  43. ENDSEGMENT
  44. SEGMENT MCHEVA
  45. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  46. ENDSEGMENT
  47. SEGMENT LCHEVA
  48. POINTEUR LISCHE(NBCHE).MCHEVA
  49. ENDSEGMENT
  50. CENDINCLUDE SMCHAEL
  51. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  52. POINTEUR FC.MCHEVA
  53. POINTEUR LCOF.LCHEVA
  54. POINTEUR JMAJAC.MCHEVA
  55. POINTEUR JMIJAC.MCHEVA
  56. POINTEUR JDTJAC.MCHEVA
  57. POINTEUR JMAREG.MCHEVA
  58. POINTEUR JMET.MCHEVA
  59. CHARACTER*8 NOMLOI
  60. INTEGER ICOF
  61. *
  62. SEGMENT MCOF
  63. POINTEUR COEF(IDIM,IDIM).MCHEVA
  64. ENDSEGMENT
  65. POINTEUR MET.MCOF
  66. *
  67. LOGICAL LBID
  68. *
  69. INTEGER IMPR,IRET
  70. *
  71. * Executable statements
  72. *
  73. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgmmd'
  74. C IF (.NOT.(IDIM.EQ.1)) THEN
  75. C WRITE(IOIMP,*) 'IDIM=',IDIM,' ?'
  76. C GOTO 9999
  77. C ENDIF
  78. NLFC=FC.VELCHE(/6)
  79. NPFC=FC.VELCHE(/5)
  80. ICOF=0
  81. *
  82. * Récupération des coefficients de la metrique
  83. *
  84. C SEGINJ MET
  85. C DO IIDIM=1,IDIM
  86. C ICOF=ICOF+1
  87. C JMET=LCOF.LISCHE(ICOF)
  88. C IF (ICOF.EQ.1) THEN
  89. C NLJM=JMET.VELCHE(/6)
  90. C NPJM=JMET.VELCHE(/5)
  91. C ELSE
  92. C NLJM2=JMET.VELCHE(/6)
  93. C NPJM2=JMET.VELCHE(/5)
  94. C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN
  95. C WRITE(IOIMP,*) 'Erreur grave dims JMET'
  96. C GOTO 9999
  97. C ENDIF
  98. C ENDIF
  99. C MET.COEF(IIDIM,IIDIM)=JMET
  100. C ENDDO
  101. C DO IIDIM=1,IDIM
  102. C NJ=IDIM-IIDIM
  103. C IF (NJ.GE.1) THEN
  104. C DO JIDIM=IIDIM+1,IDIM
  105. C ICOF=ICOF+1
  106. C JMET=LCOF.LISCHE(ICOF)
  107. C NLJM2=JMET.VELCHE(/6)
  108. C NPJM2=JMET.VELCHE(/5)
  109. C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN
  110. C WRITE(IOIMP,*) 'Erreur grave dims JMET2'
  111. C GOTO 9999
  112. C ENDIF
  113. C MET.COEF(IIDIM,JIDIM)=JMET
  114. C ENDDO
  115. C ENDIF
  116. C ENDDO
  117. *
  118. ICOF=ICOF+1
  119. JMAJAC=LCOF.LISCHE(ICOF)
  120. C NLJA=JMAJAC.VELCHE(/6)
  121. C NPJA=JMAJAC.VELCHE(/5)
  122. C IREF=JMAJAC.VELCHE(/4)
  123. C IREL=JMAJAC.VELCHE(/3)
  124. C*
  125. C IF (IREL.NE.IDIM) THEN
  126. C WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  127. C GOTO 9999
  128. C ENDIF
  129. *
  130. ICOF=ICOF+1
  131. JMIJAC=LCOF.LISCHE(ICOF)
  132. ICOF=ICOF+1
  133. JDTJAC=LCOF.LISCHE(ICOF)
  134. NLJD=JDTJAC.VELCHE(/6)
  135. NPJD=JDTJAC.VELCHE(/5)
  136. ICOF=ICOF+1
  137. JMAREG=LCOF.LISCHE(ICOF)
  138. C NLJR=JMAREG.VELCHE(/6)
  139. C NPJR=JMAREG.VELCHE(/5)
  140. C I1 =JMAREG.VELCHE(/4)
  141. C I2 =JMAREG.VELCHE(/3)
  142. C IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
  143. C $ THEN
  144. C WRITE(IOIMP,*) 'Erreur dims JMAREG'
  145. C GOTO 9999
  146. C ENDIF
  147. *
  148. DO ILFC=1,NLFC
  149. IF (NLJD.EQ.1) THEN
  150. ILJD=1
  151. ELSE
  152. ILJD=ILFC
  153. ENDIF
  154. XMADA=-XGRAND
  155. XMIDA=XGRAND
  156. XMAD=-XGRAND
  157. XMID=XGRAND
  158. DO IPJD=1,NPJD
  159. C DO IPFC=1,NPFC
  160. C IF (NPJD.EQ.1) THEN
  161. C IPJD=1
  162. C ELSE
  163. C IPJD=IPFC
  164. C ENDIF
  165. XDET=JDTJAC.VELCHE(1,1,1,1,IPJD,ILJD)
  166. AXDET=ABS(XDET)
  167. XMADA=MAX(XMADA,AXDET)
  168. XMIDA=MIN(XMIDA,AXDET)
  169. XMAD=MAX(XMAD,XDET)
  170. XMID=MIN(XMID,XDET)
  171. ENDDO
  172. *
  173. * Les déterminants nuls ou petit ou changeant de signe ont déjà été
  174. * capturés dans geoli2 (normalement !)
  175. *
  176. CONTRI=SIGN(1.D0,XMAD*XMID)*(XMADA/XMIDA)
  177. * WRITE(IOIMP,*) 'CONTRI=',CONTRI
  178. *
  179. DO IPFC=1,NPFC
  180. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  181. $ FC.VELCHE(1,1,1,1,IPFC,ILFC)+CONTRI
  182. ENDDO
  183. ENDDO
  184. *
  185. * Normal termination
  186. *
  187. IRET=0
  188. RETURN
  189. *
  190. * Format handling
  191. *
  192. *
  193. * Error handling
  194. *
  195. 9999 CONTINUE
  196. IRET=1
  197. WRITE(IOIMP,*) 'An error was detected in subroutine ccgmmd'
  198. RETURN
  199. *
  200. * End of subroutine CCGMMD
  201. *
  202. END
  203.  
  204.  
  205.  

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