Télécharger proga.eso

Retour à la liste

Numérotation des lignes :

  1. C PROGA SOURCE CB215821 16/04/21 21:18:07 8920
  2. SUBROUTINE PROGA(F1,G,YAMB1,A,B,C,D,D2,CO)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. DIMENSION V(3),A(3),B(3),C(3),D(3)
  6. IF(D2.LT.1.E-8)THEN
  7. WRITE(6,*)'PB D2=0 : MAUVAIS MAILLAGE OU PB DS MITAB'
  8. F1=0
  9. RETURN
  10. ENDIF
  11. D32=0
  12. PS1=0
  13. PS2=0
  14. RAC=0
  15. DO 10 K=1,3
  16. V(K)=(C(K)-A(K))
  17. V(K)=V(K)-YAMB1*(B(K)-A(K))
  18. D32=D32+V(K)**2
  19. 10 CONTINUE
  20. DO 20 K=1,3
  21. PS2=PS2+V(K)*(D(K)-C(K))
  22. 20 CONTINUE
  23. C
  24. C IF(ABS(CO).LT.(1.E-8))THEN
  25. C F1=0
  26. C RETURN
  27. C ENDIF
  28. PS1=PS2/D2
  29. RAC=SQRT(ABS(D32-PS1**2))
  30. D4=D32+D2**2+2*PS2
  31. IF (D4.LT.(1.E-8))THEN
  32. C WRITE(6,*)'D4=0'
  33. F1=LOG(D2)-1
  34. RETURN
  35. ENDIF
  36. IF(D32.LT.(1.E-8))THEN
  37. C WRITE(6,*)'D32=0 '
  38. F1=LOG(D2)-1
  39. RETURN
  40. ENDIF
  41. IF(RAC.LT.(1.E-8))THEN
  42. C WRITE(6,*)'RAC=0'
  43. IF (ABS(ABS(CO)-1).LT.(1.E-6))THEN
  44. F1=(D2+PS1)*(LOG(D4)-2)-(PS1*(LOG(D32)-2))
  45. F1=F1/D2/2
  46. ELSE
  47. F1=LOG(D2)-1
  48. ENDIF
  49. RETURN
  50. ENDIF
  51. F1=(D2+PS1)*(LOG(D4)-2)+2*RAC*ATAN((D2+PS1)/RAC)
  52. F1=F1-(PS1*LOG(D32)-2*PS1+2*RAC*ATAN(PS1/RAC))
  53. F1=F1/2/D2
  54. C WRITE(7,*)'F1=',F1
  55. RETURN
  56. END
  57.  
  58.  
  59.  
  60.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales