/[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.13 by heimbach, Fri May 28 16:04:42 2004 UTC revision 1.30 by heimbach, Thu Jun 21 04:06:21 2007 UTC
# Line 1  Line 1 
 C  
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
# Line 43  c     == global variables == Line 42  c     == global variables ==
42  #include "GRID.h"  #include "GRID.h"
43    
44  #include "ctrl.h"  #include "ctrl.h"
45  #include "cost.h"  #include "optim.h"
46    
47    #ifdef ALLOW_COST
48    # include "cost.h"
49    #endif
50  #ifdef ALLOW_ECCO  #ifdef ALLOW_ECCO
51  # include "ecco_cost.h"  # include "ecco_cost.h"
52  #else  #else
53  # include "ctrl_weights.h"  # include "ctrl_weights.h"
54  #endif  #endif
55    
 #ifdef ALLOW_ECCO_OPTIMIZATION  
 # include "optim.h"  
 #endif  
   
56  c     == routine arguments ==  c     == routine arguments ==
57    
58        logical first        logical first
# Line 63  c     == routine arguments == Line 61  c     == routine arguments ==
61  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
62  c     == local variables ==  c     == local variables ==
63    
 #ifndef ALLOW_ECCO_OPTIMIZATION  
       integer optimcycle  
       _RL    fmin  
 #endif  
   
64        _RL    fcloc        _RL    fcloc
65    
66        integer i, j, k        integer i, j, k
# Line 97  c     == external == Line 90  c     == external ==
90  c     == end of interface ==  c     == end of interface ==
91    
92  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
       optimcycle = 0  
93        fmin       = 0. _d 0        fmin       = 0. _d 0
94  #endif  #endif
95    
# Line 107  c--   Tiled files are used. Line 99  c--   Tiled files are used.
99  c--   Initialise adjoint variables on active files.  c--   Initialise adjoint variables on active files.
100        ladinit = .false.        ladinit = .false.
101    
102    c--   Initialise global buffer index
103          nbuffglobal = 0
104    
105  c--   Assign file names.  c--   Assign file names.
106    
107        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
# Line 117  c--   Assign file names. Line 112  c--   Assign file names.
112        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
113        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
114        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
115          call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
116          call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
117          call ctrl_set_fname(xx_swdown_file, fname_swdown, mythid)
118          call ctrl_set_fname(xx_lwflux_file, fname_lwflux, mythid)
119          call ctrl_set_fname(xx_lwdown_file, fname_lwdown, mythid)
120          call ctrl_set_fname(xx_evap_file, fname_evap, mythid)
121          call ctrl_set_fname(xx_snowprecip_file, fname_snowprecip, mythid)
122          call ctrl_set_fname(xx_apressure_file, fname_apressure, mythid)
123          call ctrl_set_fname(xx_runoff_file, fname_runoff, mythid)
124    
125        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
126        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
127        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
# Line 128  c--   Assign file names. Line 133  c--   Assign file names.
133        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
134        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
135        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
136        call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)        call ctrl_set_fname(xx_depth_file, fname_depth, mythid)
137        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
138        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
139        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
140          call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
141          call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
142          call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
143          call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
144          call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
145          call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
146          call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
147          call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)
148          call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)
149          call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)
150    
151  c  c--   Only the master thread will do I/O.
 c--     Only the master thread will do I/O.  
