Télécharger dync.eso

Retour à la liste

Numérotation des lignes :

  1. C DYNC SOURCE BP208322 20/09/18 21:16:21 10718
  2. c
  3. SUBROUTINE DYNC
  4. *
  5. ************************************************************************
  6. *
  7. * RESOUT LE PB DYNAMIQUE PAR HBM + CONTINUATION :
  8. * .. . .
  9. * M q + C q + K q = f^ext(t) + f^nl(Q,Q,a)
  10. *
  11. * avec q(t) = \sum_j{q_jc cos (jwt) + q_js sin(jwt)}
  12. *
  13. * AUTEUR : ROBERTO ALCORTA, 2020
  14. *
  15. ************************************************************************
  16. *
  17. IMPLICIT INTEGER(I-N)
  18. IMPLICIT REAL*8(A-H,O-Z)
  19. REAL*8 INDA,INDB
  20. INTEGER NHBM,NFFT,SPAS
  21. LOGICAL CHECK,RIGIDE,REPRIS
  22.  
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. ***** extrait du futur include TMDYNC.INC :
  26. SEGMENT PARNUM
  27. CHARACTER*4 TYPS
  28. REAL*8 DS,DSMAX,DSMIN,ANGMIN,ANGMAX,ITERMOY,ISENS,TOLMIN
  29. REAL*8 PARINI,PARFIN
  30. INTEGER ITERMAX,NBPAS
  31. LOGICAL JANAL
  32. ENDSEGMENT
  33. ***** fin extrait du futur include TMDYNC.INC :
  34.  
  35. ************************************************************************
  36. * LECTURE
  37. ************************************************************************
  38.  
  39. c lecture des arguments
  40. c HBMLIR copie depuis DEVLIR
  41. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMLIR'
  42. CALL HBMLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,ITOPT,NINS,
  43. & ITREDU,IPARNUM,KPREF,KCPR,NHBM,NFFT)
  44. IF (IERR.NE.0) RETURN
  45.  
  46. c allocation memoire (creation des segments)
  47. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMALO'
  48. CALL HBMALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NINS,ITREDU,
  49. & IPARNUM,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTEMP,KTLIAB,
  50. & KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,KPARNUM,
  51. & KSORT,ICHAIN,KOCLFA,KOCLB1,NHBM,NFFT)
  52.  
  53. c Remplissage des tableaux des liaisons:
  54. IF (ITLIA.NE.0) THEN
  55. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a DEVLIA'
  56. CALL DEVLIA(ITLIA,KCPR,0.D0,KTLIAA,KTLIAB,0,.false.,2)
  57. IF (IERR.NE.0) RETURN
  58. ENDIF
  59.  
  60. c Transposition des objets CASTEM dans des tableaux
  61. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMTRA'
  62. CALL HBMTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,NHBM,KTRES,KTNUM,KPREF,
  63. & KTPHI,KTLIAB,RIGIDE)
  64.  
  65.  
  66. ************************************************************************
  67. * CALCUL D'UNE SOLUTION INITIALE
  68. ************************************************************************
  69.  
  70. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMINI'
  71. CALL HBMINI(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
  72. & KCPR,KOCLFA,KOCLB1,KPARNUM,NHBM,NFFT,CHECK,ITER)
  73.  
  74. IF (CHECK) THEN
  75. c Pas de convergence, arret de %m1:8
  76. MOTERR(1:8)='DYNC '
  77. CALL ERREUR(997)
  78. RETURN
  79. ELSEIF(IIMPI.GE.2) THEN
  80. WRITE(IOIMP,*) 'DYNC : Solution initiale convergee'
  81. ENDIF
  82.  
  83. ************************************************************************
  84. * CONTINUATION EN FONCTION D'UN PARAMETRE
  85. ************************************************************************
  86.  
  87. PARNUM = KPARNUM
  88. IF (TYPS.EQ.'FORC') THEN
  89. NOTYPS = 0
  90. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a CONT'
  91. CALL HBMCON(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
  92. & KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,SPAS,ITER)
  93. ELSEIF (TYPS.EQ.'AUTO') THEN
  94. NOTYPS = 1
  95. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a CONTA'
  96. CALL HBMCO2(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
  97. & KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,SPAS,ITER)
  98. ENDIF
  99.  
  100. ************************************************************************
  101. * ECRITURE DES RESULTATS ET SORTIE DU PROGRAMME
  102. ************************************************************************
  103. *
  104. IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMSOR'
  105. CALL HBMSOR(KSORT,KPREF,NOTYPS,NHBM)
  106. *
  107. RETURN
  108. END
  109.  
  110.  
  111.  
  112.  

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