1 SUBROUTINE DATIN 2 IMPLICIT DOUBLE PRECISION (A-H,O-Z) 3 INCLUDE 'SIZES' 4 CHARACTER NUMBRS(0:9)*1, PARTYP(25)*5, FILES*64, DUMMY*50, 5 1 KEYWRD*241, TEXT*50, TXTNEW*50, ELEMNT(107)*2, 6 2 GETNAM*80 7 COMMON /ATHEAT/ ATHEAT 8 1 /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM), 9 2 NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA, 10 3 NCLOSE,NOPEN,NDUMY,FRACT 11 COMMON /ATOMIC/ EISOL(107),EHEAT(107) 12 COMMON /KEYWRD/ KEYWRD 13 DIMENSION IJPARS(5,1000), PARSIJ(1000) 14 SAVE NUMBRS, PARTYP, ELEMNT 15 DATA NUMBRS/' ','1','2','3','4','5','6','7','8','9'/ 16 DATA PARTYP/'USS ','UPP ','UDD ','ZS ','ZP ','ZD ', 17 1 'BETAS','BETAP','BETAD','GSS ','GSP ','GPP ','GP2 ', 18 2 'HSP ','AM1 ','EXPC ','GAUSS','ALP ','GSD ','GPD ', 19 3 'GDD ','FN1 ','FN2 ','FN3 ','ORB '/ 20 DATA (ELEMNT(I),I=1,107)/'H ','HE', 21 1 'LI','BE','B ','C ','N ','O ','F ','NE', 22 2 'NA','MG','AL','SI','P ','S ','CL','AR', 23 3 'K ','CA','SC','TI','V ','CR','MN','FE','CO','NI','CU', 24 4 'ZN','GA','GE','AS','SE','BR','KR', 25 5 'RB','SR','Y ','ZR','NB','MO','TC','RU','RH','PD','AG', 26 6 'CD','IN','SN','SB','TE','I ','XE', 27 7 'CS','BA','LA','CE','PR','ND','PM','SM','EU','GD','TB','DY', 28 8 'HO','ER','TM','YB','LU','HF','TA','W ','RE','OS','IR','PT', 29 9 'AU','HG','TL','PB','BI','PO','AT','RN', 30 1 'FR','RA','AC','TH','PA','U ','NP','PU','AM','CM','BK','CF','XX', 31 2 'FM','MD','CB','++','+','--','-','TV'/ 32 I=INDEX(KEYWRD,'EXTERNAL=')+9 33 J=INDEX(KEYWRD(I:),' ')+I-1 34 FILES=GETNAM(KEYWRD(I:J)) 35 WRITE(6,'(//5X,'' PARAMETER TYPE ELEMENT PARAMETER'')') 36 OPEN(14,STATUS='UNKNOWN',FILE=FILES) 37 I=0 38 NPARAS=0 39 10 READ(14,'(A40)',ERR=90,END=90)TEXT 40 NPARAS=NPARAS+1 41 IF(TEXT.EQ.' ')GOTO 90 42 IF(INDEX(TEXT,'END').NE.0)GOTO 90 43 ILOWA = ICHAR('a') 44 ILOWZ = ICHAR('z') 45 ICAPA = ICHAR('A') 46************************************************************************ 47 DO 20 I=1,50 48 ILINE=ICHAR(TEXT(I:I)) 49 IF(ILINE.GE.ILOWA.AND.ILINE.LE.ILOWZ) THEN 50 TEXT(I:I)=CHAR(ILINE+ICAPA-ILOWA) 51 ENDIF 52 20 CONTINUE 53************************************************************************ 54 IF(INDEX(TEXT,'END') .NE. 0) GOTO 90 55 DO 30 J=1,25 56 IF(J.GT.21) THEN 57 IT=INDEX(TEXT,'FN') 58 TXTNEW = TEXT(1:IT+2) 59 IF(INDEX(TXTNEW,PARTYP(J)) .NE. 0) GOTO 40 60 ENDIF 61 IF(INDEX(TEXT,PARTYP(J)) .NE. 0) GOTO 40 62 30 CONTINUE 63 WRITE(6,'('' FAULTY LINE:'',A)')TXTNEW 64 WRITE(6,'('' FAULTY LINE:'',A)')TEXT 65 WRITE(6,'('' NAME NOT FOUND'')') 66 STOP 67 40 IPARAM=J 68 IF(IPARAM.GT.21) THEN 69 I=INDEX(TEXT,'FN') 70 KFN=READA(TEXT,I+3) 71 ELSE 72 KFN=0 73 I=INDEX(TEXT,PARTYP(J)) 74 ENDIF 75 K=INDEX(TEXT(I:),' ')+1 76 DUMMY=TEXT(K:) 77 TEXT=DUMMY 78 DO 50 J=1,107 79 50 IF(INDEX(TEXT,' '//ELEMNT(J)) .NE. 0) GOTO 60 80 WRITE(6,'('' ELEMENT NOT FOUND '')') 81 WRITE(6,*)' FAULTY LINE: "'//TEXT//'"' 82 STOP 83 60 IELMNT=J 84 PARAM=READA(TEXT,INDEX(TEXT,ELEMNT(J))) 85 DO 70 I=1,LPARS 86 IF(IJPARS(1,I).EQ.KFN.AND.IJPARS(2,I).EQ.IELMNT.AND. 87 1IJPARS(3,I).EQ.IPARAM) GOTO 80 88 70 CONTINUE 89 LPARS=LPARS+1 90 I=LPARS 91 80 IJPARS(1,I)=KFN 92 IJPARS(2,I)=IELMNT 93 IJPARS(3,I)=IPARAM 94 PARSIJ(I)=PARAM 95 GOTO 10 96 90 CONTINUE 97 IF(NPARAS.EQ.0)THEN 98 WRITE(6,'(//10X,A)')' EXTERNAL PARAMETERS FILE MISSING OR EMPTY 99 1' 100 STOP 101 ENDIF 102 CLOSE(14) 103 DO 120 J=1,107 104 DO 110 K=1,25 105 DO 100 I=1,LPARS 106 IPARAM=IJPARS(3,I) 107 KFN=IJPARS(1,I) 108 IELMNT=IJPARS(2,I) 109 IF(IPARAM.NE.K) GOTO 100 110 IF(IELMNT.NE.J) GOTO 100 111 PARAM=PARSIJ(I) 112 IF(KFN.NE.0)THEN 113 WRITE(6,'(10X,A6,11X,A2,F17.6)') 114 1PARTYP(IPARAM)(:3)//NUMBRS(KFN)//' ', 115 2ELEMNT(IELMNT),PARAM 116 ELSE 117 WRITE(6,'(10X,A6,11X,A2,F17.6)') 118 1PARTYP(IPARAM)//NUMBRS(KFN), 119 2ELEMNT(IELMNT),PARAM 120 ENDIF 121 CALL UPDATE(IPARAM,IELMNT,PARAM,KFN) 122 100 CONTINUE 123 110 CONTINUE 124 120 CONTINUE 125 CALL MOLDAT(1) 126 CALL CALPAR 127 ATHEAT=0.D0 128 ETH=0.D0 129 DO 130 I=1,NUMAT 130 NI=NAT(I) 131 ATHEAT=ATHEAT+EHEAT(NI) 132 130 ETH=ETH+EISOL(NI) 133 ATHEAT=ATHEAT-ETH*23.061D0 134 RETURN 135 END 136