1 : C DYNDEV SOURCE FANDEUR 11/04/12 21:15:57 6938 2 : SUBROUTINE DYNDEV 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : *--------------------------------------------------------------------* 6 : * * 7 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 8 : * ________________________________________________ * 9 : * * 10 : * Appel aux sous-programmes de l'option 'DE_VOGELAERE' * 11 : * * 12 : * Remarque : les segments de travail sont laisses actifs durant * 13 : * l'execution de l'algorithme. * 14 : * * 15 : * Auteur, date de creation: * 16 : * * 17 : * Denis ROBERT-MOUGIN, LE 25 mai 1989. * 18 : * * 19 : *--------------------------------------------------------------------* 20 : -INC CCOPTIO 21 : * 22 : LOGICAL REPRIS,RIGIDE,LMODYN 23 : * 24 : ICHAIN = 0 25 : * 26 : * Lecture et coh�rence des op�randes: 27 : * 28 : IF (IIMPI.EQ.333) THEN 29 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVLIR' 30 : ENDIF 31 : IF (IIMPI.EQ.444) THEN 31 : CALL GIBTEM(XKT) 32 : INTERR(1)=XKT 32 : CALL ERREUR(-259) 33 : WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVLIR' 34 : ENDIF 34 : CALL DEVLIR(ITBAS,ITKM,ITA,ITLIA,ITCHAR,ITINIT,NP,PDT,NINS, 35 : & ITSORT,ITREDU,KPREF,KCPR,ITCARA,LMODYN,ITDYN) 36 : IF (IERR.NE.0) RETURN 37 : IF (IIMPI.EQ.444) THEN 37 : CALL GIBTEM(XKT) 38 : INTERR(1)=XKT 38 : CALL ERREUR(-259) 39 : WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVLIR' 40 : ENDIF 41 : ** LMODYN = .TRUE. : donn�es table PASAPAS 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 l''appel 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 : apres l''appel 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 l''appel 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 : apres l''appel 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 l''appel 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 : apres l''appel 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 DEVFX0' 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 l''appel au sous-programme DEVFX0' 103 : ENDIF 103 : CALL DEVFX0(ITCHAR,KTNUM,KPREF,KTFEX,REPRIS,RIGIDE, 104 : &LMODYN,ITBAS) 105 : IF (IERR.NE.0) RETURN 106 : IF (IIMPI.EQ.444) THEN 106 : CALL GIBTEM(XKT) 107 : INTERR(1)=XKT 107 : CALL ERREUR(-259) 108 : WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVFX0' 109 : ENDIF 110 : IF (IIMPI.EQ.333) THEN 111 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSPM' 112 : ENDIF 113 : IF (IIMPI.EQ.444) THEN 113 : CALL GIBTEM(XKT) 114 : INTERR(1)=XKT 114 : CALL ERREUR(-259) 115 : WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVPSM' 116 : ENDIF 116 : CALL DEVPSM(ITCHAR,ITBAS,KTLIAB,KTNUM,KTPHI,KTFEX,REPRIS) 117 : IF (IERR.NE.0) RETURN 118 : IF (IIMPI.EQ.444) THEN 118 : CALL GIBTEM(XKT) 119 : INTERR(1)=XKT 119 : CALL ERREUR(-259) 120 : WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVPSM' 121 : ENDIF 122 : ENDIF 123 : * 124 : * Lecture des chargements en Base B, pour les corps rigides 125 : * 126 : IF (RIGIDE) THEN 127 : IF (IIMPI.EQ.333) THEN 128 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVRIG' 129 : ENDIF 130 : IF (IIMPI.EQ.444) THEN 130 : CALL GIBTEM(XKT) 131 : INTERR(1)=XKT 131 : CALL ERREUR(-259) 132 : WRITE(IOIMP,*)'DYNDEV :avant l''appel au sous-programme 133 : & DEVRIG' 134 : ENDIF 134 : CALL DEVRIG(ITCHAR,KTNUM,KTPHI,KTFEX,KTLIAB,REPRIS) 135 : IF (IERR.NE.0) RETURN 136 : IF (IIMPI.EQ.444) THEN 136 : CALL GIBTEM(XKT) 137 : INTERR(1)=XKT 137 : CALL ERREUR(-259) 138 : WRITE(IOIMP,*)'DYNDEV :apres l''appel au sous-programme 139 : & DEVRIG' 140 : ENDIF 141 : ENDIF 142 : * 143 : * Initialisation de l'algorithme, ou reprise de calcul: 144 : * 145 : IF (IIMPI.EQ.333) THEN 146 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVINI' 147 : ENDIF 148 : IF (IIMPI.EQ.444) THEN 148 : CALL GIBTEM(XKT) 149 : INTERR(1)=XKT 149 : CALL ERREUR(-259) 150 : WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVINI' 151 : ENDIF 151 : CALL DEVINI(ITINIT,KTKAM,KTQ,KTFEX,KTPAS,KTNUM,KTLIAA,KTLIAB, 152 : & KTPHI,KCPR,KOCLFA,KOCLB1,REPRIS,RIGIDE,lmodyn) 153 : IF (IERR.NE.0) RETURN 154 : IF (IIMPI.EQ.444) THEN 154 : CALL GIBTEM(XKT) 155 : INTERR(1)=XKT 155 : CALL ERREUR(-259) 156 : WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVINI' 157 : ENDIF 158 : * 159 : * Mise en oeuvre de l'algorithme: 160 : * 161 : IF (IIMPI.EQ.333) THEN 162 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVALG' 163 : ENDIF 164 : IF (IIMPI.EQ.444) THEN 164 : CALL GIBTEM(XKT) 165 : INTERR(1)=XKT 165 : CALL ERREUR(-259) 166 : WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVALG' 167 : ENDIF 167 : CALL DEVALG(KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS,KTRES, 168 : & KTNUM,KPREF,NINS,KOCLFA,KOCLB1,REPRIS,RIGIDE) 169 : IF (IERR.NE.0) RETURN 170 : IF (IIMPI.EQ.444) THEN 170 : CALL GIBTEM(XKT) 171 : INTERR(1)=XKT 171 : CALL ERREUR(-259) 172 : WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVALG' 173 : ENDIF 174 : * 175 : * Cr�ation de la table r�sultat et nettoyage m�moire: 176 : * 177 : IF (IIMPI.EQ.333) THEN 178 : WRITE(IOIMP,*)'DYNDEV : appel au sous-programme DEVSOR' 179 : ENDIF 180 : IF (IIMPI.EQ.444) THEN 180 : CALL GIBTEM(XKT) 181 : INTERR(1)=XKT 181 : CALL ERREUR(-259) 182 : WRITE(IOIMP,*)'DYNDEV : avant l''appel au sous-programme DEVSOR' 183 : ENDIF 183 : CALL DEVSOR(KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX,KTPAS, 184 : & KTRES,KTNUM,NINS,IPMAIL,REPRIS,ICHAIN, 185 : & KOCLFA,KOCLB1,LMODYN,ITDYN) 186 : IF (IERR.NE.0) RETURN 187 : IF (IIMPI.EQ.444) THEN 187 : CALL GIBTEM(XKT) 188 : INTERR(1)=XKT 188 : CALL ERREUR(-259) 189 : WRITE(IOIMP,*)'DYNDEV : apres l''appel au sous-programme DEVSOR' 190 : ENDIF 191 : IF (IIMPI.EQ.333) THEN 192 : WRITE(IOIMP,*)'DYNDEV : fin presumee normale de ce calcul' 193 : ENDIF 194 : * 195 : RETURN 196 : END 197 : 198 :
© Cast3M 2003 - All rights reserved.
Disclaimer