/[MITgcm]/MITgcm/pkg/ctrl/ctrl_pack.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_pack.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.11 by heimbach, Thu Oct 30 19:09:05 2003 UTC revision 1.15 by mlosch, Fri Dec 3 00:48:57 2004 UTC
# Line 2  C Line 2  C
2  C $Header$  C $Header$
3  C $Name$  C $Name$
4    
5    #include "PACKAGES_CONFIG.h"
6  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
7    
8        subroutine ctrl_pack( first, mythid )        subroutine ctrl_pack( first, mythid )
# Line 26  c Line 27  c
27  c              G. Gebbie, added open boundary control packing,  c              G. Gebbie, added open boundary control packing,
28  c                  gebbie@mit.edu  18 -Mar- 2003  c                  gebbie@mit.edu  18 -Mar- 2003
29  c  c
30  c              heimbach@mit.edu totally restrucured 28-Oct-2003  c              heimbach@mit.edu totally restructured 28-Oct-2003
31  c  c
32  c     ==================================================================  c     ==================================================================
33  c     SUBROUTINE ctrl_pack  c     SUBROUTINE ctrl_pack
# Line 41  c     == global variables == Line 42  c     == global variables ==
42  #include "PARAMS.h"  #include "PARAMS.h"
43  #include "GRID.h"  #include "GRID.h"
44    
 #include "ecco.h"  
45  #include "ctrl.h"  #include "ctrl.h"
46  #include "cost.h"  #include "cost.h"
   
 #ifdef ALLOW_ECCO_OPTIMIZATION  
47  #include "optim.h"  #include "optim.h"
48    
49    #ifdef ALLOW_ECCO
50    # include "ecco_cost.h"
51    #else
52    # include "ctrl_weights.h"
53  #endif  #endif
54    
55  c     == routine arguments ==  c     == routine arguments ==
# Line 57  c     == routine arguments == Line 60  c     == routine arguments ==
60  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
61  c     == local variables ==  c     == local variables ==
62    
 #ifndef ALLOW_ECCO_OPTIMIZATION  
       integer optimcycle  
       _RL    fmin  
 #endif  
   
63        _RL    fcloc        _RL    fcloc
64    
65        integer i, j, k        integer i, j, k
# Line 91  c     == external == Line 89  c     == external ==
89  c     == end of interface ==  c     == end of interface ==
90    
91  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
       optimcycle = 0  
92        fmin       = 0. _d 0        fmin       = 0. _d 0
93  #endif  #endif
94    
# Line 101  c--   Tiled files are used. Line 98  c--   Tiled files are used.
98  c--   Initialise adjoint variables on active files.  c--   Initialise adjoint variables on active files.
99        ladinit = .false.        ladinit = .false.
100    
101    c--   Initialise global buffer index
102          nbuffglobal = 0
103    
104  c--   Assign file names.  c--   Assign file names.
105    
106        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
# Line 131  c Line 131  c
131  c--     Only the master thread will do I/O.  c--     Only the master thread will do I/O.
132        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
133    
134        print *, 'ph-pack in pack '        if ( first ) then
       if ( first .AND. optimcycle .EQ. 0 ) then  
135  c     >>> Initialise control vector for optimcycle=0 <<<  c     >>> Initialise control vector for optimcycle=0 <<<
       print *, 'ph-pack in ctrl '  
136            lxxadxx   = .TRUE.            lxxadxx   = .TRUE.
137            ictrlgrad = 1            ictrlgrad = 1
138            fcloc     = fmin            fcloc     = fmin
139            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
140       &      ctrlname(1:9),'_',yctrlid(1:10),'.opt', optimcycle       &         ctrlname(1:9),'_',yctrlid(1:10),
141         &         yctrlpospack, optimcycle
142              print *, 'ph-pack: unpacking ', ctrlname(1:9)
143        else        else
144  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
       print *, 'ph-pack in cost '  
145            lxxadxx   = .FALSE.            lxxadxx   = .FALSE.
146            ictrlgrad = 2            ictrlgrad = 2
147            fcloc     = fc            fcloc     = fc
148            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
149       &    costname(1:9),'_',yctrlid(1:10),'.opt', optimcycle       &         costname(1:9),'_',yctrlid(1:10),
150         &         yctrlpospack, optimcycle
151              print *, 'ph-pack: unpacking ', costname(1:9)
152         endif         endif
153    
       print *, 'ph-pack vor open ', optimcycle, cfile  
154         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
155         open( cunit, file   = cfile,         open( cunit, file   = cfile,
156       &      status = 'unknown',       &      status = 'unknown',
# Line 162  c--       Header information. Line 162  c--       Header information.
162            write(cunit) nvarlength            write(cunit) nvarlength
163            write(cunit) yctrlid            write(cunit) yctrlid
164            write(cunit) optimCycle            write(cunit) optimCycle
165            write(cunit) fcloc            write(cunit) fc
166            write(cunit) 1  C     place holder of obsolete variable iG
           write(cunit) 1  
167            write(cunit) 1            write(cunit) 1
168    C     place holder of obsolete variable jG
169            write(cunit) 1            write(cunit) 1
170              write(cunit) nsx
171              write(cunit) nsy
172            write(cunit) (nWetcGlobal(k), k=1,nr)            write(cunit) (nWetcGlobal(k), k=1,nr)
173            write(cunit) (nWetsGlobal(k), k=1,nr)            write(cunit) (nWetsGlobal(k), k=1,nr)
174            write(cunit) (nWetwGlobal(k), k=1,nr)            write(cunit) (nWetwGlobal(k), k=1,nr)
# Line 188  c--       Header information. Line 190  c--       Header information.
190  #endif  #endif
191            write(cunit) (ncvarindex(i), i=1,maxcvars)            write(cunit) (ncvarindex(i), i=1,maxcvars)
192            write(cunit) (ncvarrecs(i),  i=1,maxcvars)            write(cunit) (ncvarrecs(i),  i=1,maxcvars)
193            write(cunit) (nx,  i=1,maxcvars)            write(cunit) (ncvarxmax(i),  i=1,maxcvars)
194            write(cunit) (ny,  i=1,maxcvars)            write(cunit) (ncvarymax(i),  i=1,maxcvars)
195            write(cunit) (ncvarnrmax(i), i=1,maxcvars)            write(cunit) (ncvarnrmax(i), i=1,maxcvars)
196            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
197            write(cunit)            write(cunit)
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22