Sources Esope | Cast3M

lhhopn
C LHHOPN    SOURCE    OF166741  26/02/23    21:15:23     12480          
 
*----------------------------------------------------------------------*
      SUBROUTINE LHHOPN (iret)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
 
-INC CCHHOPA
-INC CCHHOPR
 
      PARAMETER (LOCHAJ = 10 * LOCHAI)
 
      CHARACTER*(LOCHAJ) cvarenv
      CHARACTER*(LOCHAI) dirb
      CHARACTER*(6)      sextl
      CHARACTER*(2)      separ
 
      EXTERNAL LONG
 
      EQUIVALENCE(cvarenv,ivarenv)
      EQUIVALENCE(entr   ,ientr  )
 
      LOGICAL logdbg
 
      iret = 0
      HHO_MaxLib = 0
      HHO_NomLib = '        '
 
* 0 - Option cachee de debogage :
      cvarenv = 'CASTEM_HHO_DEBUG'//CHAR(0)
      l = LOCHAJ
      CALL OOOZEN(ivarenv,l)
      logdbg = (l.GE.1)
      if (logdbg) write(ioimp,*) 'HHO_LIB : Mode debogage actif'
 
* 1 - Definition pour l'OS en cours (LINUX, WIN, MAC) :
*         - du separateur de recherche
*         - du(des) separateur(s) de repertoire
*         - de l'extension de la bibliotheque
%IF WIN32,WIN64
      sextl = '.dll  '
      separ = ';'//CHAR(92)
      if (logdbg) write(ioimp,*) 'HHO_LIB : OS = WIN32/WIN64'
%ELSE
%IF OSX
      sextl = '.dylib'
      separ = ':/'
      if (logdbg) write(ioimp,*) 'HHO_LIB : OS = MACOS64/OSX'
%ELSE
      sextl = '.so   '
      separ = ':/'
      if (logdbg) write(ioimp,*) 'HHO_LIB : OS = LINUX'
%ENDIF
%ENDIF
      nextl = LONG(sextl)
 
* 2 - Recherche du repertoire de la bibliotheque HHO
*     Hyp. : La variable d'environnement CASTEM_HHO_ROOT est definie 
*            correctement pour l'OS utilise.
      cvarenv = 'CASTEM_HHO_ROOT'//CHAR(0)
      l = LOCHAJ
      CALL OOOZEN(ivarenv,l)
*  On prend le premier repertoire defini dans "CASTEM_HHO_ROOT"
      IF (l.GE.1) THEN
        DO i = l, 1, -1
          IF (cvarenv(i:i).NE.' ') GOTO 2
          l = l - 1
        END DO
 2      CONTINUE
        IF (l.LE.0) THEN
          iret = 1
          goto 900
        ENDIF
        lgrep = l
        idrep = 1
        ifrep = lgrep
 20     CONTINUE
          ifrep = lgrep
*  Recherche debut fin du repertoire
          ind = INDEX(cvarenv(idrep:ifrep),separ(1:1))
          IF (ind.NE.0) ifrep = idrep + ind - 2
*  Cas particulier ou 2 separateurs se suivent
          IF (ind.EQ.1) GOTO 21
*  Cas particulier ou il n'y a que des espaces entre 2 separateurs
          lgd = ifrep - idrep + 1
          DO i = ifrep, idrep, -1
            IF (cvarenv(i:i).NE.' ') GOTO 200
            lgd = lgd - 1
          END DO
 200      CONTINUE
          IF (lgd.EQ.0) GOTO 21
*  Premier repertoire trouve :
          ifrep = idrep + lgd - 1
          GOTO 22
 21       CONTINUE
          idrep = ifrep + 2
*  Fin de la chaine atteinte sans trouver de repertoire
          IF (idrep.GT.lgrep) THEN
            iret = 1
            goto 900
          ENDIF
        GOTO 20
 22     CONTINUE
*  Pas de traitement en cas de melange de separateurs
*  Suppression des separateurs en fin de chaine
        l = lgd
        DO i = ifrep, idrep, -1
          IF (cvarenv(i:i).NE.separ(2:2)) GOTO 25
          l = l - 1
        END DO
 25     CONTINUE
        lgrep = l
        if (logdbg) then
           write(ioimp,*) 'HHO_LIB : CASTEM_HHO_ROOT found'
        endif
      ELSE
* "CASTEM_HHO_ROOT" non definie
        cvarenv = '.'
        idrep = 1
        lgrep = 1
      END IF
 
      nll = lgrep + 1 + 26 + nextl
      IF (nll .gt. LOCHAI) THEN
        iret = 2
        goto 900
      ENDIF
 
      dirb = '        '
      IF (lgrep.GT.0) THEN
        ifrep = idrep + lgrep - 1
        dirb(1:lgrep) = cvarenv(idrep:ifrep)
      ENDIF
      dirb(lgrep+1:nll) = separ(2:2)//
     &                    "libmechhcanoCast3MElements"//
     &                    sextl(1:nextl)
 
      if (logdbg) then
        write(ioimp,*) 'HHO_LIB : =>'//dirb(1:nll)//'&lt;='
      endif
 
      lmeptr = 0
      CALL PTRLIB(dirb(1:nll)//CHAR(0),nll, lmeptr)
 
      IF (lmeptr.LE.0) THEN
        iret = ABS(lmeptr)
        goto 900
      ENDIF
      if (logdbg) then
        moterr = 'HHO_LIB : dlopen(lmelib) -> '
        write(moterr(29:38),FMT='(I10)') lmeptr
        call erreur(-385)
      endif
 
      HHO_MaxLib = nll
      HHO_NomLib = dirb(1:nll)
 
 900  continue
      if (logdbg) then
        if (iret.eq.1) then
          moterr = '(Warning HHO.1) CASTEM_HHO_ROOT is empty'
          call erreur(-385)
        else if (iret.eq.2) then
          moterr = '(Warning HHO.2) HHO_LIB directory name too long'
          call erreur(-385)
        else if (iret.eq.10) then
          moterr = '(Error HHO.3) len(lmelib) & lmelgb inconsistent'
          call erreur(-385)
        else if (iret.eq.11) then
          moterr = '(Warning HHO.4) HHO_LIB not found or not opened'
          call erreur(-385)
        endif
        moterr = ' '
        call erreur(-385)
        if (iret.eq.0) then
          moterr = '=> HHO available in Cast3M'
        else
          moterr = '=> HHO NOT available in Cast3M'
        endif
        call erreur(-385)
        moterr = ' '
        call erreur(-385)
      endif
 
      RETURN
      END