152        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
153    
154        if ( first ) then        if ( first ) then
# Line 145  c     >>> Initialise control vector for Line 159  c     >>> Initialise control vector for
159            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
160       &         ctrlname(1:9),'_',yctrlid(1:10),       &         ctrlname(1:9),'_',yctrlid(1:10),
161       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
162            print *, 'ph-pack: unpacking ', ctrlname(1:9)            print *, 'ph-pack: packing ', ctrlname(1:9)
163        else        else
164  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
165            lxxadxx   = .FALSE.            lxxadxx   = .FALSE.
# Line 154  c     >>> Write gradient vector <<< Line 168  c     >>> Write gradient vector <<<
168            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
169       &         costname(1:9),'_',yctrlid(1:10),       &         costname(1:9),'_',yctrlid(1:10),
170       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
171            print *, 'ph-pack: unpacking ', costname(1:9)            print *, 'ph-pack: packing ', costname(1:9)
172         endif         endif
173    
174         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
# Line 164  c     >>> Write gradient vector <<< Line 178  c     >>> Write gradient vector <<<
178       &      access  = 'sequential'   )       &      access  = 'sequential'   )
179    
180  c--       Header information.  c--       Header information.
181            write(cunit) filenvartype            write(cunit) nvartype
182            write(cunit) filenvarlength            write(cunit) nvarlength
183            write(cunit) fileyctrlid            write(cunit) yctrlid
184            write(cunit) fileoptimCycle            write(cunit) optimCycle
185            write(cunit) filefc            write(cunit) fc
186            write(cunit) fileIg  C     place holder of obsolete variable iG
187            write(cunit) fileJg            write(cunit) 1
188            write(cunit) filensx  C     place holder of obsolete variable jG
189            write(cunit) filensy            write(cunit) 1
190            write(cunit) (filenWetcGlobal(k), k=1,nr)            write(cunit) nsx
191            write(cunit) (filenWetsGlobal(k), k=1,nr)            write(cunit) nsy
192            write(cunit) (filenWetwGlobal(k), k=1,nr)            write(cunit) (nWetcGlobal(k), k=1,nr)
193              write(cunit) (nWetsGlobal(k), k=1,nr)
194              write(cunit) (nWetwGlobal(k), k=1,nr)
195  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
196            write(cunit) (filenWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
197  #endif  #endif
198    
199  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 192  c--       Header information. Line 208  c--       Header information.
208  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
209            write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)            write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
210  #endif  #endif
211            write(cunit) (filencvarindex(i), i=1,maxcvars)            write(cunit) (ncvarindex(i), i=1,maxcvars)
212            write(cunit) (filencvarrecs(i),  i=1,maxcvars)            write(cunit) (ncvarrecs(i),  i=1,maxcvars)
213            write(cunit) (filencvarxmax(i),  i=1,maxcvars)            write(cunit) (ncvarxmax(i),  i=1,maxcvars)
214            write(cunit) (filencvarymax(i),  i=1,maxcvars)            write(cunit) (ncvarymax(i),  i=1,maxcvars)
215            write(cunit) (filencvarnrmax(i), i=1,maxcvars)            write(cunit) (ncvarnrmax(i), i=1,maxcvars)
216            write(cunit) (filencvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
217            write(cunit)            write(cunit)
218    
219  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
220            ivartype = 1            ivartype = 1
221            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
222            write(weighttype(1:80),'(a)') "wtheta"            write(weighttype(1:80),'(a)') "wthetaLev"
223            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
224       &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_theta(ictrlgrad), "maskCtrlC",
225       &         weighttype, wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
226  #endif  #endif
227    
228  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
229            ivartype = 2            ivartype = 2
230            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
231            write(weighttype(1:80),'(a)') "wsalt"            write(weighttype(1:80),'(a)') "wsaltLev"
232            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
233       &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_salt(ictrlgrad), "maskCtrlC",
234       &         weighttype, wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
235  #endif  #endif
236    
237  #if (defined (ALLOW_HFLUX_CONTROL) || \  #if (defined (ALLOW_HFLUX_CONTROL) || defined (ALLOW_HFLUX0_CONTROL))
      defined (ALLOW_HFLUX0_CONTROL))  
238            ivartype = 3            ivartype = 3
239            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
240            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
241            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
242       &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",
243       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
244  #endif  #endif
245    
246  #if (defined (ALLOW_SFLUX_CONTROL) || \  #if (defined (ALLOW_SFLUX_CONTROL) || defined (ALLOW_SFLUX0_CONTROL))
      defined (ALLOW_SFLUX0_CONTROL))  
