1 : C DEVSOR SOURCE FANDEUR 11/04/12 21:15:55 6938 2 : SUBROUTINE DEVSOR(KPREF,KTQ,KTKAM,KTPHI,KTLIAA,KTLIAB,KTFEX, 3 : & KTPAS,KTRES,KTNUM,NINS,IPMAIL,REPRIS,ICHAIN, 4 : & KOCLFA,KOCLB1,LMODYN,ITDYN) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : *--------------------------------------------------------------------* 8 : * * 9 : * Operateur DYNE : algorithme de Fu - de Vogelaere * 10 : * ________________________________________________ * 11 : * * 12 : * Sortie de la table resultat et nettoyage de la memoire. * 13 : * * 14 : * Parametres: * 15 : * * 16 : * e KPREF Segment des points de référence * 17 : * e KTQ Segment contenant les variables généralisées 18 : * (et les travaux) 19 : * e KTKAM Segment contenant les matrices XK, XASM et XM * 20 : * e KTPHI Segment contenant les déformées modales * 21 : * e KTLIAA Segment descriptif des liaisons en base A * 22 : * e KTLIAB Segment descriptif des liaisons en base B * 23 : * e KTFEX Segment contenant les chargements libres * 24 : * e KTPAS Segment des variables au cours d'un pas de temps * 25 : * e KTRES Segment de sauvegarde des résultats * 26 : * e KTNUM Segment contenant les paramètres numériques * 27 : * e NINS On veut une sortie tous les NINS pas de calcul * 28 : * e IPMAIL Maillage de référence * 29 : * e REPRIS Vrai si reprise de calcul, faux sinon * 30 : * e ICHAIN Segment MLENTI (ACTIF) contenant les adresses des * 31 : * chaines dans la pile des mots de CCNOYAU * 32 : * * 33 : * Auteur, date de creation: * 34 : * * 35 : * Denis ROBERT-MOUGIN, le 1er juin 1989. * 36 : * * 37 : *--------------------------------------------------------------------* 38 : -INC CCOPTIO 39 : -INC SMTABLE 40 : -INC SMLREEL 41 : -INC SMLENTI 42 : -INC SMELEME 43 : * 44 : SEGMENT,MTQ 45 : REAL*8 Q1(NA1,4),Q2(NA1,4),Q3(NA1,4) 46 : REAL*8 WEXT(NA1,2),WINT(NA1,2) 47 : ENDSEGMENT 48 : SEGMENT,MTKAM 49 : REAL*8 XK(NA1),XASM(NA1),XM(NA1) 50 : ENDSEGMENT 51 : SEGMENT,MTPHI 52 : INTEGER IBASB(NPLB),IPLSB(NPLB),INMSB(NSB),IORSB(NSB) 53 : INTEGER IAROTA(NSB) 54 : REAL*8 XPHILB(NSB,NPLSB,NA2,IDIMB) 55 : ENDSEGMENT 56 : SEGMENT,MTLIAA 57 : INTEGER IPALA(NLIAA,NIPALA),IPLIA(NLIAA,NPLAA),JPLIA(NPLA) 58 : REAL*8 XPALA(NLIAA,NXPALA) 59 : ENDSEGMENT 60 : SEGMENT,MTLIAB 61 : INTEGER IPALB(NLIAB,NIPALB),IPLIB(NLIAB,NPLBB),JPLIB(NPLB) 62 : REAL*8 XPALB(NLIAB,NXPALB) 63 : REAL*8 XABSCI(NLIAB,NIP),XORDON(NLIAB,NIP) 64 : ENDSEGMENT 65 : SEGMENT,MTFEX 66 : REAL*8 FEXA(NPFEXA,NPC1,2) 67 : REAL*8 FEXPSM(NPLB,NPC1,2,IDIMB) 68 : REAL*8 FTEXB(NPLB,NPC1,2,IDIM) 69 : INTEGER IFEXA(NPFEXA),IFEXB(NPFEXB) 70 : ENDSEGMENT 71 : SEGMENT,MTPAS 72 : REAL*8 FTOTA(NA1,4),FTOTB(NPLB,IDIMB),FTOTBA(NA1) 73 : REAL*8 XPTB(NPLB,4,IDIMB),FINERT(NA1,4) 74 : REAL*8 XVALA(NLIAA,4,NTVAR),XVALB(NLIAB,4,NTVAR) 75 : REAL*8 FEXB(NPLB,2,IDIM),XCHPFB(2,NLIAB,4,NPLB) 76 : ENDSEGMENT 77 : SEGMENT,MTRES 78 : REAL*8 XRES(NRES,NCRES,NPRES),XREP(NREP,NCRES) 79 : REAL*8 XRESLA(NLSA,NPRES,NVALA),XRESLB(NLSB,NPRES,NVALB) 80 : REAL*8 XMREP(NLIAB,4,IDIMB) 81 : INTEGER ICHRES(NVES),IPORES(NRES,NPRES),IPOREP(NREP) 82 : INTEGER IPOLA(NLSA),INULA(NLSA),IPLRLA(NLSA,NVALA) 83 : INTEGER IPOLB(NLSB),INULB(NLSB),IPLRLB(NLSB,NVALB) 84 : INTEGER ILIREA(NLSA,NTVAR),ILIREB(NLSB,NTVAR) 85 : INTEGER ILIRNA(NLSA,NTVAR),ILIRNB(NLSB,NTVAR) 86 : INTEGER IPOLR(1),IMREP(NLIAB,2),IPPREP(NLIAB,4) 87 : INTEGER ILPOLA(NLIAA,2) 88 : ENDSEGMENT 89 : SEGMENT,MTNUM 90 : REAL*8 XDT(NPC1),XTEMPS(NPC1) 91 : ENDSEGMENT 92 : SEGMENT,MPREF 93 : INTEGER IPOREF(NPREF) 94 : ENDSEGMENT 95 : * Segment "local" pour DEVLFA ... 96 : SEGMENT,LOCLFA 97 : REAL*8 FTEST(NA1,4),FTOTA0(NA1,4) 98 : ENDSEGMENT 99 : * Segment "local" pour DEVLB1 ... 100 : SEGMENT,LOCLB1 101 : REAL*8 FTEST2(NPLB,6),FTOTB0(NPLB,6) 102 : ENDSEGMENT 103 : * 104 : LOGICAL REPRIS,LMODYN 105 : * 106 : * Remplissage des CHPOINTs résultats: 107 : * 107 : CALL DEVSO2(KTRES) 108 : IF (IERR.NE.0) RETURN 109 : * 110 : * Création et sous-typage de la table contenant les résultats: 111 : * 111 : CALL DEVSO4(KTRES,KTLIAA,KTLIAB,KTNUM,NINS,ICHAIN, 112 : & MTABLE,REPRIS,LMODYN,ITDYN,0) 113 : IF (IERR.NE.0) RETURN 114 : * 115 : * Ecriture de la table résultat: 116 : * 116 : if (.not.lmodyn) CALL ECROBJ('TABLE',MTABLE) 117 : IF (IERR.NE.0) RETURN 118 : * 119 : * Nettoyage de la mémoire: 120 : * 121 : IF (IIMPI.EQ.333) THEN 122 : WRITE(IOIMP,*)'DEVSOR: nettoyage de la mémoire' 123 : ENDIF 124 : MELEME = IPMAIL 125 : SEGDES,MELEME 126 : * 127 : MTQ = KTQ 128 : SEGSUP,MTQ 129 : * 130 : MTFEX = KTFEX 131 : SEGSUP,MTFEX 132 : * 133 : MTPHI = KTPHI 134 : SEGSUP,MTPHI 135 : * 136 : MTLIAA = KTLIAA 137 : SEGSUP,MTLIAA 138 : * 139 : MTLIAB = KTLIAB 140 : SEGSUP,MTLIAB 141 : * 142 : MTRES = KTRES 143 : SEGSUP,MTRES 144 : * 145 : MTNUM = KTNUM 146 : SEGSUP,MTNUM 147 : MPREF = KPREF 148 : SEGSUP,MPREF 149 : * 150 : MTKAM = KTKAM 151 : SEGSUP,MTKAM 152 : * 153 : MTPAS = KTPAS 154 : SEGSUP,MTPAS 155 : * 156 : LOCLFA = KOCLFA 157 : SEGSUP,LOCLFA 158 : LOCLB1 = KOCLB1 159 : SEGSUP,LOCLB1 160 : * 161 : MLENTI = ICHAIN 162 : SEGSUP,MLENTI 163 : ICHAIN = 0 164 : * 165 : RETURN 166 : END 167 : 168 :
© Cast3M 2003 - All rights reserved.
Disclaimer