1C*********************************************************************** 2C LHS (Latin Hypercube Sampling) UNIX Library/Standalone. 3C Copyright (c) 2004, Sandia Corporation. Under the terms of Contract 4C DE-AC04-94AL85000 with Sandia Corporation, the U.S. Government 5C retains certain rights in this software. 6C 7C This software is distributed under the GNU Lesser General Public License. 8C For more information, see the README file in the LHS directory. 9C*********************************************************************** 10C Last change: SLD 5 Apr 101 7:21 am 11C**************************************************************** 12C SUBROUTINE FINDIT IS USED IN THE POSITIVE DEFINITE CHECK 13C OF THE CORRELATION MATRIX 14C 15!LHS_EXPORT_DEC ATTRIBUTES DLLEXPORT::FINDIT 16 SUBROUTINE FINDIT(NP,M,EIG,ICONV) 17cc FINDIT is called from: POSDEF sld01 18cc FINDIT does not call any other external routines sld01 19C INCLUDE 'KILLFILE.INC' GDW-96 20cc USE KILLFILE -- not needed sld01 21C 22C INCLUDE 'PARMS.INC' GDW-96 23cc USE PARMS sld01 24C INCLUDE 'CPARAM.INC' GDW-96 25 USE CPARAM 26cc CPARAM provides: N sld01 27C INCLUDE 'CCMATR.INC' GDW-96 28 USE CCMATR 29cc CCMATR provides: CORR sld01 30C INCLUDE 'CSAMP.INC' GDW-96 31 USE CSAMP 32cc CSAMP provides: X array sld01 33C 34C These statements removed to make modules work - GDW-96 35C COMMON/PDMAT/Z(NVAR,NVAR),D(NVAR) 36 USE PDMAT 37cc PDMAT provides: Z and D arrays sld01 38C 39 IMPLICIT DOUBLE PRECISION (A-H,O-Z) 40C 41 LOC(I,J)=(J-1)*N+I 42 NEV = 0 43 DO 9 I = 1,NP 44 IF (D(I) .LT. 0.0) NEV=NEV+1 45 9 CONTINUE 46C 47 IF (NEV .EQ. 0) THEN 48C 49 ICONV=1 50C 51 ELSE 52C 53 DO 11 I = 1,NEV 54 D(I)=EIG 55 11 CONTINUE 56C 57 L1=NEV+1 58 L2=NEV+NEV 59 DO 12 I = L1,L2 60 IF(D(I).LT.EIG)D(I)=EIG 61 12 CONTINUE 62C 63 DO 4 I = 1,M 64 DO 4 J = 1,M 65 X(LOC(I,J)) = 0.0 66 4 CONTINUE 67C 68 DO 5 I = 1,NP 69 DO 5 J = 1,NP 70 DO 5 K = 1,NP 71 X(LOC(I,J)) = X(LOC(I,J)) + Z(I,K)*D(K)*Z(J,K) 72 5 CONTINUE 73C 74 DO 30 I = 1,NP 75 X(LOC(I,I)) = 1.0 76 30 CONTINUE 77C 78 KI = 0 79 DO 10 I = 1,NP 80 DO 10 J = 1,I 81 KI = KI + 1 82 CORR(KI) = X(LOC(I,J)) 83 10 CONTINUE 84C 85 ENDIF 86C 87 RETURN 88 END 89