/[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.11 by heimbach, Thu Oct 30 19:09:05 2003 UTC
# Line 2  C Line 2  C
2  C $Header$  C $Header$
3  C $Name$  C $Name$
4    
 #include "AD_CONFIG.h"  
5  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
6    
7          subroutine ctrl_pack( first, mythid )
       subroutine ctrl_pack(  
      I                      myiter,  
      I                      mytime,  
      I                      mythid  
      &                    )  
8    
9  c     ==================================================================  c     ==================================================================
10  c     SUBROUTINE ctrl_pack  c     SUBROUTINE ctrl_pack
# Line 32  c Line 26  c
26  c              G. Gebbie, added open boundary control packing,  c              G. Gebbie, added open boundary control packing,
27  c                  gebbie@mit.edu  18 -Mar- 2003  c                  gebbie@mit.edu  18 -Mar- 2003
28  c  c
29    c              heimbach@mit.edu totally restrucured 28-Oct-2003
30    c
31  c     ==================================================================  c     ==================================================================
32  c     SUBROUTINE ctrl_pack  c     SUBROUTINE ctrl_pack
33  c     ==================================================================  c     ==================================================================
# Line 55  c     == global variables == Line 51  c     == global variables ==
51    
52  c     == routine arguments ==  c     == routine arguments ==
53    
54        integer myiter        logical first
       _RL     mytime  
55        integer mythid        integer mythid
56    
57    #ifndef EXCLUDE_CTRL_PACK
58  c     == local variables ==  c     == local variables ==
59    
60  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
61        integer optimcycle        integer optimcycle
62          _RL    fmin
63  #endif  #endif
64    
65          _RL    fcloc
66    
67        integer i, j, k        integer i, j, k
68        integer ii        integer ii
69        integer il        integer il
# Line 76  c     == local variables == Line 75  c     == local variables ==
75        logical doglobalread        logical doglobalread
76        logical ladinit        logical ladinit
77        integer cbuffindex        integer cbuffindex
78          logical lxxadxx
79          
80        integer cunit        integer cunit
81        _RL     tmpvar        integer ictrlgrad
82    
83        character*(128) cfile        character*(128) cfile
84        character*( 80) weighttype        character*( 80) weighttype
85    
       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  
   
86  c     == external ==  c     == external ==
87    
88        integer  ilnblnk        integer  ilnblnk
# Line 141  c     == end of interface == Line 92  c     == end of interface ==
92    
93  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
94        optimcycle = 0        optimcycle = 0
95          fmin       = 0. _d 0
96  #endif  #endif
97    
       tmpvar = -9999. _d 0  
   
98  c--   Tiled files are used.  c--   Tiled files are used.
99        doglobalread = .false.        doglobalread = .false.
100    
# Line 153  c--   Initialise adjoint variables on ac Line 103  c--   Initialise adjoint variables on ac
103    
104  c--   Assign file names.  c--   Assign file names.
105    
106        call ctrl_set_fname(        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
107       I     xx_theta_file, fname_theta, adfname_theta, mythid )        call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
108        call ctrl_set_fname(        call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
109       I     xx_salt_file, fname_salt, adfname_salt, mythid )        call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
110        call ctrl_set_fname(        call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
111       I     xx_hflux_file, fname_hflux, adfname_hflux, mythid )        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
112        call ctrl_set_fname(        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
113       I     xx_sflux_file, fname_sflux, adfname_sflux, mythid )        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
114        call ctrl_set_fname(        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
115       I     xx_tauu_file, fname_tauu, adfname_tauu, mythid )        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
116        call ctrl_set_fname(        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
117       I     xx_tauv_file, fname_tauv, adfname_tauv, mythid )        call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
118        call ctrl_set_fname(        call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
119       I     xx_atemp_file, fname_atemp, adfname_atemp, mythid )        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
120        call ctrl_set_fname(        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
121       I     xx_aqh_file, fname_aqh, adfname_aqh, mythid )        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
122        call ctrl_set_fname(        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
123       I     xx_uwind_file, fname_uwind, adfname_uwind, mythid )        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
124        call ctrl_set_fname(        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
125       I     xx_vwind_file, fname_vwind, adfname_vwind, mythid )        call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)
126        call ctrl_set_fname(        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
127       I     xx_obcsn_file, fname_obcsn, adfname_obcsn, mythid )        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
128        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 )  
129    
130  c  c
131  c--     Only the master thread will do I/O.  c--     Only the master thread will do I/O.
132        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
133    
134  c     >>> Write control vector <<<        print *, 'ph-pack in pack '
135          if ( first .AND. optimcycle .EQ. 0 ) then
136  cph   this part was removed since it's not necessary  c     >>> Initialise control vector for optimcycle=0 <<<
137  cph   and causes huge amounts of wall clock time on parallel machines        print *, 'ph-pack in ctrl '
138              lxxadxx   = .TRUE.
139              ictrlgrad = 1
140              fcloc     = fmin
141              write(cfile(1:128),'(4a,i4.4)')
142         &      ctrlname(1:9),'_',yctrlid(1:10),'.opt', optimcycle
143          else
144  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
145        lxxadxx = .FALSE.        print *, 'ph-pack in cost '
146              lxxadxx   = .FALSE.
147            call mdsfindunit( cunit, mythid )            ictrlgrad = 2
148              fcloc     = fc
149            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
150       &    costname(1:9),'_',yctrlid(1:10),'.opt',       &    costname(1:9),'_',yctrlid(1:10),'.opt', optimcycle
151       &    optimcycle         endif
152    
153            open( cunit, file   = cfile,        print *, 'ph-pack vor open ', optimcycle, cfile
154       &               status = 'unknown',         call mdsfindunit( cunit, mythid )
155       &               form   = 'unformatted',         open( cunit, file   = cfile,
156       &               access  = 'sequential'   )       &      status = 'unknown',
157         &      form   = 'unformatted',
158         &      access  = 'sequential'   )
159    
160  c--       Header information.  c--       Header information.
161            write(cunit) nvartype            write(cunit) nvartype
162            write(cunit) nvarlength            write(cunit) nvarlength
163            write(cunit) yctrlid            write(cunit) yctrlid
164            write(cunit) optimCycle            write(cunit) optimCycle
165            write(cunit) fc            write(cunit) fcloc
166            write(cunit) 1            write(cunit) 1
167            write(cunit) 1            write(cunit) 1
168            write(cunit) 1            write(cunit) 1
# Line 241  c--       Header information. Line 173  c--       Header information.
173  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
174            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
175  #endif  #endif
176    
177  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
178            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
179  #endif  #endif
# Line 266  c--       Header information. Line 199  c--       Header information.
199            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
200            write(weighttype(1:80),'(a)') "wtheta"            write(weighttype(1:80),'(a)') "wtheta"
201            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
202       &         cunit, ivartype, adfname_theta, "hFacC",       &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",
203       &         weighttype, wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
204  #endif  #endif
205    
# Line 275  c--       Header information. Line 208  c--       Header information.
208            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
209            write(weighttype(1:80),'(a)') "wsalt"            write(weighttype(1:80),'(a)') "wsalt"
210            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
211       &         cunit, ivartype, adfname_salt, "hFacC",       &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",
212       &         weighttype, wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
213  #endif  #endif
214    
# Line 285  c--       Header information. Line 218  c--       Header information.
218            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
219            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
220            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
221       &         cunit, ivartype, adfname_hflux, "hFacC", weighttype,       &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",
222       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
223  #endif  #endif
224    
225  #if (defined (ALLOW_SFLUX_CONTROL) || \  #if (defined (ALLOW_SFLUX_CONTROL) || \
# Line 295  c--       Header information. Line 228  c--       Header information.
228            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
229            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
230            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
231       &         cunit, ivartype, adfname_sflux, "hFacC", weighttype,       &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",
232       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
233  #endif  #endif
234    
235  #if (defined (ALLOW_USTRESS_CONTROL) || \  #if (defined (ALLOW_USTRESS_CONTROL) || \
# Line 305  c--       Header information. Line 238  c--       Header information.
238            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
239            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
240            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
241       &         cunit, ivartype, adfname_tauu, "maskW", weighttype,       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",
242       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
243  #endif  #endif
244    
245  #if (defined (ALLOW_VSTRESS_CONTROL) || \  #if (defined (ALLOW_VSTRESS_CONTROL) || \
# Line 315  c--       Header information. Line 248  c--       Header information.
248            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
249            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
250            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
251       &         cunit, ivartype, adfname_tauv, "maskS", weighttype,       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",
252       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
253  #endif  #endif
254    
255  #ifdef ALLOW_ATEMP_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
# Line 324  c--       Header information. Line 257  c--       Header information.
257            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
258            write(weighttype(1:80),'(a)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
259            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
260       &         cunit, ivartype, adfname_atemp, "hFacC", weighttype,       &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",
261       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
262  #endif  #endif
263    
264  #ifdef ALLOW_AQH_CONTROL  #ifdef ALLOW_AQH_CONTROL
# Line 333  c--       Header information. Line 266  c--       Header information.
266            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
267            write(weighttype(1:80),'(a)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
268            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
269       &         cunit, ivartype, adfname_aqh, "hFacC", weighttype,       &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",
270       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
271  #endif  #endif
272    
273  #ifdef ALLOW_UWIND_CONTROL  #ifdef ALLOW_UWIND_CONTROL
# Line 342  c--       Header information. Line 275  c--       Header information.
275            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
276            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
277            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
278       &         cunit, ivartype, adfname_uwind, "maskW", weighttype,       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",
279       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
280  #endif  #endif
281    
282  #ifdef ALLOW_VWIND_CONTROL  #ifdef ALLOW_VWIND_CONTROL
# Line 351  c--       Header information. Line 284  c--       Header information.
284            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
285            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
286            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
287       &         cunit, ivartype, adfname_vwind, "maskS", weighttype,       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",
288       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
289  #endif  #endif
290    
291  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 360  c--       Header information. Line 293  c--       Header information.
293            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
294            write(weighttype(1:80),'(a)') "wobcsn"            write(weighttype(1:80),'(a)') "wobcsn"
295            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
296       &         cunit, ivartype, adfname_obcsn, "maskobcsn",       &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
297       &         weighttype, wobcsn, lxxadxx, mythid)       &         weighttype, wobcsn, lxxadxx, mythid)
298  #endif  #endif
299    
# Line 369  c--       Header information. Line 302  c--       Header information.
302            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
303            write(weighttype(1:80),'(a)') "wobcss"            write(weighttype(1:80),'(a)') "wobcss"
304            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
305       &         cunit, ivartype, adfname_obcss, "maskobcss",       &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
306       &         weighttype, wobcss, lxxadxx, mythid)       &         weighttype, wobcss, lxxadxx, mythid)
307  #endif  #endif
308    
# Line 378  c--       Header information. Line 311  c--       Header information.
311            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
312            write(weighttype(1:80),'(a)') "wobcsw"            write(weighttype(1:80),'(a)') "wobcsw"
313            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
314       &         cunit, ivartype, adfname_obcsw, "maskobcsw",       &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
315       &         weighttype, wobcsw, lxxadxx, mythid)       &         weighttype, wobcsw, lxxadxx, mythid)
316  #endif  #endif
317    
# Line 387  c--       Header information. Line 320  c--       Header information.
320            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
321            write(weighttype(1:80),'(a)') "wobcse"            write(weighttype(1:80),'(a)') "wobcse"
322            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
323       &         cunit, ivartype, adfname_obcse, "maskobcse",       &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
324       &         weighttype, wobcse, lxxadxx, mythid)       &         weighttype, wobcse, lxxadxx, mythid)
325  #endif  #endif
326    
# Line 396  c--       Header information. Line 329  c--       Header information.
329            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
330            write(weighttype(1:80),'(a)') "wdiffkr"            write(weighttype(1:80),'(a)') "wdiffkr"
331            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
332       &         cunit, ivartype, adfname_diffkr, "hFacC",       &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",
333       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
334  #endif  #endif
335    
# Line 405  c--       Header information. Line 338  c--       Header information.
338            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
339            write(weighttype(1:80),'(a)') "wkapgm"            write(weighttype(1:80),'(a)') "wkapgm"
340            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
341       &         cunit, ivartype, adfname_kapgm, "hFacC",       &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",
342       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
343  #endif  #endif
344    
# Line 414  c--       Header information. Line 347  c--       Header information.
347            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
348            write(weighttype(1:80),'(a)') "wtr1"            write(weighttype(1:80),'(a)') "wtr1"
349            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
350       &         cunit, ivartype, adfname_tr1, "hFacC",       &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",
351       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
352  #endif  #endif
353    
# Line 423  c--       Header information. Line 356  c--       Header information.
356            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
357            write(weighttype(1:80),'(a)') "wsst0"            write(weighttype(1:80),'(a)') "wsst0"
358            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
359       &         cunit, ivartype, adfname_sst, "hFacC", weighttype,       &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",
360       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
361  #endif  #endif
362    
363  #ifdef ALLOW_SSS0_CONTROL  #ifdef ALLOW_SSS0_CONTROL
# Line 432  c--       Header information. Line 365  c--       Header information.
365            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
366            write(weighttype(1:80),'(a)') "wsss0"            write(weighttype(1:80),'(a)') "wsss0"
367            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
368       &         cunit, ivartype, adfname_sss, "hFacC", weighttype,       &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",
369       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
370  #endif  #endif
371    
372  #ifdef ALLOW_HFACC_CONTROL  #ifdef ALLOW_HFACC_CONTROL
# Line 442  c--       Header information. Line 375  c--       Header information.
375            write(weighttype(1:80),'(a)') "whfacc"            write(weighttype(1:80),'(a)') "whfacc"
376  # ifdef ALLOW_HFACC3D_CONTROL  # ifdef ALLOW_HFACC3D_CONTROL
377            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
378       &         cunit, ivartype, adfname_hfacc, "hFacC",       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
379       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
380  # else  # else
381            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
382       &         cunit, ivartype, adfname_hfacc, "hFacC", weighttype,       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
383       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
384  # endif  # endif
385  #endif  #endif
386    
# Line 456  c--       Header information. Line 389  c--       Header information.
389            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
390            write(weighttype(1:80),'(a)') "wefluxy0"            write(weighttype(1:80),'(a)') "wefluxy0"
391            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
392       &         cunit, ivartype, adfname_efluxy, "hFacS",       &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",
393       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
394  #endif  #endif
395    
# Line 465  c--       Header information. Line 398  c--       Header information.
398            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
399            write(weighttype(1:80),'(a)') "wefluxp0"            write(weighttype(1:80),'(a)') "wefluxp0"
400            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
401       &         cunit, ivartype, adfname_efluxp, "hFacV",       &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",
402       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
403  #endif  #endif
404    
# Line 474  c--       Header information. Line 407  c--       Header information.
407            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
408            write(weighttype(1:80),'(a)') "wbottomdrag"            write(weighttype(1:80),'(a)') "wbottomdrag"
409            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
410       &         cunit, ivartype, adfname_bottomdrag, "hFacC", weighttype,       &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",
411       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
412  #endif  #endif
413    
414            close ( cunit )            close ( cunit )
415    
416          _END_MASTER( mythid )          _END_MASTER( mythid )
417    
418    #endif /* EXCLUDE_CTRL_PACK */
419    
420        return        return
421        end        end
422    
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22