Télécharger dyndif.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNDIF SOURCE BP208322 14/09/15 21:16:25 8151
  2. C DYNDEV SOURCE LAVARENN 96/10/30 21:23:28 2349
  3. SUBROUTINE DYNDIF
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8(A-H,O-Z)
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Operateur DYNE : algorithme de Fu - de Vogelaere *
  9. * ________________________________________________ *
  10. * *
  11. * Appel aux sous-programmes de l'option 'DE_VOGELAERE' *
  12. * *
  13. * Remarque : les segments de travail sont laisses actifs durant *
  14. * l'execution de l'algorithme. *
  15. * *
  16. * Auteur, date de creation: *
  17. * *
  18. * Denis ROBERT-MOUGIN, LE 25 mai 1989. *
  19. * *
  20. *--------------------------------------------------------------------*
  21. -INC CCOPTIO
  22. *
  23. LOGICAL REPRIS,RIGIDE,LMODYN
  24. *
  25. ICHAIN = 0
  26. *
  27. * Lecture et coherence des operandes:
  28. *
  29. IF (IIMPI.EQ.333) THEN
  30. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVLIR'
  31. ENDIF
  32. IF (IIMPI.EQ.444) THEN
  33. CALL GIBTEM(XKT)
  34. INTERR(1)=INT(XKT)
  35. CALL ERREUR(-259)
  36. WRITE(IOIMP,*)'DYNDIF : avant lappel au sous-programme DEVLIR'
  37. ENDIF
  38. CALL DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS,
  39. & ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN)
  40. IF (IERR.NE.0) RETURN
  41. IF (IIMPI.EQ.444) THEN
  42. CALL GIBTEM(XKT)
  43. INTERR(1)=INT(XKT)
  44. CALL ERREUR(-259)
  45. WRITE(IOIMP,*)'DYNDIF : apres lappel au sous-programme DEVLIR'
  46. ENDIF
  47. *
  48. * Allocation de l'espace de travail:
  49. *
  50. IF (IIMPI.EQ.333) THEN
  51. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVALO'
  52. ENDIF
  53. IF (IIMPI.EQ.444) THEN
  54. CALL GIBTEM(XKT)
  55. INTERR(1)=INT(XKT)
  56. CALL ERREUR(-259)
  57. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVALO'
  58. ENDIF
  59. CALL DEVALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS,
  60. & ITSORT,ITREDU,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,
  61. & KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,ICHAIN,
  62. & KOCLFA,KOCLB1,ITCARA,LMODYN)
  63. IF (IERR.NE.0) RETURN
  64. IF (IIMPI.EQ.444) THEN
  65. CALL GIBTEM(XKT)
  66. INTERR(1)=INT(XKT)
  67. CALL ERREUR(-259)
  68. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme DEVALO'
  69. ENDIF
  70. *
  71. * Remplissage des tableaux des liaisons:
  72. *
  73. IF (ITLIA.NE.0) THEN
  74. IF (IIMPI.EQ.333) THEN
  75. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVLIA'
  76. ENDIF
  77. IF (IIMPI.EQ.444) THEN
  78. CALL GIBTEM(XKT)
  79. INTERR(1)=INT(XKT)
  80. CALL ERREUR(-259)
  81. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVLIA'
  82. ENDIF
  83. CALL DEVLIA(ITLIA,KCPR,PDT,KTLIAA,KTLIAB,ITCARA,LMODYN)
  84. IF (IERR.NE.0) RETURN
  85. IF (IIMPI.EQ.444) THEN
  86. CALL GIBTEM(XKT)
  87. INTERR(1)=INT(XKT)
  88. CALL ERREUR(-259)
  89. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme DEVLIA'
  90. ENDIF
  91. ENDIF
  92. *
  93. * Transposition du contenu d'objets CASTEM2000 dans des tableaux:
  94. *
  95. IF (IIMPI.EQ.333) THEN
  96. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VTRA'
  97. ENDIF
  98. IF (IIMPI.EQ.444) THEN
  99. CALL GIBTEM(XKT)
  100. INTERR(1)=INT(XKT)
  101. CALL ERREUR(-259)
  102. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme D2VTRA'
  103. ENDIF
  104. CALL D2VTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,KTRES,KTNUM,KPREF,KTPHI,
  105. & KTLIAB,RIGIDE,ITCARA,LMODYN)
  106. IF (IERR.NE.0) RETURN
  107. IF (IIMPI.EQ.444) THEN
  108. CALL GIBTEM(XKT)
  109. INTERR(1)=INT(XKT)
  110. CALL ERREUR(-259)
  111. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme D2VTRA'
  112. ENDIF
  113. *
  114. * Remplissage du tableau des chargements exterieurs:
  115. *
  116. IF (ITCHAR.NE.0) THEN
  117. IF (IIMPI.EQ.333) THEN
  118. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VFX0'
  119. ENDIF
  120. IF (IIMPI.EQ.444) THEN
  121. CALL GIBTEM(XKT)
  122. INTERR(1)=INT(XKT)
  123. CALL ERREUR(-259)
  124. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme D2VFX0'
  125. ENDIF
  126. CALL D2VFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE)
  127. IF (IERR.NE.0) RETURN
  128. IF (IIMPI.EQ.444) THEN
  129. CALL GIBTEM(XKT)
  130. INTERR(1)=INT(XKT)
  131. CALL ERREUR(-259)
  132. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme D2VFX0'
  133. ENDIF
  134. IF (IIMPI.EQ.333) THEN
  135. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSPM'
  136. ENDIF
  137. IF (IIMPI.EQ.444) THEN
  138. CALL GIBTEM(XKT)
  139. INTERR(1)=INT(XKT)
  140. CALL ERREUR(-259)
  141. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVPSM'
  142. ENDIF
  143. *
  144. * DEVPSM n'a pas ete modifie pour differences centrees, mais de toutes
  145. * facons les pseudomodes ne sont pas correctes en non lineaire
  146. CALL DEVPSM(ITCHAR,ITBAS,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS)
  147. IF (IERR.NE.0) RETURN
  148. IF (IIMPI.EQ.444) THEN
  149. CALL GIBTEM(XKT)
  150. INTERR(1)=INT(XKT)
  151. CALL ERREUR(-259)
  152. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme DEVPSM'
  153. ENDIF
  154. ENDIF
  155. *
  156. * Lecture des chargements en Base B, pour les corps rigides
  157. *
  158. IF (RIGIDE) THEN
  159. IF (IIMPI.EQ.333) THEN
  160. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VRIG'
  161. ENDIF
  162. IF (IIMPI.EQ.444) THEN
  163. CALL GIBTEM(XKT)
  164. INTERR(1)=INT(XKT)
  165. CALL ERREUR(-259)
  166. WRITE(IOIMP,*)'DYNDEV :avant lappel au sous-programme
  167. & D2VRIG'
  168. ENDIF
  169. CALL D2VRIG(ITCHAR,KTNUM,KTPHI,KTFEX,KTLIAB,REPRIS)
  170. IF (IERR.NE.0) RETURN
  171. IF (IIMPI.EQ.444) THEN
  172. CALL GIBTEM(XKT)
  173. INTERR(1)=INT(XKT)
  174. CALL ERREUR(-259)
  175. WRITE(IOIMP,*)'DYNDEV :apres lappel au sous-programme
  176. & D2VRIG'
  177. ENDIF
  178. ENDIF
  179. *
  180. * Initialisation de l'algorithme, ou reprise de calcul:
  181. *
  182. IF (IIMPI.EQ.333) THEN
  183. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VINI'
  184. ENDIF
  185. IF (IIMPI.EQ.444) THEN
  186. CALL GIBTEM(XKT)
  187. INTERR(1)=INT(XKT)
  188. CALL ERREUR(-259)
  189. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme D2VINI'
  190. ENDIF
  191. CALL D2VINI(ITINIT,KTKAM,KTQ,KTFEX,KTPAS,KTNUM,KTLIAA,KTLIAB,
  192. & KTPHI,KCPR,KOCLFA,KOCLB1,REPRIS,RIGIDE,lmodyn)
  193. IF (IERR.NE.0) RETURN
  194. IF (IIMPI.EQ.444) THEN
  195. CALL GIBTEM(XKT)
  196. INTERR(1)=INT(XKT)
  197. CALL ERREUR(-259)
  198. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme D2VINI'
  199. ENDIF
  200. *
  201. * Mise en oeuvre de l'algorithme:
  202. *
  203. IF (IIMPI.EQ.333) THEN
  204. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VALG'
  205. ENDIF
  206. IF (IIMPI.EQ.444) THEN
  207. CALL GIBTEM(XKT)
  208. INTERR(1)=INT(XKT)
  209. CALL ERREUR(-259)
  210. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme D2VALG'
  211. ENDIF
  212. CALL D2VALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,KTRES,
  213. & KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS,RIGIDE)
  214. IF (IERR.NE.0) RETURN
  215. IF (IIMPI.EQ.444) THEN
  216. CALL GIBTEM(XKT)
  217. INTERR(1)=INT(XKT)
  218. CALL ERREUR(-259)
  219. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme D2VALG'
  220. ENDIF
  221. *
  222. * Creation de la table resultat et nettoyage memoire:
  223. *
  224. IF (IIMPI.EQ.333) THEN
  225. WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSOR'
  226. ENDIF
  227. IF (IIMPI.EQ.444) THEN
  228. CALL GIBTEM(XKT)
  229. INTERR(1)=INT(XKT)
  230. CALL ERREUR(-259)
  231. WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVSOR'
  232. ENDIF
  233. CALL DEVSOR(KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,
  234. & KTRES,KTNUM,NINS,IPMAIL,REPRIS,ICHAIN,
  235. & KOCLFA,KOCLB1,LMODYN,ITDYN)
  236. IF (IERR.NE.0) RETURN
  237. IF (IIMPI.EQ.444) THEN
  238. CALL GIBTEM(XKT)
  239. INTERR(1)=INT(XKT)
  240. CALL ERREUR(-259)
  241. WRITE(IOIMP,*)'DYNDEV : apres lappel au sous-programme DEVSOR'
  242. ENDIF
  243. IF (IIMPI.EQ.333) THEN
  244. WRITE(IOIMP,*)'DYNDEV : fin presumee normale de ce calcul'
  245. ENDIF
  246. *
  247. RETURN
  248. END
  249.  
  250.  
  251.  
  252.  

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