Sources Esope | Cast3M

ooowi1
C OOOWI1    SOURCE    PV090527  26/04/24    08:23:31     12524          
CMODE 89/09/29 15:24:48     ESOP
      SUBROUTINE OOOWI1 (LRET,IRET,HARG,PSEG,PSG1)
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 CREE
C     PSG1     POINTEUR DESIGNANT LE SEGMENT COPIE
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 , PSG1.PSEG
 
C     LWAIT=.TRUE.  duree dans ooowait seulement
C     LGLL =.TRUE.  duree dans ooogll  seulement
      INTEGER       ITTIME(4)
      LOGICAL       LGLL,LWAIT
      CHARACTER*(6) HDUREE
 
      HDIA   = HARG
      LDIA   = LEN(HARG)
 
C     On saute l'ENTRY OOOYI1
      GOTO 100
 
      ENTRY OOOYI1 (LRET,IRET,PSEG,PSG1)
      HDIA   =' '
      LDIA   = 0
 
 100  CONTINUE
      KASINS = INSTRUCTION_SEGINI_EGAL
 
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
 
      If (.NOT.THREAD.and.THREAD) write(JLST,*) ' bug compilateur aix'
      If (.NOT.THREAD.and.THREAD) write(JERR,*) ' bug compilateur aix'
 
      nth=0
      if (thread) nth=oothrd
 
C     Debut du Chronometre
      if (LGLL) CALL oootps(ITTIME,nth)
 
      if (thread) then
        lnsf(oothrd)=0
        call ooogll(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
      endif
 
      CALL OOOVPN(PSG1)
      CALL OOOIN1(LRET,PSEG,PSG1)
 
      if (thread) then
        call ooogll(0)
        lnsf(oothrd)=1
      endif
      if(pseg.eq.abs(MZSURV)) CALL OOOMES(pseg,'GEMAT SURVEILLE   ')
 
C     Emmission du message GEMAT ATTEND apres le message SURVEILLE (regularite par rapport aux autres SEGXXX)
      if (LGLL .AND. IELAPS .ge. ABS(MZATTE)) then
        WRITE(HDUREE,'(i6)') IELAPS
        CALL OOOMES(PSEG,'GEMAT ATTEND'//HDUREE)
      endif
 
      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