/[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.10 by edhill, Thu Oct 23 04:41:40 2003 UTC revision 1.12 by heimbach, Thu Nov 6 22:05:08 2003 UTC
# Line 2  C Line 2  C
2  C $Header$  C $Header$
3  C $Name$  C $Name$
4    
5  #include "AD_CONFIG.h"  #include "PACKAGES_CONFIG.h"
6  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
7    
8          subroutine ctrl_pack( first, mythid )
       subroutine ctrl_pack(  
      I                      myiter,  
      I                      mytime,  
      I                      mythid  
      &                    )  
9    
10  c     ==================================================================  c     ==================================================================
11  c     SUBROUTINE ctrl_pack  c     SUBROUTINE ctrl_pack
# Line 32  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 restructured 28-Oct-2003
31    c
32  c     ==================================================================  c     ==================================================================
33  c     SUBROUTINE ctrl_pack  c     SUBROUTINE ctrl_pack
34  c     ==================================================================  c     ==================================================================
# Line 45  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"
47    
48    #ifdef ALLOW_ECCO
49    # include "ecco_cost.h"
50    #else
51    # include "ctrl_weights.h"
52    #endif
53    
54  #ifdef ALLOW_ECCO_OPTIMIZATION  #ifdef ALLOW_ECCO_OPTIMIZATION
55  #include "optim.h"  # include "optim.h"
56  #endif  #endif
57    
58  c     == routine arguments ==  c     == routine arguments ==
59    
60        integer myiter        logical first
       _RL     mytime  
61        integer mythid        integer mythid
62    
63    #ifndef EXCLUDE_CTRL_PACK
64  c     == local variables ==  c     == local variables ==
65    
66  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
67        integer optimcycle        integer optimcycle
68          _RL    fmin
69  #endif  #endif
70    
71          _RL    fcloc
72    
73        integer i, j, k        integer i, j, k
74        integer ii        integer ii
75        integer il        integer il
# Line 76  c     == local variables == Line 81  c     == local variables ==
81        logical doglobalread        logical doglobalread
82        logical ladinit        logical ladinit
83        integer cbuffindex        integer cbuffindex
84          logical lxxadxx
85          
86        integer cunit        integer cunit
87        _RL     tmpvar        integer ictrlgrad
88    
89        character*(128) cfile        character*(128) cfile
90        character*( 80) weighttype        character*( 80) weighttype
91    
       character*( 80) fname_theta  
       character*( 80) fname_salt  
       character*( 80) fname_hflux  
       character*( 80) fname_sflux  
       character*( 80) fname_tauu  
       character*( 80) fname_tauv  
       character*( 80) adfname_theta  
       character*( 80) adfname_salt  
       character*( 80) adfname_hflux  
       character*( 80) adfname_sflux  
       character*( 80) adfname_tauu  
       character*( 80) adfname_tauv  
       character*( 80)   fname_atemp  
       character*( 80) adfname_atemp  
       character*( 80)   fname_aqh  
       character*( 80) adfname_aqh  
       character*( 80)   fname_uwind  
       character*( 80) adfname_uwind  
       character*( 80)   fname_vwind  
       character*( 80) adfname_vwind  
       character*( 80)   fname_obcsn  
       character*( 80) adfname_obcsn  
       character*( 80)   fname_obcss  
       character*( 80) adfname_obcss  
       character*( 80)   fname_obcsw  
       character*( 80) adfname_obcsw  
       character*( 80)   fname_obcse  
       character*( 80) adfname_obcse  
       character*( 80)   fname_diffkr  
       character*( 80) adfname_diffkr  
       character*( 80)   fname_kapgm  
       character*( 80) adfname_kapgm  
       character*( 80)   fname_tr1  
       character*( 80) adfname_tr1  
       character*( 80)   fname_sst  
       character*( 80) adfname_sst  
       character*( 80)   fname_sss  
       character*( 80) adfname_sss  
       character*( 80)   fname_hfacc  
       character*( 80) adfname_hfacc  
       character*( 80)   fname_efluxy  
       character*( 80) adfname_efluxy  
       character*( 80)   fname_efluxp  
       character*( 80) adfname_efluxp  
       character*( 80)   fname_bottomdrag  
       character*( 80) adfname_bottomdrag  
   
       logical lxxadxx  
   
92  c     == external ==  c     == external ==
93    
94        integer  ilnblnk        integer  ilnblnk
# Line 141  c     == end of interface == Line 98  c     == end of interface ==
98    
99  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
100        optimcycle = 0        optimcycle = 0
101          fmin       = 0. _d 0
102  #endif  #endif
103    
       tmpvar = -9999. _d 0  
   
104  c--   Tiled files are used.  c--   Tiled files are used.
105        doglobalread = .false.        doglobalread = .false.
106    
# Line 153  c--   Initialise adjoint variables on ac Line 109  c--   Initialise adjoint variables on ac
109    
110  c--   Assign file names.  c--   Assign file names.
111    
112        call ctrl_set_fname(        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
113       I     xx_theta_file, fname_theta, adfname_theta, mythid )        call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
114        call ctrl_set_fname(        call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
115       I     xx_salt_file, fname_salt, adfname_salt, mythid )        call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
116        call ctrl_set_fname(        call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
117       I     xx_hflux_file, fname_hflux, adfname_hflux, mythid )        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
118        call ctrl_set_fname(        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
119       I     xx_sflux_file, fname_sflux, adfname_sflux, mythid )        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
120        call ctrl_set_fname(        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
121       I     xx_tauu_file, fname_tauu, adfname_tauu, mythid )        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
122        call ctrl_set_fname(        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
123       I     xx_tauv_file, fname_tauv, adfname_tauv, mythid )        call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
124        call ctrl_set_fname(        call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
125       I     xx_atemp_file, fname_atemp, adfname_atemp, mythid )        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
126        call ctrl_set_fname(        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
127       I     xx_aqh_file, fname_aqh, adfname_aqh, mythid )        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
128        call ctrl_set_fname(        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
129       I     xx_uwind_file, fname_uwind, adfname_uwind, mythid )        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
130        call ctrl_set_fname(        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
131       I     xx_vwind_file, fname_vwind, adfname_vwind, mythid )        call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)
132        call ctrl_set_fname(        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
133       I     xx_obcsn_file, fname_obcsn, adfname_obcsn, mythid )        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
134        call ctrl_set_fname(        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
      I     xx_obcss_file, fname_obcss, adfname_obcss, mythid )  
       call ctrl_set_fname(  
      I     xx_obcsw_file, fname_obcsw, adfname_obcsw, mythid )  
       call ctrl_set_fname(  
      I     xx_obcse_file, fname_obcse, adfname_obcse, mythid )  
       call ctrl_set_fname(  
      I     xx_diffkr_file, fname_diffkr, adfname_diffkr, mythid )  
       call ctrl_set_fname(  
      I     xx_kapgm_file, fname_kapgm, adfname_kapgm, mythid )  
       call ctrl_set_fname(  
      I     xx_tr1_file, fname_tr1, adfname_tr1, mythid )  
       call ctrl_set_fname(  
      I     xx_sst_file, fname_sst, adfname_sst, mythid )  
       call ctrl_set_fname(  
      I     xx_sss_file, fname_sss, adfname_sss, mythid )  
       call ctrl_set_fname(  
      I     xx_hfacc_file, fname_hfacc, adfname_hfacc, mythid )  
       call ctrl_set_fname(  
      I     xx_efluxy_file, fname_efluxy, adfname_efluxy, mythid )  
       call ctrl_set_fname(  
      I     xx_efluxp_file, fname_efluxp, adfname_efluxp, mythid )  
       call ctrl_set_fname(  
      I     xx_bottomdrag_file, fname_bottomdrag, adfname_bottomdrag  
      I   , mythid )  
