cgetLoginN.f

Go to the documentation of this file.

!           ***************************************************
!              cgetLoginN:  get login name ( <= 8 characters)
!           *************************************************** 
!        +U77 compliler option is needed
!        for the HP compiler.
!        
#undef GENERIC

#if defined DECALPHA
#define GENERIC
#elif defined PCLinux
#define GENERIC
#elif defined PCLinuxIFC64
#define GENERIC
#elif defined (PCLinuxIFC)  || defined (KEKA) || defined (KEKB) 
#define GENERIC
#elif defined MACOSX
#define GENERIC
#elif defined CF_AlphaLinux
#define GENERIC
#endif


#if defined NEXT486
!           ******************** next Absoft  fortran ***************
!           the same one as sun/hp may be usable instead of this.
!
       subroutine cgetloginn(userid)
        character*(*) userid
    integer getlogin,  intlogin
        pointer(pu, intlogin)
    pu=getlogin()
         call copycstring(intlogin, userid)
       end
       subroutine copycstring(Cstring, target)
         implicit none
         integer i
         character Cstring(*), target*(*)
         
         target=' '
         do i=1, len(target)
            if(cstring(i) == char(0) ) exit
            target(i:i)=cstring(i)
         enddo
       end
#elif defined GENERIC
      subroutine cgetloginn(userid)
      implicit none
      character*(*) userid
      character*16 user
      character*1 NULL
      integer leng, kgetenv
      null = char(0)
      leng = kgetenv("USER"//null, user)
      userid = user(1:leng)
      end
#else
!     **************************** sun4/hp ***************************
!       !!!!  for HP you need +U77 compiler option
!
       subroutine cgetloginn(userid)
!
       character*(*)  userid
       call getlog(userid)
       end
#endif
#ifdef IBMAIX
        subroutine getlog(user)
        character user*(*)
        call getenv('USER',user)
        end
#endif
!
!       easier interface to kgetenv
!
      integer function kgetenv2(envname, envresult)

      character*(*)  envname   ! input.  environment variable name
      character*(*)  envresult ! output. value of hte env. variable.
 
      integer leng, kgetenv, klena
      character*1  NULL
      character*128 path
      null = char(0)
      leng = klena(envname)
      if( leng .gt. 0 ) then
         leng = kgetenv( envname(1:leng)//null, envresult)
      else
         leng = 0
         envresult = ' '
      endif
      envresult=envresult(1:leng)//" "
      kgetenv2 = leng
      end
      subroutine cqversion(cosv)
      implicit none
#include "Zmanagerp.h"
      character*8::cosv ! output  cosmos version such 7.58; left justified
      character*64::COSMOSTOP
      character*128:: filen
      integer kgetenv2, icon

      if( kgetenv2("COSMOSTOP", cosmostop) == 0 ) then
         write(0,*) " Environmental variable "
         write(0,*) "COSMOSTOP cannot be obtained in cqversion"
         stop
      endif
      filen = trim(cosmostop)//"/Version/version" 
      call copenf(tempdev, filen, icon)
      read(tempdev, '(a)') cosv
      close(tempdev)
      end