Télécharger la plaquette Cast3M


fr en

Télécharger dyndif.eso

Retour à la liste

Numérotation des lignes : 

dyndif

  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