CSUBR file = NIJX1.DEC **** 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 done now, as we have no valid DEC time routines (Feb. 96) C Subroutine DATIME is only used by the subroutines KEDATE and KETIME . C+---------------------------------------------------------------------- SUBROUTINE DATIME (I1, I2, I3) I1 = 0 I2 = 0 I3 = 0 RETURN C END OF SUBR DATIME END CSUBROUTINE KEYSWI C----------------------------------------------------------------------- C Subr. for 'local' KEYS and SWITCH settings, and 'local' specialities ! C DEC 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 DEC version: KEYS(11)=IATX==> =3 for SPF, =4 for SCHAKAL, =5 for both. C === output atoms file for programs PLUTON and SCHAKAL, respectively. IATX = 5 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 DEC version: CCNAME=.FALSE. set for short file names: lower case . C DEC 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 DEC version: alternat.: concatenation of CCODE with file names? C DEC version: CCNAME=.FALSE. : set for short file names: lower case . C DEC 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