/[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.17 by heimbach, Tue Jan 4 22:02:31 2005 UTC revision 1.42 by jmc, Fri Aug 10 19:38:57 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "CTRL_OPTIONS.h"
5  #include "CTRL_CPPOPTIONS.h"  #include "AD_CONFIG.h"
6    
7        subroutine ctrl_pack( first, mythid )        subroutine ctrl_pack( first, mythid )
8    
# Line 18  c Line 18  c
18  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
19  c              - Transferred some filename declarations  c              - Transferred some filename declarations
20  c                from here to namelist in ctrl_init  c                from here to namelist in ctrl_init
21  c    c
22  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000
23  c              - single file name convention with or without  c              - single file name convention with or without
24  c                ALLOW_ECCO_OPTIMIZATION  c                ALLOW_ECCO_OPTIMIZATION
# Line 59  c     == routine arguments == Line 59  c     == routine arguments ==
59        integer mythid        integer mythid
60    
61  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
62    #if (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN))
63  c     == local variables ==  c     == local variables ==
64    
65        _RL    fcloc        _RL    fcloc
# Line 75  c     == local variables == Line 76  c     == local variables ==
76        logical ladinit        logical ladinit
77        integer cbuffindex        integer cbuffindex
78        logical lxxadxx        logical lxxadxx
79          
80        integer cunit        integer cunit
81        integer ictrlgrad        integer ictrlgrad
82    
# Line 112  c--   Assign file names. Line 113  c--   Assign file names.
113        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
114        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
115        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
116          call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
117          call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
118          call ctrl_set_fname(xx_swdown_file, fname_swdown, mythid)
119          call ctrl_set_fname(xx_lwflux_file, fname_lwflux, mythid)
120          call ctrl_set_fname(xx_lwdown_file, fname_lwdown, mythid)
121          call ctrl_set_fname(xx_evap_file, fname_evap, mythid)
122          call ctrl_set_fname(xx_snowprecip_file, fname_snowprecip, mythid)
123          call ctrl_set_fname(xx_apressure_file, fname_apressure, mythid)
124          call ctrl_set_fname(xx_runoff_file, fname_runoff, mythid)
125    
126        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
127        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
128        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
# Line 120  c--   Assign file names. Line 131  c--   Assign file names.
131        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
132        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
133        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
134          call ctrl_set_fname(xx_kapredi_file, fname_kapredi, mythid)
135        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
136        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
137        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
138        call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)        call ctrl_set_fname(xx_depth_file, fname_depth, mythid)
139        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
140        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
141        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
142          call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
143          call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
144          call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
145          call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
146          call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
147          call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
148          call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
149          call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)
150          call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)
151          call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)
152    cHFLUXM_CONTROL
153          call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid)
154    cHFLUXM_CONTROL
155          call ctrl_set_fname(xx_shifwflx_file, fname_shifwflx, mythid)
156    
157  c  c--   Only the master thread will do I/O.
 c--     Only the master thread will do I/O.  
