program asd2asc c===============================================================c c written by Vassilis Hajivassiliou and Yoosoon Chang. c c version 1.0, March 22, 1992 c c===============================================================c c c Changes the 13 direct access files *.asd into regular ones *.asc c character*2 resfil character*12 cdfilCFS,cdfilNISE,cdfilNIST,cdfilKFS,cdfilSDS, / cdfilGHK,cdfilPCF,cdfilDCS,cdfilARSE,cdfilARSR, / cdfilGSS,cdfilAUS,cdfilSUS character*11 csfilCFS,csfilNISE,csfilNIST,csfilKFS,csfilSDS, / csfilGHK,csfilPCF,csfilDCS,csfilARSE,csfilARSR, / csfilGSS,csfilAUS,csfilSUS print *, ' ' print *, '2-letter identifier for result files:' read(*,'(a)') resfil print *, ' ' c-----create DOS batch file for gauss users: print *, *'Dimension of multivariate normal in the '//resfil//' runs:' read(*,*) m call asc2gau(m,resfil) cdfilCFS = resfil//'CFS.asd' csfilCFS = resfil//'CFS.asc' call dir2seq(cdfilCFS,csfilCFS) cdfilNISE = resfil//'NISE.asd' csfilNISE = resfil//'NISE.asc' call dir2seq(cdfilNISE,csfilNISE) cdfilNIST = resfil//'NIST.asd' csfilNIST = resfil//'NIST.asc' call dir2seq(cdfilNIST,csfilNIST) cdfilKFS = resfil//'KFS.asd' csfilKFS = resfil//'KFS.asc' call dir2seq(cdfilKFS,csfilKFS) cdfilSDS = resfil//'SDS.asd' csfilSDS = resfil//'SDS.asc' call dir2seq(cdfilSDS,csfilSDS) cdfilGHK = resfil//'GHK.asd' csfilGHK = resfil//'GHK.asc' call dir2seq(cdfilGHK,csfilGHK) cdfilPCF = resfil//'PCF.asd' csfilPCF = resfil//'PCF.asc' call dir2seq(cdfilPCF,csfilPCF) cdfilDCS = resfil//'DCS.asd' csfilDCS = resfil//'DCS.asc' call dir2seq(cdfilDCS,csfilDCS) cdfilARSE = resfil//'ARSE.asd' csfilARSE = resfil//'ARSE.asc' call dir2seq(cdfilARSE,csfilARSE) cdfilARSR = resfil//'ARSR.asd' csfilARSR = resfil//'ARSR.asc' call dir2seq(cdfilARSR,csfilARSR) cdfilGSS = resfil//'GSS.asd' csfilGSS = resfil//'GSS.asc' call dir2seq(cdfilGSS,csfilGSS) cdfilAUS = resfil//'AUS.asd' csfilAUS = resfil//'AUS.asc' call dir2seq(cdfilAUS,csfilAUS) cdfilSUS = resfil//'SUS.asd' csfilSUS = resfil//'SUS.asc' call dir2seq(cdfilSUS,csfilSUS) print *,'Done!!!' end subroutine dir2seq(dirfil,seqfil) character*(*) dirfil,seqfil character*130 line open(10,file=dirfil,access='direct',form='formatted',recl=130) open(11,file=seqfil) irec=1 1 continue ccc read(10,'(a)',rec=irec,end=2) line read(10,'(a)',rec=irec,err=2) line irec=irec+1 write(11,'(a)') line(1:ltrim(line)) goto 1 2 continue close(10) close(11) return end integer function ltrim(string) c===============================================================c c written by Vassilis Hajivassiliou and Yoosoon Chang. c c version 1.0, March 22, 1992 c c===============================================================c c c vah 6:47 pm, saturday, february 27, 1988 character*(*) string c c return the blank-stripped length c c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ do 10 l=len(string),1,-1 ltrim=l if (string(l:l) .ne. ' ') return 10 continue return end subroutine asc2gau(m,gennam) c===============================================================c c written by Vassilis Hajivassiliou and Yoosoon Chang. c c version 1.0, March 22, 1992 c c===============================================================c c c Creates the file gennam//'mkgau.bat', which is a DOS batch c file to translate the resulting *.asc files to gauss data- c sets (*.DAT/DHT) c c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ character*2 gennam,cm character*4 cmeth write(cm,'(i2.2)') m open(10,file=gennam//'mkgau.bat') write(10,'(a)') '@echo off' c cmeth='arse' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='arsr' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='aus' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='cfs' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='dcs' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='ghk' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='gss' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='nise' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='nist' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='pcf' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='kfs' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='sds' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c cmeth='sus' call uc(cmeth) lmeth=ltrim(cmeth) write(10,'(a)') *'echo input '//gennam//cmeth(1:lmeth)//'.asc;>tmpgau.gcf' write(10,'(a)') *'echo output '//gennam//cmeth(1:lmeth)//';>>tmpgau.gcf' write(10,'(a)') *'echo invar '// *' p'//cmeth(1:lmeth)// *' dm'//cm//cmeth(1:lmeth)// *' lm'//cm//cmeth(1:lmeth)// *' dl'//cm//cmeth(1:lmeth)// *' ll'//cm//cmeth(1:lmeth)// *' Rsim'//cmeth(1:lmeth)// *' tim'//cmeth(1:lmeth)// *' seed;>>tmpgau.gcf' write(10,'(a)') 'atog tmpgau.gcf' write(10,'(a)') *'echo File '//gennam//cmeth(1:lmeth)//'.asc converted.' c write(10,'(a)') 'del tmpgau.gcf' write(10,'(a)') 'echo Done!!!' close(10) return end SUBROUTINE UC(CH) c===============================================================c c written by Vassilis Hajivassiliou and Yoosoon Chang. c c version 1.0, March 22, 1992 c c===============================================================c C CHANGES THE CHARACTER VARIABLE CH TO UPPER CASE C VAH 5:13 pm, Thursday, April 3, 1986 C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ INTEGER*4 LENGTH CHARACTER*(*) CH CHARACTER*1 C1 LENGTH=LEN(CH) DO 1 I=1,LENGTH C1=CH(I:I) IC=ICHAR(C1) C PRINT *,'IC:',IC IF(IC.GT.96.AND.IC.LT.123) CH(I:I)=CHAR(IC-32) 1 CONTINUE RETURN END