pkg/ctrl/ctrl_pack.F

C
C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_pack.F,v 1.13 2004/05/28 16:04:42 heimbach Exp $
C $Name:  $

#include "PACKAGES_CONFIG.h"
#include "CTRL_CPPOPTIONS.h"

      subroutine ctrl_pack( first, mythid )

c     ==================================================================
c     SUBROUTINE ctrl_pack
c     ==================================================================
c
c     o Compress the control vector such that only ocean points are
c       written to file.
c
c     started: Christian Eckert eckert@mit.edu  10-Mar=2000
c
c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
c              - Transferred some filename declarations
c                from here to namelist in ctrl_init
c  
c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000
c              - single file name convention with or without
c                ALLOW_ECCO_OPTIMIZATION
c
c              G. Gebbie, added open boundary control packing,
c                  gebbie@mit.edu  18 -Mar- 2003
c
c              heimbach@mit.edu totally restructured 28-Oct-2003
c
c     ==================================================================
c     SUBROUTINE ctrl_pack
c     ==================================================================

      implicit none

c     == global variables ==

#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"
#include "GRID.h"

#include "ctrl.h"
#include "cost.h"
#include "optim.h"

#ifdef ALLOW_ECCO
# include "ecco_cost.h"
#else
# include "ctrl_weights.h"
#endif

c     == routine arguments ==

      logical first
      integer mythid

#ifndef EXCLUDE_CTRL_PACK
c     == local variables ==

      _RL    fcloc

      integer i, j, k
      integer ii
      integer il
      integer irec
      integer ig,jg
      integer ivartype
      integer iobcs

      logical doglobalread
      logical ladinit
      integer cbuffindex
      logical lxxadxx
      
      integer cunit
      integer ictrlgrad

      character*(128) cfile
      character*( 80) weighttype

c     == external ==

      integer  ilnblnk
      external ilnblnk

c     == end of interface ==

#ifndef ALLOW_ECCO_OPTIMIZATION
      fmin       = 0. _d 0
#endif

c--   Tiled files are used.
      doglobalread = .false.

c--   Initialise adjoint variables on active files.
      ladinit = .false.

c--   Initialise global buffer index
      nbuffglobal = 0

c--   Assign file names.

      call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
      call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
      call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
      call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
      call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
      call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
      call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
      call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
      call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
      call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
      call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
      call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
      call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
      call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
      call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
      call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
      call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
      call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
      call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
      call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)
      call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
      call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
      call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)

c
c--     Only the master thread will do I/O.
      _BEGIN_MASTER( mythid )

      if ( first ) then
c     >>> Initialise control vector for optimcycle=0 <<<
          lxxadxx   = .TRUE.
          ictrlgrad = 1
          fcloc     = fmin
          write(cfile(1:128),'(4a,i4.4)')
     &         ctrlname(1:9),'_',yctrlid(1:10), 
     &         yctrlpospack, optimcycle
          print *, 'ph-pack: unpacking ', ctrlname(1:9)
      else
c     >>> Write gradient vector <<<
          lxxadxx   = .FALSE.
          ictrlgrad = 2
          fcloc     = fc
          write(cfile(1:128),'(4a,i4.4)')
     &         costname(1:9),'_',yctrlid(1:10), 
     &         yctrlpospack, optimcycle
          print *, 'ph-pack: unpacking ', costname(1:9)
       endif

       call mdsfindunit( cunit, mythid )
       open( cunit, file   = cfile,
     &      status = 'unknown',
     &      form   = 'unformatted',
     &      access  = 'sequential'   )

c--       Header information.
          write(cunit) filenvartype
          write(cunit) filenvarlength
          write(cunit) fileyctrlid
          write(cunit) fileoptimCycle
          write(cunit) filefc
          write(cunit) fileIg
          write(cunit) fileJg
          write(cunit) filensx
          write(cunit) filensy
          write(cunit) (filenWetcGlobal(k), k=1,nr)
          write(cunit) (filenWetsGlobal(k), k=1,nr)
          write(cunit) (filenWetwGlobal(k), k=1,nr)
#ifdef ALLOW_CTRL_WETV
          write(cunit) (filenWetvGlobal(k), k=1,nr)
#endif

#ifdef ALLOW_OBCSN_CONTROL
          write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
