Sources Esope | Cast3M

ooowsu
C OOOWSU    SOURCE    PV090527  26/04/24    08:23:33     12524          
CMODE 89/09/29 15:24:48     ESOP
      SUBROUTINE OOOWSU (LRET,IRET,HARG,PSEG,KOD)
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 L'ENTRY OOOWAD
C
C--------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
%INC IOOWCOM
%INC IOOUNIT
%INC IOOSAF
 
      CHARACTER*(*) HARG
      POINTEUR      PSEG.PSEG
      integer ooolen
 
      INTEGER       ITTIME(4)
      LOGICAL       LGLL,LWAIT
      CHARACTER*(6) HDUREE
 
 
      HDIA   = HARG
      LDIA   = LEN(HARG)
 
C     On saute l'ENTRY OOOYSU
      GOTO 100
 
      ENTRY OOOYSU (LRET,IRET,PSEG,KOD)
      HDIA   =' '
      LDIA   = 0
 
 100  CONTINUE
 
      IF (PSEG.EQ.0)                                    RETURN
      KASINS = INSTRUCTION_SEGSUP
 
      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     Si horodatage SEGMENT plus ancien que horodatage COURANT ==> RETURN
C     On n'autorise pas la suppression d'un SEGMENT cree dans un operateur plus ancien
      if (.not.ooofor .and. MDHOR(PSEG).LT.HORO(NTH))then
C       En mode VERACT je chasse les SEGSUP de SEGMENTS ANTI-HORODATE ==> GEMAT ERROR
        if (VERACT) GOTO 902
 
        LRET=2
        return
      endif
 
C     SEGMENT mis en queue de suppression
      ISUPQ(nth)=ISUPQ(nth)+1
      SUPQ(nth,ISUPQ(nth))=PSEG
      LSUPQ(nth)=LSUPQ(nth)+ooolen(pseg)
 
C     Retrait des SEGEMENT a supprimer de la queue de DESACTIVATION (Voir ooowde --> SEGDES)
      do i=1,idesq(nth)
        if (abs(desq(nth,i)).eq.pseg) desq(nth,i)=0
      enddo
 
C     SUPPRESSION des elements de la queue lorsque :
C       - queue pleine
C       - mode FORCE (menage)
C       - mode SURVEILLANCE (DEBUG)
C       - La taille occupee par les elements de la queue de suppression depasse une taille limite
C       - mode VERACT (ESOPE_PARAM)
      IF (ISUPQ(nth) .EQ. NSUPQ .or. ooofor .OR. MZSURV .GT. 0 .or.
     &    LSUPQ(nth) .ge. 1048576 .OR. VERACT) then
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
 
C       Vidange de la queue de suppression
        CALL OOOSUQ(nth)
        if (thread) call ooogll(0)
      endif
      PSEG=0
      LRET=2
      RETURN
 
C     Debut du Chronometre
      if (LGLL) CALL oootps(ITTIME,nth)
 
      if (thread) call ooogll(1)
 
      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
 
C     Hors MENAGE (force), et dans les ASSISTANTS : il faut attendre que le segment soit libre
      if (.not.ooofor .or. nth.ne.0) then
  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,HDIA)
 
C         Debut du Chronometre
          if (LWAIT) CALL oootps(ITTIME,nth)
 
          lnsf(nth)=0
          call ooowait(mdco(pseg))
          lnsf(nth)=1
 
          if (LWAIT) then
C           Fin du Chronometre : Mesure du temps
            ITPS0=ITTIME(1)+ITTIME(2)
            CALL oootps(ITTIME,nth)
            IELAPS=ITTIME(1)+ITTIME(2)-ITPS0
C            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
        endif
      endif
 
      CALL OOOVPN (PSEG)
      CALL OOOSUP (LRET,PSEG,KOD)
      IF   (LRET.EQ.1)                                  THEN
        IF (IRET.EQ.0)                                  GO TO 901
C      Remise a ZERO de PSEG deja faite dans OOOSUP en sortie
C      ELSE
C        PSEG = 0
      ENDIF
      if (thread) call ooogll(0)
                                                        RETURN
C-----------------------------------------------------------------------
C                MESSAGES D'ERREUR
C-----------------------------------------------------------------------
 901  CALL OOOERR (0,0,'PAS ASSEZ DE PLACE EN MEMOIRE')
                                                        STOP 16
 902  CALL OOOERR (PSEG,-1,'POINTEUR ANTI-HORODATE')
                                                        STOP 16
      END