C DYNDEV SOURCE FANDEUR 11/04/12 21:15:57 6938 SUBROUTINE DYNDEV IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *--------------------------------------------------------------------* * * * Operateur DYNE : algorithme de Fu - de Vogelaere * * ________________________________________________ * * * * Appel aux sous-programmes de l'option 'DE_VOGELAERE' * * * * Remarque : les segments de travail sont laisses actifs durant * * l'execution de l'algorithme. * * * * Auteur, date de creation: * * * * Denis ROBERT-MOUGIN, LE 25 mai 1989. * * * *--------------------------------------------------------------------* -INC CCOPTIO * LOGICAL REPRIS,RIGIDE,LMODYN * ICHAIN = 0 * * Lecture et coh�rence des op�randes: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVLIR' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVLIR' ENDIF CALL DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS, & ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVLIR' ENDIF ** LMODYN = .TRUE. : donn�es table PASAPAS * * Allocation de l'espace de travail: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVALO' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVALO' ENDIF CALL DEVALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS, & ITSORT,ITREDU,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB, & KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,ICHAIN, & KOCLFA,KOCLB1,ITCARA,LMODYN) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVALO' ENDIF * * Remplissage des tableaux des liaisons: * IF (ITLIA.NE.0) THEN IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVLIA' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVLIA' ENDIF CALL DEVLIA(ITLIA,KCPR,PDT,KTLIAA,KTLIAB,ITCARA,LMODYN) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVLIA' ENDIF ENDIF * * Transposition du contenu d'objets CASTEM2000 dans des tableaux: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVTRA' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVTRA' ENDIF CALL DEVTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,KTRES,KPREF,KTPHI,KTLIAB, & RIGIDE,ITCARA,LMODYN) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVTRA' ENDIF * * Remplissage du tableau des chargements ext�rieurs: * IF (ITCHAR.NE.0) THEN IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVFX0' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVFX0' ENDIF CALL DEVFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE, &LMODYN,ITBAS) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVFX0' ENDIF IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSPM' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVPSM' ENDIF CALL DEVPSM(ITCHAR,ITBAS,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVPSM' ENDIF ENDIF * * Lecture des chargements en Base B, pour les corps rigides * IF (RIGIDE) THEN IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVRIG' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV :avant l''appel au sous-programme & DEVRIG' ENDIF CALL DEVRIG(ITCHAR,KTNUM,KTPHI,KTFEX,KTLIAB,REPRIS) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV :apres l''appel au sous-programme & DEVRIG' ENDIF ENDIF * * Initialisation de l'algorithme, ou reprise de calcul: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVINI' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVINI' ENDIF CALL DEVINI(ITINIT,KTKAM,KTQ,KTFEX,KTPAS,KTNUM,KTLIAA,KTLIAB, & KTPHI,KCPR,KOCLFA,KOCLB1,REPRIS,RIGIDE,lmodyn) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVINI' ENDIF * * Mise en oeuvre de l'algorithme: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVALG' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVALG' ENDIF CALL DEVALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,KTRES, & KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS,RIGIDE) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVALG' ENDIF * * Cr�ation de la table r�sultat et nettoyage m�moire: * IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSOR' ENDIF IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVSOR' ENDIF CALL DEVSOR(KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS, & KTRES,KTNUM,NINS,IPMAIL,REPRIS,ICHAIN, & KOCLFA,KOCLB1,LMODYN,ITDYN) IF (IERR.NE.0) RETURN IF (IIMPI.EQ.444) THEN CALL GIBTEM(XKT) INTERR(1)=XKT CALL ERREUR(-259) WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVSOR' ENDIF IF (IIMPI.EQ.333) THEN WRITE(IOIMP,*)'DYNDEV : fin presumee normale de ce calcul' ENDIF * RETURN END