Sources Esope | Cast3M

inipro
C INIPRO    SOURCE    CB215821  24/07/17    21:15:07     11961          
 
      SUBROUTINE INIPRO (cnompr,mbloT)
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMBLOC
-INC CCNOYAU
-INC CCASSIS
      CHARACTER*8 MOBLO,ichp
      CHARACTER*(LONOM) cnompr
      LOGICAL IPREM,IDEU
      SEGMENT ITTRAM
        INTEGER IJTRAM(NHU)
      ENDSEGMENT
      DATA MOBLO/'BLOC    '/
 
      if(iimpi.eq.1754) then
        write(ioimp,*) ' initialisation de la procedur ', cnompr
      endif
      if(nbesc.ne.0) segact ipiloc
      NHU=IPCHAR(/1)
      SEGINI ITTRAM
      IDE1 = 1
*      IDE2 = MFIOBJ +1
      IFI1 = MDEOBJ-1
*      IFI2 = INOOB1(/1)
      IPREM =.TRUE.
      IF(MDEOBJ.EQ.1) IPREM=.FALSE.
*      IDEU=.TRUE.
*      IF(MFIOBJ.EQ.IFI2) IDEU = .FALSE.
*      IF(IDEU) THEN
*          DO 3 J=IDE2,IFI2
*          INO=INOOB1(J)
*          IF (INO.NE.0) IJTRAM(INO)= J
*   3      CONTINUE
*      ENDIF
      IF( IPREM) THEN
          DO 2 J=IDE1,IFI1
          INO=INOOB1(J)
          IJTRAM(INO)= J
  2       CONTINUE
      ENDIF
      DO 1 I=MDEOBJ,MFIOBJ
      INO= INOOB1(I)
      IDEBCH=IPCHAR(INO)
      IFINCH=IPCHAR(INO+1)-1
      IF ( ICHARA(IDEBCH:IDEBCH).EQ.'!')  THEN
          INOOB2(I)='ANNULE'
          GO TO 1
      ENDIF
      IF ( ICHARA(IDEBCH:IFINCH).EQ.' ')  GO TO 1
*      if(  ICHARA(IDEBCH:IFINCH).EQ.cnompr) then
*        inoob2(i)='PROCEDUR'
*        iouep2(i)=
*        go to 1
*       endif
      IF(INOOB2(I).EQ.MOBLO) GO TO 1
      if(inoob2(i).eq.'PROCEDUR') go to 1
      IF(IJTRAM(INO).NE.0) THEN
         J=IJTRAM(INO)
         ichp=INOOB2(I)
         INOOB2(I)=INOOB2(J)
         IOUEP2(I)=IOUEP2(J)
         if (iimpi.eq.1754) then
            write(ioimp,*)'initialisation ',ICHARA(IDEBCH:IFINCH),'  ',
     $                    INOOB2(I),' ',ichp,iouep2(i)
         endif
      ENDIF
    1 CONTINUE
      if(nbesc.ne.0) SEGDES,IPILOC
      SEGSUP ITTRAM
      RETURN
      END