#ifdef __VMS
   	subroutine jc_job(string)  !   
c   	Return image name	      !10/25/84  !   
   	character string*(*)  !   
   	include '($jpidef)'		!Include system codes  !   
   	character mystring*128  !   
   	structure /itmlst/  !   
   	  integer*2 buflen,itmcod  !   
   	  integer*4 bufadr	!*8  !   
   	  integer*4 retlen  !   
           end structure  !   
   	record  /itmlst/ jpi_list(2)  !   
   	integer sys$getjpi  !   
   	jpi_list(1).buflen=128		!Allowable length  !   
   	jpi_list(1).itmcod=jpi$_imagname	!Imagefile name  !   
   	jpi_list(1).bufadr=%loc(mystring)  !   
   	igood = sys$getjpi(,,,jpi_list,,,)  !   
   	ib=1  !   
   	k=1  !   
   	do while (k.gt.0)  !   
   	  k=index(mystring(ib:),']')		!Skip disk part  !   
   	  ib=ib+k  !   
   	enddo  !   
   	id=index(mystring(ib:),'.')	!Skip ".exe" part  !   
   	string=mystring(ib:ib+id-2)	!Return just file name  !   
   	end  !   
   	subroutine jc_timer(elapsed_time)  !   
   	icode=2		!cpu time, in 10ms counts  !   
   	istat=lib$stat_timer(icode,lapsed_time, )  !   
   	elapsed_time=float(lapsed_time)*.01	!convert to seconds  !   
   	call lib$init_timer	!reinit for next call  !   
   	end  !   
#endif
	subroutine jc_day(weekday,day)	                           !12/07/84
	character*(*) weekday,day
	character*9 today,days(7),cdate
	data days /'Sunday','Monday','Tuesday',
     >		'Wednesday','Thursday','Friday','Saturday'/
#ifdef __VMS
   	istat=lib$day(iday)  !   
   	weekday=days(1+jmod(iday+3,7))  !   
#endif
c	call idate(im,id,iy)
c	write(today,'(i2.2,1h/,i2.2,1h/,i2.2)')im,id,iy
	call c9date(cdate)
	write(today,'(a9)') cdate
	day=today
	end
#ifdef __VMS
   	subroutine jc_user(mode,myterm,user)	!   
c          return user,etc	!01/22/90  !   
c     mode = 0(other), 1(network), 2(batch), 3(interactive)  !   
c     myterm = terminal name (<= 7 chars)  !   
c     user = user name (<= 12 chars)  !   
   	character*(*) myterm,user  !   
   	structure /itmlst/  !   
   	  integer*2 buflen,itmcod  !   
   	  integer*4 bufadr	!*8  !   
   	  integer*4 retlen  !   
           end structure  !   
   	record  /itmlst/ jpi_list(4)  !   
   	include '($jpidef)'  !   
   	integer sys$getjpi  !   
c     !   
   	myterm = ' '  !   
   	user = ' '  !   
   	jpi_list(1).itmcod = jpi$_mode  !   
   	jpi_list(1).buflen = 4  !   
   	jpi_list(1).bufadr = %loc(mode)  !   
   	jpi_list(3).itmcod = jpi$_terminal  !   
   	jpi_list(3).buflen = 8  !   
   	jpi_list(3).bufadr = %loc(myterm)  !   
   	jpi_list(2).itmcod = jpi$_username  !   
   	jpi_list(2).buflen = 12  !   
   	jpi_list(2).bufadr = %loc(user)  !   
   	jpi_list(4).itmcod = 0  !   
c     !   
   	igood = sys$getjpi(,,,jpi_list,,,)  !   
   	if(.not.igood) call lib$signal(%val(igood))  !   
c     !   
cx	if(mode.ne.jpi$k_interactive) myterm = 'NL:' !   
   	do ii=1,8  !   
   	  if(ichar(myterm(ii:ii)).eq.0) myterm(ii:ii) = ' '  !   
   	enddo  !   
   	end  !   
   	subroutine jc_getdvi(devn,klass,ierr)  !get device class !03/92  !   
   	character*(*) devn	!physical name of device  !   
   	integer       klass	!(return) device class  !   
   			! 0=unknown, 1=disk, 2=terminal, 5=mailbox/nl:  !   
   	integer       ierr	!(return) status code  !   
   	integer*2 dvi$_devclass  !   
   	parameter (dvi$_devclass='0004'x)  !   
