Sources Esope | Cast3M

lhhopn
C LHHOPN    SOURCE    PV090527  24/06/24    21:15:01     896            
 
*----------------------------------------------------------------------*
      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)
      PARAMETER (NBOS  = 3)
 
      EXTERNAL long
 
      CHARACTER*(LOCHAJ) cvarenv,dirb
      CHARACTER*(2)      separ(NBOS)
      CHARACTER*(6)      sextl(NBOS)
 
      EQUIVALENCE(cvarenv,ivarenv)
      EQUIVALENCE(entr   ,ientr  )
 
      INTEGER logdbg
      LOGICAL b_z
 
      iret = 0
      HHO_MaxLib = 0
      HHO_NomLib = '        '
 
* 0 - Option cachee de debogage :
      logdbg = 0
      cvarenv = 'CASTEM_HHO_DEBUG'//CHAR(0)
      l = LOCHAJ
      CALL OOOZEN(ivarenv,l)
      if (l.GE.1) logdbg = 1
      if (logdbg.gt.0) write(ioimp,*) 'HHO_LIB : Mode debogage actif'
 
* 1 - Definition pour chaque OS (LINUX, WIN, MAC) :
*         - du separateur de recherche
*         - du(des) separateur(s) de repertoire
*         - de l'extension de la bibliotheque
      sextl(1) = '.so   '
      separ(1) = ':/'
      sextl(2) = '.dll  '
      separ(2) = ';'//char(92)
      sextl(3) = '.dylib'
      separ(3) = ':/'
%IF WIN32,WIN64
      iextl = 2
%ELSE
      iextl = 1
* Cas particulier du MACOS
      cvarenv = 'CASTEM_PLATEFORME'//CHAR(0)
      l = LOCHAI
      CALL OOOZEN(ivarenv,l)
      IF (l.GE.1) THEN
        IF (cvarenv(1:l).EQ.'MAC') iextl = 3
      END IF
%ENDIF
      nextl = LONG(sextl(iextl))
      if (logdbg.gt.0) then
        if (iextl.eq.1) write(ioimp,*) 'HHO_LIB : OS = LINUX (default)'
        if (iextl.eq.2) write(ioimp,*) 'HHO_LIB : OS = WIN32/WIN64'
        if (iextl.eq.3) write(ioimp,*) 'HHO_LIB : OS = MACOS64'
      endif
 
* 2 - Recherche du repertoire de la bibliotheque HHO
      dirb = '        '
      cvarenv = 'CASTEM_HHO_ROOT'//CHAR(0)
      l = LOCHAJ
      CALL OOOZEN(ivarenv,l)
      IF (l.GE.1) THEN
        dirb(1:l) = cvarenv(1:l)
        l = l+1
* Cas tres particulier :
        if (l.gt.LOCHAJ) then
          iret = 1
          goto 900
        endif
        dirb(l:l) = separ(iextl)(1:1)
        do ib = 1, l-1
          b_z = .FALSE.
          do i = 1, NBOS
            if ( dirb(ib:ib).eq.separ(i)(1:1) ) b_z = .TRUE.
          enddo
          if (b_z) dirb(ib:ib) = separ(iextl)(1:1)
          b_z = .FALSE.
          do i = 1, NBOS
            if ( dirb(ib:ib).eq.separ(i)(2:2) ) b_z = .TRUE.
          enddo
          if (b_z) dirb(ib:ib) = separ(iextl)(2:2)
        enddo
        ind = INDEX(dirb(1:l),separ(iextl)(1:1))
        l = ind-1
        if (logdbg.gt.0) then
          write(ioimp,*) 'HHO_LIB : CASTEM_HHO_ROOT found'
          write(ioimp,*) '          =>'//dirb(1:l)//'&lt;='
        endif
        b_z = .TRUE.
        do ib = l, 1, -1
          if (dirb(ib:ib).eq.separ(iextl)(2:2)) then
            if (b_z) l = ib-1
          else
            b_z = .FALSE.
          endif
        enddo
        if (l.lt.1) then
          iret = 2
          goto 900
        endif
        dirb(l+1:LOCHAJ) = ' '
      ELSE
        dirb = '.'
      END IF
      l = LONG(dirb)
C*//      nll = l + (1 + 3 + 1 + 26) + nextl
      nll = l + (1 + 26) + nextl
      IF (nll .lt. 1 .OR. nll .gt. LOCHAI) THEN
        iret = 3
        goto 900
      ENDIF
C*//      dirb = dirb(1:l)//separ(iextl)(2:2)//"lib"//separ(iextl)(2:2)//
C*//     &       "libmechhcanoCast3MElements"//sextl(iextl)(1:nextl)
      dirb = dirb(1:l)//separ(iextl)(2:2)//
     &       "libmechhcanoCast3MElements"//sextl(iextl)(1:nextl)
      nll = LONG(dirb)
 
      if (logdbg.gt.0)
     &  write(ioimp,*) 'HHO_LIB : =>'//dirb(1:nll)//'&lt;='
 
      lmeptr = 0
      CALL PTRLIB(dirb(1:nll)//CHAR(0),nll, lmeptr)
 
      IF (lmeptr.LE.0) THEN
        iret = ABS(lmeptr)
        goto 900
      ENDIF
      if (logdbg.gt.0) 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.gt.0) then
        if (iret.eq.1) then
          moterr = '(Warning 1) CASTEM_HHO_ROOT too long'
          call erreur(-385)
        else if (iret.eq.2) then
          moterr = '(Warning 2) CASTEM_HHO_ROOT is empty'
          call erreur(-385)
        else if (iret.eq.3) then
          moterr = '(Warning 3) (castem_hho_root) CHARLIB too long'
          call erreur(-385)
        else if (iret.eq.10) then
          moterr = '(Error 4) len(lmelib) & lmelgb inconsistent'
          call erreur(-385)
        else if (iret.eq.11) then
          moterr = '(Warning 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