mnsave.f

Go to the documentation of this file.

*
* $Id: mnsave.F,v 1.1.1.1 1996/03/07 14:31:31 mclareni Exp $
*
* $Log: mnsave.F,v $
* Revision 1.1.1.1  1996/03/07 14:31:31  mclareni
* Minuit
*
*
      SUBROUTINE mnsave
*
* $Id: d506dp.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506dp.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506dp.inc
*
C ************ DOUBLE PRECISION VERSION *************
      IMPLICIT DOUBLE PRECISION (a-h,o-z)
CC       Writes current parameter values and step sizes onto file ISYSSA
CC          in format which can be reread by Minuit for restarting.
CC       The covariance matrix is also output if it exists.
CC
*
* $Id: d506cm.inc,v 1.1.1.1 1996/03/07 14:31:32 mclareni Exp $
*
* $Log: d506cm.inc,v $
* Revision 1.1.1.1  1996/03/07 14:31:32  mclareni
* Minuit
*
*
*
*
* d506cm.inc
*
      parameter(mne=100 , mni=50)
      parameter(mnihl=mni*(mni+1)/2)
      CHARACTER*10 CPNAM
      COMMON
     1/mn7nam/ cpnam(mne)
     2/mn7ext/ u(mne)     ,alim(mne)  ,blim(mne)
     3/mn7err/ erp(mni)   ,ern(mni)   ,werr(mni)  ,globcc(mni)
     4/mn7inx/ nvarl(mne) ,niofex(mne),nexofi(mni)
     5/mn7int/ x(mni)     ,xt(mni)    ,dirin(mni)
     6/mn7fx2/ xs(mni)    ,xts(mni)   ,dirins(mni)
     7/mn7der/ grd(mni)   ,g2(mni)    ,gstep(mni) ,gin(mne) ,dgrd(mni)
     8/mn7fx3/ grds(mni)  ,g2s(mni)   ,gsteps(mni)
     9/mn7fx1/ ipfix(mni) ,npfix
     a/mn7var/ vhmat(mnihl)
     b/mn7vat/ vthmat(mnihl)
     c/mn7sim/ p(mni,mni+1),pstar(mni),pstst(mni) ,pbar(mni),prho(mni)
C
      parameter(maxdbg=10, maxstk=10, maxcwd=20, maxp=30, maxcpt=101)
      parameter(zero=0.0,  one=1.0,   half=0.5)
      COMMON
     d/mn7npr/ maxint ,npar   ,maxext ,nu
     e/mn7iou/ isysrd ,isyswr ,isyssa ,npagwd ,npagln ,newpag
     e/mn7io2/ istkrd(maxstk) ,nstkrd ,istkwr(maxstk) ,nstkwr
     f/mn7tit/ cfrom  ,cstatu ,ctitl  ,cword  ,cundef ,cvrsn ,covmes
     g/mn7flg/ isw(7) ,idbg(0:maxdbg) ,nblock ,icomnd
     h/mn7min/ amin   ,up     ,edm    ,fval3  ,epsi   ,apsi  ,dcovar
     i/mn7cnv/ nfcn   ,nfcnmx ,nfcnlc ,nfcnfr ,itaur,istrat,nwrmes(2)
     j/mn7arg/ word7(maxp)
     k/mn7log/ lwarn  ,lrepor ,limset ,lnolim ,lnewmn ,lphead
     l/mn7cns/ epsmac ,epsma2 ,vlimlo ,vlimhi ,undefi ,bigedm,updflt
     m/mn7rpt/ xpt(maxcpt)    ,ypt(maxcpt)
     n/mn7cpt/ chpt(maxcpt)
     o/mn7xcr/ xmidcr ,ymidcr ,xdircr ,ydircr ,ke1cr  ,ke2cr
      CHARACTER CTITL*50, CWORD*(maxcwd), CUNDEF*10, CFROM*8,
     +          cvrsn*6,  covmes(0:3)*22, cstatu*10, chpt*1
      LOGICAL   LWARN, LREPOR, LIMSET, LNOLIM, LNEWMN, LPHEAD
      LOGICAL LOPEN,LNAME
      CHARACTER CGNAME*64, CFNAME*64, CANSWR*1
