Skip to content
Open
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
204 changes: 1 addition & 203 deletions LCModel.f
Original file line number Diff line number Diff line change
Expand Up @@ -2519,211 +2519,9 @@ SUBROUTINE DATAIN ()
end if
C
C ----------------------------------------------------------------------
C Test license.
C LI = host identification number initially; later this is modifed by
C OWNER information.
C LLINE = T if the run is to be aborted because of no license, and this is
c not the Test Data.
c COUNTC used instead of GETID for routine name for getting ID.
c NOLINE = T if there is no license; used instead of NOLIC for security.
C Skip license check.
C ----------------------------------------------------------------------
CALL FTDATA(0)
c -----------------------------------------------------------------------
c Skip license tests with Intel Windows version & dongle.
c -----------------------------------------------------------------------
if (nlin .gt. 0) go to 200!Cyg
c -----------------------------------------------------------------------
c Check for Master KEY.
c -----------------------------------------------------------------------
if (key(1) .eq. 210387309) go to 200
LLINE=.FALSE.
NOLINE=.FALSE.
c -------------------------------------------------------------------------
c The numerical year & month below should be updated to foil backdating.
c -------------------------------------------------------------------------
IF (KNUM(3) .LT. 100) KNUM(3)=KNUM(3)+2000
if (knum(3) .lt. 2018 .or.
1 (knum(3) .eq. 2018 .and. knum(2) .lt. 7)) go to 195
c -------------------------------------------------------------------------
c GETFFT produces a segmentation fault if called more than once (although
c NPAR & NLIN were verified to be correct.
c Therefore, HAVLIN=T (set below) if Linux valid license was found, and
c this allows skipping a 2nd test.
c -------------------------------------------------------------------------
if (havlin) go to 200
c -------------------------------------------------------------------------
c Initialize LDEVX, since some may be commented out in DEVX*.INC
c -------------------------------------------------------------------------
do 250 j = 1, mdevx
ldevx(j) = -2
250 continue
ndevx = 999999
c ------------------------------------------------------------------------
c The following statement will never be reached with the Cyg flag, but
c the start of the IF must be there to avoid diagnostics with Sun,
c etc. Should use INCLUDEs instead.
c -------------------------------------------------------------------------
C if (nlin .gt. 0) then!Linux
if (nlin .gt. 0) then!Cyg
C if (nlin .lt. 0) then!sun
C if (nlin .lt. 0) then!IRIX
C if (nlin .lt. 0) then!OSF
c --------------------------------------------------------------------
c LETT = STATUS for ERRMES from GETFFT (GETLIC) = 0 for valid license.
c NPAR = 120 = NSTART in GETLIC
c NLIN = 65549 = ARG1 in GETLIC
c --------------------------------------------------------------------
len_owner = 0
C call getfft(npar, nlin, lett, owner, len_owner, knum3, !Linux
C 1 knum2, idevx, version_lcm)!Linux
if (len_owner .gt. 0) then
c -----------------------------------------------------------------
c The following 2 lines are a clumsy way to properly fill OWNER with
c blanks, avoiding the output of a binary character in the
c Namelist output of OWNER.
c -----------------------------------------------------------------
ownout = OWNER(1:len_owner) // ' '
owner = ownout
OWNOUT='Data of: ' // OWNER(1:len_owner)
JOWNER=ILEN(OWNOUT)
JDATE=ILEN(CHDATE)
if (ltable .gt. 0)
1 write (ltable, 5410) OWNOUT(1:JOWNER), CHDATE(1:JDATE)
5410 format(1x, a)
IF (LCOORD .GT. 0)
1 write (lcoord, 5410) OWNOUT(1:JOWNER), CHDATE(1:JDATE)
end if
C include 'devx_linux.inc'!Linux
do 410 j = 1, ndevx
if (idevx .eq. ldevx(j)) lett = 40
410 continue
if (lett .eq. 0) then
if (knum(3) .gt. knum3 .or.
1 (knum(3) .eq. knum3 .and. knum(2) .gt. knum2))
2 lett = 50
end if
havlin = lett .eq. 0
if (havlin) go to 200
else
NDEV=1
L=0
C CALL countc (L)!sun
C CALL countc (L)!IRIX
LDEV(1)=L
C ------------------------------------------------------------------
C Initialize LDEV1 to only output NDEV LDEV1 values in One-Page Output.
C ------------------------------------------------------------------
DO 185 JDEV=2,MDEV
LDEV1(JDEV)=-1
185 CONTINUE
C ------------------------------------------------------------------
C OSF IGETAD can return NDEV>1 LDEV values.
C ------------------------------------------------------------------
C MDEVAR=MDEV!OSF
C NDEV=IABS(IGETAD (CHLI, MDEVAR))!OSF
C DO 186 JDEV=1,NDEV!OSF
C LDEV(JDEV)=77*ICHAR(CHLI(JDEV)(1:1))+!OSF
C 1 7*ICHAR(CHLI(JDEV)(2:2))+!OSF
C 2 26*ICHAR(CHLI(JDEV)(3:3))+!OSF
C 3 65536*ICHAR(CHLI(JDEV)(4:4))+!OSF
C 4 256*ICHAR(CHLI(JDEV)(5:5))+!OSF
C 5 ICHAR(CHLI(JDEV)(6:6))!OSF
C 186 CONTINUE!OSF
C NDEV=MAX0(1, NDEV)!OSF
C
C include 'devx.inc'!IRIX
C include 'devx.inc'!OSF
C include 'devx.inc'!sun
DO 187 JDEV=1,NDEV
LDEV1(JDEV) = IGETP (34481 + IABS(LDEV(JDEV)), 35)
c -------------------------------------------------------------
c Reject license if LDEV1 is on blacklist in LDEVX
c -------------------------------------------------------------
do 1875 jdevx = 1, ndevx
if (LDEV1(JDEV) .eq. ldevx(jdevx)) go to 195
1875 continue
LDEV(JDEV)=LDEV1(JDEV)
C ----------------------------------------------------------------
C Modify LDEV(JDEV) with OWNER info.
C ----------------------------------------------------------------
DO 188 J=1,ILEN(OWNER)
LDEV(JDEV)=LDEV(JDEV)-(J+9)*ICHAR(OWNER(J:J))
188 CONTINUE
LDEV(JDEV)=IABS(LDEV(JDEV))
C ----------------------------------------------------------------
C Test LDEV(JDEV) for lifetime license.
C ----------------------------------------------------------------
K = IGETP (LDEV(JDEV) + 8829, 59)
DO 189 J = 1, MKEY
IF (KEY(J) .EQ. K) GO TO 200
189 CONTINUE
C -------------------------------------------------------------
C Test host identification number for license for next 25 months.
C KNUM(2) = month
C KNUM(3) = year
C -------------------------------------------------------------
KJ = 100*(KNUM(3) - 1997)
KM = KNUM(2) - 1
DO 191 JPAR = 1, 25
KM = KM + 1
IF (KM .GT. 12) THEN
KM = KM - 12
KJ = KJ + 100
END IF
K = IGETP (LDEV(JDEV) + (KJ + KM)*3678, 41)
DO 193 J = 1, MKEY
IF (KEY(J) .EQ. 0) GO TO 191
IF (KEY(J) .EQ. K) GO TO 200
193 CONTINUE
191 CONTINUE
187 CONTINUE
end if
C ----------------------------------------------------------------------
C There is no license. Check if this is demo data.
C ----------------------------------------------------------------------
195 NOLINE=.TRUE.
PPM1=3.4
PPM2=2.8
SUML=0.
DO 9210 J=NINT((4.65-PPM1)/PPMINC)+1+nunfil,
1 NINT((4.65-PPM2)/PPMINC)+1+nunfil
SUML=AMAX1(SUML,CABS(DATAF(J)))
9210 CONTINUE
C
PPM1=2.8
PPM2=2.2
SUMM=0.
DO 9220 J=NINT((4.65-PPM1)/PPMINC)+1+nunfil,
1 NINT((4.65-PPM2)/PPMINC)+1+nunfil
SUMM=AMAX1(SUMM,CABS(DATAF(J)))
9220 CONTINUE
C
PPM1=2.2
PPM2=1.8
SUMR=0.
DO 9230 J=NINT((4.65-PPM1)/PPMINC)+1+nunfil,
1 NINT((4.65-PPM2)/PPMINC)+1+nunfil
SUMR=AMAX1(SUMR,CABS(DATAF(J)))
9230 CONTINUE
C
TEST=SUML-SUMM
LLINE=ABS(TEST).LE.0.
IF (.NOT.LLINE) THEN
TEST=(SUMR-SUMM)/TEST
C write (*, 5230) test!delete
C5230 format (1pe15.6)!delete
C if (nunfil .gt. 0) stop!delete
C LLINE=MOD(NINT(3.*TEST),2) .EQ. 0
LLINE=TEST.LT.2.16 .OR. TEST.GT.2.17
END IF
C -------------------------------------------------------------------------
c NOLINE = T if there is no license.
C LLINE = T if the run is to be aborted because of no license, and this is
c not the Test Data.
c fndata = 0. causes the run to be aborted in MYBASI. This will sabotage
c the run, even if the abort is stopped.
C -------------------------------------------------------------------------
if (lline) fndata = 0.
200 RETURN
END
C
Expand Down