Sources Esope | Cast3M

ooowad
C OOOWAD    SOURCE    PV090527  26/04/24    08:23:29     12524          
      SUBROUTINE OOOWAD(LRET,IRET,HARG,PSEG,IDI1,JDES,NTAB)
C--------------------------------------------------------------------
C
C                       SEGXXX /ERR=100/ PSEG
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE ET : IRET = 1
C           2  OK
C
C     IRET     ACTION SI PLUS DE PLACE MEMOIRE
C           0  STOP 16
C           1  RETURN AVEC LRET = 1
C
C     HARG     'NOM_SUBROUTINE NUMERO_LIGNE NOM_SEGMENT '
C
C     PSEG     POINTEUR DESIGNANT LE SEGMENT
C     LSEG     LONGUEUR DES DONNEES DU SEGMENT EN MOTS
C
C PROGRAMMEUR : MOUGIN
C        CREE : 15/12/88    OOOY.. => OOOW.. (ARGUMENT HARG EN PLUS)
C       MODIF : 02/05/89    SEPARE D'AVEC LES AUTRES ENTRY : OOOWXX
C
C--------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOWCOM
%INC IOOUNIT
%INC IOOSAF
 
      CHARACTER*(*) HARG
      POINTEUR      PSEG.PSEG
      INTEGER       JDES(NTAB)
      logical lectur
 
 
      INTEGER       ITTIME(4)
      LOGICAL       LGLL,LWAIT
      CHARACTER*(6) HDUREE
 
C      ENTRY OOOWAe(LRET,IRET,HARG,PSEG,IDI1,JDES,NTAB)
C      ENTRY OOOWAf(LRET,IRET,HARG,PSEG,IDI1,JDES,NTAB)
C      ENTRY OOOWAg(LRET,IRET,HARG,PSEG,IDI1,JDES,NTAB)
C      ENTRY OOOWAh(LRET,IRET,HARG,PSEG,IDI1,JDES,NTAB)
C      ENTRY OOOWAi(LRET,IRET,HARG,PSEG,IDI1,JDES,NTAB)
C      ENTRY OOOWAj(LRET,IRET,HARG,PSEG,IDI1,JDES,NTAB)
 
 
C     Pour le message affiche
      HDIA   = HARG
      LDIA   = LEN(HARG)
 
C     On saute l'ENTRY OOOYAD
      GOTO 100
 
      ENTRY OOOYAD (LRET,IRET,PSEG,IDI1,JDES,NTAB)
      HDIA   =' '
      LDIA   = 0
 
 100  CONTINUE
      KASINS = INSTRUCTION_SEGADJ
 
      if(pseg.eq.abs(MZSURV)) CALL OOOMES(pseg,'GEMAT SURVEILLE   ')
 
C     Logique pour chronométrer l'attente
C     LWAIT=.TRUE.  duree dans ooowait seulement
C     LGLL =.TRUE.  duree dans ooogll  seulement
      LGLL  =MZATTE .LT. 0 .AND. thread
      LWAIT =MZATTE .GT. 0
 
      nth=0
      if (thread) nth=oothrd
 
C     Debut du Chronometre
      if (LGLL) CALL oootps(ITTIME,nth)
 
      if (thread) then
        lnsf(nth)=0
        call ooogll(1)
        lnsf(nth)=1
      endif
 
      if (LGLL) then
C       Fin du Chronometre : Mesure du temps
        ITPS0=ITTIME(1)+ITTIME(2)
        CALL oootps(ITTIME,nth)
        IELAPS=ITTIME(1)+ITTIME(2)-ITPS0
        IF(IELAPS .ge. ABS(MZATTE))THEN
          WRITE(HDUREE,'(i6)') IELAPS
          CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE)
        ENDIF
      endif
 
      lectur=(mdro1(pseg).eq.0).and.(mdro2(pseg).eq.0)
C     verif queue de desactivation
      if (idesq(nth).ne.0)  call ooodeq(nth)
C si on est en attente, on libere le segment
C avant pour eviter les blocages
C et on le signale
      call oootdl(pseg,ifla)
      if (mdco(pseg).ne.0.and.
     > (nth.lt.64.and.mdro1(pseg).eq.ibset(0,nth)).or.
     > (nth.ge.64.and.mdro2(pseg).eq.ibset(0,nth-64))
     > .and.ifla.eq.1)
     >      call ooosig(mdco(pseg))
       if (nth.lt.64) mdro1(pseg)=ibclr(mdro1(pseg),nth)
       if (nth.ge.64) mdro2(pseg)=ibclr(mdro2(pseg),nth-64)
C  segact ecr=  ???
  10  if ((ibits(mdrw(pseg),0,18).ne.0.and.ibits(mdrw(pseg),0,18).ne.
     > nth+1).or.
     > (nth.lt.64.and.mdro1(pseg).ne.0.and.mdro1(pseg).ne.ibset(0,nth))
     > .or.(nth.ge.64.and.mdro2(pseg).ne.0.and.mdro2(pseg).ne.
     > ibset(0,nth-64))) then
C  on doit attendre.
C  si necessaire on cree une condition
        if (mdco(pseg).eq.0) then
          call ooocon(mdco(pseg))
        endif
        call oooddl(pseg,harg)
C       Mesure du TEMPS
        if (LWAIT) CALL oootps(ITTIME,nth)
        lnsf(nth)=0
        call ooowait(mdco(pseg))
        lnsf(nth)=1
        if (LWAIT) then
C         Mesure de l'attente
          ITPS0=ITTIME(1)+ITTIME(2)
          CALL oootps(ITTIME,nth)
          IELAPS=ITTIME(1)+ITTIME(2)-ITPS0
          I1 = INDEX(HDIA(   1:LDIA),' ')
          IF(IELAPS .ge. ABS(MZATTE))THEN
            WRITE(HDUREE,'(i6)') IELAPS
            CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE)
          ENDIF
        endif
        call oooudl
        goto 10
 
C      else
      endif
 
      CALL OOOVPN (PSEG)
      CALL OOOACT (LRET,PSEG,0)
      CALL OOOADJ (LRET,PSEG,IDI1,JDES,NTAB)
      IF   (LRET.EQ.1)                                  THEN
        IF (IRET.EQ.0)                                  GO TO 901
        PSEG = 0
      ENDIF
                                                        RETURN
C-----------------------------------------------------------------------
C                MESSAGES D'ERREUR
C-----------------------------------------------------------------------
 901  CALL OOOERR (0,0,'PAS ASSEZ DE PLACE EN MEMOIRE')
                                                        STOP 16
      END