pkg/ctrl/ctrl_pack.F

C
C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_pack.F,v 1.14 2004/11/16 05:42:12 heimbach Exp $
C $Name: checkpoint56 $

#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) nvartype
          write(cunit) nvarlength
          write(cunit) yctrlid
          write(cunit) optimCycle
          write(cunit) fc
C     place holder of obsolete variable iG
          write(cunit) 1
C     place holder of obsolete variable jG
          write(cunit) 1
          write(cunit) nsx
          write(cunit) nsy
          write(cunit) (nWetcGlobal(k), k=1,nr)
          write(cunit) (nWetsGlobal(k), k=1,nr)
          write(cunit) (nWetwGlobal(k), k=1,nr)
#ifdef ALLOW_CTRL_WETV
          write(cunit) (nWetvGlobal(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) (ncvarindex(i), i=1,maxcvars)
          write(cunit) (ncvarrecs(i),  i=1,maxcvars)
          write(cunit) (ncvarxmax(i),  i=1,maxcvars)
          write(cunit) (ncvarymax(i),  i=1,maxcvars)
          write(cunit) (ncvarnrmax(i), i=1,maxcvars)
          write(cunit) (ncvargrd(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	mlosch	1.15	C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_pack.F,v 1.14 2004/11/16 05:42:12 heimbach Exp $
3			C $Name: checkpoint56 $
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	mlosch	1.15	write(cunit) nvartype
162			write(cunit) nvarlength
163			write(cunit) yctrlid
164			write(cunit) optimCycle
165			write(cunit) fc
166			C place holder of obsolete variable iG
167			write(cunit) 1
168			C place holder of obsolete variable jG
169			write(cunit) 1
170			write(cunit) nsx
171			write(cunit) nsy
172			write(cunit) (nWetcGlobal(k), k=1,nr)
173			write(cunit) (nWetsGlobal(k), k=1,nr)
174			write(cunit) (nWetwGlobal(k), k=1,nr)
175	heimbach	1.7	#ifdef ALLOW_CTRL_WETV
176	mlosch	1.15	write(cunit) (nWetvGlobal(k), k=1,nr)
177	heimbach	1.7	#endif
178	heimbach	1.11
179	heimbach	1.5	#ifdef ALLOW_OBCSN_CONTROL
180			write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
181			#endif
182			#ifdef ALLOW_OBCSS_CONTROL
183			write(cunit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
184			#endif
185			#ifdef ALLOW_OBCSW_CONTROL
186			write(cunit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
187			#endif
188			#ifdef ALLOW_OBCSE_CONTROL
189			write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
190			#endif
191	mlosch	1.15	write(cunit) (ncvarindex(i), i=1,maxcvars)
192			write(cunit) (ncvarrecs(i), i=1,maxcvars)
193			write(cunit) (ncvarxmax(i), i=1,maxcvars)
194			write(cunit) (ncvarymax(i), i=1,maxcvars)
195			write(cunit) (ncvarnrmax(i), i=1,maxcvars)
196			write(cunit) (ncvargrd(i), i=1,maxcvars)
197	heimbach	1.1	write(cunit)
198
199			#ifdef ALLOW_THETA0_CONTROL
200	heimbach	1.5	ivartype = 1
201	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
202			write(weighttype(1:80),'(a)') "wtheta"
203	heimbach	1.5	call ctrl_set_pack_xyz(
204	heimbach	1.11	& cunit, ivartype, fname_theta(ictrlgrad), "hFacC",
205	heimbach	1.8	& weighttype, wtheta, lxxadxx, mythid)
206	heimbach	1.1	#endif
207
208			#ifdef ALLOW_SALT0_CONTROL
209	heimbach	1.5	ivartype = 2
210	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
211			write(weighttype(1:80),'(a)') "wsalt"
212	heimbach	1.5	call ctrl_set_pack_xyz(
213	heimbach	1.11	& cunit, ivartype, fname_salt(ictrlgrad), "hFacC",
214	heimbach	1.8	& weighttype, wsalt, lxxadxx, mythid)
215	heimbach	1.5	#endif
216
217			#if (defined (ALLOW_HFLUX_CONTROL) \|\| \
218			defined (ALLOW_HFLUX0_CONTROL))
219			ivartype = 3
220			write(weighttype(1:80),'(80a)') ' '
221			write(weighttype(1:80),'(a)') "whflux"
222			call ctrl_set_pack_xy(
223	heimbach	1.11	& cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",
224			& weighttype, lxxadxx, mythid)
225	heimbach	1.5	#endif
226
227			#if (defined (ALLOW_SFLUX_CONTROL) \|\| \
228			defined (ALLOW_SFLUX0_CONTROL))
229			ivartype = 4
230			write(weighttype(1:80),'(80a)') ' '
231			write(weighttype(1:80),'(a)') "wsflux"
232			call ctrl_set_pack_xy(
233	heimbach	1.11	& cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",
234			& weighttype, lxxadxx, mythid)
235	heimbach	1.5	#endif
236
237			#if (defined (ALLOW_USTRESS_CONTROL) \|\| \
238			defined (ALLOW_TAUU0_CONTROL))
239			ivartype = 5
240			write(weighttype(1:80),'(80a)') ' '
241			write(weighttype(1:80),'(a)') "wtauu"
242			call ctrl_set_pack_xy(
243	heimbach	1.11	& cunit, ivartype, fname_tauu(ictrlgrad), "maskW",
244			& weighttype, lxxadxx, mythid)
245	heimbach	1.5	#endif
246
247			#if (defined (ALLOW_VSTRESS_CONTROL) \|\| \
248			defined (ALLOW_TAUV0_CONTROL))
249			ivartype = 6
250			write(weighttype(1:80),'(80a)') ' '
251			write(weighttype(1:80),'(a)') "wtauv"
252			call ctrl_set_pack_xy(
253	heimbach	1.11	& cunit, ivartype, fname_tauv(ictrlgrad), "maskS",
254			& weighttype, lxxadxx, mythid)
255	heimbach	1.5	#endif
256
257			#ifdef ALLOW_ATEMP_CONTROL
258			ivartype = 7
259			write(weighttype(1:80),'(80a)') ' '
260			write(weighttype(1:80),'(a)') "watemp"
261			call ctrl_set_pack_xy(
262	heimbach	1.11	& cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",
263			& weighttype, lxxadxx, mythid)
264	heimbach	1.5	#endif
265
266			#ifdef ALLOW_AQH_CONTROL
267			ivartype = 8
268			write(weighttype(1:80),'(80a)') ' '
269			write(weighttype(1:80),'(a)') "waqh"
270			call ctrl_set_pack_xy(
271	heimbach	1.11	& cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",
272			& weighttype, lxxadxx, mythid)
273	heimbach	1.5	#endif
274
275			#ifdef ALLOW_UWIND_CONTROL
276			ivartype = 9
277			write(weighttype(1:80),'(80a)') ' '
278			write(weighttype(1:80),'(a)') "wuwind"
279			call ctrl_set_pack_xy(
280	heimbach	1.11	& cunit, ivartype, fname_uwind(ictrlgrad), "maskW",
281			& weighttype, lxxadxx, mythid)
282	heimbach	1.5	#endif
283
284			#ifdef ALLOW_VWIND_CONTROL
285			ivartype = 10
286			write(weighttype(1:80),'(80a)') ' '
287			write(weighttype(1:80),'(a)') "wvwind"
288			call ctrl_set_pack_xy(
289	heimbach	1.11	& cunit, ivartype, fname_vwind(ictrlgrad), "maskS",
290			& weighttype, lxxadxx, mythid)
291	heimbach	1.5	#endif
292
293			#ifdef ALLOW_OBCSN_CONTROL
294			ivartype = 11
295	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
296			write(weighttype(1:80),'(a)') "wobcsn"
297	heimbach	1.5	call ctrl_set_pack_xz(
298	heimbach	1.11	& cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
299	heimbach	1.8	& weighttype, wobcsn, lxxadxx, mythid)
300	heimbach	1.5	#endif
301
302			#ifdef ALLOW_OBCSS_CONTROL
303			ivartype = 12
304	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
305			write(weighttype(1:80),'(a)') "wobcss"
306	heimbach	1.5	call ctrl_set_pack_xz(
307	heimbach	1.11	& cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
308	heimbach	1.8	& weighttype, wobcss, lxxadxx, mythid)
309	heimbach	1.5	#endif
310
311			#ifdef ALLOW_OBCSW_CONTROL
312			ivartype = 13
313	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
314			write(weighttype(1:80),'(a)') "wobcsw"
315	heimbach	1.5	call ctrl_set_pack_yz(
316	heimbach	1.11	& cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
317	heimbach	1.8	& weighttype, wobcsw, lxxadxx, mythid)
318	heimbach	1.5	#endif
319
320			#ifdef ALLOW_OBCSE_CONTROL
321			ivartype = 14
322	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
323			write(weighttype(1:80),'(a)') "wobcse"
324	heimbach	1.5	call ctrl_set_pack_yz(
325	heimbach	1.11	& cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
326	heimbach	1.8	& weighttype, wobcse, lxxadxx, mythid)
327	heimbach	1.1	#endif
328	heimbach	1.3
329			#ifdef ALLOW_DIFFKR_CONTROL
330	heimbach	1.5	ivartype = 15
331	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
332			write(weighttype(1:80),'(a)') "wdiffkr"
333	heimbach	1.5	call ctrl_set_pack_xyz(
334	heimbach	1.11	& cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",
335	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
336	heimbach	1.3	#endif
337
338			#ifdef ALLOW_KAPGM_CONTROL
339	heimbach	1.5	ivartype = 16
340	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
341			write(weighttype(1:80),'(a)') "wkapgm"
342	heimbach	1.5	call ctrl_set_pack_xyz(
343	heimbach	1.11	& cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",
344	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
345	heimbach	1.3	#endif
346
347	heimbach	1.5	#ifdef ALLOW_TR10_CONTROL
348			ivartype = 17
349	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
350			write(weighttype(1:80),'(a)') "wtr1"
351	heimbach	1.5	call ctrl_set_pack_xyz(
352	heimbach	1.11	& cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",
353	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
354	heimbach	1.5	#endif
355
356	heimbach	1.6	#ifdef ALLOW_SST0_CONTROL
357			ivartype = 18
358			write(weighttype(1:80),'(80a)') ' '
359			write(weighttype(1:80),'(a)') "wsst0"
360			call ctrl_set_pack_xy(
361	heimbach	1.11	& cunit, ivartype, fname_sst(ictrlgrad), "hFacC",
362			& weighttype, lxxadxx, mythid)
363	heimbach	1.6	#endif
364
365			#ifdef ALLOW_SSS0_CONTROL
366			ivartype = 19
367			write(weighttype(1:80),'(80a)') ' '
368			write(weighttype(1:80),'(a)') "wsss0"
369			call ctrl_set_pack_xy(
370	heimbach	1.11	& cunit, ivartype, fname_sss(ictrlgrad), "hFacC",
371			& weighttype, lxxadxx, mythid)
372	heimbach	1.6	#endif
373
374			#ifdef ALLOW_HFACC_CONTROL
375			ivartype = 20
376	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
377			write(weighttype(1:80),'(a)') "whfacc"
378			# ifdef ALLOW_HFACC3D_CONTROL
379	heimbach	1.6	call ctrl_set_pack_xyz(
380	heimbach	1.11	& cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
381	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
382			# else
383	heimbach	1.6	call ctrl_set_pack_xy(
384	heimbach	1.11	& cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
385			& weighttype, lxxadxx, mythid)
386	heimbach	1.8	# endif
387	heimbach	1.6	#endif
388
389	heimbach	1.5	#ifdef ALLOW_EFLUXY0_CONTROL
390			ivartype = 21
391	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
392			write(weighttype(1:80),'(a)') "wefluxy0"
393	heimbach	1.5	call ctrl_set_pack_xyz(
394	heimbach	1.11	& cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",
395	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
396	heimbach	1.5	#endif
397
398			#ifdef ALLOW_EFLUXP0_CONTROL
399			ivartype = 22
400	heimbach	1.8	write(weighttype(1:80),'(80a)') ' '
401			write(weighttype(1:80),'(a)') "wefluxp0"
402	heimbach	1.5	call ctrl_set_pack_xyz(
403	heimbach	1.11	& cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",
404	heimbach	1.8	& weighttype, wunit, lxxadxx, mythid)
405	heimbach	1.6	#endif
406
407			#ifdef ALLOW_BOTTOMDRAG_CONTROL
408			ivartype = 23
409			write(weighttype(1:80),'(80a)') ' '
410			write(weighttype(1:80),'(a)') "wbottomdrag"
411			call ctrl_set_pack_xy(
412	heimbach	1.11	& cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",
413			& weighttype, lxxadxx, mythid)
414	heimbach	1.5	#endif
415
416			close ( cunit )
417	heimbach	1.1
418	heimbach	1.5	_END_MASTER( mythid )
419	heimbach	1.11
420			#endif /* EXCLUDE_CTRL_PACK */
421	heimbach	1.1
422			return
423			end
424