Back to home page

MITgcm

 
 

    


File indexing completed on 2018-03-02 18:36:18 UTC

view on githubraw file Latest commit f7e8e52a on 2006-03-12 08:21:47 UTC
4cee17c1be Patr*0001 
                0002       subroutine lsopt_top( nn, xx, ff, gg, simul, optline
                0003      $                  , epsx, fmin, epsg
                0004      $                  , iprint, itmax, nfunc, nupdate
                0005      $                  , dd, gold, xdiff
                0006      $                  , loffline
                0007      $                  , ifail )
                0008 
                0009 c     ==================================================================
                0010 c     SUBROUTINE lsopt_top
                0011 c     ==================================================================
                0012 c
                0013 c     o uses a set of control variables, their adjoint variables,
                0014 c       and a cost function value
                0015 c       to compute an improved set of controls with respect to the
                0016 c       cost function via a
                0017 c       variable-storage Quasi-Newton method
                0018 c
                0019 c     o Reference: J.C. Gilbert & C. Lemarechal
                0020 c                  Some numerical experiments with variable-storage
                0021 c                  quasi-Newton algorithms
                0022 c                  Mathematical Programming 45 (1989), pp. 407-435
                0023 c
                0024 c     o started: ??? not reproducible
                0025 c
                0026 c     o changed: Patrick Heimbach, MIT/EAPS
                0027 c                
                0028 c     o Version: 2.0, 24-Feb-2000: 
                0029 c                    (Version 1.0 is considered as version
                0030 c                     starting from which changes were made).
                0031 c                   - severe changes in structure including various
                0032 c                     bug-fixes to enable multi-optimization runs;
                0033 c                   - routine lsoptw incorporated into lsoptv
                0034 c                   - optimization iteration loop restructured
                0035 c                   - complete restructuring of handling
                0036 c                     cold start cases
                0037 c                   - number of 3 control flags for error handling
                0038 c                     (indic, moderl, ifail) reduced to 1 (ifail)
                0039 c                     and homogenized with routine lsline
                0040 c
                0041 c     o Version: 2.1, 29-Feb-2000:
                0042 c                   - handling of case ifail = 6 changed;
                0043 c                     leads to stop of optimization
                0044 c                     (similar to case ifail = 8)
                0045 c                   - logical lphprint included
                0046 c
                0047 c     ==================================================================
                0048 c     SUBROUTINE lsopt_top
                0049 c     ==================================================================
                0050 
                0051       implicit none
                0052 
ae287463fd Patr*0053 ccc#include <blas1.h>
4cee17c1be Patr*0054 
                0055 c-----------------------------------------
                0056 c declare arguments
                0057 c-----------------------------------------
                0058       integer nn, iprint, itmax, nfunc, nupdate, ifail
                0059 
                0060       double precision  xx(nn), ff, gg(nn), epsx, fmin, epsg
                0061       double precision  dd(nn), gold(nn), xdiff(nn)
                0062 
                0063 cph(
                0064       integer phniter0, phniterold
                0065       double precision phff
                0066       COMMON /PH_OPTI/ phniter0, phniterold, phff
                0067 cph)
                0068 
                0069       external simul, optline
                0070 
                0071 c-----------------------------------------
                0072 C declare local variables
                0073 c-----------------------------------------
                0074       logical cold, lphprint, loffline
                0075       parameter (lphprint = .true.)
                0076 
                0077       integer mm, mupd, jmin, jmax, indic, isize, REAL_BYTE
                0078       integer i, iiter, ifunc
                0079 
                0080       double precision   fupd
                0081       double precision   r1, tmin, tmax, tact, gnorm, gnorm0, eps1
                0082       double precision   fold, ys
                0083       double precision   dotdg
                0084 
ae287463fd Patr*0085       external DDOT, DNRM2, DSCAL
                0086       double precision     DDOT, DNRM2
4cee17c1be Patr*0087 
                0088 c-----------------------------------------
                0089 c parameters
                0090 c-----------------------------------------
                0091 
                0092       double precision rmin
                0093       parameter( rmin = 1.e-20 )
                0094 
                0095       character*(*) iform
                0096       parameter(iform='(i5,2x,1pe8.1,1x,i5,4x,1pe11.4,3(2x,1pe8.1))' )
                0097 
                0098 c     ==================================================================
                0099 c
                0100 c-----------------------------------------
                0101 c initialization
                0102 c-----------------------------------------
                0103       cold  = .true.
                0104       fupd  = 1.0e+10
                0105       indic = 0
                0106       tmin  = 0.
                0107       tmax  = 1.0e+10
                0108       tact  = 1.0
                0109 cph(
                0110       phniterold = 0
                0111 cph)
                0112       iiter = 0
                0113       eps1  = 1.0
                0114       ifunc = 0
                0115       ifail = 0
                0116       gnorm0 = 1.
                0117 
                0118 c-----------------------------------------
                0119 c initialization for dd and dds
                0120 c-----------------------------------------
                0121 
                0122       jmin  = 1
                0123       jmax  = 0
                0124 
                0125       mm    = nn
                0126       mupd  = nupdate
                0127 
f7e8e52ac8 Patr*0128       REAL_BYTE = 4
4cee17c1be Patr*0129       isize = REAL_BYTE
                0130 
                0131 c-----------------------------------------
                0132 c print information
                0133 c-----------------------------------------
                0134       if (iprint .ge. 1) then
                0135          print '(2x,a)',
                0136      $         '==============================================='
                0137          print '(2x,a)',
                0138      $         '===         O P T I M I Z A T I O N         ==='
                0139          print '(2x,a)',
                0140      $         '==============================================='
                0141          print '(a,i9)'
                0142      $        , '  number of control variables.......', nn
                0143          print '(a,e9.2)'
                0144      $        , '  precision on x....................', epsx
                0145          print '(a,e9.2)'
                0146      $        , '  precision on g....................', epsg
                0147          print '(a,e9.2)'
                0148      $        , '  expected optimal function value...', fmin
                0149          print '(a,i9)'
                0150      $        , '  maximal number of iterations......', itmax
                0151          print '(a,i9)'
                0152      $        , '  maximal number of simulations.....', nfunc
                0153          print '(a,i9)'
                0154      $        , '  information level.................', iprint
                0155          print '(a,i9)'
                0156      $        , '  number of updates.................', nupdate
                0157          print '(a,i9)'
                0158      $        , '  size of used memory...............', 3*nn
                0159       endif
                0160 
                0161 c-----------------------------------------
                0162 c check arguments
                0163 c-----------------------------------------
                0164 
                0165       if (nn .le. 0) then
                0166          if (iprint.ge.1) then
                0167             print '(a,i6)'  , '  ERROR : n     = ', nn
                0168          endif
                0169          ifail = 1
                0170          goto 999
                0171       endif
                0172 
                0173       if (itmax .lt. 0) then
                0174          if (iprint.ge.1) then
                0175             print '(a,i6)'  , '  ERROR : itmax = ', itmax
                0176          endif
                0177          ifail = 1
                0178          goto 999
                0179       endif
                0180 
                0181       if (nfunc .le. 0) then
                0182          if (iprint.ge.10) then
                0183             print '(a,i6)'  , '  ERROR : nfunc  = ', nfunc
                0184          endif
                0185          ifail = 1
                0186          goto 999
                0187       endif
                0188 
                0189       if (epsx .le. 0.) then
                0190          if (iprint.ge.1) then
                0191             print '(a,e9.2)', '  ERROR : epsx = ', epsx
                0192          endif
                0193          ifail = 1
                0194          goto 999
                0195       endif
                0196 
                0197       if (epsg .le. 0.) then
                0198          if (iprint.ge.1) then
                0199             print '(a,e9.2)', '  ERROR : epsg  = ', epsg
                0200          endif
                0201          ifail = 1
                0202          goto 999
                0203       endif
                0204 
                0205       if (epsg .gt. 1.) then
                0206          if (iprint.ge.1) then
                0207             print '(a,e9.2)', '  ERROR : epsg  = ', epsg
                0208          endif
                0209          ifail = 1
                0210          goto 999
                0211       endif
                0212 
                0213 cph(
                0214       print *, 'pathei: vor instore '
                0215 cph)
                0216       call instore( mm, fupd, gnorm0, isize, mupd, jmin, jmax, cold,
                0217      &              ifail )
                0218 
                0219 cph(
                0220       phff = fupd
                0221 cph)
                0222 
                0223 c-----------------------------------------
                0224 c check warm start parameters
                0225 c-----------------------------------------
                0226       if (ifail .ne. 0) then
                0227          if (iprint.ge.1) then
                0228             print '(a)', ' ERROR : reading restart file'
                0229          end if
                0230          ifail = 2
                0231          goto 999
                0232       end if
                0233 
                0234       if (isize .ne. REAL_BYTE) then
                0235          if (iprint.ge.1) then
                0236             print '(a)', ' ERROR : uncompatible floating point format'
                0237          end if
                0238          ifail = 2
                0239          goto 999
                0240       end if
                0241 
                0242       if (mupd .lt. 1) then
                0243          if (iprint .ge. 1) then
                0244             print '(a)', ' ERROR : m is set too small in instore'
                0245          endif
                0246          ifail = 2
                0247          goto 999
                0248       endif
                0249 
                0250 c-----------------------------------------
                0251 c cold start or warm restart ?
                0252 c-----------------------------------------
                0253 
                0254       if (cold) then
                0255 c--- start if cold start ---
                0256          if (lphprint) then
                0257             print '(a)', 'pathei-lsopt: cold start'
                0258          end if
                0259 