247            ivartype = 4            ivartype = 4
248            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
249            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
250            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
251       &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",
252       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
253  #endif  #endif
254    
255  #if (defined (ALLOW_USTRESS_CONTROL) || \  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
      defined (ALLOW_TAUU0_CONTROL))  
256            ivartype = 5            ivartype = 5
257            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
258            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
259            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
260       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
261       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
262  #endif  #endif
263    
264  #if (defined (ALLOW_VSTRESS_CONTROL) || \  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
      defined (ALLOW_TAUV0_CONTROL))  
265            ivartype = 6            ivartype = 6
266            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
267            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
268            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
269       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
270       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
271  #endif  #endif
272    
# Line 263  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)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
277            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
278       &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",
279       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
280  #endif  #endif
281    
# Line 272  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)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
286            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
287       &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",
288       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
289  #endif  #endif
290    
# Line 281  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)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
295            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
296       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
297       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
298  #endif  #endif
299    
# Line 290  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)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
304            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
305       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
306       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
307  #endif  #endif
308    
# Line 335  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)') "wdiffkr"            write(weighttype(1:80),'(a)') "wdiffkr"
349            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
350       &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_diffkr(ictrlgrad), "maskCtrlC",
351       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wdiffkr, lxxadxx, mythid)
352  #endif  #endif
353    
354  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
# Line 344  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)') "wkapgm"            write(weighttype(1:80),'(a)') "wkapgm"
358            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
359       &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_kapgm(ictrlgrad), "maskCtrlC",
360       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wkapgm, lxxadxx, mythid)
361  #endif  #endif
362    
363  #ifdef ALLOW_TR10_CONTROL  #ifdef ALLOW_TR10_CONTROL
# Line 353  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)') "wtr1"            write(weighttype(1:80),'(a)') "wtr1"
367            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
368       &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_tr1(ictrlgrad), "maskCtrlC",
369       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
370  #endif  #endif
371    
372  #ifdef ALLOW_SST0_CONTROL  #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
373            ivartype = 18            ivartype = 18
374            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
375            write(weighttype(1:80),'(a)') "wsst0"            write(weighttype(1:80),'(a)') "wsst"
376            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
377       &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",
378       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
379  #endif  #endif
380    
381  #ifdef ALLOW_SSS0_CONTROL  #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
382            ivartype = 19            ivartype = 19
383            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
384            write(weighttype(1:80),'(a)') "wsss0"            write(weighttype(1:80),'(a)') "wsss"
385            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
386       &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sss(ictrlgrad),
387       &         weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
388  #endif  #endif
389    
390  #ifdef ALLOW_HFACC_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
391            ivartype = 20            ivartype = 20
392            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
393            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  
394            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
395       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_depth(ictrlgrad),
396       &         weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
397  # endif  #endif /* ALLOW_DEPTH_CONTROL */
 #endif  
