1 : C CFL2 SOURCE PV 09/03/12 21:16:30 6325 2 : SUBROUTINE CFL2(ICAS,IPMAIL,MELE,IVAM1,IVAM2,MELV1,MELV2,N2) 3 : *---------------------------------------------------------------------* 4 : * 5 : * calcul du pas de temps CFL 6 : * 7 : * elements massifs formulation mécanique 8 : * 9 : * 10 : * entree 11 : * icas : cas à traiter 12 : * = 1 calcul du pas de temps complet ivam1 avec cara 13 : * = 2 calcul du pas de temps lorsque cson est donne ivam2 14 : * = 3 calcul du pas de temps lorsque la taille est donnée ivam1 si cara 15 : * = 4 calcul de la vitesse du son ivam1 donné 16 : * = 5 calcul du parametre de taille ivam1 si cara 17 : * 18 : * ipmail : pointeur vers le maillage a traiter 19 : * mele : numero de l'élément finis dans nomtp 20 : * ivam1 : pointeur vers mptval du cham1 actif 21 : * ivam2 : pointeur vers mptval du cham2 actif 22 : * n2 : nombre de comosante en sortie 23 : * 24 : * sortie 25 : * melv1 : melval de la première composante du chamelem resultat 26 : * inactif en sortie 27 : * melv2 : melval de la deuxième composante du chamelem resultat 28 : * inactif en sortie 29 : * 30 : * 31 : *---------------------------------------------------------------------* 32 : IMPLICIT INTEGER(I-N) 33 : IMPLICIT REAL*8(A-H,O-Z) 34 : * 35 : -INC CCOPTIO 36 : -INC CCHAMP 37 : -INC SMCHAML 38 : -INC SMELEME 39 : * 40 : * 41 : SEGMENT MPTVAL 42 : * ipos pointeur vers la sous zone du mchelm 43 : * nsof ?? 44 : INTEGER IPOS(NS) ,NSOF(NS) 45 : * ival pointeur vers le melval de la composante 46 : * =0 si il n'est pas présente 47 : * ncosou = nbrfac + nbrobl 48 : INTEGER IVAL(NCOSOU) 49 : * continent le type de composante 50 : CHARACTER*16 TYVAL(NCOSOU) 51 : ENDSEGMENT 52 : POINTEUR MPTVA1.MPTVAL,MPTVA2.MPTVAL 53 : * 54 : * 55 : * 56 : MPTVA1 = IVAM1 57 : MPTVA2 = IVAM2 58 : * 59 : * 60 : * branchement en fonction de l'élément fini 61 : * 62 : * 0 5 0 5 0 63 : GOTO (99,99,99, 4,99,99,99, 4,99,99,99,99,99,99,99,99,99,99,99,99, 64 : 2 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 65 : 4 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 66 : 6 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 67 : 8 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 68 : 1 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 69 : 2 99,99,99,99,99,99,99),MELE 70 : * 71 : * éléments massifs 72 : * 73 : 4 CONTINUE 74 : * ================ calcul de la vitesse du son 75 : * le resultat est stocké dans melval avec n1ptel =1 76 : IF (ICAS.EQ.1.OR.ICAS.EQ.3.OR.ICAS.EQ.4) THEN 77 : * recherche des paramètre matériau 78 : * module d'young 79 : MELVA3 = MPTVA1.IVAL(1) 80 : * densite 81 : MELVA4 = MPTVA1.IVAL(3) 82 : SEGDES MPTVA1 83 : SEGACT MELVA3,MELVA4 84 : * 85 : N1EL = MIN(MELVA3.VELCHE(/2),MELVA4.VELCHE(/2)) 86 : N1PTEL = 1 87 : N2PTEL = 0 88 : N2EL = 0 89 : SEGINI MELVAL 90 : MCSON = MELVAL 91 : * boucle sur les éléments pour calculer la vitesse du son 92 : DO 403 I=1,N1EL 93 : * on prend les valeurs moyennes sur les éléments 94 : YOU1 = 0.D0 95 : I3 = MIN(I,MELVA3.VELCHE(/2)) 96 : DO 401 J=1,MELVA3.VELCHE(/1) 97 : YOU1 = YOU1 + MELVA3.VELCHE(J,I3) 98 : 401 CONTINUE 99 : YOU1 = YOU1 / MELVA3.VELCHE(/1) 100 : * 101 : RO1 = 0.D0 102 : I4 = MIN(I,MELVA4.VELCHE(/2)) 103 : DO 402 J=1,MELVA4.VELCHE(/1) 104 : RO1 = RO1 + MELVA4.VELCHE(J,I4) 105 : 402 CONTINUE 106 : RO1 = RO1 / MELVA4.VELCHE(/1) 107 : IF (RO1.EQ.0.D0) THEN 108 : SEGDES MELVA4,MELVA3 109 : SEGSUP MELVAL 109 : CALL ERREUR(855) 110 : RETURN 111 : ENDIF 112 : * 113 : IF (YOU1.EQ.0.D0) THEN 114 : SEGDES MELVA4,MELVA3 115 : SEGSUP MELVAL 115 : CALL ERREUR(856) 116 : RETURN 117 : ENDIF 118 : VELCHE(1,I) = SQRT(YOU1/RO1) 119 : * write(6,*) 'Element', i , 'Cson' , VELCHE(1,i) 120 : 403 CONTINUE 121 : SEGDES MELVA4,MELVA3 122 : IF (ICAS.EQ.4) THEN 123 : * cas ou seule la vitesse du son est demandée 124 : MELVA2 = 0 125 : MELV1 = MELVAL 126 : SEGDES MELVAL 127 : RETURN 128 : ENDIF 129 : ELSE IF (ICAS.EQ.2) THEN 130 : * recuperation du champ 131 : SEGACT MPTVA2 132 : MELVA1 = MPTVA2.IVAL(1) 133 : SEGACT MELVA1 134 : MCSON = MELVA1 135 : SEGDES MPTVA2 136 : ENDIF 137 : * ================ paramètre geometrique 138 : * stocké dans un melval mtaille 139 : IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.5) THEN 140 : MELEME = IPMAIL 141 : SEGACT MELEME 142 : N1EL = NUM(/2) 143 : N1PTEL = 1 144 : N2PTEL = 0 145 : N2EL = 0 146 : SEGINI MELVAL 147 : MTAIL1 = MELVAL 148 : MTAIL2 = 0 148 : CALL CFLTAI(MTAIL1,IPMAIL,MELE) 149 : SEGDES MELEME 150 : IF (ICAS.EQ.5) THEN 151 : MELV1 = MTAIL1 152 : MELV2 = 0 153 : SEGDES MELVAL 154 : RETURN 155 : ENDIF 156 : ELSE IF (ICAS.EQ.3) THEN 157 : * recuperation du champ 158 : SEGACT MPTVA2 159 : MELVA1 = MPTVA2.IVAL(1) 160 : SEGACT MELVA1 161 : MTAIL1 = MELVA1 162 : SEGDES MPTVA2 163 : ENDIF 164 : * ================ pas de temps cfl 165 : IF (ICAS.EQ.1.OR.ICAS.EQ.2.OR.ICAS.EQ.3) THEN 166 : * recuperation de la vitesse du son 167 : * et du paramètre de taille 168 : MELVA1 = MCSON 169 : MELVA2 = MTAIL1 170 : * creation du melval résultat 171 : N1EL = MAX(MELVA1.VELCHE(/2),MELVA2.VELCHE(/2)) 172 : N1PTEL = 1 173 : N2EL = 0 174 : N2PTEL = 0 175 : SEGINI MELVAL 176 : * 177 : DO 404 I=1,N1EL 178 : I1 = MIN(I,MELVA1.VELCHE(/2)) 179 : I2 = MIN(I,MELVA2.VELCHE(/2)) 180 : VELCHE(1,I)=MELVA2.VELCHE(1,I2)/MELVA1.VELCHE(1,I1) 181 : * write(6,*) 'Element', i , 'Dtcfl' , VELCHE(1,i) 182 : 404 CONTINUE 183 : MELV1 = MELVAL 184 : MELV2 = 0 185 : SEGDES MELVAL 186 : IF (ICAS.EQ.1) THEN 187 : SEGSUP MELVA1,MELVA2 188 : ELSE IF (ICAS.EQ.2) THEN 189 : SEGSUP MELVA2 190 : SEGDES MELVA1 191 : ELSE 192 : SEGSUP MELVA1 193 : SEGDES MELVA2 194 : ENDIF 195 : RETURN 196 : ENDIF 197 : * 198 : 199 : 99 CONTINUE 200 : MOTERR(1:4)=NOMTP(MELE) 201 : MOTERR(9:12)='CFL5' 201 : CALL ERREUR(86) 202 : * 203 : RETURN 204 : END 205 : 206 : 207 : 208 : 209 : 210 : 211 :
© Cast3M 2003 - All rights reserved.
Disclaimer