Télécharger prajus.eso

Retour à la liste

Numérotation des lignes :

  1. C PRAJUS SOURCE BP208322 16/11/18 21:19:59 9177
  2. C INTERFACE AVEC TRANSF POUR PERMETTRE A CE DERNIER D'ETRE
  3. C ECRIT EN FORTRAN,CE QUI EST PLUS ECONOMIQUE
  4. C
  5. SUBROUTINE PRAJUS(FER,XPROJ,MELEME,NUMELG,NUMNP,ichp)
  6. IMPLICIT INTEGER(I-N)
  7. IMPLICIT REAL*8 (A-H,O-Z)
  8. -INC CCOPTIO
  9. -INC SMELEME
  10. -INC CCGEOME
  11. SEGMENT/FER/(NFI(ITT),MAI(IPP),ITOUR),AFER.FER
  12. SEGMENT/XPROJ/(X(3,1))
  13. SEGMENT /SXAUX/(XAUX(2,NFI(/1)),INAT(MAI(/1)))
  14. CHARACTER*(4) MOT
  15. NFMAX=NFI(/1)
  16. MAIMAX=MAI(/1)-1
  17. IMOYE=0
  18. QUAL=0.4
  19. IREGU=4
  20. 930 CONTINUE
  21. CALL LIRCHA(MOT,0,IRETOU)
  22. IF (IRETOU.EQ.0) GOTO 932
  23. IF (MOT.NE.'REGU') GOTO 910
  24. CALL LIRENT(IREGU,1,IRETOU)
  25. IF (IERR.NE.0) RETURN
  26. GOTO 930
  27. 910 CONTINUE
  28. IF (MOT.NE.'MOYE') GOTO 931
  29. CALL LIRREE(XXX,1,IRETOU)
  30. XMOY=XXX
  31. IF (IERR.NE.0) RETURN
  32. IMOYE=1
  33. GOTO 930
  34. 931 CONTINUE
  35. IF (MOT.NE.'QUAL') GOTO 933
  36. CALL LIRREE(XXX,1,IRETOU)
  37. QUAL=XXX
  38. IF (IERR.NE.0) RETURN
  39. GOTO 930
  40. 933 CALL REFUS
  41. 932 CONTINUE
  42. SEGINI SXAUX
  43. NBNN=3
  44. IF (KSURF(ILCOUR).EQ.8.OR.KSURF(ILCOUR).EQ.10) NBNN=4
  45. NBELEM=X(/2)*2
  46. C CORRECTION POUR LE CAS DE FABRICATION DE TRI6
  47. IF (MAI(1).NE.0) NBELEM=NBELEM/4+1
  48. NCTIN=MAI(1)+1
  49. NBSOUS=0
  50. NBREF=0
  51. SEGINI MELEME
  52. MAXPTS=X(/2)
  53. IRECHA=0
  54. CALL TRANSF(NFI(1),NFMAX,MAI(1),MAIMAX,ITOUR,X(1,1),MAXPTS,
  55. # NUM(1,1),NBNN,NBELEM,NUMELG,NUMNP,XAUX(1,1),NUMINI,ICLE,
  56. # QUAL,INAT(1),IREGU,IMOYE,XMOY,NBNN,IRECHA,ichp)
  57. IF(IRECHA.NE.0) THEN
  58. CALL ERREUR(IRECHA)
  59. IF (IRECHA.EQ.27.AND.IOLEC.NE.5) IERR=2
  60. RETURN
  61. ENDIF
  62. SEGSUP FER,SXAUX
  63. IF (ICLE.EQ.0) RETURN
  64. CALL PRAMEL(XPROJ,MELEME,NUMELG,NUMNP,NUMINI,ICLE,QUAL,NCTIN,NBNN)
  65. RETURN
  66. END
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  

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