C DYNC      SOURCE    OF166741  26/05/11    21:15:05     12538          

      SUBROUTINE DYNC

************************************************************************
*
*     RESOUT LE PB DYNAMIQUE PAR HBM + CONTINUATION :
*         ..     .                           .
*       M q  + C q + K q = f^ext(t) + f^nl(Q,Q,a)
*
*     avec q(t) = \sum_j{q_jc cos (jwt) + q_js sin(jwt)}
*
*     AUTEUR : ROBERTO ALCORTA, 2020
*
************************************************************************

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)

-INC PPARAM
-INC CCOPTIO

-INC SMCOORD

-INC TMDYNC

      INTEGER NHBM,NFFT,NSPAS
      LOGICAL CHECK,RIGIDE,REPRIS

************************************************************************
*     LECTURE
************************************************************************

c     lecture des arguments
c     HBMLIR copie depuis DEVLIR
      IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMLIR'
      CALL HBMLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,ITOPT,NINS,
     &            ITREDU,IPARNUM,KPREF,KCPR,NHBM,NFFT)
      IF (IERR.NE.0) RETURN

c     allocation memoire (creation des segments)
      IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMALO'
      CALL HBMALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NINS,ITREDU,
     &            IPARNUM,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTEMP,KTLIAB,
     &            KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,KPARNUM,
     &            KSORT,ICHAIN,KOCLFA,KOCLB1,NHBM,NFFT)

c     Remplissage des tableaux des liaisons
      IF (ITLIA.NE.0) THEN
         IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a DEVLIA'
         SEGACT,MCOORD
         CALL DEVLIA(ITLIA,KCPR,0.D0,KTLIAA,KTLIAB,0,.FALSE.,2)
         SEGDES,MCOORD
         IF (IERR.NE.0) RETURN
      ENDIF

c     Transposition des objets CASTEM dans des tableaux
      IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMTRA'
      CALL HBMTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,NHBM,KTRES,KTNUM,KPREF,
     &            KTPHI,KTLIAB,RIGIDE)

************************************************************************
*     CALCUL D'UNE SOLUTION INITIALE
************************************************************************

      IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMINI'
      CALL HBMINI(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
     &             KCPR,KOCLFA,KOCLB1,KPARNUM,NHBM,NFFT,CHECK,ITER)

      IF (CHECK) THEN
c        Pas de convergence, arret de %m1:8
         MOTERR(1:8)='DYNC    '
         CALL ERREUR(997)
         RETURN
      ENDIF
      IF(IIMPI.GE.2)
     &   WRITE(IOIMP,*) 'DYNC : Solution initiale convergee'

************************************************************************
*     CONTINUATION EN FONCTION D'UN PARAMETRE
************************************************************************

      PARNUM = KPARNUM
      IF (parnum.TYPS.EQ.'FORC') THEN
        NOTYPS = 0
        IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMCON'
        CALL HBMCON(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
     &              KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,NSPAS,
     &              ITER)
      ELSEIF (parnum.TYPS.EQ.'AUTO') THEN
        NOTYPS = 1
        IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMCO2'
        CALL HBMCO2(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
     &              KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,NSPAS,
     &              ITER)
      ELSEIF (parnum.TYPS.EQ.'NNM') THEN
        NOTYPS = 0
        IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMCO3'
        CALL HBMCO3(KTKAM,KTQ,KTFEX,KTPAS,KTLIAA,KTEMP,KTLIAB,KTPHI,
     &              KCPR,KOCLFA,KOCLB1,NHBM,NFFT,KPARNUM,KSORT,NSPAS,
     &              ITER)
      ENDIF

************************************************************************
*     ECRITURE DES RESULTATS ET SORTIE DU PROGRAMME
************************************************************************

      IF (IIMPI.EQ.333) WRITE(IOIMP,*) 'DYNC : appel a HBMSOR'
      CALL HBMSOR(KSORT,KPREF,NOTYPS,NHBM)

      RETURN
      END