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 PPARAM
  38. -INC CCOPTIO
  39. CBEGININCLUDE SMPOUET
  40. SEGMENT TABGEO
  41. CHARACTER*4 DISGEO
  42. POINTEUR IGEO.MCHAEL
  43. ENDSEGMENT
  44. SEGMENT TABVDC
  45. INTEGER VVARPR(NUMVPR)
  46. INTEGER VVARDU(NUMVDU)
  47. INTEGER VDATPR(NUMDPR)
  48. INTEGER VDATDU(NUMDDU)
  49. INTEGER VCOFPR(NUMCPR)
  50. INTEGER VCOFDU(NUMCDU)
  51. INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR)
  52. INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU)
  53. POINTEUR VLCOF(JLCOF).MLENTI
  54. POINTEUR VCOMP(JGCOF).COMP
  55. POINTEUR VLDAT(JGCOF).MLENTI
  56. INTEGER DJSVD(JGVD)
  57. POINTEUR NOMVD(JGVD).MLMOTS
  58. POINTEUR MVD(JGVD).MCHPOI
  59. REAL*8 XVD(JGVD)
  60. CHARACTER*4 DISVD(KGVD)
  61. ENDSEGMENT
  62. SEGMENT TATRAV
  63. POINTEUR VVCOF(JLCOF).MCHEVA
  64. POINTEUR VCOF(JGCOF).MCHEVA
  65. POINTEUR IVD(JGVD).MCHAEL
  66. POINTEUR VD(JGVD).MCHEVA
  67. POINTEUR DVD(JGVD).MCHEVA
  68. POINTEUR FFVD(KGVD).MCHEVA
  69. POINTEUR DFFVD(KGVD).MCHEVA
  70. LOGICAL LVCOF(JGCOF)
  71. LOGICAL LVD(JGVD)
  72. LOGICAL LDVD(JGVD)
  73. LOGICAL LFFVD(KGVD)
  74. LOGICAL LDFFVD(KGVD)
  75. ENDSEGMENT
  76. SEGMENT TABMAT
  77. POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL
  78. ENDSEGMENT
  79. CENDINCLUDE SMPOUET
  80. -INC SMLENTI
  81. POINTEUR POWCOF.MLENTI
  82. CBEGININCLUDE SMCHAEL
  83. SEGMENT MCHAEL
  84. POINTEUR IMACHE(N1).MELEME
  85. POINTEUR ICHEVA(N1).MCHEVA
  86. ENDSEGMENT
  87. SEGMENT MCHEVA
  88. REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM)
  89. ENDSEGMENT
  90. SEGMENT LCHEVA
  91. POINTEUR LISCHE(NBCHE).MCHEVA
  92. ENDSEGMENT
  93. CENDINCLUDE SMCHAEL
  94. POINTEUR LCOF.LCHEVA
  95. POINTEUR MYCOF.MCHEVA
  96. * Segments où l'on stocke les nombres d'éléments et nombre de points de
  97. * Gauss pour chaque champ à fin de vérification
  98. POINTEUR LNELEM.MLENTI
  99. POINTEUR LNPOGA.MLENTI
  100. POINTEUR LPOW.MLENTI
  101. POINTEUR IPROCO.MCHEVA
  102. *
  103. INTEGER IMPR,IRET
  104. *
  105. * Executable statements
  106. *
  107. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans calpco.eso'
  108. *
  109. NBCHE=0
  110. SEGINI LCOF
  111. JG=0
  112. SEGINI LNELEM
  113. JG=0
  114. SEGINI LNPOGA
  115. JG=0
  116. SEGINI LPOW
  117. SEGACT POWCOF
  118. JGCOF=POWCOF.LECT(/1)
  119. DO IJGCOF=1,JGCOF
  120. IPOW=POWCOF.LECT(IJGCOF)
  121. IF (IPOW.NE.0) THEN
  122. MYCOF=TATRAV.VCOF(IJGCOF)
  123. SEGACT MYCOF
  124. NDLIG =MYCOF.VELCHE(/1)
  125. NDCOL =MYCOF.VELCHE(/2)
  126. N2DLIG=MYCOF.VELCHE(/3)
  127. N2DCOL=MYCOF.VELCHE(/4)
  128. NEL=MYCOF.VELCHE(/6)
  129. NPG=MYCOF.VELCHE(/5)
  130. SEGDES MYCOF
  131. IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
  132. $ N2DCOL.NE.1) THEN
  133. WRITE(IOIMP,*) 'Erreur dims MYCOF'
  134. WRITE(IOIMP,*) 'IJGCOF=',IJGCOF
  135. WRITE(IOIMP,*) 'NDLIG=',NDLIG
  136. WRITE(IOIMP,*) 'NDCOL=',NDCOL
  137. WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
  138. WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
  139. WRITE(IOIMP,*) 'NPG =',NPG
  140. WRITE(IOIMP,*) 'NEL =',NEL
  141. GOTO 9999
  142. ENDIF
  143. LCOF.LISCHE(**)=MYCOF
  144. LNELEM.LECT(**)=NEL
  145. LNPOGA.LECT(**)=NPG
  146. LPOW.LECT(**)=IPOW
  147. ENDIF
  148. ENDDO
  149. SEGDES POWCOF
  150. * Vérifications des dimensions
  151. * Calcul des max
  152. JG=LNELEM.LECT(/1)
  153. NELMAX=1
  154. NPGMAX=1
  155. DO IG=1,JG
  156. NELMAX=MAX(NELMAX,LNELEM.LECT(IG))
  157. NPGMAX=MAX(NPGMAX,LNPOGA.LECT(IG))
  158. ENDDO
  159. * Vérif proprement dite
  160. DO IG=1,JG
  161. NEL=LNELEM.LECT(IG)
  162. NPG=LNPOGA.LECT(IG)
  163. IF ((NPG.NE.1.AND.NPG.NE.NPGMAX)
  164. $ .OR.(NEL.NE.1.AND.NEL.NE.NELMAX)) THEN
  165. WRITE(IOIMP,*) 'Erreur dims MYCOF'
  166. WRITE(IOIMP,*) 'MYCOF=',LCOF.LISCHE(IG)
  167. WRITE(IOIMP,*) 'NPG=',NPG
  168. WRITE(IOIMP,*) 'NEL=',NEL
  169. WRITE(IOIMP,*) 'NPGMAX=',NPGMAX
  170. WRITE(IOIMP,*) 'NELMAX=',NELMAX
  171. GOTO 9999
  172. ENDIF
  173. ENDDO
  174. *
  175. * Initialisation du segment contenant la valeur de la loi de
  176. * comportement
  177. NBLIG=1
  178. NBCOL=1
  179. N2LIG=1
  180. N2COL=1
  181. NBPOI=NPGMAX
  182. NBELM=NELMAX
  183. SEGINI IPROCO
  184. DO IBELM=1,NBELM
  185. DO IBPOI=1,NBPOI
  186. IPROCO.VELCHE(1,1,1,1,IBPOI,IBELM)=1.D0
  187. ENDDO
  188. ENDDO
  189. *
  190. * Calcul proprement dit
  191. *
  192. DO IG=1,JG
  193. MYCOF=LCOF.LISCHE(IG)
  194. NEL=LNELEM.LECT(IG)
  195. NPG=LNPOGA.LECT(IG)
  196. IPOW=LPOW.LECT(IG)
  197. SEGACT MYCOF
  198. CALL CALPC1(IPROCO.VELCHE,NPGMAX,NELMAX,
  199. $ MYCOF.VELCHE,NPG,NEL,IPOW,
  200. $ IMPR,IRET)
  201. IF (IRET.NE.0) GOTO 9999
  202. SEGDES MYCOF
  203. ENDDO
  204. SEGSUP LCOF
  205. SEGSUP LNELEM
  206. SEGSUP LNPOGA
  207. SEGSUP LPOW
  208. *
  209. * Fin
  210. *
  211. SEGDES IPROCO
  212.  
  213.  
  214. *
  215. * Normal termination
  216. *
  217. IRET=0
  218. RETURN
  219. *
  220. * Format handling
  221. *
  222. *
  223. * Error handling
  224. *
  225. 9999 CONTINUE
  226. IRET=1
  227. WRITE(IOIMP,*) 'An error was detected in subroutine calpco'
  228. RETURN
  229. *
  230. * End of subroutine CALPCO
  231. *
  232. END
  233.  
  234.  
  235.  
  236.  

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