Télécharger inipro.eso

Retour à la liste

Numérotation des lignes :

  1. C INIPRO SOURCE FANDEUR 13/01/16 21:15:20 7666
  2.  
  3. SUBROUTINE INIPRO (cnompr,mbloT)
  4. IMPLICIT INTEGER(I-N)
  5. -INC CCOPTIO
  6. -INC SMBLOC
  7. -INC CCNOYAU
  8. -INC CCASSIS
  9. CHARACTER*8 MOBLO,ichp,cnompr
  10. LOGICAL IPREM,IDEU
  11. SEGMENT ITTRAM
  12. INTEGER IJTRAM(NHU)
  13. ENDSEGMENT
  14. DATA MOBLO/'BLOC '/
  15.  
  16. if(iimpi.eq.1754) then
  17. write(ioimp,*) ' initialisation de la procedur ', cnompr
  18. endif
  19. if(nbesc.ne.0) segact ipiloc
  20. NHU=IPCHAR(/1)
  21. SEGINI ITTRAM
  22. IDE1 = 1
  23. * IDE2 = MFIOBJ +1
  24. IFI1 = MDEOBJ-1
  25. * IFI2 = INOOB1(/1)
  26. IPREM =.TRUE.
  27. IF(MDEOBJ.EQ.1) IPREM=.FALSE.
  28. * IDEU=.TRUE.
  29. * IF(MFIOBJ.EQ.IFI2) IDEU = .FALSE.
  30. * IF(IDEU) THEN
  31. * DO 3 J=IDE2,IFI2
  32. * INO=INOOB1(J)
  33. * IF (INO.NE.0) IJTRAM(INO)= J
  34. * 3 CONTINUE
  35. * ENDIF
  36. IF( IPREM) THEN
  37. DO 2 J=IDE1,IFI1
  38. INO=INOOB1(J)
  39. IJTRAM(INO)= J
  40. 2 CONTINUE
  41. ENDIF
  42. DO 1 I=MDEOBJ,MFIOBJ
  43. INO= INOOB1(I)
  44. IDEBCH=IPCHAR(INO)
  45. IFINCH=IPCHAR(INO+1)-1
  46. IF ( ICHARA(IDEBCH:IDEBCH).EQ.'!') THEN
  47. INOOB2(I)='ANNULE'
  48. GO TO 1
  49. ENDIF
  50. IF ( ICHARA(IDEBCH:IFINCH).EQ.' ') GO TO 1
  51. * if( ICHARA(IDEBCH:IFINCH).EQ.cnompr) then
  52. * inoob2(i)='PROCEDUR'
  53. * iouep2(i)=
  54. * go to 1
  55. * endif
  56. IF(INOOB2(I).EQ.MOBLO) GO TO 1
  57. if(inoob2(i).eq.'PROCEDUR') go to 1
  58. IF(IJTRAM(INO).NE.0) THEN
  59. J=IJTRAM(INO)
  60. ichp=INOOB2(I)
  61. INOOB2(I)=INOOB2(J)
  62. IOUEP2(I)=IOUEP2(J)
  63. if (iimpi.eq.1754) then
  64. write(ioimp,*)'initialisation ',ICHARA(IDEBCH:IFINCH),' ',
  65. $ INOOB2(I),' ',ichp,iouep2(i)
  66. endif
  67. ENDIF
  68. 1 CONTINUE
  69. if(nbesc.ne.0) segdes ipiloc
  70. SEGSUP ITTRAM
  71. RETURN
  72. END
  73.  
  74.  
  75.  

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