135    
136  c  c
137  c--     Only the master thread will do I/O.  c--     Only the master thread will do I/O.
138        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
139    
140  c     >>> Write control vector <<<        if ( first .AND. optimcycle .EQ. 0 ) then
141    c     >>> Initialise control vector for optimcycle=0 <<<
142  cph   this part was removed since it's not necessary            lxxadxx   = .TRUE.
143  cph   and causes huge amounts of wall clock time on parallel machines            ictrlgrad = 1
144              fcloc     = fmin
145              write(cfile(1:128),'(4a,i4.4)')
146         &      ctrlname(1:9),'_',yctrlid(1:10),'.opt', optimcycle
147          else
148  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
149        lxxadxx = .FALSE.            lxxadxx   = .FALSE.
150              ictrlgrad = 2
151            call mdsfindunit( cunit, mythid )            fcloc     = fc
152            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
153       &    costname(1:9),'_',yctrlid(1:10),'.opt',       &    costname(1:9),'_',yctrlid(1:10),'.opt', optimcycle
154       &    optimcycle         endif
155    
156            open( cunit, file   = cfile,         call mdsfindunit( cunit, mythid )
157       &               status = 'unknown',         open( cunit, file   = cfile,
158       &               form   = 'unformatted',       &      status = 'unknown',
159       &               access  = 'sequential'   )       &      form   = 'unformatted',
160         &      access  = 'sequential'   )
161    
162  c--       Header information.  c--       Header information.
163            write(cunit) nvartype            write(cunit) nvartype
164            write(cunit) nvarlength            write(cunit) nvarlength
165            write(cunit) yctrlid            write(cunit) yctrlid
166            write(cunit) optimCycle            write(cunit) optimCycle
167            write(cunit) fc            write(cunit) fcloc
168            write(cunit) 1            write(cunit) 1
169            write(cunit) 1            write(cunit) 1
170            write(cunit) 1            write(cunit) 1
# Line 241  c--       Header information. Line 175  c--       Header information.
175  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
176            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
177  #endif  #endif
178    
179  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
180            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
181  #endif  #endif
# Line 266  c--       Header information. Line 201  c--       Header information.
201            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
202            write(weighttype(1:80),'(a)') "wtheta"            write(weighttype(1:80),'(a)') "wtheta"
203            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
204       &         cunit, ivartype, adfname_theta, "hFacC",       &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",
205       &         weighttype, wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
206  #endif  #endif
207    
# Line 275  c--       Header information. Line 210  c--       Header information.
210            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
211            write(weighttype(1:80),'(a)') "wsalt"            write(weighttype(1:80),'(a)') "wsalt"
212            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
213       &         cunit, ivartype, adfname_salt, "hFacC",       &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",
214       &         weighttype, wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
215  #endif  #endif
216    
# Line 285  c--       Header information. Line 220  c--       Header information.
220            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
221            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
222            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
223       &         cunit, ivartype, adfname_hflux, "hFacC", weighttype,       &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",
224       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
225  #endif  #endif
226    
227  #if (defined (ALLOW_SFLUX_CONTROL) || \  #if (defined (ALLOW_SFLUX_CONTROL) || \
# Line 295  c--       Header information. Line 230  c--       Header information.
230            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
231            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
232            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
233       &         cunit, ivartype, adfname_sflux, "hFacC", weighttype,       &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",
234       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
235  #endif  #endif
236    
237  #if (defined (ALLOW_USTRESS_CONTROL) || \  #if (defined (ALLOW_USTRESS_CONTROL) || \
# Line 305  c--       Header information. Line 240  c--       Header information.
240            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
241            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
242            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
243       &         cunit, ivartype, adfname_tauu, "maskW", weighttype,       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",
244       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
245  #endif  #endif
246    
247  #if (defined (ALLOW_VSTRESS_CONTROL) || \  #if (defined (ALLOW_VSTRESS_CONTROL) || \
# Line 315  c--       Header information. Line 250  c--       Header information.
250            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
251            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
252            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
253       &         cunit, ivartype, adfname_tauv, "maskS", weighttype,       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",
254       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
255  #endif  #endif
256    
257  #ifdef ALLOW_ATEMP_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
# Line 324  c--       Header information. Line 259  c--       Header information.
259            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
260            write(weighttype(1:80),'(a)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
261            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
262       &         cunit, ivartype, adfname_atemp, "hFacC", weighttype,       &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",
263       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
264  #endif  #endif
265    
266  #ifdef ALLOW_AQH_CONTROL  #ifdef ALLOW_AQH_CONTROL
# Line 333  c--       Header information. Line 268  c--       Header information.
268            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
269            write(weighttype(1:80),'(a)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
270            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
271       &         cunit, ivartype, adfname_aqh, "hFacC", weighttype,       &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",
272       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
273  #endif  #endif
274    
275  #ifdef ALLOW_UWIND_CONTROL  #ifdef ALLOW_UWIND_CONTROL
# Line 342  c--       Header information. Line 277  c--       Header information.
277            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
278            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
279            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
280       &         cunit, ivartype, adfname_uwind, "maskW", weighttype,       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",
281       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
282  #endif  #endif
283    
284  #ifdef ALLOW_VWIND_CONTROL  #ifdef ALLOW_VWIND_CONTROL
# Line 351  c--       Header information. Line 286  c--       Header information.
286            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
287            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
288            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
289       &         cunit, ivartype, adfname_vwind, "maskS", weighttype,       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",
290       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
291  #endif  #endif
292    
293  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 360  c--       Header information. Line 295  c--       Header information.
295            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
296            write(weighttype(1:80),'(a)') "wobcsn"            write(weighttype(1:80),'(a)') "wobcsn"
297            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
298       &         cunit, ivartype, adfname_obcsn, "maskobcsn",       &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
299       &         weighttype, wobcsn, lxxadxx, mythid)       &         weighttype, wobcsn, lxxadxx, mythid)
300  #endif  #endif
301    
# Line 369  c--       Header information. Line 304  c--       Header information.
304            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
305            write(weighttype(1:80),'(a)') "wobcss"            write(weighttype(1:80),'(a)') "wobcss"
306            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
307       &         cunit, ivartype, adfname_obcss, "maskobcss",       &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
308       &         weighttype, wobcss, lxxadxx, mythid)       &         weighttype, wobcss, lxxadxx, mythid)
309  #endif  #endif
310    
# Line 378  c--       Header information. Line 313  c--       Header information.
313            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
314            write(weighttype(1:80),'(a)') "wobcsw"            write(weighttype(1:80),'(a)') "wobcsw"
315            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
316       &         cunit, ivartype, adfname_obcsw, "maskobcsw",       &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
317       &         weighttype, wobcsw, lxxadxx, mythid)       &         weighttype, wobcsw, lxxadxx, mythid)
318  #endif  #endif
319    
# Line 387  c--       Header information. Line 322  c--       Header information.
322            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
323            write(weighttype(1:80),'(a)') "wobcse"            write(weighttype(1:80),'(a)') "wobcse"
324            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
325       &         cunit, ivartype, adfname_obcse, "maskobcse",       &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
326       &         weighttype, wobcse, lxxadxx, mythid)       &         weighttype, wobcse, lxxadxx, mythid)
327  #endif  #endif
328    
# Line 396  c--       Header information. Line 331  c--       Header information.
331            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
332            write(weighttype(1:80),'(a)') "wdiffkr"            write(weighttype(1:80),'(a)') "wdiffkr"
333            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
334       &         cunit, ivartype, adfname_diffkr, "hFacC",       &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",
335       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
336  #endif  #endif
337    
# Line 405  c--       Header information. Line 340  c--       Header information.
340            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
341            write(weighttype(1:80),'(a)') "wkapgm"            write(weighttype(1:80),'(a)') "wkapgm"
342            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
343       &         cunit, ivartype, adfname_kapgm, "hFacC",       &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",
344       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
345  #endif  #endif
346    
# Line 414  c--       Header information. Line 349  c--       Header information.
349            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
350            write(weighttype(1:80),'(a)') "wtr1"            write(weighttype(1:80),'(a)') "wtr1"
351            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
352       &         cunit, ivartype, adfname_tr1, "hFacC",       &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",
353       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
354  #endif  #endif
355    
# Line 423  c--       Header information. Line 358  c--       Header information.
358            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
359            write(weighttype(1:80),'(a)') "wsst0"            write(weighttype(1:80),'(a)') "wsst0"
360            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
361       &         cunit, ivartype, adfname_sst, "hFacC", weighttype,       &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",
362       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
363  #endif  #endif
364    
365  #ifdef ALLOW_SSS0_CONTROL  #ifdef ALLOW_SSS0_CONTROL
# Line 432  c--       Header information. Line 367  c--       Header information.
367            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
368            write(weighttype(1:80),'(a)') "wsss0"            write(weighttype(1:80),'(a)') "wsss0"
369            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
370       &         cunit, ivartype, adfname_sss, "hFacC", weighttype,       &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",
371       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
372  #endif  #endif
373    
374  #ifdef ALLOW_HFACC_CONTROL  #ifdef ALLOW_HFACC_CONTROL
# Line 442  c--       Header information. Line 377  c--       Header information.
377            write(weighttype(1:80),'(a)') "whfacc"            write(weighttype(1:80),'(a)') "whfacc"
378  # ifdef ALLOW_HFACC3D_CONTROL  # ifdef ALLOW_HFACC3D_CONTROL
379            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
380       &         cunit, ivartype, adfname_hfacc, "hFacC",       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
381       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
382  # else  # else
383            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
384       &         cunit, ivartype, adfname_hfacc, "hFacC", weighttype,       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
385       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
386  # endif  # endif
387  #endif  #endif
388    
# Line 456  c--       Header information. Line 391  c--       Header information.
391            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
392            write(weighttype(1:80),'(a)') "wefluxy0"            write(weighttype(1:80),'(a)') "wefluxy0"
393            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
394       &         cunit, ivartype, adfname_efluxy, "hFacS",       &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",
395       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
396  #endif  #endif
397    
# Line 465  c--       Header information. Line 400  c--       Header information.
400            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
401            write(weighttype(1:80),'(a)') "wefluxp0"            write(weighttype(1:80),'(a)') "wefluxp0"
402            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
403       &         cunit, ivartype, adfname_efluxp, "hFacV",       &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",
404       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
405  #endif  #endif
406    
# Line 474  c--       Header information. Line 409  c--       Header information.
409            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
410            write(weighttype(1:80),'(a)') "wbottomdrag"            write(weighttype(1:80),'(a)') "wbottomdrag"
411            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
412       &         cunit, ivartype, adfname_bottomdrag, "hFacC", weighttype,       &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",
413       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
414  #endif  #endif
415    
416            close ( cunit )            close ( cunit )
417    
418          _END_MASTER( mythid )          _END_MASTER( mythid )
419    
420    #endif /* EXCLUDE_CTRL_PACK */
421    
422        return        return
423        end        end
424    
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22