C
      INQUIRE(unit=isyssa,opened=lopen,named=lname,name=cgname)
      IF (lopen) THEN
         IF (.NOT.lname) cgname='UNNAMED FILE'
         WRITE (isyswr,32) isyssa,cgname
   32    FORMAT (' CURRENT VALUES WILL BE SAVED ON UNIT',i3,': ',a/)
      ELSE
C                new file, open it
         WRITE (isyswr,35) isyssa
   35    FORMAT (' UNIT',i3,' IS NOT OPENED.')
         IF (isw(6) .EQ. 1) THEN
            WRITE (isyswr,'(A)') ' PLEASE GIVE FILE NAME:'
            READ (isysrd,'(A)') cfname
            OPEN (unit=isyssa,file=cfname,status='NEW',err=600)
            cgname = cfname
         ELSE
            GO TO 650
         ENDIF
      ENDIF
C                               file is now correctly opened
      IF (isw(6) .EQ. 1)  THEN
         WRITE (isyswr,37)  isyssa
   37    FORMAT (' SHOULD UNIT',i3,' BE REWOUND BEFORE WRITING TO IT?' )
         READ  (isysrd,'(A)')  canswr
         IF (canswr.EQ.'Y' .OR. canswr.EQ.'y') rewind isyssa
      ENDIF
C                               and rewound if requested
      WRITE (isyssa,'(10HSET TITLE )',err=700)
      WRITE (isyssa,'(A)')  ctitl
      WRITE (isyssa,'(10HPARAMETERS)')
      nlines = 3
C                                write out parameter values
      DO 200 i= 1, nu
      IF (nvarl(i) .LT. 0)  GO TO 200
      nlines = nlines + 1
      iint = niofex(i)
      IF (nvarl(i) .GT. 1)  GO TO 100
C         parameter without limits
      WRITE (isyssa,1001)  i,cpnam(i),u(i),werr(iint)
      GO TO 200
C         parameter with limits
  100 CONTINUE
      WRITE (isyssa,1001) i,cpnam(i),u(i),werr(iint),alim(i),blim(i)
 1001 FORMAT (1x,i5,1h',A10,1H',4e13.5)
  200 CONTINUE
      WRITE (isyssa,'(A)')  ' '
      nlines = nlines + 1
C                                  write out covariance matrix, if any
      IF (isw(2) .LT. 1)  GO TO 750
      WRITE (isyssa,1003,err=700)  npar
 1003 FORMAT ('SET COVARIANCE',i6)
      npar2 = npar*(npar+1)/2
      WRITE (isyssa,1004) (vhmat(i),i=1,npar2)
 1004 FORMAT (bn,7e11.4,3x)
      ncovar = npar2/7 + 1
      IF (mod(npar2,7) .GT. 0)  ncovar = ncovar + 1
      nlines = nlines + ncovar
      WRITE (isyswr, 501) nlines,isyssa,cgname(1:45)
  501 FORMAT (1x,i5,' RECORDS WRITTEN TO UNIT',i4,':',a)
      IF (ncovar .GT. 0) WRITE (isyswr, 502) ncovar
  502 FORMAT (' INCLUDING',i5,' RECORDS FOR THE COVARIANCE MATRIX.'/)
      GO TO 900
C                                           some error conditions
  600 WRITE (isyswr,'(A,I4)') ' I/O ERROR: UNABLE TO OPEN UNIT',isyssa
      GO TO 900
  650 WRITE (isyswr,'(A,I4,A)') ' UNIT',isyssa,' IS NOT OPENED.'
      GO TO 900
  700 WRITE (isyswr,'(A,I4)') ' ERROR: UNABLE TO WRITE TO UNIT',isyssa
      GO TO 900
  750 WRITE (isyswr,'(A)') ' THERE IS NO COVARIANCE MATRIX TO SAVE.'
C
  900 RETURN
      END