1 : C ELFGR0 SOURCE CHAT 05/01/12 23:31:56 5004 2 : SUBROUTINE ELFGR0(KGREEN,DELTAT,NPAS, KGREE2) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8(A-H,O-Z) 5 : ************************************************************************ 6 : * 7 : * E L F G R 0 8 : * ----------- 9 : * 10 : * FONCTION: 11 : * --------- 12 : * 13 : * TRANSFORMER LES FONCTIONS DE GREEN ET DERIVEES EN INTEGRALES SUR 14 : * LES PAS DE TEMPS DE CALCUL. 15 : * 16 : * MODULES UTILISES: 17 : * ----------------- 18 : * 19 : -INC CCOPTIO 20 : -INC SMEVOLL 21 : -INC SMLREEL 22 : * 23 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 24 : * ----------- 25 : * 26 : * KGREEN (E) OBJET "EVOLUTION" CONTENANT LES FONCTIONS DE GREEN. 27 : * DELTAT (E) PAS DE TEMPS DU CALCUL. 28 : * NPAS (E) NOMBRE DE PAS DE CALCUL. 29 : * KGREE2 (S) OBJET "EVOLUTION" CONTENANT LES INTEGRALES DES 30 : * FONCTIONS DE GREEN. 31 : * 32 : REAL*8 DELTAT 33 : * 34 : * VARIABLES: 35 : * ---------- 36 : * 37 : CHARACTER*72 ITEX 38 : LOGICAL TRACTI,TORSIO 39 : * 40 : * AUTEUR, DATE DE CREATION: 41 : * ------------------------- 42 : * 43 : * PASCAL MANIGOT 29 MARS 1988 44 : * 45 : * LANGAGE: 46 : * -------- 47 : * 48 : * ESOPE + FORTRAN77 49 : * 50 : ************************************************************************ 51 : * 52 : MEVOL1 = KGREEN 53 : SEGACT MEVOL1 54 : NBEL = MEVOL1.IEVOLL(/1) 55 : IF (MOD(NBEL,28).NE.0) THEN 56 : * IL MANQUE DES FONCTIONS DE GREEN 56 : CALL ERREUR(388) 57 : SEGDES MEVOL1 58 : RETURN 59 : END IF 60 : * 61 : ITEX = MEVOL1.IEVTEX 62 : IND = INDEX(ITEX,'VERSION') 63 : IF (IND .NE. 0) THEN 64 : READ (ITEX(IND+7:IND+7),'(I1)') IVERS 65 : END IF 66 : * 67 : IF (IND.EQ.0 .OR. IVERS.EQ.1) THEN 68 : KGREE2 = KGREEN 69 : * INUTILE DE DESACTIVER: CA VA RESSERVIR BIENTOT. 70 : RETURN 71 : END IF 72 : * 73 : * ON DEPASSE LE TEMPS MINIMUM NECESSAIRE POUR PALIER A 74 : * DES ERREURS D'ARRONDI SUR DES CUMULS DE PAS DE TEMPS 75 : TMAX = (NPAS + 1) * DELTAT 76 : * 77 : * CALCUL DES FONCTIONS INTEGRALES: 78 : TINI = 0.D0 78 : CALL SOMME1 (KGREEN,TINI,TMAX,DELTAT, KGREE2) 79 : IF (IERR .NE. 0) RETURN 80 : * 81 : MEVOLL = KGREE2 82 : SEGACT,MEVOLL,MEVOL1 83 : NBEL = NBEL/28 - 1 84 : * 85 : * 86 : * BOUCLAGE SUR LES DIFFERENTS TYPES DE POUTRES: 87 : DO 200 NB=0,NBEL 88 : * 89 : DO 280 J=1,28 90 : TRACTI = J.EQ.1.OR.J.EQ.2.OR.J.EQ.15.OR.J.EQ.16 91 : TORSIO = J.EQ.3.OR.J.EQ.4.OR.J.EQ.17.OR.J.EQ.18 92 : * 93 : KEVOLL = IEVOLL(NB*28+J) 94 : SEGACT KEVOLL 95 : * 96 : IF (TRACTI.OR.TORSIO) THEN 97 : * 98 : ITEX = KEVTEX 99 : READ (ITEX(24:35),FMT='(1PE12.5)') CT 100 : READ (ITEX(43:54),FMT='(1PE12.5)') RT 101 : CSR = CT / RT 102 : CSR1 = - CSR 103 : MLREEL = IPROGY 104 : SEGACT MLREEL 105 : NBINTG = PROG(/1) 106 : * 107 : IF ((J/2)*2 .NE. J) THEN 108 : * INTEGRALE DE "G" 108 : CALL MULVE1 (CSR,PROG,NBINTG) 109 : IF (IIMPI .EQ. 1806) THEN 110 : IF (TRACTI) THEN 111 : WRITE (IOIMP,*) 'INTEGRALE DE G' 112 : WRITE (IOIMP,*) (PROG(NP),NP=1,NBINTG) 113 : END IF 114 : END IF 115 : ELSE 116 : * INTEGRALE DE "DG/DX" 116 : CALL MULVE1 (CSR1,PROG,NBINTG) 117 : IF (IIMPI .EQ. 1806) THEN 118 : IF (TRACTI) THEN 119 : WRITE (IOIMP,*) 'INTEGRALE DE DG/DX' 120 : WRITE (IOIMP,*) (PROG(NP),NP=1,NBINTG) 121 : END IF 122 : END IF 123 : END IF 124 : * 125 : SEGDES,MLREEL 126 : * 127 : ELSE 128 : * FLEXION 129 : * 130 : *+* READ (ITEX(43:54),FMT='(1PE12.5)') RFZ 131 : * 132 : * EN FLEXION, LA VERSION 2 N'EXISTE PAS ENCORE. LES 133 : * INTEGRALES CALCULEES SONT BIDON ET LES BONNES SONT DANS 134 : * LE "KEVOLL" ORIGINEL: 135 : * 136 : KEVOL1 = MEVOL1.IEVOLL(NB*28+J) 137 : SEGACT,KEVOL1 138 : MLREE1 = KEVOL1.IPROGY 139 : SEGINI,MLREEL=MLREE1 140 : IPROGY = MLREEL 141 : SEGDES,MLREEL 142 : SEGDES,KEVOL1 143 : * 144 : END IF 145 : * 146 : SEGDES,KEVOLL 147 : * 148 : 280 CONTINUE 149 : * END DO 150 : * 151 : 200 CONTINUE 152 : * END DO 153 : * 154 : SEGDES,MEVOLL,MEVOL1 155 : * 156 : END 157 :
© Cast3M 2003 - All rights reserved.
Disclaimer