60c4531875 Patr*0260          print *, 'pathei-lsopt vor simul', nn
                0261          print *, 'pathei-lsopt xx(1), gg(1) ', xx(1), gg(1)
                0262 
4cee17c1be Patr*0263          call simul( indic, nn, xx, ff, gg )
60c4531875 Patr*0264 
4cee17c1be Patr*0265          print *, 'pathei: nach simul:   nn, ff = ', nn, ff
60c4531875 Patr*0266          print *, 'pathei: nach simul:   xx(1), gg(1) = ', xx(1), gg(1)
4cee17c1be Patr*0267 
                0268          do i = 1, nn
                0269             xdiff(i) = 1.
                0270          end do
                0271 
                0272 cph(
                0273       print *, 'pathei: vor dostore '
                0274 cph)
                0275          call dostore( nn, xx, .true., 1 )
                0276          call dostore( nn, gg, .true., 2 )
                0277          call dostore( nn, xdiff, .true., 3 )
                0278                
                0279 cph(
                0280       print *, 'pathei: vor lswri '
                0281 cph)
f7e8e52ac8 Patr*0282 cph         call lswri( isize, iiter, nn, xx, gg, lphprint )
4cee17c1be Patr*0283 
                0284 cph(
                0285       print *, 'pathei: vor gnorm0 '
                0286 cph)
ae287463fd Patr*0287          gnorm0 = DNRM2( nn, gg, 1 )
4cee17c1be Patr*0288 cph(
                0289       print *, 'pathei: gnorm0 = ', gnorm0
                0290 cph)
                0291          if (gnorm0 .lt. rmin) then
                0292             ifail = 3
                0293            goto 1000
                0294          endif
                0295 
                0296 cph(
                0297          phff = ff
                0298 cph)
                0299 
                0300          if (lphprint)
                0301      &        print *, 'pathei-lsopt: cold; first call simul: ff = ', 
                0302      &        phff
                0303 
                0304 c--- end if cold start ---
                0305       else
                0306 c--- start if warm start ---
                0307          if (mm .ne. nn) then
                0308             if (iprint.ge.1) then
                0309                print '(a,i6)'
                0310      $              , '  ERROR : inconsistent nn = ', mm
                0311             endif
                0312             ifail = 2
                0313             goto 999
                0314          endif
                0315          if (mupd .ne. nupdate) then
                0316             if (iprint.ge.1) then
                0317                print '(a,i6)'
                0318      $              , '  ERROR : inconsistent nupdate = ', mupd
                0319             endif
                0320             ifail = 2
                0321             goto 999
                0322          endif
                0323          if (jmin .lt. 1) then
                0324             if (iprint.ge.1) then
                0325                print '(a,i6)'
                0326      $              , '  ERROR : inconsistent jmin = ', jmin
                0327             endif
                0328             ifail = 2
                0329             goto 999
                0330          endif
                0331          if (jmin .gt. mupd) then
                0332             if (iprint.ge.1) then
                0333                print '(a,i6)'
                0334      $              , '  ERROR : inconsistent jmin = ', jmin
                0335             endif
                0336             ifail = 2
                0337             goto 999
                0338          endif
                0339          if (jmax .gt. mupd) then
                0340             if (iprint.ge.1) then
                0341                print '(a,i6)'
                0342      $              , '  ERROR : inconsistent jmax = ', jmax
                0343             endif
                0344             ifail = 2
                0345             goto 999
                0346          endif
                0347          
                0348          if (lphprint) then
                0349             print *, 'pathei-lsopt: warm start; read via dostore'
                0350             print *
                0351          endif
                0352 
                0353          call dostore( nn, xx, .false., 1 )
                0354          call dostore( nn, gg, .false., 2 )
                0355          ff = fupd
                0356 
                0357 cph(
                0358          phff = ff
                0359 cph)
                0360 
                0361          if (lphprint)
                0362      &        print *, 'pathei-lsopt: warm; first dostore read: ff = ',
                0363      &        ff
                0364 
                0365 c--- end if warm start ---
                0366       endif
                0367 
                0368       if (iprint .ge. 1) then
                0369          print '(2a)', '  Itn      Step  Nfun      Objective    '
                0370      $        , 'Norm G    Norm X   Norm (X(k-1)-X(k))'
                0371       end if
                0372 
                0373 c-----------------------------------------
                0374 c print information line
                0375 c-----------------------------------------
                0376          if (cold) then
                0377             print iform, iiter, tact, ifunc, ff, gnorm0
