subroutine intoex(pint) C ----------------------- include 'fit.inc' real pint(maxpar) real al, fact integer i,j real voigt ! function c internal to external parameters do i= 1, nu j=lcorsp(i) if (j .gt. 0) then if (lcode(i) .eq. 1) then u(i) = pint(j) else al = alim(i) u(i) = al + 0.5 *(sin(pint(j)) +1.0) * (blim(i) -al) endif endif enddo c correlated parameters do j=1,ncor i=icord(j) fact=cfac(i) if (icsw(i) .lt. 0) then if (ififu .eq. 1) then if (mod(i,5) .eq. 0) then fact=1/voigt(0.0,u(i+1),u(i+2)) ! Int.Int is calculated from Max.Int else fact=voigt(0.0,u(i+2),u(i+3)) ! Max.Int is calculated from Int.Int endif endif endif u(i) = u(icto(i))*fact+coff(i) enddo ni=-1 return end subroutine extoin c ----------------- include 'fit.inc' integer i,j,k,l real uplus, uminu real pintf ! function isw(1)=0 isw(2)=0 ncor=0 if (ififu .eq. 1) then ! remove peaks with zero intensity i=5 do k=5,nu,5 if (i .ne. k) call fit_mov_par(k-2, i-2, 5) if (u(k) .ne. 0 .or. u(k-1) .ne. 0 .or. 1 lcode(k) .gt. 0 .or. icsw(k) .gt. 0) then u(i+1)=abs(u(i+1)) u(i+2)=abs(u(i+2)) i=i+5 endif enddo if (i .eq. 5 .and. nu .gt. 2) then u(1)=u(1)-u(2)*u(3) u(3)=0 endif do k=i-2,nu,5 call fit_del_par(k, 5) ! remove correlations to deleted peak enddo nu=i-3 endif npar=0 do k=1,nu if (lcode(k) .gt. 0) then if (npar .ge. maxpar) then if (lcode(k) .gt. 0) lcode(k)=-lcode(k) write(isyswr, '(x,3a)') 1 'To much variable parameters -> ',pnam(k),' fixed' else if (werr(k) .eq. 0) then if (werrs(k) .gt. 0) then werr(k)=werrs(k) else if (ififu .eq. 1 .and. mod(k,5) .eq. 3) then werr(k)=sqrt(werr(k+2)**2+werr(k+3)**2)/10 endif if (werr(k) .eq. 0) werr(k)=max(1e-5,abs(u(k))/10) endif endif npar=npar+1 lcorsp(k)=npar x(npar)=pintf(u(k),k) uplus=u(k)+werr(k) uminu=u(k)-werr(k) dirin(npar)=(abs(pintf(uplus,k)-x(npar)) 1 +abs(pintf(uminu,k)-x(npar)))/2 endif else lcorsp(k)=0 j=k l=nu do while (icsw(j) .ne. 0) ! go along correlation path do i=1,ncor if (icord(i) .eq. j) goto 8 ! already in ICORD enddo do i=l+1,nu if (icord(i) .eq. j) goto 8 ! already in path list enddo icord(l)=j l=l-1 j=icto(j) if (j .lt. k) goto 8 ! already tested if (j .gt. nu) goto 8 ! illegal par. no enddo 8 do j=l+1,nu ncor=ncor+1 icord(ncor)=icord(j) enddo endif 9 enddo nfree=max(1,nxmax-nxmin+1-npar) end real function pintf(pexti, i) C ----------------------------- include 'fit.inc' integer i real pexti real alimi, blimi, yy goto (100,200,300,400) lcode(i) C no limits 100 pintf = pexti return C lower limit (not implemented) 200 continue C upper limit (not implemented) 300 continue C both limits 400 alimi = alim(i) blimi = blim(i) yy=2*(pexti-alimi)/(blimi-alimi)-1.0 if (yy .lt. -1.0) then yy=-1.0 pexti=alimi elseif (yy .gt. 1.0) then yy=1.0 pexti=blimi endif pintf=asin(yy) end