mlosch/optim_m1qn3/optim_store_m1qn3.F

C $Header: $
C $Name: $

      subroutine optim_store_m1qn3(
     I     ndz,
     U     iz,dz,niter,nsim,epsg,df1,
     I     optimcycle,
     I     store)
c     
c     subroutine optim_store_m1qn3
c     
c     Depending on the parameter store, store or restore the state of 
c     m1qn3. The communication is mostly via common blocks in order
c     to keep the changes to m1qn3 to a minimum. Only iz and dz are passed
c     as arguments
c     
      implicit none
c--   global variables
#include "m1qn3_common.h"
#include "m1qn3a_common.h"
#include "mlis3_common.h"
c--   routine arguments
      integer ndz
      integer iz(5)
      _RL dz(ndz)
      integer niter, nsim
      _RL epsg,df1
      integer optimcycle
      logical store

c--   local variables
      integer io, k
      character*(14) fname

c--   routine body
      fname = ' '
      io = 99
      print *, 'ml-optimcycle', optimcycle
      if ( store ) then
       write(fname,'(A,I4.4)') 'OPWARM.opt',optimcycle+1
c
       print *
       print *, ' OPTIM_STORE_M1QN3: saving the state of m1qn3 in ',
     &      fname
       print *
c
       open(io,file=fname,form='unformatted',status='unknown')
       write(io) niter,nsim
       write(io) iz
       write(io) (dz(k),k=1,ndz)
c     some extra info
       write(io) epsg,df1
c     m1qn3_common.h
       write(io) inmemo,id,igg,idiag,iaux,ialpha,iybar,isbar,reentry
c     m1qn3a_common.h
       write(io) cold,warm,itmax,isim,jcour,d1,t,tmin,tmax,
     &      gnorm,gnorms,eps1,ff,dk
c     mlis3_common.h
       write(io) tesf,tesd,fa,fpa,fn,barmin,barmul,barmax,barr
      else
       write(fname,'(A,I4.4)') 'OPWARM.opt',optimcycle
c
       print *
       print *, ' OPTIM_STORE_M1QN3: restoring the state'//
     &      ' of m1qn3 from ', fname
       print *
c
       open(io,file=fname,form='unformatted',status='old')
       read(io) niter,nsim
       read (io) iz
       read (io) (dz(k),k=1,ndz)
c     some extra info
       read (io) epsg,df1
c     m1qn3_common.h
       read (io) inmemo,id,igg,idiag,iaux,ialpha,iybar,isbar,reentry
c     m1qn3a_common.h
       read (io) cold,warm,itmax,isim,jcour,d1,t,tmin,tmax,
     &      gnorm,gnorms,eps1,ff,dk
c     mlis3_common.h
       read (io) tesf,tesd,fa,fpa,fn,barmin,barmul,barmax,barr
      endif

      close(io)

      return
      end
1	mlosch	1.1	C $Header: $
2			C $Name: $
3
4			subroutine optim_store_m1qn3(
5			I ndz,
6			U iz,dz,niter,nsim,epsg,df1,
7			I optimcycle,
8			I store)
9			c
10			c subroutine optim_store_m1qn3
11			c
12			c Depending on the parameter store, store or restore the state of
13			c m1qn3. The communication is mostly via common blocks in order
14			c to keep the changes to m1qn3 to a minimum. Only iz and dz are passed
15			c as arguments
16			c
17			implicit none
18			c-- global variables
19			#include "m1qn3_common.h"
20			#include "m1qn3a_common.h"
21			#include "mlis3_common.h"
22			c-- routine arguments
23			integer ndz
24			integer iz(5)
25			_RL dz(ndz)
26			integer niter, nsim
27			_RL epsg,df1
28			integer optimcycle
29			logical store
30
31			c-- local variables
32			integer io, k
33			character*(14) fname
34
35			c-- routine body
36			fname = ' '
37			io = 99
38			print *, 'ml-optimcycle', optimcycle
39			if ( store ) then
40			write(fname,'(A,I4.4)') 'OPWARM.opt',optimcycle+1
41			c
42			print *
43			print *, ' OPTIM_STORE_M1QN3: saving the state of m1qn3 in ',
44			& fname
45			print *
46			c
47			open(io,file=fname,form='unformatted',status='unknown')
48			write(io) niter,nsim
49			write(io) iz
50			write(io) (dz(k),k=1,ndz)
51			c some extra info
52			write(io) epsg,df1
53			c m1qn3_common.h
54			write(io) inmemo,id,igg,idiag,iaux,ialpha,iybar,isbar,reentry
55			c m1qn3a_common.h
56			write(io) cold,warm,itmax,isim,jcour,d1,t,tmin,tmax,
57			& gnorm,gnorms,eps1,ff,dk
58			c mlis3_common.h
59			write(io) tesf,tesd,fa,fpa,fn,barmin,barmul,barmax,barr
60			else
61			write(fname,'(A,I4.4)') 'OPWARM.opt',optimcycle
62			c
63			print *
64			print *, ' OPTIM_STORE_M1QN3: restoring the state'//
65			& ' of m1qn3 from ', fname
66			print *
67			c
68			open(io,file=fname,form='unformatted',status='old')
69			read(io) niter,nsim
70			read (io) iz
71			read (io) (dz(k),k=1,ndz)
72			c some extra info
73			read (io) epsg,df1
74			c m1qn3_common.h
75			read (io) inmemo,id,igg,idiag,iaux,ialpha,iybar,isbar,reentry
76			c m1qn3a_common.h
77			read (io) cold,warm,itmax,isim,jcour,d1,t,tmin,tmax,
78			& gnorm,gnorms,eps1,ff,dk
79			c mlis3_common.h
80			read (io) tesf,tesd,fa,fpa,fn,barmin,barmul,barmax,barr
81			endif
82
83			close(io)
84
85			return
86			end