398    
399  #ifdef ALLOW_EFLUXY0_CONTROL  #ifdef ALLOW_EFLUXY0_CONTROL
400            ivartype = 21            ivartype = 21
401            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
402            write(weighttype(1:80),'(a)') "wefluxy0"            write(weighttype(1:80),'(a)') "wefluxy0"
403            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
404       &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",       &         cunit, ivartype, fname_efluxy(ictrlgrad), "maskCtrlS",
405       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
406  #endif  #endif
407    
# Line 404  c--       Header information. Line 410  c--       Header information.
410            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
411            write(weighttype(1:80),'(a)') "wefluxp0"            write(weighttype(1:80),'(a)') "wefluxp0"
412            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
413       &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",       &         cunit, ivartype, fname_efluxp(ictrlgrad), "maskhFacV",
414       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
415  #endif  #endif
416    
# Line 413  c--       Header information. Line 419  c--       Header information.
419            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
420            write(weighttype(1:80),'(a)') "wbottomdrag"            write(weighttype(1:80),'(a)') "wbottomdrag"
421            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
422       &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",       &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",
423       &         weighttype, lxxadxx, mythid)       &      weighttype, lxxadxx, mythid)
424    #endif
425    
426    #ifdef ALLOW_EDTAUX_CONTROL
427              ivartype = 25
428              write(weighttype(1:80),'(80a)') ' '
429              write(weighttype(1:80),'(a)') "wedtaux"
430              call ctrl_set_pack_xyz(
431         &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
432         &         weighttype, wedtaux, lxxadxx, mythid)
433    #endif
434    
435    #ifdef ALLOW_EDTAUY_CONTROL
436              ivartype = 26
437              write(weighttype(1:80),'(80a)') ' '
438              write(weighttype(1:80),'(a)') "wedtauy"
439              call ctrl_set_pack_xyz(
440         &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskCtrlS",
441         &         weighttype, wedtauy, lxxadxx, mythid)
442    #endif
443    
444    #ifdef ALLOW_UVEL0_CONTROL
445              ivartype = 27
446              write(weighttype(1:80),'(80a)') ' '
447              write(weighttype(1:80),'(a)') "wuvel"
448              call ctrl_set_pack_xyz(
449         &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
450         &         weighttype, wunit, lxxadxx, mythid)
451    #endif
452    
453    #ifdef ALLOW_VVEL0_CONTROL
454              ivartype = 28
455              write(weighttype(1:80),'(80a)') ' '
456              write(weighttype(1:80),'(a)') "wvvel"
457              call ctrl_set_pack_xyz(
458         &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
459         &         weighttype, wunit, lxxadxx, mythid)
460    #endif
461    
462    #ifdef ALLOW_ETAN0_CONTROL
463              ivartype = 29
464              write(weighttype(1:80),'(80a)') ' '
465              write(weighttype(1:80),'(a)') "wetan"
466              call ctrl_set_pack_xy(
467         &         cunit, ivartype, fname_etan(ictrlgrad),
468         &         "maskCtrlC", weighttype, lxxadxx, mythid)
469    #endif
470    
471    #ifdef ALLOW_RELAXSST_CONTROL
472              ivartype = 30
473              write(weighttype(1:80),'(80a)') ' '
474              write(weighttype(1:80),'(a)') "wrelaxsst"
475              call ctrl_set_pack_xy(
476         &         cunit, ivartype, fname_relaxsst(ictrlgrad),
477         &         "maskCtrlC", weighttype, lxxadxx, mythid)
478    #endif
479    
480    #ifdef ALLOW_RELAXSSS_CONTROL
481              ivartype = 31
482              write(weighttype(1:80),'(80a)') ' '
483              write(weighttype(1:80),'(a)') "wrelaxsss"
484              call ctrl_set_pack_xy(
485         &         cunit, ivartype, fname_relaxsss(ictrlgrad),
486         &         "maskCtrlC", weighttype, lxxadxx, mythid)
487    #endif
488    
489    #ifdef ALLOW_PRECIP_CONTROL
490              ivartype = 32
491              write(weighttype(1:80),'(80a)') ' '
492              write(weighttype(1:80),'(a)') "wprecip"
493              call ctrl_set_pack_xy(
494         &         cunit, ivartype, fname_precip(ictrlgrad),
495         &         "maskCtrlC", weighttype, lxxadxx, mythid)
496    #endif
497    
498    #ifdef ALLOW_SWFLUX_CONTROL
499              ivartype = 33
500              write(weighttype(1:80),'(80a)') ' '
501              write(weighttype(1:80),'(a)') "wswflux"
502              call ctrl_set_pack_xy(
503         &         cunit, ivartype, fname_swflux(ictrlgrad),
504         &         "maskCtrlC", weighttype, lxxadxx, mythid)
505    #endif
506    
507    #ifdef ALLOW_SWDOWN_CONTROL
508              ivartype = 34
509              write(weighttype(1:80),'(80a)') ' '
510              write(weighttype(1:80),'(a)') "wswdown"
511              call ctrl_set_pack_xy(
512         &         cunit, ivartype, fname_swdown(ictrlgrad),
513         &         "maskCtrlC", weighttype, lxxadxx, mythid)
514    #endif
515    
516    #ifdef ALLOW_LWFLUX_CONTROL
517              ivartype = 35
518              write(weighttype(1:80),'(80a)') ' '
519              write(weighttype(1:80),'(a)') "wlwflux"
520              call ctrl_set_pack_xy(
521         &         cunit, ivartype, fname_lwflux(ictrlgrad),
522         &         "maskCtrlC", weighttype, lxxadxx, mythid)
523    #endif
524    
525    #ifdef ALLOW_LWDOWN_CONTROL
526              ivartype = 36
527              write(weighttype(1:80),'(80a)') ' '
528              write(weighttype(1:80),'(a)') "wlwdown"
529              call ctrl_set_pack_xy(
530         &         cunit, ivartype, fname_lwdown(ictrlgrad),
531         &         "maskCtrlC", weighttype, lxxadxx, mythid)
532    #endif
533    
534    #ifdef ALLOW_EVAP_CONTROL
535              ivartype = 37
536              write(weighttype(1:80),'(80a)') ' '
537              write(weighttype(1:80),'(a)') "wevap"
538              call ctrl_set_pack_xy(
539         &         cunit, ivartype, fname_evap(ictrlgrad),
540         &         "maskCtrlC", weighttype, lxxadxx, mythid)
541    #endif
542    
543    #ifdef ALLOW_SNOWPRECIP_CONTROL
544              ivartype = 38
545              write(weighttype(1:80),'(80a)') ' '
546              write(weighttype(1:80),'(a)') "wsnowprecip"
547              call ctrl_set_pack_xy(
548         &         cunit, ivartype, fname_snowprecip(ictrlgrad),
549         &         "maskCtrlC", weighttype, lxxadxx, mythid)
550    #endif
551    
552    #ifdef ALLOW_APRESSURE_CONTROL
553              ivartype = 39
554              write(weighttype(1:80),'(80a)') ' '
555              write(weighttype(1:80),'(a)') "wapressure"
556              call ctrl_set_pack_xy(
557         &         cunit, ivartype, fname_apressure(ictrlgrad),
558         &         "maskCtrlC", weighttype, lxxadxx, mythid)
559    #endif
560    
561    #ifdef ALLOW_RUNOFF_CONTROL
562              ivartype = 40
563              write(weighttype(1:80),'(80a)') ' '
564              write(weighttype(1:80),'(a)') "wrunoff"
565              call ctrl_set_pack_xy(
566         &         cunit, ivartype, fname_runoff(ictrlgrad),
567         &         "maskCtrlC", weighttype, lxxadxx, mythid)
568    #endif
569    
570    #ifdef ALLOW_SIAREA_CONTROL
571              ivartype = 41
572              write(weighttype(1:80),'(80a)') ' '
573              write(weighttype(1:80),'(a)') "wunit"
574              call ctrl_set_pack_xy(
575         &         cunit, ivartype, fname_siarea(ictrlgrad),
576         &         "maskCtrlC", weighttype, lxxadxx, mythid)
577    #endif
578    
579    #ifdef ALLOW_SIHEFF_CONTROL
580              ivartype = 42
581              write(weighttype(1:80),'(80a)') ' '
582              write(weighttype(1:80),'(a)') "wunit"
583              call ctrl_set_pack_xy(
584         &         cunit, ivartype, fname_siheff(ictrlgrad),
585         &         "maskCtrlC", weighttype, lxxadxx, mythid)
586    #endif
587    
588    #ifdef ALLOW_SIHSNOW_CONTROL
589              ivartype = 43
590              write(weighttype(1:80),'(80a)') ' '
591              write(weighttype(1:80),'(a)') "wunit"
592              call ctrl_set_pack_xy(
593         &         cunit, ivartype, fname_sihsnow(ictrlgrad),
594         &         "maskCtrlC", weighttype, lxxadxx, mythid)
595  #endif  #endif
596    
597            close ( cunit )            close ( cunit )
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.30
  ViewVC Help
Powered by ViewVC 1.1.22