158        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
159    
160        if ( first ) then        if ( first ) then
# Line 138  c     >>> Initialise control vector for Line 163  c     >>> Initialise control vector for
163            ictrlgrad = 1            ictrlgrad = 1
164            fcloc     = fmin            fcloc     = fmin
165            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
166       &         ctrlname(1:9),'_',yctrlid(1:10),       &         ctrlname(1:9),'_',yctrlid(1:10),
167       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
168            print *, 'ph-pack: packing ', ctrlname(1:9)            print *, 'ph-pack: packing ', ctrlname(1:9)
169        else        else
# Line 147  c     >>> Write gradient vector <<< Line 172  c     >>> Write gradient vector <<<
172            ictrlgrad = 2            ictrlgrad = 2
173            fcloc     = fc            fcloc     = fc
174            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
175       &         costname(1:9),'_',yctrlid(1:10),       &         costname(1:9),'_',yctrlid(1:10),
176       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
177            print *, 'ph-pack: packing ', costname(1:9)            print *, 'ph-pack: packing ', costname(1:9)
178         endif         endif
179    
180    c--   Only Proc 0 will do I/O.
181          IF ( myProcId .eq. 0 ) THEN
182    
183         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
184         open( cunit, file   = cfile,         open( cunit, file   = cfile,
185       &      status = 'unknown',       &      status = 'unknown',
# Line 176  C     place holder of obsolete variable Line 204  C     place holder of obsolete variable
204  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
205            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
206  #endif  #endif
207    #ifdef ALLOW_SHIFWFLX_CONTROL
208              write(cunit) (nWetiGlobal(k), k=1,nr)
209    c          write(cunit) nWetiGlobal(1)
210    #endif
211    
212  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
213            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
# Line 197  C     place holder of obsolete variable Line 229  C     place holder of obsolete variable
229            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
230            write(cunit)            write(cunit)
231    
232    #ifdef ALLOW_PACKUNPACK_METHOD2
233          ENDIF
234          _END_MASTER( mythid )
235          _BARRIER
236    #endif
237    
238  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
239            ivartype = 1            ivartype = 1
240            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
241            write(weighttype(1:80),'(a)') "wtheta"            write(weighttype(1:80),'(a)') "wthetaLev"
242            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
243       &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_theta(ictrlgrad), "maskCtrlC",
244       &         weighttype, wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
245  #endif  #endif
246    
247  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
248            ivartype = 2            ivartype = 2
249            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
250            write(weighttype(1:80),'(a)') "wsalt"            write(weighttype(1:80),'(a)') "wsaltLev"
251            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
252       &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_salt(ictrlgrad), "maskCtrlC",
253       &         weighttype, wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
254  #endif  #endif
255    
256  #if (defined (ALLOW_HFLUX_CONTROL) || \  #if (defined (ALLOW_HFLUX_CONTROL) || defined (ALLOW_HFLUX0_CONTROL))
      defined (ALLOW_HFLUX0_CONTROL))  
257            ivartype = 3            ivartype = 3
258            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
259            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
260            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
261       &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",
262       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
263  #endif  #endif
264    
265  #if (defined (ALLOW_SFLUX_CONTROL) || \  #if (defined (ALLOW_SFLUX_CONTROL) || defined (ALLOW_SFLUX0_CONTROL))
      defined (ALLOW_SFLUX0_CONTROL))  
266            ivartype = 4            ivartype = 4
267            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
268            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
269            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
270       &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",
271       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
272  #endif  #endif
273    
274  #if (defined (ALLOW_USTRESS_CONTROL) || \  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
      defined (ALLOW_TAUU0_CONTROL))  
275            ivartype = 5            ivartype = 5
276            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
277            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
278            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
279       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",  #ifndef ALLOW_ROTATE_UV_CONTROLS
280         &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
281    #else
282         &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlC",
283    #endif
284       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
285  #endif  #endif
286    
287  #if (defined (ALLOW_VSTRESS_CONTROL) || \  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
      defined (ALLOW_TAUV0_CONTROL))  
