55 lines
1.1 KiB
Fortran
55 lines
1.1 KiB
Fortran
subroutine FIT_COR(K,K1,FAC,OFF)
|
|
C --------------------------------
|
|
|
|
include 'fit.inc'
|
|
|
|
integer k,k1
|
|
real fac, off
|
|
|
|
integer j
|
|
|
|
if (ififu .eq. 6) then
|
|
write(isyswr,*) 'Strange: correlation not possible'
|
|
return
|
|
endif
|
|
|
|
if (k.gt.nu .or. k.le.0) then
|
|
write(isyswr,'(4x,a,i3)') 'Illegal parameter no.:',k
|
|
endif
|
|
if (k1.gt.nu .or. k1.le.0) then
|
|
write(isyswr,'(4x,a,i3)') 'Illegal parameter no.:',k1
|
|
return
|
|
endif
|
|
if (k.gt.nu .or. k.le.0) return
|
|
|
|
if (icsw(k) .lt. 0 .or. icsw(k) .gt. 0 .and. icto(k) .ne. k1) then
|
|
write (isyswr,'(4x,3a)')
|
|
1 pnam(k),' already correlated to ',pnam(icto(k))
|
|
return
|
|
endif
|
|
|
|
j=k1
|
|
do while (icsw(j) .ne. 0)
|
|
if (j .eq. k) goto 9
|
|
j=icto(j)
|
|
enddo
|
|
9 if (j .eq. k) then
|
|
write(isyswr,*) 'recursive correlation not allowed'
|
|
return
|
|
endif
|
|
|
|
if (lcode(k) .gt. 0) lcode(k)=-lcode(k)
|
|
icsw(k)=1
|
|
icto(k)=k1
|
|
cfac(k)=fac
|
|
coff(k)=off
|
|
if (off .eq. 0) then
|
|
write (isyswr,'(/4x,5a,f7.3)')
|
|
1 'Correlation: ',pnam(k),' = ',pnam(k1),' *',fac
|
|
else
|
|
write (isyswr,'(/4x,5a,f7.3,a,g12.5)')
|
|
1 'Correlation: ',pnam(k),' = ',pnam(k1),' *',fac,' +',off
|
|
endif
|
|
call extoin
|
|
end
|