Télécharger ccgmmd.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  36. -INC CCREEL
  37. CBEGININCLUDE SMCHAEL
  38. SEGMENT MCHAEL
  39. POINTEUR IMACHE(N1).MELEME
  40. POINTEUR ICHEVA(N1).MCHEVA
  41. ENDSEGMENT
  42. SEGMENT MCHEVA
  43. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  44. ENDSEGMENT
  45. SEGMENT LCHEVA
  46. POINTEUR LISCHE(NBCHE).MCHEVA
  47. ENDSEGMENT
  48. CENDINCLUDE SMCHAEL
  49. INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
  50. POINTEUR FC.MCHEVA
  51. POINTEUR LCOF.LCHEVA
  52. POINTEUR JMAJAC.MCHEVA
  53. POINTEUR JMIJAC.MCHEVA
  54. POINTEUR JDTJAC.MCHEVA
  55. POINTEUR JMAREG.MCHEVA
  56. POINTEUR JMET.MCHEVA
  57. CHARACTER*8 NOMLOI
  58. INTEGER ICOF
  59. *
  60. SEGMENT MCOF
  61. POINTEUR COEF(IDIM,IDIM).MCHEVA
  62. ENDSEGMENT
  63. POINTEUR MET.MCOF
  64. *
  65. LOGICAL LBID
  66. *
  67. INTEGER IMPR,IRET
  68. *
  69. * Executable statements
  70. *
  71. IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgmmd'
  72. C IF (.NOT.(IDIM.EQ.1)) THEN
  73. C WRITE(IOIMP,*) 'IDIM=',IDIM,' ?'
  74. C GOTO 9999
  75. C ENDIF
  76. NLFC=FC.VELCHE(/6)
  77. NPFC=FC.VELCHE(/5)
  78. ICOF=0
  79. *
  80. * Récupération des coefficients de la metrique
  81. *
  82. C SEGINJ MET
  83. C DO IIDIM=1,IDIM
  84. C ICOF=ICOF+1
  85. C JMET=LCOF.LISCHE(ICOF)
  86. C IF (ICOF.EQ.1) THEN
  87. C NLJM=JMET.VELCHE(/6)
  88. C NPJM=JMET.VELCHE(/5)
  89. C ELSE
  90. C NLJM2=JMET.VELCHE(/6)
  91. C NPJM2=JMET.VELCHE(/5)
  92. C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN
  93. C WRITE(IOIMP,*) 'Erreur grave dims JMET'
  94. C GOTO 9999
  95. C ENDIF
  96. C ENDIF
  97. C MET.COEF(IIDIM,IIDIM)=JMET
  98. C ENDDO
  99. C DO IIDIM=1,IDIM
  100. C NJ=IDIM-IIDIM
  101. C IF (NJ.GE.1) THEN
  102. C DO JIDIM=IIDIM+1,IDIM
  103. C ICOF=ICOF+1
  104. C JMET=LCOF.LISCHE(ICOF)
  105. C NLJM2=JMET.VELCHE(/6)
  106. C NPJM2=JMET.VELCHE(/5)
  107. C IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN
  108. C WRITE(IOIMP,*) 'Erreur grave dims JMET2'
  109. C GOTO 9999
  110. C ENDIF
  111. C MET.COEF(IIDIM,JIDIM)=JMET
  112. C ENDDO
  113. C ENDIF
  114. C ENDDO
  115. *
  116. ICOF=ICOF+1
  117. JMAJAC=LCOF.LISCHE(ICOF)
  118. C NLJA=JMAJAC.VELCHE(/6)
  119. C NPJA=JMAJAC.VELCHE(/5)
  120. C IREF=JMAJAC.VELCHE(/4)
  121. C IREL=JMAJAC.VELCHE(/3)
  122. C*
  123. C IF (IREL.NE.IDIM) THEN
  124. C WRITE(IOIMP,*) 'Erreur dims JMAJAC'
  125. C GOTO 9999
  126. C ENDIF
  127. *
  128. ICOF=ICOF+1
  129. JMIJAC=LCOF.LISCHE(ICOF)
  130. ICOF=ICOF+1
  131. JDTJAC=LCOF.LISCHE(ICOF)
  132. NLJD=JDTJAC.VELCHE(/6)
  133. NPJD=JDTJAC.VELCHE(/5)
  134. ICOF=ICOF+1
  135. JMAREG=LCOF.LISCHE(ICOF)
  136. C NLJR=JMAREG.VELCHE(/6)
  137. C NPJR=JMAREG.VELCHE(/5)
  138. C I1 =JMAREG.VELCHE(/4)
  139. C I2 =JMAREG.VELCHE(/3)
  140. C IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
  141. C $ THEN
  142. C WRITE(IOIMP,*) 'Erreur dims JMAREG'
  143. C GOTO 9999
  144. C ENDIF
  145. *
  146. DO ILFC=1,NLFC
  147. IF (NLJD.EQ.1) THEN
  148. ILJD=1
  149. ELSE
  150. ILJD=ILFC
  151. ENDIF
  152. XMADA=-XGRAND
  153. XMIDA=XGRAND
  154. XMAD=-XGRAND
  155. XMID=XGRAND
  156. DO IPJD=1,NPJD
  157. C DO IPFC=1,NPFC
  158. C IF (NPJD.EQ.1) THEN
  159. C IPJD=1
  160. C ELSE
  161. C IPJD=IPFC
  162. C ENDIF
  163. XDET=JDTJAC.VELCHE(1,1,1,1,IPJD,ILJD)
  164. AXDET=ABS(XDET)
  165. XMADA=MAX(XMADA,AXDET)
  166. XMIDA=MIN(XMIDA,AXDET)
  167. XMAD=MAX(XMAD,XDET)
  168. XMID=MIN(XMID,XDET)
  169. ENDDO
  170. *
  171. * Les déterminants nuls ou petit ou changeant de signe ont déjà été
  172. * capturés dans geoli2 (normalement !)
  173. *
  174. CONTRI=SIGN(1.D0,XMAD*XMID)*(XMADA/XMIDA)
  175. * WRITE(IOIMP,*) 'CONTRI=',CONTRI
  176. *
  177. DO IPFC=1,NPFC
  178. FC.VELCHE(1,1,1,1,IPFC,ILFC)=
  179. $ FC.VELCHE(1,1,1,1,IPFC,ILFC)+CONTRI
  180. ENDDO
  181. ENDDO
  182. *
  183. * Normal termination
  184. *
  185. IRET=0
  186. RETURN
  187. *
  188. * Format handling
  189. *
  190. *
  191. * Error handling
  192. *
  193. 9999 CONTINUE
  194. IRET=1
  195. WRITE(IOIMP,*) 'An error was detected in subroutine ccgmmd'
  196. RETURN
  197. *
  198. * End of subroutine CCGMMD
  199. *
  200. END
  201.  
  202.  
  203.  

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