diff --git a/src/covr.f90 b/src/covr.f90 index c6505a7b..10809c97 100644 --- a/src/covr.f90 +++ b/src/covr.f90 @@ -43,6 +43,7 @@ module covm real(kr),dimension(:),allocatable::xx,xy real(kr),dimension(:),allocatable::rsdx,rsdy integer,dimension(:),allocatable::imtx,imtx1,imatx1 + logical::verboseFile=.false. contains @@ -114,7 +115,10 @@ subroutine covr ! ! card 2b ! matype output library matrix option - ! 3/4=covariances/correlations + ! 1=covariances (verbose text format) + ! 2=correlations (verbose text format) + ! 3=covariances (boxer format) + ! 4=correlations (boxer format) ! (default=3) ! ncase no. cases to be run (maximum=ncasemx=100) ! (default=1) @@ -244,6 +248,11 @@ subroutine covr matype=3 ncase=1 read(nsysi,*) matype,ncase + ! determine format of nout file + if (matype.eq.1 .or. matype.eq.2) then + verboseFile=.true. + matype=matype+2 + endif if (matype.ne.4) matype=3 if (ncase.le.0) ncase=1 if (ncase.gt.ncamx)& @@ -434,29 +443,13 @@ subroutine covr if (matype.eq.3) write(hlibid,'(a6,''-a-'',i3)') hinpid,ixmax if (matype.eq.4) write(hlibid,'(a6,''-b-'',i3)') hinpid,ixmax endif - nrow=ixmax+1 - ncol=1 - nvf=10 - ncf=3 - itype=0 - ! for first sub-case of first case, write the group structure - if (n.eq.1.and.ne.eq.1) call press(0,nout,x,nrow,ncol) - nrow=ixmax - if (mat1.eq.mat.and.mt1.eq.mt) then - itype=1 - call press(0,nout,xx,ixmax,1) - itype=2 - call press(0,nout,rsdx,ixmax,1) + + if (verboseFile) then + call write_verbose_lib(n, ne) + else + call write_boxer_lib(n, ne) endif - ncol=nrow - if (mat1.eq.mat.and.mt1.eq.mt) ncol=0 - nvf=7 - if (matype.eq.3) nvf=10 - ncf=6 - if (ixmax.le.100) ncf=5 - if (ixmax.le.30) ncf=4 - itype=matype - call press(0,nout,cf,2,ixmax) + 190 continue if (allocated(x))deallocate(x) if (allocated(y))deallocate(y) @@ -2246,5 +2239,97 @@ subroutine setfor(ivft,icft,nvf,ncf) return end subroutine setfor + subroutine write_boxer_lib(n, ne) + + integer, intent(in) :: n, ne + + nrow=ixmax+1 + ncol=1 + nvf=10 + ncf=3 + itype=0 + ! for first sub-case of first case, write the group structure + if (n.eq.1 .and. ne.eq.1) call press(0,nout,x,nrow,ncol) + nrow=ixmax + if (mat1.eq.mat .and. mt1.eq.mt) then + itype=1 + call press(0,nout,xx,ixmax,1) + itype=2 + call press(0,nout,rsdx,ixmax,1) + endif + ncol=nrow + if (mat1.eq.mat .and. mt1.eq.mt) ncol=0 + nvf=7 + if (matype.eq.3) nvf=10 + ncf=6 + if (ixmax.le.100) ncf=5 + if (ixmax.le.30) ncf=4 + itype=matype + call press(0,nout,cf,2,ixmax) + + end subroutine write_boxer_lib + + subroutine write_verbose_lib(n, ne) + + use util, only: repoz + + integer, intent(in) :: n, ne + + integer :: idx, jdx, grp + character(len=9) :: writeFmt='(es24.16)' + character(len=12) :: mtxType + real(kr), allocatable :: tmpMat(:,:) + + ! write group structure + if (n.eq.1 .and. ne.eq.1) then + write(nout,'(a,i0,a)') "# energy group structure for ",ixmax," groups" + do idx=1,ixmax+1 + write(nout, writeFmt, advance='no') x(idx) + enddo + write(nout,'()') + endif + + if (mat1.eq.mat .and. mt1.eq.mt) then + + ! write cross section data + write(nout,'(a,i0,",",i0,x,a)') "# cross section for mat,mt=",& + mat,mt,trim(adjustl(hdescr)) + do idx=1,ixmax + write(nout, writeFmt, advance='no') xx(idx) + enddo + write(nout,'()') + + ! write standard deviation data + write(nout,'(a,i0,",",i0,x,a)') "# relative standard deviations for mat,mt=",& + mat,mt,trim(adjustl(hdescr)) + do idx=1,ixmax + write(nout, writeFmt, advance='no') rsdx(idx) + enddo + write(nout,'()') + + endif + + ! read matrix data from scratch tape + allocate(tmpMat(ixmax,ixmax)); tmpMat=0.0 + call repoz(-nscr1) + do idx=1,ixmax + read(nscr1) grp,(tmpMat(idx,jdx),jdx=1,ixmax) + enddo + + ! print to output + if (matype.eq.3) mtxType="covariance" + if (matype.eq.4) mtxType="correlation" + write(nout,'(3a,3(i0,","),i0,x,a)') "# ", trim(mtxType), " matrix for mat,mt,mat1,mt1=",& + mat,mt,mat1,mt1,trim(adjustl(hdescr)) + do idx=1,ixmax + do jdx=1,ixmax + write(nout, writeFmt, advance='no') tmpMat(idx,jdx) + if( mod(jdx,ixmax).eq.0 ) write(nout,'()') + enddo + enddo + deallocate(tmpMat) + + end subroutine write_verbose_lib + end module covm