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

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