/[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.12 by heimbach, Thu Nov 6 22:05:08 2003 UTC revision 1.18 by heimbach, Mon Feb 28 17:29:38 2005 UTC
# Line 1  Line 1 
 C  
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
# Line 43  c     == global variables == Line 42  c     == global variables ==
42  #include "GRID.h"  #include "GRID.h"
43    
44  #include "ctrl.h"  #include "ctrl.h"
45  #include "cost.h"  #include "optim.h"
46    
47    #ifdef ALLOW_COST
48    # include "cost.h"
49    #endif
50  #ifdef ALLOW_ECCO  #ifdef ALLOW_ECCO
51  # include "ecco_cost.h"  # include "ecco_cost.h"
52  #else  #else
53  # include "ctrl_weights.h"  # include "ctrl_weights.h"
54  #endif  #endif
55    
 #ifdef ALLOW_ECCO_OPTIMIZATION  
 # include "optim.h"  
 #endif  
   
56  c     == routine arguments ==  c     == routine arguments ==
57    
58        logical first        logical first
# Line 63  c     == routine arguments == Line 61  c     == routine arguments ==
61  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
62  c     == local variables ==  c     == local variables ==
63    
 #ifndef ALLOW_ECCO_OPTIMIZATION  
       integer optimcycle  
       _RL    fmin  
 #endif  
   
64        _RL    fcloc        _RL    fcloc
65    
66        integer i, j, k        integer i, j, k
# Line 97  c     == external == Line 90  c     == external ==
90  c     == end of interface ==  c     == end of interface ==
91    
92  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
       optimcycle = 0  
93        fmin       = 0. _d 0        fmin       = 0. _d 0
94  #endif  #endif
95    
# Line 107  c--   Tiled files are used. Line 99  c--   Tiled files are used.
99  c--   Initialise adjoint variables on active files.  c--   Initialise adjoint variables on active files.
100        ladinit = .false.        ladinit = .false.
101    
102    c--   Initialise global buffer index
103          nbuffglobal = 0
104    
105  c--   Assign file names.  c--   Assign file names.
106    
107        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
# Line 132  c--   Assign file names. Line 127  c--   Assign file names.
127        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
128        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
129        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
130          call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
131          call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
132    
133  c  c
134  c--     Only the master thread will do I/O.  c--     Only the master thread will do I/O.
135        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
136    
137        if ( first .AND. optimcycle .EQ. 0 ) then        if ( first ) then
138  c     >>> Initialise control vector for optimcycle=0 <<<  c     >>> Initialise control vector for optimcycle=0 <<<
139            lxxadxx   = .TRUE.            lxxadxx   = .TRUE.
140            ictrlgrad = 1            ictrlgrad = 1
141            fcloc     = fmin            fcloc     = fmin
142            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
143       &      ctrlname(1:9),'_',yctrlid(1:10),'.opt', optimcycle       &         ctrlname(1:9),'_',yctrlid(1:10),
144         &         yctrlpospack, optimcycle
145              print *, 'ph-pack: packing ', ctrlname(1:9)
146        else        else
147  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
148            lxxadxx   = .FALSE.            lxxadxx   = .FALSE.
149            ictrlgrad = 2            ictrlgrad = 2
150            fcloc     = fc            fcloc     = fc
151            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
152       &    costname(1:9),'_',yctrlid(1:10),'.opt', optimcycle       &         costname(1:9),'_',yctrlid(1:10),
153         &         yctrlpospack, optimcycle
154              print *, 'ph-pack: packing ', costname(1:9)
155         endif         endif
156    
157         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
# Line 164  c--       Header information. Line 165  c--       Header information.
165            write(cunit) nvarlength            write(cunit) nvarlength
166            write(cunit) yctrlid            write(cunit) yctrlid
167            write(cunit) optimCycle            write(cunit) optimCycle
168            write(cunit) fcloc            write(cunit) fc
169            write(cunit) 1  C     place holder of obsolete variable iG
           write(cunit) 1  
170            write(cunit) 1            write(cunit) 1
171    C     place holder of obsolete variable jG
172            write(cunit) 1            write(cunit) 1
173              write(cunit) nsx
174              write(cunit) nsy
175            write(cunit) (nWetcGlobal(k), k=1,nr)            write(cunit) (nWetcGlobal(k), k=1,nr)
176            write(cunit) (nWetsGlobal(k), k=1,nr)            write(cunit) (nWetsGlobal(k), k=1,nr)
177            write(cunit) (nWetwGlobal(k), k=1,nr)            write(cunit) (nWetwGlobal(k), k=1,nr)
# Line 190  c--       Header information. Line 193  c--       Header information.
193  #endif  #endif
194            write(cunit) (ncvarindex(i), i=1,maxcvars)            write(cunit) (ncvarindex(i), i=1,maxcvars)
195            write(cunit) (ncvarrecs(i),  i=1,maxcvars)            write(cunit) (ncvarrecs(i),  i=1,maxcvars)
196            write(cunit) (nx,  i=1,maxcvars)            write(cunit) (ncvarxmax(i),  i=1,maxcvars)
197            write(cunit) (ny,  i=1,maxcvars)            write(cunit) (ncvarymax(i),  i=1,maxcvars)
198            write(cunit) (ncvarnrmax(i), i=1,maxcvars)            write(cunit) (ncvarnrmax(i), i=1,maxcvars)
199            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
200            write(cunit)            write(cunit)
# Line 413  c--       Header information. Line 416  c--       Header information.
416       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
417  #endif  #endif
418    
419    #ifdef ALLOW_EDTAUX_CONTROL
420              ivartype = 25
421              write(weighttype(1:80),'(80a)') ' '
422              write(weighttype(1:80),'(a)') "wedtaux"
423              call ctrl_set_pack_xyz(
424         &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskW",
425         &         weighttype, wunit, lxxadxx, mythid)
426    #endif
427    
428    #ifdef ALLOW_EDTAUY_CONTROL
429              ivartype = 26
430              write(weighttype(1:80),'(80a)') ' '
431              write(weighttype(1:80),'(a)') "wedtauy"
432              call ctrl_set_pack_xyz(
433         &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskS",
434         &         weighttype, wunit, lxxadxx, mythid)
435    #endif
436    
437    
438            close ( cunit )            close ( cunit )
439    
440          _END_MASTER( mythid )          _END_MASTER( mythid )
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.18
  ViewVC Help
Powered by ViewVC 1.1.22