Télécharger la plaquette Cast3M


fr en

Télécharger dync.eso

Retour à la liste

Numérotation des lignes : 

dync

  1. C DYNC      SOURCE    CB215821  23/01/25    21:15:12     11573          
  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 SMCOORD    
  24. -INC PPARAM    
  25. -INC CCOPTIO   
  26. ***** extrait du futur include TMDYNC.INC :
  27.       SEGMENT PARNUM
  28.          CHARACTER*4 TYPS
  29.          REAL*8   DS,DSMAX,DSMIN,ANGMIN,ANGMAX,ITERMOY,ISENS,TOLMIN
  30.          REAL*8   PARINI,PARFIN
  31.          INTEGER  ITERMAX,NBPAS
  32.          LOGICAL  JANAL
  33.       ENDSEGMENT
  34. ***** fin extrait du futur include TMDYNC.INC :
  35.  
  36. ************************************************************************
  37. *     LECTURE
  38. ************************************************************************
  39.  
  40. c     lecture des arguments
  41. c     HBMLIR copie depuis DEVLIR
  42.       IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMLIR'
  43.       CALL HBMLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,ITOPT,NINS,
  44.      &            ITREDU,IPARNUM,KPREF,KCPR,NHBM,NFFT)
  45.       IF (IERR.NE.0) RETURN         
  46.  
  47. c     allocation memoire (creation des segments)
  48.       IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMALO'
  49.       CALL HBMALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NINS,ITREDU,
  50.      &            IPARNUM,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTEMP,KTLIAB,
  51.      &            KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,KPARNUM,
  52.      &            KSORT,ICHAIN,KOCLFA,KOCLB1,NHBM,NFFT)
  53.  
  54. c     Remplissage des tableaux des liaisons: 
  55.       IF (ITLIA.NE.0) THEN
  56.          IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a DEVLIA'
  57.          SEGACT,MCOORD
  58.          CALL DEVLIA(ITLIA,KCPR,0.D0,KTLIAA,KTLIAB,0,.false.,2)
  59.          SEGDES,MCOORD
  60.          IF (IERR.NE.0) RETURN
  61.       ENDIF
  62.  
  63. c     Transposition des objets CASTEM dans des tableaux 
  64.       IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMTRA'
  65.       CALL HBMTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,NHBM,KTRES,KTNUM,KPREF,
  66.      &            KTPHI,KTLIAB,RIGIDE) 
  67.  
  68.  
  69. ************************************************************************
  70. *     CALCUL D'UNE SOLUTION INITIALE
  71. ************************************************************************ 
  72.  
  73.        IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMINI'
  74.        CALL HBMINI(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
  75.      &             KCPR,KOCLFA,KOCLB1,KPARNUM,NHBM,NFFT,CHECK,ITER)
  76.  
  77.        IF (CHECK) THEN
  78. c        Pas de convergence, arret de %m1:8
  79.          MOTERR(1:8)='DYNC    '
  80.          CALL ERREUR(997)
  81.          RETURN
  82.        ELSEIF(IIMPI.GE.2) THEN
  83.          WRITE(IOIMP,*) 'DYNC : Solution initiale convergee'
  84.        ENDIF
  85.  
  86. ************************************************************************
  87. *     CONTINUATION EN FONCTION D'UN PARAMETRE
  88. ************************************************************************ 
  89.  
  90.        PARNUM = KPARNUM 
  91.        IF (TYPS.EQ.'FORC') THEN
  92.         NOTYPS = 0
  93.         IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMCON'
  94.         CALL HBMCON(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
  95.      &            KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,SPAS,ITER) 
  96.        ELSEIF (TYPS.EQ.'AUTO') THEN
  97.         NOTYPS = 1
  98.         IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMCO2'
  99.         CALL HBMCO2(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
  100.      &            KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,SPAS,ITER) 
  101.        ELSEIF (TYPS.EQ.'NNM') THEN
  102.         NOTYPS = 0
  103.         IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMCO3'
  104.         CALL HBMCO3(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
  105.      &            KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,SPAS,ITER) 
  106.        ENDIF
  107.  
  108. ************************************************************************
  109. *     ECRITURE DES RESULTATS ET SORTIE DU PROGRAMME
  110. ************************************************************************
  111. *
  112.       IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMSOR'
  113.       CALL HBMSOR(KSORT,KPREF,NOTYPS,NHBM)
  114. *      
  115.       RETURN
  116.       END
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  

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