Télécharger calpco.eso

Retour à la liste

Numérotation des lignes :

  1. C CALPCO SOURCE GOUNAND 06/01/18 21:15:11 5293
  2. SUBROUTINE CALPCO(POWCOF,TATRAV,
  3. $ IPROCO,IMPR,IRET)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. IMPLICIT INTEGER (I-N)
  6. C***********************************************************************
  7. C NOM : CALPCO
  8. C DESCRIPTION : Calcul d'un produit de coefficients
  9. C à une certaine puissance
  10. C
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES :
  17. C APPELES (E/S) :
  18. C APPELES (BLAS) :
  19. C APPELES (CALCUL) :
  20. C APPELE PAR :
  21. C***********************************************************************
  22. C SYNTAXE GIBIANE :
  23. C ENTREES :
  24. C ENTREES/SORTIES :
  25. C SORTIES :
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 19/12/2005, version initiale
  29. C HISTORIQUE : v1, 19/12/2005, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. -INC CCOPTIO
  38. CBEGININCLUDE SMPOUET
  39. SEGMENT TABGEO
  40. CHARACTER*4 DISGEO
  41. POINTEUR IGEO.MCHAEL
  42. ENDSEGMENT
  43. SEGMENT TABVDC
  44. INTEGER VVARPR(NUMVPR)
  45. INTEGER VVARDU(NUMVDU)
  46. INTEGER VDATPR(NUMDPR)
  47. INTEGER VDATDU(NUMDDU)
  48. INTEGER VCOFPR(NUMCPR)
  49. INTEGER VCOFDU(NUMCDU)
  50. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  51. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  52. POINTEUR VLCOF(JLCOF).MLENTI
  53. POINTEUR VCOMP(JGCOF).COMP
  54. POINTEUR VLDAT(JGCOF).MLENTI
  55. INTEGER DJSVD(JGVD)
  56. POINTEUR NOMVD(JGVD).MLMOTS
  57. POINTEUR MVD(JGVD).MCHPOI
  58. REAL*8 XVD(JGVD)
  59. CHARACTER*4 DISVD(KGVD)
  60. ENDSEGMENT
  61. SEGMENT TATRAV
  62. POINTEUR VVCOF(JLCOF).MCHEVA
  63. POINTEUR VCOF(JGCOF).MCHEVA
  64. POINTEUR IVD(JGVD).MCHAEL
  65. POINTEUR VD(JGVD).MCHEVA
  66. POINTEUR DVD(JGVD).MCHEVA
  67. POINTEUR FFVD(KGVD).MCHEVA
  68. POINTEUR DFFVD(KGVD).MCHEVA
  69. LOGICAL LVCOF(JGCOF)
  70. LOGICAL LVD(JGVD)
  71. LOGICAL LDVD(JGVD)
  72. LOGICAL LFFVD(KGVD)
  73. LOGICAL LDFFVD(KGVD)
  74. ENDSEGMENT
  75. SEGMENT TABMAT
  76. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  77. ENDSEGMENT
  78. CENDINCLUDE SMPOUET
  79. -INC SMLENTI
  80. POINTEUR POWCOF.MLENTI
  81. CBEGININCLUDE SMCHAEL
  82. SEGMENT MCHAEL
  83. POINTEUR IMACHE(N1).MELEME
  84. POINTEUR ICHEVA(N1).MCHEVA
  85. ENDSEGMENT
  86. SEGMENT MCHEVA
  87. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  88. ENDSEGMENT
  89. SEGMENT LCHEVA
  90. POINTEUR LISCHE(NBCHE).MCHEVA
  91. ENDSEGMENT
  92. CENDINCLUDE SMCHAEL
  93. POINTEUR LCOF.LCHEVA
  94. POINTEUR MYCOF.MCHEVA
  95. * Segments où l'on stocke les nombres d'éléments et nombre de points de
  96. * Gauss pour chaque champ à fin de vérification
  97. POINTEUR LNELEM.MLENTI
  98. POINTEUR LNPOGA.MLENTI
  99. POINTEUR LPOW.MLENTI
  100. POINTEUR IPROCO.MCHEVA
  101. *
  102. INTEGER IMPR,IRET
  103. *
  104. * Executable statements
  105. *
  106. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans calpco.eso'
  107. *
  108. NBCHE=0
  109. SEGINI LCOF
  110. JG=0
  111. SEGINI LNELEM
  112. JG=0
  113. SEGINI LNPOGA
  114. JG=0
  115. SEGINI LPOW
  116. SEGACT POWCOF
  117. JGCOF=POWCOF.LECT(/1)
  118. DO IJGCOF=1,JGCOF
  119. IPOW=POWCOF.LECT(IJGCOF)
  120. IF (IPOW.NE.0) THEN
  121. MYCOF=TATRAV.VCOF(IJGCOF)
  122. SEGACT MYCOF
  123. NDLIG =MYCOF.VELCHE(/1)
  124. NDCOL =MYCOF.VELCHE(/2)
  125. N2DLIG=MYCOF.VELCHE(/3)
  126. N2DCOL=MYCOF.VELCHE(/4)
  127. NEL=MYCOF.VELCHE(/6)
  128. NPG=MYCOF.VELCHE(/5)
  129. SEGDES MYCOF
  130. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  131. $ N2DCOL.NE.1) THEN
  132. WRITE(IOIMP,*) 'Erreur dims MYCOF'
  133. WRITE(IOIMP,*) 'IJGCOF=',IJGCOF
  134. WRITE(IOIMP,*) 'NDLIG=',NDLIG
  135. WRITE(IOIMP,*) 'NDCOL=',NDCOL
  136. WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
  137. WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
  138. WRITE(IOIMP,*) 'NPG =',NPG
  139. WRITE(IOIMP,*) 'NEL =',NEL
  140. GOTO 9999
  141. ENDIF
  142. LCOF.LISCHE(**)=MYCOF
  143. LNELEM.LECT(**)=NEL
  144. LNPOGA.LECT(**)=NPG
  145. LPOW.LECT(**)=IPOW
  146. ENDIF
  147. ENDDO
  148. SEGDES POWCOF
  149. * Vérifications des dimensions
  150. * Calcul des max
  151. JG=LNELEM.LECT(/1)
  152. NELMAX=1
  153. NPGMAX=1
  154. DO IG=1,JG
  155. NELMAX=MAX(NELMAX,LNELEM.LECT(IG))
  156. NPGMAX=MAX(NPGMAX,LNPOGA.LECT(IG))
  157. ENDDO
  158. * Vérif proprement dite
  159. DO IG=1,JG
  160. NEL=LNELEM.LECT(IG)
  161. NPG=LNPOGA.LECT(IG)
  162. IF ((NPG.NE.1.AND.NPG.NE.NPGMAX)
  163. $ .OR.(NEL.NE.1.AND.NEL.NE.NELMAX)) THEN
  164. WRITE(IOIMP,*) 'Erreur dims MYCOF'
  165. WRITE(IOIMP,*) 'MYCOF=',LCOF.LISCHE(IG)
  166. WRITE(IOIMP,*) 'NPG=',NPG
  167. WRITE(IOIMP,*) 'NEL=',NEL
  168. WRITE(IOIMP,*) 'NPGMAX=',NPGMAX
  169. WRITE(IOIMP,*) 'NELMAX=',NELMAX
  170. GOTO 9999
  171. ENDIF
  172. ENDDO
  173. *
  174. * Initialisation du segment contenant la valeur de la loi de
  175. * comportement
  176. NBLIG=1
  177. NBCOL=1
  178. N2LIG=1
  179. N2COL=1
  180. NBPOI=NPGMAX
  181. NBELM=NELMAX
  182. SEGINI IPROCO
  183. DO IBELM=1,NBELM
  184. DO IBPOI=1,NBPOI
  185. IPROCO.VELCHE(1,1,1,1,IBPOI,IBELM)=1.D0
  186. ENDDO
  187. ENDDO
  188. *
  189. * Calcul proprement dit
  190. *
  191. DO IG=1,JG
  192. MYCOF=LCOF.LISCHE(IG)
  193. NEL=LNELEM.LECT(IG)
  194. NPG=LNPOGA.LECT(IG)
  195. IPOW=LPOW.LECT(IG)
  196. SEGACT MYCOF
  197. CALL CALPC1(IPROCO.VELCHE,NPGMAX,NELMAX,
  198. $ MYCOF.VELCHE,NPG,NEL,IPOW,
  199. $ IMPR,IRET)
  200. IF (IRET.NE.0) GOTO 9999
  201. SEGDES MYCOF
  202. ENDDO
  203. SEGSUP LCOF
  204. SEGSUP LNELEM
  205. SEGSUP LNPOGA
  206. SEGSUP LPOW
  207. *
  208. * Fin
  209. *
  210. SEGDES IPROCO
  211.  
  212.  
  213. *
  214. * Normal termination
  215. *
  216. IRET=0
  217. RETURN
  218. *
  219. * Format handling
  220. *
  221. *
  222. * Error handling
  223. *
  224. 9999 CONTINUE
  225. IRET=1
  226. WRITE(IOIMP,*) 'An error was detected in subroutine calpco'
  227. RETURN
  228. *
  229. * End of subroutine CALPCO
  230. *
  231. END
  232.  
  233.  
  234.  
  235.  

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