cx   	include '($dvidef)'	!   
   	include '($dcdef)'  !   
   	integer sys$getdviw  !   
   	structure /itmlst/  !   
   	  integer*2 dvi_leng /4/	!length of response  !   
   	  integer*2 dvi_code /dvi$_devclass/	!code for device class  !   
   	  integer*4 dvi_bufr /0/	!address of response  !   
   	  integer*4 dvi_resl /0/	!address of response length  !   
   	endstructure  !   
   	record /itmlst/ dvi  !   
   	integer class		!response buffer  !   
   	integer lphys		!length of device name  !   
c     !   
   	lphys=jc_trim(devn)  !   
   	ierr = 1		!assume success  !   
   	lcol = index(devn(1:lphys),':')  !   
   	ldot = index(devn(1:lphys),'.')  !   
   	if(ldot.ne.0 .and. lcol.eq.0) then  !   
   	  klass = 1		!has a dot, but no colon => disk  !   
   	  go to 800  !   
   	endif  !   
   	class = 0		!assume undefined  !   
c     !   
   	dvi.dvi_bufr = %loc(class)  !   
   	igood = sys$getdviw(,,devn(1:lphys),dvi,,,,)  !   
cx   	if(.not.igood) go to 800 !   
   	if(class.eq.0) then  !   
   	  klass = 0	!unknown  !   
   	elseif(class.eq.dc$_term) then  !   
   	  klass = 2	!terminal (on this node)  !   
   	elseif(class.eq.dc$_mailbox) then  !   
   	  klass = 5	!null device or xtc  !   
   	else  !   
   	  klass = 1	!disk  !   
   	endif  !   
c     !   
   	ierr = igood  !   
  800	return  !   
   	end  !   
#endif
	subroutine jc_trnlog(ctabl,clogical,ctrans,nc,igood) 
	character ctabl*(*),clogical*(*),ctrans*(*)
#ifdef __VMS
   	include '($lnmdef)'    !   
   	structure /itmlst/  !   
   	  integer*2 buflen,itmcod  !   
   	  integer*4 bufadr	!*8  !   
   	  integer*4 retlen  !   
           end structure  !   
   	record  /itmlst/ trn_list(3)  !   
   	integer sys$trnlnm  !   
   	integer iattr  !   
   	character*16 ttabl  !   
   	ttabl=ctabl  !   
   	if(ttabl.eq.' ') ttabl = 'LNM$FILE_DEV'  !   
   	trn_list(1).itmcod=lnm$_string  !   
   	trn_list(1).buflen=len(ctrans)  !   
   	trn_list(1).bufadr=%loc(ctrans)  !   
   	trn_list(1).retlen=%loc(nc)  !   
   	trn_list(2).itmcod=lnm$_attributes  !   
   	trn_list(2).buflen=4  !   
   	trn_list(2).bufadr=%loc(iattr)  !   
   	trn_list(3).itmcod=0  !   
   	ltt=jc_trim(ttabl)  !   
   	lcl=jc_trim(clogical)  !   
   	ctrans=' '	!in case of error  !   
   	igood=sys$trnlnm(,ttabl(:ltt),clogical(:lcl),,trn_list)  !   
#else
	igood=usr_trnlog(ctabl,clogical,ctrans,nc,igood)  !   
#endif
	end
	subroutine jc_malloc(kbytes,jxx)
#ifdef __f90
	real, pointer :: jxx
#else
	real xx(*)
	pointer (jxx,xx)
#endif
#ifdef __VMS
   	igood=lib$get_vm(kbytes,jxx)  !   
   	if(.not.igood) call lib$signal(%val(igood))  !   
#else
	igood=lib_get_vm(kbytes,jxx)  !   
	if(jxx.eq.0) then  !   
	  call at_msg('**Cant get more memory')  !   
	  call good_exit  !   
	endif  !   
#endif
	end
	subroutine jc_mfree(kbytes,jxx)
#ifdef __f90
	real, pointer :: jxx
#else
	real xx(*)
	pointer (jxx,xx)
#endif
	if(kbytes.le.0) return
#ifdef __VMS
   	call lib$free_vm(kbytes,jxx)  !   
#else
	call lib_free_vm(kbytes,jxx)  !   
#endif
	end