#endif
#ifdef ALLOW_OBCSS_CONTROL
          write(cunit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
#endif
#ifdef ALLOW_OBCSW_CONTROL
          write(cunit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
#endif
#ifdef ALLOW_OBCSE_CONTROL
          write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
#endif
          write(cunit) (filencvarindex(i), i=1,maxcvars)
          write(cunit) (filencvarrecs(i),  i=1,maxcvars)
          write(cunit) (filencvarxmax(i),  i=1,maxcvars)
          write(cunit) (filencvarymax(i),  i=1,maxcvars)
          write(cunit) (filencvarnrmax(i), i=1,maxcvars)
          write(cunit) (filencvargrd(i),   i=1,maxcvars)
          write(cunit)

#ifdef ALLOW_THETA0_CONTROL
          ivartype = 1
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wtheta"
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",
     &         weighttype, wtheta, lxxadxx, mythid)
#endif

#ifdef ALLOW_SALT0_CONTROL
          ivartype = 2
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wsalt"
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",
     &         weighttype, wsalt, lxxadxx, mythid)
#endif

#if (defined (ALLOW_HFLUX_CONTROL) || \
     defined (ALLOW_HFLUX0_CONTROL))
          ivartype = 3
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "whflux"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
#endif

#if (defined (ALLOW_SFLUX_CONTROL) || \
     defined (ALLOW_SFLUX0_CONTROL))
          ivartype = 4
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wsflux"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
#endif

#if (defined (ALLOW_USTRESS_CONTROL) || \
     defined (ALLOW_TAUU0_CONTROL))
          ivartype = 5
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wtauu"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",
     &         weighttype, lxxadxx, mythid)
#endif

#if (defined (ALLOW_VSTRESS_CONTROL) || \
     defined (ALLOW_TAUV0_CONTROL))
          ivartype = 6
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wtauv"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",
     &         weighttype, lxxadxx, mythid)
#endif

#ifdef ALLOW_ATEMP_CONTROL
          ivartype = 7
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "watemp"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
#endif

#ifdef ALLOW_AQH_CONTROL
          ivartype = 8
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "waqh"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
#endif

#ifdef ALLOW_UWIND_CONTROL
          ivartype = 9
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wuwind"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",
     &         weighttype, lxxadxx, mythid)
#endif

#ifdef ALLOW_VWIND_CONTROL
          ivartype = 10
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wvwind"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",
     &         weighttype, lxxadxx, mythid)
#endif

#ifdef ALLOW_OBCSN_CONTROL
          ivartype = 11
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wobcsn"
          call ctrl_set_pack_xz(
     &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
     &         weighttype, wobcsn, lxxadxx, mythid)
#endif

#ifdef ALLOW_OBCSS_CONTROL
          ivartype = 12
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wobcss"
          call ctrl_set_pack_xz(
     &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
     &         weighttype, wobcss, lxxadxx, mythid)
#endif

#ifdef ALLOW_OBCSW_CONTROL
          ivartype = 13
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wobcsw"
          call ctrl_set_pack_yz(
     &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
     &         weighttype, wobcsw, lxxadxx, mythid)
#endif

#ifdef ALLOW_OBCSE_CONTROL
          ivartype = 14
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wobcse"
          call ctrl_set_pack_yz(
     &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
     &         weighttype, wobcse, lxxadxx, mythid)
#endif

#ifdef ALLOW_DIFFKR_CONTROL
          ivartype = 15
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wdiffkr"
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",
     &         weighttype, wunit, lxxadxx, mythid)
#endif

#ifdef ALLOW_KAPGM_CONTROL
          ivartype = 16
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wkapgm"
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",
     &         weighttype, wunit, lxxadxx, mythid)
#endif

#ifdef ALLOW_TR10_CONTROL
          ivartype = 17
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wtr1"
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",
     &         weighttype, wunit, lxxadxx, mythid)
#endif

#ifdef ALLOW_SST0_CONTROL
          ivartype = 18
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wsst0"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
#endif

#ifdef ALLOW_SSS0_CONTROL
          ivartype = 19
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wsss0"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
#endif

#ifdef ALLOW_HFACC_CONTROL
          ivartype = 20
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "whfacc"
# ifdef ALLOW_HFACC3D_CONTROL
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
     &         weighttype, wunit, lxxadxx, mythid)
# else
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
# endif
#endif

#ifdef ALLOW_EFLUXY0_CONTROL
          ivartype = 21
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wefluxy0"
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",
     &         weighttype, wunit, lxxadxx, mythid)
#endif

#ifdef ALLOW_EFLUXP0_CONTROL
          ivartype = 22
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wefluxp0"
          call ctrl_set_pack_xyz(
     &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",
     &         weighttype, wunit, lxxadxx, mythid)