ae287463fd Patr*0378      $           , DNRM2( nn, xx, 1 ), 0.
4cee17c1be Patr*0379 
ad98788efb Mart*0380 Cml            write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))')
                0381 Cml     &           iiter, ff, gnorm0, tact, 
                0382 Cml     &           DNRM2( nn, xx, 1 ), 0.
4cee17c1be Patr*0383 
                0384             if ( itmax .EQ. 0 ) then
                0385                ifail = 10
                0386                goto 1000
                0387             end if
                0388          end if
                0389 
                0390 c=======================================================================
                0391 c begin of loop
                0392 c compute x(k+1) out of x(k) + t*d, where  t > 0.
                0393 c=======================================================================
                0394 
                0395       do iiter = 1, itmax
                0396 
                0397          if (lphprint) then
                0398             print *, 'pathei-lsopt: ++++++++++++++++++++++++'
                0399             print *, 'pathei-lsopt: entering iiter =', iiter
                0400          end if
                0401 
                0402 c-----------------------------------------
                0403 c store old values
                0404 c-----------------------------------------
                0405       do i = 1, nn
                0406          gold(i) = gg(i)
                0407       end do
                0408 
                0409       fold = ff
                0410 cph(
                0411       phniter0 = iiter
                0412       phff = ff
                0413 cph)
                0414 
                0415 c-----------------------------------------
                0416 c compute new dd and xx
                0417 c-----------------------------------------
                0418 c
                0419       call lsupdxx(
                0420      &     nn, ifail, lphprint
                0421      &     , jmin, jmax, nupdate
                0422      &     , ff, fmin, fold, gnorm0, dotdg
                0423      &     , gg, dd, xx, xdiff
                0424      &     , tmin, tmax, tact, epsx
                0425      &     )
                0426 
                0427 c-----------------------------------------
                0428 c check whether new direction is a descent one
                0429 c-----------------------------------------
                0430       if ( ifail .eq. 4) goto 1000
                0431 
                0432 c-----------------------------------------
                0433 c optline returns new values of x, f, and g
                0434 c-----------------------------------------
                0435 c
                0436       call optline( 
                0437      &     simul
                0438      &     , nn, ifail, lphprint
                0439      &     , ifunc, nfunc
                0440      &     , ff, dotdg
                0441      &     , tmin, tmax, tact, epsx
                0442      &     , dd, gg, xx, xdiff
                0443      &     )
                0444 
                0445       if (lphprint) print *, 'pathei-lsopt: ',
                0446      &     'back from optline; ifail = ', ifail
                0447       if (lphprint) print *, 'pathei-lsopt: ',
                0448      &     'dostore 1,2 at iiter ', iiter
                0449 
                0450       call dostore( nn, xx, .true., 1 )
                0451       call dostore( nn, gg, .true., 2 )
                0452 cph(
f7e8e52ac8 Patr*0453 cph      call lswri( isize, iiter, nn, xx, gg, lphprint )
4cee17c1be Patr*0454 cph)
                0455 
ae287463fd Patr*0456       gnorm = DNRM2( nn, gg, 1 )
4cee17c1be Patr*0457 
                0458 c-----------------------------------------
                0459 c print information line
                0460 c-----------------------------------------
                0461       print iform, iiter, tact, ifunc, ff, gnorm
ae287463fd Patr*0462      $     , DNRM2( nn, xx, 1 ), tact*DNRM2( nn, dd, 1 )
4cee17c1be Patr*0463 
ad98788efb Mart*0464 Cml      write(94,'(i5,2x,1pe11.4,4(2x,1pe8.1))')
                0465 Cml     &     iiter, ff, gnorm, tact,
                0466 Cml     &     DNRM2( nn, xx, 1 ), tact*DNRM2( nn, dd, 1 )
