CSUBR file = NIJX1.RS6 **** Part 1 of the NIJX subroutines **** Computer specific subroutines **** update: 27 Sep. 1999 **** Note: before compiling, concatenate: NIJX = NIJX1 + NIJX2 !!!!! **** List of subroutines given in this file:===> DATIME, KEYSWI, FILINX C+---------------------------------------------------------------------- CSUBROUTINE DATIME (I1, I2, I3) C----------------------------------------------------------------------- C Subroutine to get the system date and the CPU time in msec. Output: C I1 time of the day as hhmm (hh=hours, mm=minutes) C I2 CPU time in msec used since initiation C I3 day-number as yynnn (yy=year, nnn=number) C I1 = I2 = I3 = 0 implies that no valid clock value is available C This subroutine is computer dependent ===== it is not in FORTRAN77 ANS C Subroutine DATIME is only used by the subroutines KEDATE and KETIME . C Note: subr DDTIME (as used in the Silicon Graphics) is not used here. C+---------------------------------------------------------------------- SUBROUTINE DATIME (I1, I2, I3) C Time routine for Risc 6000 7 July 1995 C written by Joe Lakovits, Chem., Northwestern Univ., Evanston, IL, USA. C CPU time is the sum of the current process's user time and the user & C system time of all child processes INTEGER*4 SINCE_EPOCH, TM(9) POINTER (TMADDR, TM) N = TIME(SINCE_EPOCH) C TMADDR is the address of a 9-element integer array TMADDR = LOCALTIME(SINCE_EPOCH) C now TM=(SECS 0-59, MIN 0-59, HOURS 0-23, MONTH 0-11, YEAR-1900, C WEEK SUN=0, DAYOFYEAR 0-165, NONZERO if DAYLIGHT SAVINGS TIME ) I1 = ( 100 * TM(3) ) + TM(2) I3 = ( 1000 * TM(6) ) + TM(8) +1 C MCLOCK returns the user & system time as 1/100 sec increments I2 = MCLOCK() * 10 RETURN C END OF SUBR DATIME END CSUBROUTINE KEYSWI C----------------------------------------------------------------------- C Subr. for 'local' KEYS and SWITCH settings, and 'local' specialities ! C RS6 version: KEYS(11)=IATX==> =3 for SPF, =4 for SCHAKAL, =5 for both. C Switches are defaulted .FALSE. and may be changed at any time: C SWITCH(1) = NIJMEG = .TRUE. on execution in Nijmegen: see NIJX1.FORIBM C SWITCH(2) = MOLEN = .TRUE. for MOLEN users: see -------> NIJX1.FORVAX C SWITCH(3), SWITCH(4), SWITCH(5) and SWITCH(6) are free. C KEYS() are defaulted = 0 and several are still free. C KEYSWI is called once at the beginning of each program, and it is C called again at any STOP (including at an error stop). *** Note 1: if you wish us to implement some special private features C for you, please, write to us. These private features then will be C activated by these SWITCHes or KEYS. *** Note 2: you can implement your own routine at the beginning and at C the end of the execution of any program. E.g. see NIJX1.FORCYB. *** Note 3: we will be very happy to help ! C+---------------------------------------------------------------------- SUBROUTINE KEYSWI C ------ /SYSTA/ and /SYSTB/ interface with supervisor. COMMON /SYSTA/ IFILE(20), IFSTAT(20), ITIME(4), KEYS(28), * NFNUM, NLIT, NCOLN(32), NCOLL(32), * NFDOT(32), NFDOL(32), NLUSER(32), FNUM(32), * SWITCH(28) LOGICAL SWITCH EQUIVALENCE (IATX, KEYS(11)) LOGICAL FIRST DATA FIRST / .TRUE. / C RS6 version: KEYS(11)=IATX==> =3 for SPF, =4 for SCHAKAL, =5 for both. C === output atoms file for programs PLUTON and SCHAKAL, respectively. Cxxx IF (IATX .EQ. 0) IATX = 5 Cxxx IF (FIRST) THEN C switch FIRST = .TRUE. for first entry, reset to .FALSE. FIRST = .FALSE. C things to be done at start for each program ELSE FIRST = .TRUE. C things to be done at STOP for each program ENDIF RETURN C END OF SUBROUTINE KEYSWI END CSUBROUTINE FILINX (FNAME) C----------------------------------------------------------------------- C Subroutine for 'local' file definitions. C This subroutine is called prior to opening any file (input or output). C The file name for an input or output file is defaulted by FORTRAN in : C CHARACTER FNAME *64 C The DIRDIF standard is : up to six characters: all letters as CAPITALS C This may be modified to suit your needs. C In this subroutine all CAPITALS are converted to lower case letter !!! C Note: the CCODE (in CAP) is present in CCODE: C RS6 version: CCNAME=.FALSE. set for short file names: lower case . C RS6 version: CCNAME=.TRUE. concatenation of CCODE with file names C+---------------------------------------------------------------------- SUBROUTINE FILINX (FNAME) CHARACTER *64 FNAME C ------ /SYSTA/ and /SYSTB/ interface with supervisor. COMMON /SYSTA/ IFILE(20), IFSTAT(20), ITIME(4), KEYS(28), * NFNUM, NLIT, NCOLN(32), NCOLL(32), * NFDOT(32), NFDOL(32), NLUSER(32), FNUM(32), * SWITCH(28) LOGICAL SWITCH COMMON /SYSTB/ PROGNM, PROSNM, CCODE, TITLE, * CHIN, LIT(32), CHOUT CHARACTER PROGNM *8, PROSNM *6, CCODE *6, TITLE *64, * CHIN *80, LIT *6, CHOUT *72 LOGICAL CCNAME CHARACTER *14 CCCC C procedure inverted from SUBROUTINE KERC2U CHARACTER * 1 LUC(26), LLC(26) DATA LUC / 'A','B','C','D','E', 'F','G','H','I','J', + 'K','L','M','N','O', 'P','Q','R','S','T', + 'U','V','W','X','Y', 'Z' / DATA LLC / 'a','b','c','d','e', 'f','g','h','i','j', + 'k','l','m','n','o', 'p','q','r','s','t', + 'u','v','w','x','y', 'z' / C RS6 version: alternat.: concatenation of CCODE with file names? C RS6 version: CCNAME=.FALSE. : set for short file names: lower case . C RS6 version: CCNAME=.TRUE. : concatenation of CCODE with file names C changing 'fname' to 'ccode.fname'. C For instance CCNAME=.FALSE. : 'ATOMS' is changed into: 'atoms' C For instance CCNAME=.TRUE. : 'ATOMS' is changed into: 'ccode.atoms' C Here we activate CCNAME = .TRUE. on next line: CCNAME = .TRUE. C convert SCHAKL to sch IF (FNAME(1:6) .EQ. 'SCHAKL') THEN C Convert 'fname' to 'ccode.fname' ? IF (CCNAME) THEN FNAME = 'SCH' GOTO 100 ENDIF FNAME = 'atom.sch' RETURN ENDIF 100 I7 = 7 IF (FNAME(1:6) .EQ. 'DDJOB ' .OR. FNAME(1:6) .EQ. 'DDSYST' .OR. * FNAME(1:6) .EQ. 'DDHELP' .OR. FNAME(1:6) .EQ. 'ORBASE' .OR. * FNAME(1:6) .EQ. 'DDCON ' .OR. FNAME(1:6) .EQ. 'DDLIC ' .OR. * FNAME(1:6) .EQ. 'ORUSER' ) GOTO 113 * rm ddconfig IF (FNAME(1:8) .EQ. 'DDCONFIG') THEN FNAME = 'ddconfig' RETURN ENDIF C Convert 'fname' to 'ccode.fname' ? IF (CCNAME) THEN CCCC = CCODE DO 111 I=1,7 IF (CCCC(I:I) .EQ. ' ') GOTO 112 111 CONTINUE C the first blank is at position I=7 or less 112 CCCC(I:I) = '.' I = I + 1 CCCC(I:14) = FNAME(1:7) FNAME = CCCC I7 = 14 ENDIF C convert CAPs to lower case letters 113 DO 120 I = 1, I7 IF (FNAME(I:I) .EQ. ' ') GOTO 120 CALL KEREQ1 (FNAME(I:I), LUC, 26, KEND) IF (KEND .GT. 0) FNAME(I:I) = LLC(KEND) 120 CONTINUE RETURN C END OF SUBROUTINE FILINX / last subroutine of NIJX1 END