Télécharger lijonc.eso

Retour à la liste

Numérotation des lignes :

  1. C LIJONC SOURCE CHAT 05/01/13 01:18:04 5004
  2. SUBROUTINE LIJONC(IORES,ITLACC,IMAX1,IRET,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C BUT : LECTURE DU MJONC
  7. C APPELE PAR : LIPIL
  8. C APPELLE : LFCDIM LFCDIE LFCDI2
  9. C ECRIT PAR FARVACQUE -REPRIS PAR LENA
  10. C
  11. C=======================================================================
  12. -INC SMATTAC
  13. SEGMENT /ITLACC/ (ITLAC(0))
  14. C=======================================================================
  15. C
  16. DIMENSION ILENA(10),ILECBI(1)
  17. IRET=0
  18. IRETOU=0
  19. C ***************************** MJONCT *****************************
  20. 6014 CONTINUE
  21. DO 140 IEL=1,IMAX1
  22. ITOTO=2
  23. CALL LFCDIE ( IORES,ITOTO,ILENA,IRETOU,IFORM)
  24. IF (IRETOU.NE.0) GO TO 1000
  25. N=ILENA(1)
  26. SEGINI MJONCT
  27. ITLAC(**)=MJONCT
  28. MJOPOI=ILENA(2)
  29. CALL LFCDIM ( IORES,1 ,ILECBI,IRETOU,IFORM)
  30. WRITE(MJODDL,FMT='(A4)')ILECBI(1)
  31. IF (IRETOU.NE.0) GO TO 1000
  32. CALL LFCDIM ( IORES,1 ,ILECBI,IRETOU,IFORM)
  33. WRITE(MJOTYP,FMT='(A4)')ILECBI(1)
  34. IF (IRETOU.NE.0) GO TO 1000
  35. CALL LFCDIE ( IORES,N ,ISTRJO,IRETOU,IFORM)
  36. IF (IRETOU.NE.0) GO TO 1000
  37. CALL LFCDIE ( IORES,N ,IPCHJO,IRETOU,IFORM)
  38. IF (IRETOU.NE.0) GO TO 1000
  39. CALL LFCDIE ( IORES,N ,IPOSJO,IRETOU,IFORM)
  40. IF (IRETOU.NE.0) GO TO 1000
  41. SEGDES MJONCT
  42. 140 CONTINUE
  43. GO TO 1098
  44. 1000 CONTINUE
  45. 1098 CONTINUE
  46. IRET=IRETOU
  47. RETURN
  48. C -------------------------------------------------------
  49. END
  50.  
  51.  

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