4cee17c1be Patr*0467 
                0468 c-----------------------------------------
                0469 c check output mode of ifail
                0470 c-----------------------------------------
                0471       if (ifail .eq. 7
                0472      &     .or. ifail .eq. 8
                0473      &     .or. ifail .eq. 9) goto 1000
                0474 
                0475 c-----------------------------------------
                0476 c maximal number of simulation reached
                0477 c no goto in order to update Hessian
                0478 c-----------------------------------------
                0479          if (ifail .eq. 6) ifail = 0
                0480 
                0481 c-----------------------------------------
                0482 c NOTE: stopping tests are now done
                0483 c after having updated the matrix,
                0484 c so that update information can be stored
                0485 c in case of a later warm restart
                0486 c-----------------------------------------
                0487 c-----------------------------------------
                0488 c  compute new s, y
                0489 c-----------------------------------------
                0490          do i = 1, nn
                0491             xdiff(i) = tact*dd(i)
                0492          end do
                0493 
                0494 c-----------------------------------------
                0495 c compute ys
                0496 c-----------------------------------------
                0497          do i = 1, nn
                0498             gold(i) = gg(i)-gold(i)
                0499          end do
                0500 
ae287463fd Patr*0501          ys = DDOT( nn, gold, 1, xdiff, 1 )
4cee17c1be Patr*0502          if (ys .le. 0.) then
                0503             ifail = 4
                0504             print *, 'pathei-lsopt: ys < 0; ifail = ', ifail
                0505             goto 1000
                0506          endif
                0507 cph(
                0508 cph-----------------------------------------
                0509 cph at this point it is clear that xdiff 
                0510 cph provides a true optimized solution;
                0511 cph i.e. take new gradient gg to compute new dd
                0512 cph-----------------------------------------
                0513 cph)
                0514 
                0515 c-----------------------------------------
                0516 c update pointers for hessupd
                0517 c-----------------------------------------
                0518       if (nupdate .gt. 0) then
                0519 
                0520          if (jmax .eq. 0) then
                0521             jmax = jmax+1
                0522             if (lphprint) 
                0523      &           print *, 'pathei-lsopt: ',
                0524      &           'first pointer update after cold start; ',
                0525      &           'iiter, jmin, jmax = ', iiter, jmin, jmax
                0526          else
                0527             jmax = jmax+1
                0528             if (jmax .gt. nupdate) jmax = jmax-nupdate
                0529 
                0530             if (jmin .eq. jmax) then
                0531                if (lphprint) 
                0532      &              print *, 'pathei-lsopt: pointers updated for ',
                0533      &              ' iiter, jmin, jmax = ', iiter, jmin, jmax
                0534                jmin = jmin+1
                0535                if (jmin .gt. nupdate) jmin = jmin-nupdate
                0536             end if
                0537          end if
                0538 
                0539 c-----------------------------------------
                0540 c compute sbar, ybar store rec = min 4,5
                0541 c-----------------------------------------
                0542          r1 = sqrt(1./ys)
ae287463fd Patr*0543          call DSCAL( nn, r1, xdiff, 1 )
                0544          call DSCAL( nn, r1, gold, 1 )
