Télécharger dyndif.eso

Retour à la liste

Numérotation des lignes :

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

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