Paul,
I have the following code which appears to work for /64, but perhaps after reading this thread it should not.
The following bit does not work for a valid date:
dll_version = scc_lib_version@ ()
dll_date = dos_date (ints(dll_version))
Could you suggest any changes, as I would like to get info on salflibc.dll
subroutine echo_dll_version
!
include <clearwin.ins>
C_EXTERNAL SCC_LIB_VERSION@ '_scc_lib_version' :INTEGER*4
C_EXTERNAL INITLIBRARYFILEINFO@ '_InitLibraryFileInfo'():INTEGER*4
C_EXTERNAL GetLibraryVersionInfo@ '_GetLibraryVersionInfo'():STRING
C_EXTERNAL GetLibraryPath@ '_GetLibraryPath'():STRING
C_EXTERNAL GetLibraryDateInfo@ '_GetLibraryDateInfo'():STRING
!
integer dll_version
character str*256, ftn95_ver*80
character dos_date*9, dll_date*9
external dos_date
!
call get_compiler_version ( ftn95_ver )
!
dll_version = scc_lib_version@ ()
dll_date = dos_date (ints(dll_version))
!
WRITE ( *,1001) trim(ftn95_ver), dll_date, dll_version
WRITE (98,1001) trim(ftn95_ver), dll_date, dll_version
!
WRITE ( *,1000) 'get_library_info.f90 /64'
WRITE (98,1000) 'get_library_info.f90 /64'
str = GetLibraryVersionInfo@ ()
WRITE ( *,1000) ' VERSION: ', trim (str)
WRITE (98,1000) ' VERSION: ', trim (str)
str = GetLibraryPath@ ()
WRITE ( *,1000) ' PATH : ', trim (str)
WRITE (98,1000) ' PATH : ', trim (str)
str = GetLibraryDateInfo@ ()
WRITE ( *,1000) ' DATE : ', trim (str)
WRITE (98,1000) ' DATE : ', trim (str)
write ( *,1000) ' '
write (98,1000) ' '
1000 FORMAT (a,a)
1001 FORMAT (/a/' Salford DLL code : ',a,i11/)
!
RETURN
!
end subroutine echo_dll_version
character*9 function dos_date (yymmdd)
!
integer*2 yymmdd
!
character temp*9, label(0:12)*3
integer*4 yy,mm,dd
intrinsic mod
data label / '___', 'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun', &
'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec' /
!
! yyyyyyy mmmm ddddd
dd = iand (yymmdd,31) ! 0-31
mm = iand (ishft(yymmdd,-5),15) ! 0-15
yy = ishft (yymmdd,-9) ! 0-127
!
yy = mod (yy+1980,100)
if (mm>12 .OR. mm<0) mm = 0
!
write (temp,1001) dd,label(mm),yy
1001 format (i2.2,'-',a3,'-',i2.2)
dos_date = temp
return
end function dos_date
subroutine get_compiler_version ( version )
character version*(*)
character ftn95_ver*80
!
include <ftn95_ver.ins>
version = ftn95_ver
end subroutine get_compiler_version
File ftn95_ver.ins is unique to each FTN95 directory:
ftn95_ver = '[FTN95/Win32 Ver. 8.20.0 Nov 17 Copyright (c) Silverfrost Ltd 1993-2017]'