4cee17c1be Patr*0545 
                0546       if (lphprint) 
                0547      &        print *, 'pathei-lsopt: dostore at iiter, jmin, jmax ', 
                0548      &        iiter, jmin, jmax
                0549 
                0550          call dostore( nn, gold, .true., 2*jmax+2 )
                0551          call dostore( nn, xdiff, .true., 2*jmax+3 )
                0552 
                0553 c-----------------------------------------
                0554 c compute the diagonal preconditioner
                0555 c use dd as temporary array
                0556 c-----------------------------------------
                0557          call dgscale( nn, gold, xdiff, dd, rmin )
                0558 
                0559       endif
                0560 
                0561 c-----------------------------------------
                0562 c test convergence and stopping criteria
                0563 c-----------------------------------------
                0564       eps1 = gnorm / gnorm0
                0565 
                0566       if (eps1 .lt. epsg) then
                0567 
                0568          ifail = 11
                0569          goto 1000
                0570       endif
                0571 
                0572 c=======================================================================
                0573 c return of loop
                0574 c=======================================================================
                0575       
                0576       end do
                0577 
                0578       iiter = iiter - 1
                0579       ifail = 5
                0580 
                0581 c-----------------------------------------
                0582 c loop exit
                0583 c-----------------------------------------
                0584  1000 continue
                0585       nfunc = ifunc
                0586       epsg = eps1
                0587 
                0588 c-----------------------------------------------------------------------
                0589 c save data for warm start
                0590 c-----------------------------------------------------------------------
                0591 
                0592       call outstore( nn, ff, gnorm0, nupdate, jmin, jmax )
                0593 
                0594 c-----------------------------------------------------------------------
                0595 c compute dd(i+1), xx(i+1) based on latest available gg(i), xx(i)
                0596 c for offline version
                0597 c-----------------------------------------------------------------------
                0598 
                0599       if (loffline) then
                0600 
                0601          call lsupdxx(
                0602      &        nn, ifail, lphprint
                0603      &        , jmin, jmax, nupdate
                0604      &        , ff, fmin, fold, gnorm0, dotdg
                0605      &        , gg, dd, xx, xdiff
                0606      &        , tmin, tmax, tact, epsx
                0607      &        )
                0608 
                0609 c        Save xx(i+1) to file for offline version.
                0610          call optim_write_control( nn, xdiff )
                0611 
                0612       end if
                0613 
                0614 c-----------------------------------------
                0615 c print final information
                0616 c-----------------------------------------
                0617       if (iprint .ge. 5) then
                0618          print *
                0619          print '(a,i9)'
                0620      $        , '  number of iterations..............', iiter
                0621          print '(a,i9)'
                0622      $        , '  number of simultations............', nfunc
                0623          print '(a,e9.2)'
                0624      $        , '  relative precision on g...........', epsg
                0625       end if
                0626 
                0627       if (iprint.ge.10) then
                0628          print *
                0629          print '(a,e15.8)'
                0630      $        , '  cost function...............', ff
                0631          print '(a,e15.8)'
ae287463fd Patr*0632      $        , '  norm of x...................', DNRM2( nn, xx, 1 )
4cee17c1be Patr*0633          print '(a,e15.8)'
ae287463fd Patr*0634      $        , '  norm of g...................', DNRM2( nn, gg, 1 )
4cee17c1be Patr*0635       end if
                0636 
                0637 c-----------------------------------------
                0638 c print error message
                0639 c-----------------------------------------
                0640  999  continue
                0641 
                0642       if (ifail .ne. 0) then
                0643          if (iprint .ge. 5) then
                0644             print *
                0645             print '(a)', '  optimization stopped because :'
                0646             if (ifail .lt. 0) then
                0647                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0648      $              , '    user request during simul'
                0649             else if (ifail .eq. 0) then
                0650                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0651      $              , '    optimal solution found'
                0652             else if (ifail .eq. 1) then
                0653                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0654      $              , '    an input argument is wrong'
                0655             else if (ifail .eq. 2) then
                0656                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0657      $              , '    warm start file is corrupted'
                0658             else if (ifail .eq. 3) then
                0659                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0660      $              , '    the initial gradient is too small'
                0661             else if (ifail .eq. 4) then
                0662                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0663      $              , '    the search direction is not a descent one'
                0664             else if (ifail .eq. 5) then
                0665                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0666      $              , '    maximal number of iterations reached'
                0667             else if (ifail .eq. 6) then
                0668                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0669      $              , '    maximal number of simulations reached'
                0670             else if (ifail .eq. 7) then
                0671                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0672      $              , '    the linesearch failed'
                0673             else if (ifail .eq. 8) then
                0674                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0675      $              , '    the function could not be improved'
                0676             else if (ifail .eq. 9) then
                0677                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0678      $              , '    optline parameters wrong'
                0679             else if (ifail .eq. 10) then
                0680                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0681      $              , '    cold start, no optimization done'
                0682             else if (ifail .eq. 11) then
                0683                print '(2x,a8,I3,a)', 'ifail = ', ifail
                0684      $              , '    convergence achieved within precision'
                0685             end if
                0686             print *
                0687          else if (iprint .ge. 1) then
                0688             print *
                0689             print '(a,i9)'
                0690      $           , '  after optimization ifail..........', ifail
                0691             print *
                0692          end if
                0693       end if
                0694 
                0695 c-----------------------------------------
                0696 c end of subroutine
                0697 c-----------------------------------------
                0698       return
                0699 
                0700       end