288            ivartype = 6            ivartype = 6
289            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
290            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
291            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
292       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",  #ifndef ALLOW_ROTATE_UV_CONTROLS
293         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
294    #else
295         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlC",
296    #endif
297       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
298  #endif  #endif
299    
# Line 260  C     place holder of obsolete variable Line 302  C     place holder of obsolete variable
302            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
303            write(weighttype(1:80),'(a)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
304            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
305       &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",
306       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
307  #endif  #endif
308    
# Line 269  C     place holder of obsolete variable Line 311  C     place holder of obsolete variable
311            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
312            write(weighttype(1:80),'(a)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
313            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
314       &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",
315       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
316  #endif  #endif
317    
# Line 278  C     place holder of obsolete variable Line 320  C     place holder of obsolete variable
320            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
321            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
322            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
323       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
324       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
325  #endif  #endif
326    
# Line 287  C     place holder of obsolete variable Line 329  C     place holder of obsolete variable
329            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
330            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
331            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
332       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
333       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
334  #endif  #endif
335    
# Line 332  C     place holder of obsolete variable Line 374  C     place holder of obsolete variable
374            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
375            write(weighttype(1:80),'(a)') "wdiffkr"            write(weighttype(1:80),'(a)') "wdiffkr"
376            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
377       &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_diffkr(ictrlgrad), "maskCtrlC",
378       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wdiffkr, lxxadxx, mythid)
379  #endif  #endif
380    
381  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
# Line 341  C     place holder of obsolete variable Line 383  C     place holder of obsolete variable
383            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
384            write(weighttype(1:80),'(a)') "wkapgm"            write(weighttype(1:80),'(a)') "wkapgm"
385            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
386       &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_kapgm(ictrlgrad), "maskCtrlC",
387       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wkapgm, lxxadxx, mythid)
388  #endif  #endif
389    
390  #ifdef ALLOW_TR10_CONTROL  #ifdef ALLOW_TR10_CONTROL
# Line 350  C     place holder of obsolete variable Line 392  C     place holder of obsolete variable
392            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
393            write(weighttype(1:80),'(a)') "wtr1"            write(weighttype(1:80),'(a)') "wtr1"
394            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
395       &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_tr1(ictrlgrad), "maskCtrlC",
396       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
397  #endif  #endif
398    
399  #ifdef ALLOW_SST0_CONTROL  #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
400            ivartype = 18            ivartype = 18
401            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
402            write(weighttype(1:80),'(a)') "wsst0"            write(weighttype(1:80),'(a)') "wsst"
403            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
404       &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",
405       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
406  #endif  #endif
407    
408  #ifdef ALLOW_SSS0_CONTROL  #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
409            ivartype = 19            ivartype = 19
410            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
411            write(weighttype(1:80),'(a)') "wsss0"            write(weighttype(1:80),'(a)') "wsss"
412            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
413       &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sss(ictrlgrad),
414       &         weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
415  #endif  #endif
416    
417  #ifdef ALLOW_HFACC_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
418            ivartype = 20            ivartype = 20
419            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
420            write(weighttype(1:80),'(a)') "whfacc"            write(weighttype(1:80),'(a)') "wdepth"
 # ifdef ALLOW_HFACC3D_CONTROL  
           call ctrl_set_pack_xyz(  
      &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",  
      &         weighttype, wunit, lxxadxx, mythid)  
 # else  
421            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
422       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_depth(ictrlgrad),
423       &         weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
424  # endif  #endif /* ALLOW_DEPTH_CONTROL */
 #endif  