#endif

#ifdef ALLOW_BOTTOMDRAG_CONTROL
          ivartype = 23
          write(weighttype(1:80),'(80a)') ' '
          write(weighttype(1:80),'(a)') "wbottomdrag"
          call ctrl_set_pack_xy(
     &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",
     &         weighttype, lxxadxx, mythid)
#endif

          close ( cunit )

        _END_MASTER( mythid )

#endif /* EXCLUDE_CTRL_PACK */

      return
      end

1	edhill	1.10	C
2	heimbach	1.14	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_pack.F,v 1.13 2004/05/28 16:04:42 heimbach Exp $
3	heimbach	1.11	C $Name: $
4	heimbach	1.1
5	heimbach	1.12	#include "PACKAGES_CONFIG.h"
6	heimbach	1.1	#include "CTRL_CPPOPTIONS.h"
7
8	heimbach	1.11	subroutine ctrl_pack( first, mythid )
9	heimbach	1.8
10			c ==================================================================
11			c SUBROUTINE ctrl_pack
12			c ==================================================================
13			c
14			c o Compress the control vector such that only ocean points are
15			c written to file.
16			c
17			c started: Christian Eckert eckert@mit.edu 10-Mar=2000
18			c
19			c changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
20			c - Transferred some filename declarations
21			c from here to namelist in ctrl_init
22			c
23			c Patrick Heimbach heimbach@mit.edu 16-Jun-2000
24			c - single file name convention with or without
25			c ALLOW_ECCO_OPTIMIZATION
26			c
27			c G. Gebbie, added open boundary control packing,
28			c gebbie@mit.edu 18 -Mar- 2003
29			c
30	heimbach	1.12	c heimbach@mit.edu totally restructured 28-Oct-2003
31	heimbach	1.11	c
32	heimbach	1.8	c ==================================================================
33			c SUBROUTINE ctrl_pack
34			c ==================================================================
35
36	heimbach	1.1	implicit none
37
38			c == global variables ==
39	heimbach	1.5
40	heimbach	1.1	#include "EEPARAMS.h"
41			#include "SIZE.h"
42			#include "PARAMS.h"
43			#include "GRID.h"
44	heimbach	1.5
45	heimbach	1.1	#include "ctrl.h"
46			#include "cost.h"
47	heimbach	1.14	#include "optim.h"
48	heimbach	1.5
49	heimbach	1.12	#ifdef ALLOW_ECCO
50			# include "ecco_cost.h"
51			#else
52			# include "ctrl_weights.h"
53			#endif
54
55	heimbach	1.1	c == routine arguments ==
56	heimbach	1.5
57	heimbach	1.11	logical first
58	heimbach	1.1	integer mythid
59
60	heimbach	1.11	#ifndef EXCLUDE_CTRL_PACK
61	heimbach	1.1	c == local variables ==
62
63	heimbach	1.11	_RL fcloc
64
65	heimbach	1.5	integer i, j, k
66	heimbach	1.1	integer ii
67			integer il
68			integer irec
69	heimbach	1.5	integer ig,jg
70			integer ivartype
71			integer iobcs
72	heimbach	1.1
73			logical doglobalread
74			logical ladinit
75	heimbach	1.5	integer cbuffindex
76	heimbach	1.11	logical lxxadxx
77
78	heimbach	1.5	integer cunit
79	heimbach	1.11	integer ictrlgrad
80	heimbach	1.1
81			character*(128) cfile
82	heimbach	1.5	character*( 80) weighttype
83
84	heimbach	1.1	c == external ==
85	heimbach	1.5
86	heimbach	1.1	integer ilnblnk
87			external ilnblnk
88
89			c == end of interface ==
90
91	heimbach	1.5	#ifndef ALLOW_ECCO_OPTIMIZATION
92	heimbach	1.11	fmin = 0. _d 0
93	heimbach	1.5	#endif
94	heimbach	1.1
95			c-- Tiled files are used.
96			doglobalread = .false.
97
98			c-- Initialise adjoint variables on active files.
99			ladinit = .false.
100
101	heimbach	1.14	c-- Initialise global buffer index
102			nbuffglobal = 0
103
104	heimbach	1.5	c-- Assign file names.
105
106	heimbach	1.11	call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
107			call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
108			call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
109			call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
110			call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
111			call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
112			call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
113			call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
114			call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
115			call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
116			call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
117			call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
118			call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
119			call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
120			call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
121			call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
122			call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
123			call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
124			call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
125			call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)
126			call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
127			call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
128			call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
129	heimbach	1.5
130	heimbach	1.1	c
131	heimbach	1.5	c-- Only the master thread will do I/O.
132	heimbach	1.1	_BEGIN_MASTER( mythid )
133
134	heimbach	1.13	if ( first ) then
135	heimbach	1.11	c >>> Initialise control vector for optimcycle=0 <<<
136			lxxadxx = .TRUE.
137			ictrlgrad = 1
138			fcloc = fmin
139			write(cfile(1:128),'(4a,i4.4)')
140	heimbach	1.13	& ctrlname(1:9),'_',yctrlid(1:10),
141			& yctrlpospack, optimcycle
142			print *, 'ph-pack: unpacking ', ctrlname(1:9)
143	heimbach	1.11	else
144	heimbach	1.1	c >>> Write gradient vector <<<
145	heimbach	1.11	lxxadxx = .FALSE.
146			ictrlgrad = 2
147			fcloc = fc
148	heimbach	1.5	write(cfile(1:128),'(4a,i4.4)')
149	heimbach	1.13	& costname(1:9),'_',yctrlid(1:10),
150			& yctrlpospack, optimcycle
151			print *, 'ph-pack: unpacking ', costname(1:9)
152	heimbach	1.11	endif
153	heimbach	1.1
154	heimbach	1.11	call mdsfindunit( cunit, mythid )
155			open( cunit, file = cfile,
156			& status = 'unknown',
157			& form = 'unformatted',
158			& access = 'sequential' )
159	heimbach	1.1
160			c-- Header information.
161	heimbach	1.13	write(cunit) filenvartype
162			write(cunit) filenvarlength
163			write(cunit) fileyctrlid
164			write(cunit) fileoptimCycle
165			write(cunit) filefc
166			write(cunit) fileIg
167			write(cunit) fileJg
168			write(cunit) filensx
169			write(cunit) filensy
170			write(cunit) (filenWetcGlobal(k), k=1,nr)
171			write(cunit) (filenWetsGlobal(k), k=1,nr)
172			write(cunit) (filenWetwGlobal(k), k=1,nr)
173	heimbach	1.7	#ifdef ALLOW_CTRL_WETV
174	heimbach	1.13	write(cunit) (filenWetvGlobal(k), k=1,nr)
175	heimbach	1.7	#endif
176	heimbach	1.11
177	heimbach	1.5	#ifdef ALLOW_OBCSN_CONTROL
178			write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
179			#endif
180			#ifdef ALLOW_OBCSS_CONTROL
181			write(cunit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
182			#endif
183			#ifdef ALLOW_OBCSW_CONTROL
184			write(cunit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
185			#endif
186			#ifdef ALLOW_OBCSE_CONTROL
187			write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
188			#endif
189	heimbach	1.13	write(cunit) (filencvarindex(i), i=1,maxcvars)
190			write(cunit) (filencvarrecs(i), i=1,maxcvars)
191			write(cunit) (filencvarxmax(i), i=1,maxcvars)
192			write(cunit) (filencvarymax(i), i=1,maxcvars)
193			write(cunit) (filencvarnrmax(i), i=1,maxcvars)
194			write(cunit) (filencvargrd(i), i=1,maxcvars)
195	heimbach	1.1	write(cunit)
196
197			#ifdef ALLOW_THETA0_CONTROL
198	heimbach	1.5	ivartype = 1
199	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
200			write(weighttype(1:80),'(a)') "wtheta"
201	heimbach	1.5	call ctrl_set_pack_xyz(
202	heimbach	1.11	& cunit, ivartype, fname_theta(ictrlgrad), "hFacC",
203	heimbach	1.8	& weighttype, wtheta, lxxadxx, mythid)
204	heimbach	1.1	#endif
205
206			#ifdef ALLOW_SALT0_CONTROL
207	heimbach	1.5	ivartype = 2
208	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
209			write(weighttype(1:80),'(a)') "wsalt"
210	heimbach	1.5	call ctrl_set_pack_xyz(
211	heimbach	1.11	& cunit, ivartype, fname_salt(ictrlgrad), "hFacC",
212	heimbach	1.8	& weighttype, wsalt, lxxadxx, mythid)
213	heimbach	1.5	#endif
214
215			#if (defined (ALLOW_HFLUX_CONTROL) \|\| \
216			defined (ALLOW_HFLUX0_CONTROL))
217			ivartype = 3
218			write(weighttype(1:80),'(80a)') ' '
219			write(weighttype(1:80),'(a)') "whflux"
220			call ctrl_set_pack_xy(
221	heimbach	1.11	& cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",
222			& weighttype, lxxadxx, mythid)
223	heimbach	1.5	#endif
224
225			#if (defined (ALLOW_SFLUX_CONTROL) \|\| \
226			defined (ALLOW_SFLUX0_CONTROL))
227			ivartype = 4
228			write(weighttype(1:80),'(80a)') ' '
229			write(weighttype(1:80),'(a)') "wsflux"
230			call ctrl_set_pack_xy(
231	heimbach	1.11	& cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",
232			& weighttype, lxxadxx, mythid)
233	heimbach	1.5	#endif
234
235			#if (defined (ALLOW_USTRESS_CONTROL) \|\| \
236			defined (ALLOW_TAUU0_CONTROL))
237			ivartype = 5
238			write(weighttype(1:80),'(80a)') ' '
239			write(weighttype(1:80),'(a)') "wtauu"
240			call ctrl_set_pack_xy(
241	heimbach	1.11	& cunit, ivartype, fname_tauu(ictrlgrad), "maskW",
242			& weighttype, lxxadxx, mythid)
243	heimbach	1.5	#endif
244
245			#if (defined (ALLOW_VSTRESS_CONTROL) \|\| \
246			defined (ALLOW_TAUV0_CONTROL))
247			ivartype = 6
248			write(weighttype(1:80),'(80a)') ' '
249			write(weighttype(1:80),'(a)') "wtauv"
250			call ctrl_set_pack_xy(
251	heimbach	1.11	& cunit, ivartype, fname_tauv(ictrlgrad), "maskS",
252			& weighttype, lxxadxx, mythid)
253	heimbach	1.5	#endif
254
255			#ifdef ALLOW_ATEMP_CONTROL
256			ivartype = 7
257			write(weighttype(1:80),'(80a)') ' '
258			write(weighttype(1:80),'(a)') "watemp"
259			call ctrl_set_pack_xy(
260	heimbach	1.11	& cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",
261			& weighttype, lxxadxx, mythid)
262	heimbach	1.5	#endif
263
264			#ifdef ALLOW_AQH_CONTROL
265			ivartype = 8
266			write(weighttype(1:80),'(80a)') ' '
267			write(weighttype(1:80),'(a)') "waqh"
268			call ctrl_set_pack_xy(
269	heimbach	1.11	& cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",
270			& weighttype, lxxadxx, mythid)
271	heimbach	1.5	#endif
272
273			#ifdef ALLOW_UWIND_CONTROL
274			ivartype = 9
275			write(weighttype(1:80),'(80a)') ' '
276			write(weighttype(1:80),'(a)') "wuwind"
277			call ctrl_set_pack_xy(
278	heimbach	1.11	& cunit, ivartype, fname_uwind(ictrlgrad), "maskW",
279			& weighttype, lxxadxx, mythid)
280	heimbach	1.5	#endif
281
282			#ifdef ALLOW_VWIND_CONTROL
283			ivartype = 10
284			write(weighttype(1:80),'(80a)') ' '
285			write(weighttype(1:80),'(a)') "wvwind"
286			call ctrl_set_pack_xy(
287	heimbach	1.11	& cunit, ivartype, fname_vwind(ictrlgrad), "maskS",
288			& weighttype, lxxadxx, mythid)
289	heimbach	1.5	#endif
290
291			#ifdef ALLOW_OBCSN_CONTROL
292			ivartype = 11
293	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
294			write(weighttype(1:80),'(a)') "wobcsn"
295	heimbach	1.5	call ctrl_set_pack_xz(
296	heimbach	1.11	& cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
297	heimbach	1.8	& weighttype, wobcsn, lxxadxx, mythid)
298	heimbach	1.5	#endif
299
300			#ifdef ALLOW_OBCSS_CONTROL
301			ivartype = 12
302	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
303			write(weighttype(1:80),'(a)') "wobcss"
304	heimbach	1.5	call ctrl_set_pack_xz(
305	heimbach	1.11	& cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
306	heimbach	1.8	& weighttype, wobcss, lxxadxx, mythid)
307	heimbach	1.5	#endif
308
309			#ifdef ALLOW_OBCSW_CONTROL
310			ivartype = 13
311	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
312			write(weighttype(1:80),'(a)') "wobcsw"
313	heimbach	1.5	call ctrl_set_pack_yz(
314	heimbach	1.11	& cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
315	heimbach	1.8	& weighttype, wobcsw, lxxadxx, mythid)
316	heimbach	1.5	#endif
317
318			#ifdef ALLOW_OBCSE_CONTROL
319			ivartype = 14
320	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
321			write(weighttype(1:80),'(a)') "wobcse"
322	heimbach	1.5	call ctrl_set_pack_yz(
323	heimbach	1.11	& cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
324	heimbach	1.8	& weighttype, wobcse, lxxadxx, mythid)
325	heimbach	1.1	#endif
326	heimbach	1.3
327			#ifdef ALLOW_DIFFKR_CONTROL
328	heimbach	1.5	ivartype = 15
329	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
330			write(weighttype(1:80),'(a)') "wdiffkr"
331	heimbach	1.5	call ctrl_set_pack_xyz(
332	heimbach	1.11	& cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",
333	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
334	heimbach	1.3	#endif
335
336			#ifdef ALLOW_KAPGM_CONTROL
337	heimbach	1.5	ivartype = 16
338	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
339			write(weighttype(1:80),'(a)') "wkapgm"
340	heimbach	1.5	call ctrl_set_pack_xyz(
341	heimbach	1.11	& cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",
342	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
343	heimbach	1.3	#endif
344
345	heimbach	1.5	#ifdef ALLOW_TR10_CONTROL
346			ivartype = 17
347	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
348			write(weighttype(1:80),'(a)') "wtr1"
349	heimbach	1.5	call ctrl_set_pack_xyz(
350	heimbach	1.11	& cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",
351	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
352	heimbach	1.5	#endif
353
354	heimbach	1.6	#ifdef ALLOW_SST0_CONTROL
355			ivartype = 18
356			write(weighttype(1:80),'(80a)') ' '
357			write(weighttype(1:80),'(a)') "wsst0"
358			call ctrl_set_pack_xy(
359	heimbach	1.11	& cunit, ivartype, fname_sst(ictrlgrad), "hFacC",
360			& weighttype, lxxadxx, mythid)
361	heimbach	1.6	#endif
362
363			#ifdef ALLOW_SSS0_CONTROL
364			ivartype = 19
365			write(weighttype(1:80),'(80a)') ' '
366			write(weighttype(1:80),'(a)') "wsss0"
367			call ctrl_set_pack_xy(
368	heimbach	1.11	& cunit, ivartype, fname_sss(ictrlgrad), "hFacC",
369			& weighttype, lxxadxx, mythid)
370	heimbach	1.6	#endif
371
372			#ifdef ALLOW_HFACC_CONTROL
373			ivartype = 20
374	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
375			write(weighttype(1:80),'(a)') "whfacc"
376			# ifdef ALLOW_HFACC3D_CONTROL
377	heimbach	1.6	call ctrl_set_pack_xyz(
378	heimbach	1.11	& cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
379	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
380			# else
381	heimbach	1.6	call ctrl_set_pack_xy(
382	heimbach	1.11	& cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
383			& weighttype, lxxadxx, mythid)
384	heimbach	1.8	# endif
385	heimbach	1.6	#endif
386
387	heimbach	1.5	#ifdef ALLOW_EFLUXY0_CONTROL
388			ivartype = 21
389	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
390			write(weighttype(1:80),'(a)') "wefluxy0"
391	heimbach	1.5	call ctrl_set_pack_xyz(
392	heimbach	1.11	& cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",
393	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
394	heimbach	1.5	#endif
395
396			#ifdef ALLOW_EFLUXP0_CONTROL
397			ivartype = 22
398	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
399			write(weighttype(1:80),'(a)') "wefluxp0"
400	heimbach	1.5	call ctrl_set_pack_xyz(
401	heimbach	1.11	& cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",
402	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
403	heimbach	1.6	#endif
404
405			#ifdef ALLOW_BOTTOMDRAG_CONTROL
406			ivartype = 23
407			write(weighttype(1:80),'(80a)') ' '
408			write(weighttype(1:80),'(a)') "wbottomdrag"
409			call ctrl_set_pack_xy(
410	heimbach	1.11	& cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",
411			& weighttype, lxxadxx, mythid)
412	heimbach	1.5	#endif
413
414			close ( cunit )
415	heimbach	1.1
416	heimbach	1.5	_END_MASTER( mythid )
417	heimbach	1.11
418			#endif /* EXCLUDE_CTRL_PACK */
419	heimbach	1.1
420			return
421			end
422