Télécharger dyndev.eso

Retour à la liste

Numérotation des lignes :

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

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