425    
426  #ifdef ALLOW_EFLUXY0_CONTROL  #ifdef ALLOW_EFLUXY0_CONTROL
427            ivartype = 21            ivartype = 21
428            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
429            write(weighttype(1:80),'(a)') "wefluxy0"            write(weighttype(1:80),'(a)') "wefluxy0"
430            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
431       &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",       &         cunit, ivartype, fname_efluxy(ictrlgrad), "maskCtrlS",
432       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
433  #endif  #endif
434    
# Line 401  C     place holder of obsolete variable Line 437  C     place holder of obsolete variable
437            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
438            write(weighttype(1:80),'(a)') "wefluxp0"            write(weighttype(1:80),'(a)') "wefluxp0"
439            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
440       &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",       &         cunit, ivartype, fname_efluxp(ictrlgrad), "maskhFacV",
441       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
442  #endif  #endif
443    
# Line 410  C     place holder of obsolete variable Line 446  C     place holder of obsolete variable
446            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
447            write(weighttype(1:80),'(a)') "wbottomdrag"            write(weighttype(1:80),'(a)') "wbottomdrag"
448            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
449       &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",       &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",
450         &      weighttype, lxxadxx, mythid)
451    #endif
452    
453    #ifdef ALLOW_HFLUXM_CONTROL
454              ivartype = 24
455              write(weighttype(1:80),'(80a)') ' '
456              write(weighttype(1:80),'(a)') "whfluxm"
457              call ctrl_set_pack_xy(
458         &         cunit, ivartype, fname_hfluxm(ictrlgrad), "maskCtrlC",
459       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
460  #endif  #endif
461    
462            close ( cunit )  #ifdef ALLOW_EDDYPSI_CONTROL
463              ivartype = 25
464              write(weighttype(1:80),'(80a)') ' '
465              write(weighttype(1:80),'(a)') "wedtaux"
466              call ctrl_set_pack_xyz(
467         &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
468         &         weighttype, wedtaux, lxxadxx, mythid)
469    
470              ivartype = 26
471              write(weighttype(1:80),'(80a)') ' '
472              write(weighttype(1:80),'(a)') "wedtauy"
473              call ctrl_set_pack_xyz(
474         &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskCtrlS",
475         &         weighttype, wedtauy, lxxadxx, mythid)
476    #endif
477    
478    #ifdef ALLOW_UVEL0_CONTROL
479              ivartype = 27
480              write(weighttype(1:80),'(80a)') ' '
481              write(weighttype(1:80),'(a)') "wuvel"
482              call ctrl_set_pack_xyz(
483         &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
484         &         weighttype, wuvel, lxxadxx, mythid)
485    #endif
486    
487    #ifdef ALLOW_VVEL0_CONTROL
488              ivartype = 28
489              write(weighttype(1:80),'(80a)') ' '
490              write(weighttype(1:80),'(a)') "wvvel"
491              call ctrl_set_pack_xyz(
492         &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
493         &         weighttype, wvvel, lxxadxx, mythid)
494    #endif
495    
496    #ifdef ALLOW_ETAN0_CONTROL
497              ivartype = 29
498              write(weighttype(1:80),'(80a)') ' '
499              write(weighttype(1:80),'(a)') "wetan"
500              call ctrl_set_pack_xy(
501         &         cunit, ivartype, fname_etan(ictrlgrad),
502         &         "maskCtrlC", weighttype, lxxadxx, mythid)
503    #endif
504    
505    #ifdef ALLOW_RELAXSST_CONTROL
506              ivartype = 30
507              write(weighttype(1:80),'(80a)') ' '
508              write(weighttype(1:80),'(a)') "wrelaxsst"
509              call ctrl_set_pack_xy(
510         &         cunit, ivartype, fname_relaxsst(ictrlgrad),
511         &         "maskCtrlC", weighttype, lxxadxx, mythid)
512    #endif
513    
514    #ifdef ALLOW_RELAXSSS_CONTROL
515              ivartype = 31
516              write(weighttype(1:80),'(80a)') ' '
517              write(weighttype(1:80),'(a)') "wrelaxsss"
518              call ctrl_set_pack_xy(
519         &         cunit, ivartype, fname_relaxsss(ictrlgrad),
520         &         "maskCtrlC", weighttype, lxxadxx, mythid)
521    #endif
522    
523    #ifdef ALLOW_PRECIP_CONTROL
524              ivartype = 32
525              write(weighttype(1:80),'(80a)') ' '
526              write(weighttype(1:80),'(a)') "wprecip"
527              call ctrl_set_pack_xy(
528         &         cunit, ivartype, fname_precip(ictrlgrad),
529         &         "maskCtrlC", weighttype, lxxadxx, mythid)
530    #endif
531    
532    #ifdef ALLOW_SWFLUX_CONTROL
533              ivartype = 33
534              write(weighttype(1:80),'(80a)') ' '
535              write(weighttype(1:80),'(a)') "wswflux"
536              call ctrl_set_pack_xy(
537         &         cunit, ivartype, fname_swflux(ictrlgrad),
538         &         "maskCtrlC", weighttype, lxxadxx, mythid)
539    #endif
540    
541    #ifdef ALLOW_SWDOWN_CONTROL
542              ivartype = 34
543              write(weighttype(1:80),'(80a)') ' '
544              write(weighttype(1:80),'(a)') "wswdown"
545              call ctrl_set_pack_xy(
546         &         cunit, ivartype, fname_swdown(ictrlgrad),
547         &         "maskCtrlC", weighttype, lxxadxx, mythid)
548    #endif
549    
550    #ifdef ALLOW_LWFLUX_CONTROL
551              ivartype = 35
552              write(weighttype(1:80),'(80a)') ' '
553              write(weighttype(1:80),'(a)') "wlwflux"
554              call ctrl_set_pack_xy(
555         &         cunit, ivartype, fname_lwflux(ictrlgrad),
556         &         "maskCtrlC", weighttype, lxxadxx, mythid)
557    #endif
558    
559    #ifdef ALLOW_LWDOWN_CONTROL
560              ivartype = 36
561              write(weighttype(1:80),'(80a)') ' '
562              write(weighttype(1:80),'(a)') "wlwdown"
563              call ctrl_set_pack_xy(
564         &         cunit, ivartype, fname_lwdown(ictrlgrad),
565         &         "maskCtrlC", weighttype, lxxadxx, mythid)
566    #endif
567    
568    #ifdef ALLOW_EVAP_CONTROL
569              ivartype = 37
570              write(weighttype(1:80),'(80a)') ' '
571              write(weighttype(1:80),'(a)') "wevap"
572              call ctrl_set_pack_xy(
573         &         cunit, ivartype, fname_evap(ictrlgrad),
574         &         "maskCtrlC", weighttype, lxxadxx, mythid)
575    #endif
576    
577    #ifdef ALLOW_SNOWPRECIP_CONTROL
578              ivartype = 38
579              write(weighttype(1:80),'(80a)') ' '
580              write(weighttype(1:80),'(a)') "wsnowprecip"
581              call ctrl_set_pack_xy(
582         &         cunit, ivartype, fname_snowprecip(ictrlgrad),
583         &         "maskCtrlC", weighttype, lxxadxx, mythid)
584    #endif
585    
586    #ifdef ALLOW_APRESSURE_CONTROL
587              ivartype = 39
588              write(weighttype(1:80),'(80a)') ' '
589              write(weighttype(1:80),'(a)') "wapressure"
590              call ctrl_set_pack_xy(
591         &         cunit, ivartype, fname_apressure(ictrlgrad),
592         &         "maskCtrlC", weighttype, lxxadxx, mythid)
593    #endif
594    
595          _END_MASTER( mythid )  #ifdef ALLOW_RUNOFF_CONTROL
596              ivartype = 40
597              write(weighttype(1:80),'(80a)') ' '
598              write(weighttype(1:80),'(a)') "wrunoff"
599              call ctrl_set_pack_xy(
600         &         cunit, ivartype, fname_runoff(ictrlgrad),
601         &         "maskCtrlC", weighttype, lxxadxx, mythid)
602    #endif
603    
604    #ifdef ALLOW_SIAREA_CONTROL
605              ivartype = 41
606              write(weighttype(1:80),'(80a)') ' '
607              write(weighttype(1:80),'(a)') "wunit"
608              call ctrl_set_pack_xy(
609         &         cunit, ivartype, fname_siarea(ictrlgrad),
610         &         "maskCtrlC", weighttype, lxxadxx, mythid)
611    #endif
612    
613    #ifdef ALLOW_SIHEFF_CONTROL
614              ivartype = 42
615              write(weighttype(1:80),'(80a)') ' '
616              write(weighttype(1:80),'(a)') "wunit"
617              call ctrl_set_pack_xy(
618         &         cunit, ivartype, fname_siheff(ictrlgrad),
619         &         "maskCtrlC", weighttype, lxxadxx, mythid)
620    #endif
621    
622    #ifdef ALLOW_SIHSNOW_CONTROL
623              ivartype = 43
624              write(weighttype(1:80),'(80a)') ' '
625              write(weighttype(1:80),'(a)') "wunit"
626              call ctrl_set_pack_xy(
627         &         cunit, ivartype, fname_sihsnow(ictrlgrad),
628         &         "maskCtrlC", weighttype, lxxadxx, mythid)
629    #endif
630    
631    #ifdef ALLOW_KAPREDI_CONTROL
632              ivartype = 44
633              write(weighttype(1:80),'(80a)') ' '
634              write(weighttype(1:80),'(a)') "wkapredi"
635              call ctrl_set_pack_xyz(
636         &         cunit, ivartype, fname_kapredi(ictrlgrad), "maskCtrlC",
637         &         weighttype, wkapredi, lxxadxx, mythid)
638    #endif
639    
640    #ifdef ALLOW_SHIFWFLX_CONTROL
641              ivartype = 45
642              write(weighttype(1:80),'(80a)') ' '
643              write(weighttype(1:80),'(a)') "wshifwflx"
644              call ctrl_set_pack_xy(
645         &         cunit, ivartype, fname_shifwflx(ictrlgrad),
646         &         "maskCtrlI", weighttype, lxxadxx, mythid)
647    #endif
648    
649    #ifdef ALLOW_PACKUNPACK_METHOD2
650          _BEGIN_MASTER( mythid )
651          IF ( myProcId .eq. 0 ) THEN
652    #endif
653    
654           close ( cunit )
655           ENDIF !IF ( myProcId .eq. 0 )
656           _END_MASTER( mythid )
657          _BARRIER
658    #endif /* (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) */
659  #endif /* EXCLUDE_CTRL_PACK */  #endif /* EXCLUDE_CTRL_PACK */
660    
661        return        return
662        end        end
   
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.42
  ViewVC Help
Powered by ViewVC 1.1.22