Télécharger prajus.eso

Retour à la liste

Numérotation des lignes :

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

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