1 : C DYNDIF SOURCE FANDEUR 11/04/12 21:15:58 6938 2 : C DYNDEV SOURCE LAVARENN 96/10/30 21:23:28 2349 3 : SUBROUTINE DYNDIF 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *--------------------------------------------------------------------* 7 : * * 8 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 9 : * ________________________________________________ * 10 : * * 11 : * Appel aux sous-programmes de l'option 'DE_VOGELAERE' * 12 : * * 13 : * Remarque : les segments de travail sont laisses actifs durant * 14 : * l'execution de l'algorithme. * 15 : * * 16 : * Auteur, date de creation: * 17 : * * 18 : * Denis ROBERT-MOUGIN, LE 25 mai 1989. * 19 : * * 20 : *--------------------------------------------------------------------* 21 : -INC CCOPTIO 22 : * 23 : LOGICAL REPRIS,RIGIDE,LMODYN 24 : * 25 : ICHAIN = 0 26 : * 27 : * Lecture et coh�rence des op�randes: 28 : * 29 : IF (IIMPI.EQ.333) THEN 30 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVLIR' 31 : ENDIF 32 : IF (IIMPI.EQ.444) THEN 32 : CALL GIBTEM(XKT) 33 : INTERR(1)=XKT 33 : CALL ERREUR(-259) 34 : WRITE(IOIMP,*)'DYNDIF : avant lappel au sous-programme DEVLIR' 35 : ENDIF 35 : CALL DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS, 36 : & ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN) 37 : IF (IERR.NE.0) RETURN 38 : IF (IIMPI.EQ.444) THEN 38 : CALL GIBTEM(XKT) 39 : INTERR(1)=XKT 39 : CALL ERREUR(-259) 40 : WRITE(IOIMP,*)'DYNDIF : apr�s lappel au sous-programme DEVLIR' 41 : ENDIF 42 : * 43 : * Allocation de l'espace de travail: 44 : * 45 : IF (IIMPI.EQ.333) THEN 46 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVALO' 47 : ENDIF 48 : IF (IIMPI.EQ.444) THEN 48 : CALL GIBTEM(XKT) 49 : INTERR(1)=XKT 49 : CALL ERREUR(-259) 50 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVALO' 51 : ENDIF 51 : CALL DEVALO(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS, 52 : & ITSORT,ITREDU,KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB, 53 : & KTFEX,KTPAS,KTRES,KTNUM,IPMAIL,REPRIS,ICHAIN, 54 : & KOCLFA,KOCLB1,ITCARA,LMODYN) 55 : IF (IERR.NE.0) RETURN 56 : IF (IIMPI.EQ.444) THEN 56 : CALL GIBTEM(XKT) 57 : INTERR(1)=XKT 57 : CALL ERREUR(-259) 58 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme DEVALO' 59 : ENDIF 60 : * 61 : * Remplissage des tableaux des liaisons: 62 : * 63 : IF (ITLIA.NE.0) THEN 64 : IF (IIMPI.EQ.333) THEN 65 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVLIA' 66 : ENDIF 67 : IF (IIMPI.EQ.444) THEN 67 : CALL GIBTEM(XKT) 68 : INTERR(1)=XKT 68 : CALL ERREUR(-259) 69 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVLIA' 70 : ENDIF 70 : CALL DEVLIA(ITLIA,KCPR,PDT,KTLIAA,KTLIAB,ITCARA,LMODYN) 71 : IF (IERR.NE.0) RETURN 72 : IF (IIMPI.EQ.444) THEN 72 : CALL GIBTEM(XKT) 73 : INTERR(1)=XKT 73 : CALL ERREUR(-259) 74 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme DEVLIA' 75 : ENDIF 76 : ENDIF 77 : * 78 : * Transposition du contenu d'objets CASTEM2000 dans des tableaux: 79 : * 80 : IF (IIMPI.EQ.333) THEN 81 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVTRA' 82 : ENDIF 83 : IF (IIMPI.EQ.444) THEN 83 : CALL GIBTEM(XKT) 84 : INTERR(1)=XKT 84 : CALL ERREUR(-259) 85 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVTRA' 86 : ENDIF 86 : CALL DEVTRA(ITBAS,ITKM,ITA,KTKAM,IPMAIL,KTRES,KPREF,KTPHI,KTLIAB, 87 : & RIGIDE,ITCARA,LMODYN) 88 : IF (IERR.NE.0) RETURN 89 : IF (IIMPI.EQ.444) THEN 89 : CALL GIBTEM(XKT) 90 : INTERR(1)=XKT 90 : CALL ERREUR(-259) 91 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme DEVTRA' 92 : ENDIF 93 : * 94 : * Remplissage du tableau des chargements ext�rieurs: 95 : * 96 : IF (ITCHAR.NE.0) THEN 97 : IF (IIMPI.EQ.333) THEN 98 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VFX0' 99 : ENDIF 100 : IF (IIMPI.EQ.444) THEN 100 : CALL GIBTEM(XKT) 101 : INTERR(1)=XKT 101 : CALL ERREUR(-259) 102 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme D2VFX0' 103 : ENDIF 103 : CALL D2VFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE) 104 : IF (IERR.NE.0) RETURN 105 : IF (IIMPI.EQ.444) THEN 105 : CALL GIBTEM(XKT) 106 : INTERR(1)=XKT 106 : CALL ERREUR(-259) 107 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme D2VFX0' 108 : ENDIF 109 : IF (IIMPI.EQ.333) THEN 110 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSPM' 111 : ENDIF 112 : IF (IIMPI.EQ.444) THEN 112 : CALL GIBTEM(XKT) 113 : INTERR(1)=XKT 113 : CALL ERREUR(-259) 114 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVPSM' 115 : ENDIF 116 : * 117 : * DEVPSM n'a pas ete modifie pour differences centrees, mais de toutes 118 : * facons les pseudomodes ne sont pas correctes en non lineaire 118 : CALL DEVPSM(ITCHAR,ITBAS,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS) 119 : IF (IERR.NE.0) RETURN 120 : IF (IIMPI.EQ.444) THEN 120 : CALL GIBTEM(XKT) 121 : INTERR(1)=XKT 121 : CALL ERREUR(-259) 122 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme DEVPSM' 123 : ENDIF 124 : ENDIF 125 : * 126 : * Lecture des chargements en Base B, pour les corps rigides 127 : * 128 : IF (RIGIDE) THEN 129 : IF (IIMPI.EQ.333) THEN 130 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VRIG' 131 : ENDIF 132 : IF (IIMPI.EQ.444) THEN 132 : CALL GIBTEM(XKT) 133 : INTERR(1)=XKT 133 : CALL ERREUR(-259) 134 : WRITE(IOIMP,*)'DYNDEV :avant lappel au sous-programme 135 : & D2VRIG' 136 : ENDIF 136 : CALL D2VRIG(ITCHAR,KTNUM,KTPHI,KTFEX,KTLIAB,REPRIS) 137 : IF (IERR.NE.0) RETURN 138 : IF (IIMPI.EQ.444) THEN 138 : CALL GIBTEM(XKT) 139 : INTERR(1)=XKT 139 : CALL ERREUR(-259) 140 : WRITE(IOIMP,*)'DYNDEV :apr�s lappel au sous-programme 141 : & D2VRIG' 142 : ENDIF 143 : ENDIF 144 : * 145 : * Initialisation de l'algorithme, ou reprise de calcul: 146 : * 147 : IF (IIMPI.EQ.333) THEN 148 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VINI' 149 : ENDIF 150 : IF (IIMPI.EQ.444) THEN 150 : CALL GIBTEM(XKT) 151 : INTERR(1)=XKT 151 : CALL ERREUR(-259) 152 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme D2VINI' 153 : ENDIF 153 : CALL D2VINI(ITINIT,KTKAM,KTQ,KTFEX,KTPAS,KTNUM,KTLIAA,KTLIAB, 154 : & KTPHI,KCPR,KOCLFA,KOCLB1,REPRIS,RIGIDE,lmodyn) 155 : IF (IERR.NE.0) RETURN 156 : IF (IIMPI.EQ.444) THEN 156 : CALL GIBTEM(XKT) 157 : INTERR(1)=XKT 157 : CALL ERREUR(-259) 158 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme D2VINI' 159 : ENDIF 160 : * 161 : * Mise en oeuvre de l'algorithme: 162 : * 163 : IF (IIMPI.EQ.333) THEN 164 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme D2VALG' 165 : ENDIF 166 : IF (IIMPI.EQ.444) THEN 166 : CALL GIBTEM(XKT) 167 : INTERR(1)=XKT 167 : CALL ERREUR(-259) 168 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme D2VALG' 169 : ENDIF 169 : CALL D2VALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,KTRES, 170 : & KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS,RIGIDE) 171 : IF (IERR.NE.0) RETURN 172 : IF (IIMPI.EQ.444) THEN 172 : CALL GIBTEM(XKT) 173 : INTERR(1)=XKT 173 : CALL ERREUR(-259) 174 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme D2VALG' 175 : ENDIF 176 : * 177 : * Cr�ation de la table r�sultat et nettoyage m�moire: 178 : * 179 : IF (IIMPI.EQ.333) THEN 180 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSOR' 181 : ENDIF 182 : IF (IIMPI.EQ.444) THEN 182 : CALL GIBTEM(XKT) 183 : INTERR(1)=XKT 183 : CALL ERREUR(-259) 184 : WRITE(IOIMP,*)'DYNDEV : avant lappel au sous-programme DEVSOR' 185 : ENDIF 185 : CALL DEVSOR(KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS, 186 : & KTRES,KTNUM,NINS,IPMAIL,REPRIS,ICHAIN, 187 : & KOCLFA,KOCLB1,LMODYN,ITDYN) 188 : IF (IERR.NE.0) RETURN 189 : IF (IIMPI.EQ.444) THEN 189 : CALL GIBTEM(XKT) 190 : INTERR(1)=XKT 190 : CALL ERREUR(-259) 191 : WRITE(IOIMP,*)'DYNDEV : apr�s lappel au sous-programme DEVSOR' 192 : ENDIF 193 : IF (IIMPI.EQ.333) THEN 194 : WRITE(IOIMP,*)'DYNDEV : fin pr�sum�e normale de ce calcul' 195 : ENDIF 196 : * 197 : RETURN 198 : END 199 : 200 :
© Cast3M 2003 - All rights reserved.
Disclaimer