/[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.47 by jmc, Wed Sep 12 22:20:06 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    #ifdef ALLOW_EXF
7    # include "EXF_OPTIONS.h"
8    #endif
9    
10        subroutine ctrl_pack( first, mythid )        subroutine ctrl_pack( first, mythid )
11    
# Line 18  c Line 21  c
21  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
22  c              - Transferred some filename declarations  c              - Transferred some filename declarations
23  c                from here to namelist in ctrl_init  c                from here to namelist in ctrl_init
24  c    c
25  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000
26  c              - single file name convention with or without  c              - single file name convention with or without
27  c                ALLOW_ECCO_OPTIMIZATION  c                ALLOW_ECCO_OPTIMIZATION
# Line 42  c     == global variables == Line 45  c     == global variables ==
45  #include "GRID.h"  #include "GRID.h"
46    
47  #include "ctrl.h"  #include "ctrl.h"
48    #include "CTRL_SIZE.h"
49    #include "CTRL_GENARR.h"
50  #include "optim.h"  #include "optim.h"
51    
52  #ifdef ALLOW_COST  #ifdef ALLOW_COST
# Line 52  c     == global variables == Line 57  c     == global variables ==
57  #else  #else
58  # include "ctrl_weights.h"  # include "ctrl_weights.h"
59  #endif  #endif
60    #ifdef ALLOW_EXF
61    # include "EXF_PARAM.h"
62    #endif
63    
64  c     == routine arguments ==  c     == routine arguments ==
   
65        logical first        logical first
66        integer mythid        integer mythid
67    
68  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
69    #if (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN))
70    c     == external ==
71          integer  ilnblnk
72          external ilnblnk
73    
74  c     == local variables ==  c     == local variables ==
75    
76        _RL    fcloc        _RL    fcloc
# Line 70  c     == local variables == Line 82  c     == local variables ==
82        integer ig,jg        integer ig,jg
83        integer ivartype        integer ivartype
84        integer iobcs        integer iobcs
85    #if (defined ALLOW_GENARR2D_CONTROL) || (defined ALLOW_GENARR3D_CONTROL)
86    C-    Providing we set the file-name just before calling ctrl_set_pack,
87    C     the same local file-name variable can be used for different variables.
88    C     This is how GENARR2/3D_CONTROL is implemented (+ provides an example)
89          integer iarr
90          character*(80) fname_local(3)
91    #endif
92    
93        logical doglobalread        logical doglobalread
94        logical ladinit        logical ladinit
95        integer cbuffindex        integer cbuffindex
96        logical lxxadxx        logical lxxadxx
97          
98        integer cunit        integer cunit
99        integer ictrlgrad        integer ictrlgrad
100    
101        character*(128) cfile        character*(128) cfile
102        character*( 80) weighttype        character*( 80) weighttype
103    
 c     == external ==  
   
       integer  ilnblnk  
       external ilnblnk  
   
104  c     == end of interface ==  c     == end of interface ==
105    
106  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
# Line 112  c--   Assign file names. Line 126  c--   Assign file names.
126        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
127        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
128        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
129          call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
130          call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
131          call ctrl_set_fname(xx_swdown_file, fname_swdown, mythid)
132          call ctrl_set_fname(xx_lwflux_file, fname_lwflux, mythid)
133          call ctrl_set_fname(xx_lwdown_file, fname_lwdown, mythid)
134          call ctrl_set_fname(xx_evap_file, fname_evap, mythid)
135          call ctrl_set_fname(xx_snowprecip_file, fname_snowprecip, mythid)
136          call ctrl_set_fname(xx_apressure_file, fname_apressure, mythid)
137          call ctrl_set_fname(xx_runoff_file, fname_runoff, mythid)
138        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
139        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
140        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 143  c--   Assign file names.
143        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
144        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
145        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
146          call ctrl_set_fname(xx_kapredi_file, fname_kapredi, mythid)
147        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
148        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
149        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
150        call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)        call ctrl_set_fname(xx_depth_file, fname_depth, mythid)
151        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
152        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
153        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
154          call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
155          call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
156          call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
157          call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
158          call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
159          call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
160          call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
161          call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)
162          call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)
163          call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)
164          call ctrl_set_fname(xx_shifwflx_file, fname_shifwflx, mythid)
165    cHFLUXM_CONTROL
166          call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid)
167    cHFLUXM_CONTROL
168    
169  c  c--   Only the master thread will do I/O.
 c--     Only the master thread will do I/O.  
170        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
171    
172        if ( first ) then        if ( first ) then
# Line 138  c     >>> Initialise control vector for Line 175  c     >>> Initialise control vector for
175            ictrlgrad = 1            ictrlgrad = 1
176            fcloc     = fmin            fcloc     = fmin
177            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
178       &         ctrlname(1:9),'_',yctrlid(1:10),       &         ctrlname(1:9),'_',yctrlid(1:10),
179       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
180            print *, 'ph-pack: packing ', ctrlname(1:9)            print *, 'ph-pack: packing ', ctrlname(1:9)
181        else        else
182  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
183            lxxadxx   = .FALSE.            lxxadxx   = .FALSE.
184            ictrlgrad = 2            ictrlgrad = 2
185    #ifdef ALLOW_AUTODIFF_OPENAD
186              fcloc     = fc%v
187    #else
188            fcloc     = fc            fcloc     = fc
189    #endif
190            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
191       &         costname(1:9),'_',yctrlid(1:10),       &         costname(1:9),'_',yctrlid(1:10),
192       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
193            print *, 'ph-pack: packing ', costname(1:9)            print *, 'ph-pack: packing ', costname(1:9)
194         endif         endif
195    
196    c--   Only Proc 0 will do I/O.
197          IF ( myProcId .eq. 0 ) THEN
198    
199         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
200         open( cunit, file   = cfile,         open( cunit, file   = cfile,
201       &      status = 'unknown',       &      status = 'unknown',
# Line 176  C     place holder of obsolete variable Line 220  C     place holder of obsolete variable
220  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
221            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
222  #endif  #endif
223    #ifdef ALLOW_SHIFWFLX_CONTROL
224              write(cunit) (nWetiGlobal(k), k=1,nr)
225    c          write(cunit) nWetiGlobal(1)
226    #endif
227    
228  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
229            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 245  C     place holder of obsolete variable
245            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
246            write(cunit)            write(cunit)
247    
248    #ifdef ALLOW_PACKUNPACK_METHOD2
249          ENDIF
250          _END_MASTER( mythid )
251          _BARRIER
252    #endif
253    
254  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
255            ivartype = 1            ivartype = 1
256            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
257            write(weighttype(1:80),'(a)') "wtheta"            write(weighttype(1:80),'(a)') "wthetaLev"
258            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
259       &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_theta(ictrlgrad), "maskCtrlC",
260       &         weighttype, wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
261  #endif  #endif
262    
263  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
264            ivartype = 2            ivartype = 2
265            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
266            write(weighttype(1:80),'(a)') "wsalt"            write(weighttype(1:80),'(a)') "wsaltLev"
267            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
268       &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_salt(ictrlgrad), "maskCtrlC",
269       &         weighttype, wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
270  #endif  #endif
271    
272  #if (defined (ALLOW_HFLUX_CONTROL) || \  #if (defined (ALLOW_HFLUX_CONTROL) || defined (ALLOW_HFLUX0_CONTROL))
      defined (ALLOW_HFLUX0_CONTROL))  
273            ivartype = 3            ivartype = 3
274            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
275            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
276            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
277       &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",
278       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
279  #endif  #endif
280    
281  #if (defined (ALLOW_SFLUX_CONTROL) || \  #if (defined (ALLOW_SFLUX_CONTROL) || defined (ALLOW_SFLUX0_CONTROL))
      defined (ALLOW_SFLUX0_CONTROL))  
282            ivartype = 4            ivartype = 4
283            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
284            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
285            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
286       &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",
287       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
288  #endif  #endif
289    
290  #if (defined (ALLOW_USTRESS_CONTROL) || \  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
291       defined (ALLOW_TAUU0_CONTROL))  #ifdef ALLOW_EXF
292          IF ( .NOT.useAtmWind ) THEN
293    #endif
294            ivartype = 5            ivartype = 5
295            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
296            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
297            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
298       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",  #ifndef ALLOW_ROTATE_UV_CONTROLS
299         &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
300    #else
301         &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlC",
302    #endif
303       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
304    #ifdef ALLOW_EXF
305          ENDIF
306    #endif
307  #endif  #endif
308    
309  #if (defined (ALLOW_VSTRESS_CONTROL) || \  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
310       defined (ALLOW_TAUV0_CONTROL))  #ifdef ALLOW_EXF
311          IF ( .NOT.useAtmWind ) THEN
312    #endif
313            ivartype = 6            ivartype = 6
314            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
315            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
316            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
317       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",  #ifndef ALLOW_ROTATE_UV_CONTROLS
318         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
319    #else
320         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlC",
321    #endif
322       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
323    #ifdef ALLOW_EXF
324          ENDIF
325    #endif
326  #endif  #endif
327    
328  #ifdef ALLOW_ATEMP_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
# Line 260  C     place holder of obsolete variable Line 330  C     place holder of obsolete variable
330            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
331            write(weighttype(1:80),'(a)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
332            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
333       &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",
334       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
335  #endif  #endif
336    
# Line 269  C     place holder of obsolete variable Line 339  C     place holder of obsolete variable
339            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
340            write(weighttype(1:80),'(a)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
341            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
342       &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",
343       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
344  #endif  #endif
345    
346  #ifdef ALLOW_UWIND_CONTROL  #ifdef ALLOW_UWIND_CONTROL
347    #ifdef ALLOW_EXF
348          IF ( useAtmWind ) THEN
349    #endif
350            ivartype = 9            ivartype = 9
351            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
352            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
353            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
354       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
355       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
356    #ifdef ALLOW_EXF
357          ENDIF
358    #endif
359  #endif  #endif
360    
361  #ifdef ALLOW_VWIND_CONTROL  #ifdef ALLOW_VWIND_CONTROL
362    #ifdef ALLOW_EXF
363          IF ( useAtmWind ) THEN
364    #endif
365            ivartype = 10            ivartype = 10
366            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
367            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
368            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
369       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
370       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
371    #ifdef ALLOW_EXF
372          ENDIF
373    #endif
374  #endif  #endif
375    
376  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 332  C     place holder of obsolete variable Line 414  C     place holder of obsolete variable
414            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
415            write(weighttype(1:80),'(a)') "wdiffkr"            write(weighttype(1:80),'(a)') "wdiffkr"
416            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
417       &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_diffkr(ictrlgrad), "maskCtrlC",
418       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wdiffkr, lxxadxx, mythid)
419  #endif  #endif
420    
421  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
# Line 341  C     place holder of obsolete variable Line 423  C     place holder of obsolete variable
423            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
424            write(weighttype(1:80),'(a)') "wkapgm"            write(weighttype(1:80),'(a)') "wkapgm"
425            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
426       &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_kapgm(ictrlgrad), "maskCtrlC",
427       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wkapgm, lxxadxx, mythid)
428  #endif  #endif
429    
430  #ifdef ALLOW_TR10_CONTROL  #ifdef ALLOW_TR10_CONTROL
# Line 350  C     place holder of obsolete variable Line 432  C     place holder of obsolete variable
432            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
433            write(weighttype(1:80),'(a)') "wtr1"            write(weighttype(1:80),'(a)') "wtr1"
434            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
435       &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_tr1(ictrlgrad), "maskCtrlC",
436       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
437  #endif  #endif
438    
439  #ifdef ALLOW_SST0_CONTROL  #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
440            ivartype = 18            ivartype = 18
441            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
442            write(weighttype(1:80),'(a)') "wsst0"            write(weighttype(1:80),'(a)') "wsst"
443            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
444       &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",
445       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
446  #endif  #endif
447    
448  #ifdef ALLOW_SSS0_CONTROL  #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
449            ivartype = 19            ivartype = 19
450            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
451            write(weighttype(1:80),'(a)') "wsss0"            write(weighttype(1:80),'(a)') "wsss"
452            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
453       &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_sss(ictrlgrad),
454       &         weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
455  #endif  #endif
456    
457  #ifdef ALLOW_HFACC_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
458            ivartype = 20            ivartype = 20
459            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
460            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  
461            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
462       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",       &         cunit, ivartype, fname_depth(ictrlgrad),
463       &         weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
464  # endif  #endif /* ALLOW_DEPTH_CONTROL */
 #endif  
465    
466  #ifdef ALLOW_EFLUXY0_CONTROL  #ifdef ALLOW_EFLUXY0_CONTROL
467            ivartype = 21            ivartype = 21
468            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
469            write(weighttype(1:80),'(a)') "wefluxy0"            write(weighttype(1:80),'(a)') "wefluxy0"
470            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
471       &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",       &         cunit, ivartype, fname_efluxy(ictrlgrad), "maskCtrlS",
472       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
473  #endif  #endif
474    
# Line 401  C     place holder of obsolete variable Line 477  C     place holder of obsolete variable
477            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
478            write(weighttype(1:80),'(a)') "wefluxp0"            write(weighttype(1:80),'(a)') "wefluxp0"
479            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
480       &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",       &         cunit, ivartype, fname_efluxp(ictrlgrad), "maskhFacV",
481       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
482  #endif  #endif
483    
# Line 410  C     place holder of obsolete variable Line 486  C     place holder of obsolete variable
486            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
487            write(weighttype(1:80),'(a)') "wbottomdrag"            write(weighttype(1:80),'(a)') "wbottomdrag"
488            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
489       &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",       &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",
490         &      weighttype, lxxadxx, mythid)
491    #endif
492    
493    #ifdef ALLOW_HFLUXM_CONTROL
494              ivartype = 24
495              write(weighttype(1:80),'(80a)') ' '
496              write(weighttype(1:80),'(a)') "whfluxm"
497              call ctrl_set_pack_xy(
498         &         cunit, ivartype, fname_hfluxm(ictrlgrad), "maskCtrlC",
499       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
500  #endif  #endif
501    
502            close ( cunit )  #ifdef ALLOW_EDDYPSI_CONTROL
503              ivartype = 25
504              write(weighttype(1:80),'(80a)') ' '
505              write(weighttype(1:80),'(a)') "wedtaux"
506              call ctrl_set_pack_xyz(
507         &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
508         &         weighttype, wedtaux, lxxadxx, mythid)
509    
510              ivartype = 26
511              write(weighttype(1:80),'(80a)') ' '
512              write(weighttype(1:80),'(a)') "wedtauy"
513              call ctrl_set_pack_xyz(
514         &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskCtrlS",
515         &         weighttype, wedtauy, lxxadxx, mythid)
516    #endif
517    
518    #ifdef ALLOW_UVEL0_CONTROL
519              ivartype = 27
520              write(weighttype(1:80),'(80a)') ' '
521              write(weighttype(1:80),'(a)') "wuvel"
522              call ctrl_set_pack_xyz(
523         &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
524         &         weighttype, wuvel, lxxadxx, mythid)
525    #endif
526    
527    #ifdef ALLOW_VVEL0_CONTROL
528              ivartype = 28
529              write(weighttype(1:80),'(80a)') ' '
530              write(weighttype(1:80),'(a)') "wvvel"
531              call ctrl_set_pack_xyz(
532         &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
533         &         weighttype, wvvel, lxxadxx, mythid)
534    #endif
535    
536    #ifdef ALLOW_ETAN0_CONTROL
537              ivartype = 29
538              write(weighttype(1:80),'(80a)') ' '
539              write(weighttype(1:80),'(a)') "wetan"
540              call ctrl_set_pack_xy(
541         &         cunit, ivartype, fname_etan(ictrlgrad),
542         &         "maskCtrlC", weighttype, lxxadxx, mythid)
543    #endif
544    
545    #ifdef ALLOW_RELAXSST_CONTROL
546              ivartype = 30
547              write(weighttype(1:80),'(80a)') ' '
548              write(weighttype(1:80),'(a)') "wrelaxsst"
549              call ctrl_set_pack_xy(
550         &         cunit, ivartype, fname_relaxsst(ictrlgrad),
551         &         "maskCtrlC", weighttype, lxxadxx, mythid)
552    #endif
553    
554    #ifdef ALLOW_RELAXSSS_CONTROL
555              ivartype = 31
556              write(weighttype(1:80),'(80a)') ' '
557              write(weighttype(1:80),'(a)') "wrelaxsss"
558              call ctrl_set_pack_xy(
559         &         cunit, ivartype, fname_relaxsss(ictrlgrad),
560         &         "maskCtrlC", weighttype, lxxadxx, mythid)
561    #endif
562    
563    #ifdef ALLOW_PRECIP_CONTROL
564              ivartype = 32
565              write(weighttype(1:80),'(80a)') ' '
566              write(weighttype(1:80),'(a)') "wprecip"
567              call ctrl_set_pack_xy(
568         &         cunit, ivartype, fname_precip(ictrlgrad),
569         &         "maskCtrlC", weighttype, lxxadxx, mythid)
570    #endif
571    
572    #ifdef ALLOW_SWFLUX_CONTROL
573              ivartype = 33
574              write(weighttype(1:80),'(80a)') ' '
575              write(weighttype(1:80),'(a)') "wswflux"
576              call ctrl_set_pack_xy(
577         &         cunit, ivartype, fname_swflux(ictrlgrad),
578         &         "maskCtrlC", weighttype, lxxadxx, mythid)
579    #endif
580    
581    #ifdef ALLOW_SWDOWN_CONTROL
582              ivartype = 34
583              write(weighttype(1:80),'(80a)') ' '
584              write(weighttype(1:80),'(a)') "wswdown"
585              call ctrl_set_pack_xy(
586         &         cunit, ivartype, fname_swdown(ictrlgrad),
587         &         "maskCtrlC", weighttype, lxxadxx, mythid)
588    #endif
589    
590          _END_MASTER( mythid )  #ifdef ALLOW_LWFLUX_CONTROL
591              ivartype = 35
592              write(weighttype(1:80),'(80a)') ' '
593              write(weighttype(1:80),'(a)') "wlwflux"
594              call ctrl_set_pack_xy(
595         &         cunit, ivartype, fname_lwflux(ictrlgrad),
596         &         "maskCtrlC", weighttype, lxxadxx, mythid)
597    #endif
598    
599    #ifdef ALLOW_LWDOWN_CONTROL
600              ivartype = 36
601              write(weighttype(1:80),'(80a)') ' '
602              write(weighttype(1:80),'(a)') "wlwdown"
603              call ctrl_set_pack_xy(
604         &         cunit, ivartype, fname_lwdown(ictrlgrad),
605         &         "maskCtrlC", weighttype, lxxadxx, mythid)
606    #endif
607    
608    #ifdef ALLOW_EVAP_CONTROL
609              ivartype = 37
610              write(weighttype(1:80),'(80a)') ' '
611              write(weighttype(1:80),'(a)') "wevap"
612              call ctrl_set_pack_xy(
613         &         cunit, ivartype, fname_evap(ictrlgrad),
614         &         "maskCtrlC", weighttype, lxxadxx, mythid)
615    #endif
616    
617    #ifdef ALLOW_SNOWPRECIP_CONTROL
618              ivartype = 38
619              write(weighttype(1:80),'(80a)') ' '
620              write(weighttype(1:80),'(a)') "wsnowprecip"
621              call ctrl_set_pack_xy(
622         &         cunit, ivartype, fname_snowprecip(ictrlgrad),
623         &         "maskCtrlC", weighttype, lxxadxx, mythid)
624    #endif
625    
626    #ifdef ALLOW_APRESSURE_CONTROL
627              ivartype = 39
628              write(weighttype(1:80),'(80a)') ' '
629              write(weighttype(1:80),'(a)') "wapressure"
630              call ctrl_set_pack_xy(
631         &         cunit, ivartype, fname_apressure(ictrlgrad),
632         &         "maskCtrlC", weighttype, lxxadxx, mythid)
633    #endif
634    
635    #ifdef ALLOW_RUNOFF_CONTROL
636              ivartype = 40
637              write(weighttype(1:80),'(80a)') ' '
638              write(weighttype(1:80),'(a)') "wrunoff"
639              call ctrl_set_pack_xy(
640         &         cunit, ivartype, fname_runoff(ictrlgrad),
641         &         "maskCtrlC", weighttype, lxxadxx, mythid)
642    #endif
643    
644    #ifdef ALLOW_SIAREA_CONTROL
645              ivartype = 41
646              write(weighttype(1:80),'(80a)') ' '
647              write(weighttype(1:80),'(a)') "wunit"
648              call ctrl_set_pack_xy(
649         &         cunit, ivartype, fname_siarea(ictrlgrad),
650         &         "maskCtrlC", weighttype, lxxadxx, mythid)
651    #endif
652    
653    #ifdef ALLOW_SIHEFF_CONTROL
654              ivartype = 42
655              write(weighttype(1:80),'(80a)') ' '
656              write(weighttype(1:80),'(a)') "wunit"
657              call ctrl_set_pack_xy(
658         &         cunit, ivartype, fname_siheff(ictrlgrad),
659         &         "maskCtrlC", weighttype, lxxadxx, mythid)
660    #endif
661    
662    #ifdef ALLOW_SIHSNOW_CONTROL
663              ivartype = 43
664              write(weighttype(1:80),'(80a)') ' '
665              write(weighttype(1:80),'(a)') "wunit"
666              call ctrl_set_pack_xy(
667         &         cunit, ivartype, fname_sihsnow(ictrlgrad),
668         &         "maskCtrlC", weighttype, lxxadxx, mythid)
669    #endif
670    
671    #ifdef ALLOW_KAPREDI_CONTROL
672              ivartype = 44
673              write(weighttype(1:80),'(80a)') ' '
674              write(weighttype(1:80),'(a)') "wkapredi"
675              call ctrl_set_pack_xyz(
676         &         cunit, ivartype, fname_kapredi(ictrlgrad), "maskCtrlC",
677         &         weighttype, wkapredi, lxxadxx, mythid)
678    #endif
679    
680    #ifdef ALLOW_SHIFWFLX_CONTROL
681              ivartype = 45
682              write(weighttype(1:80),'(80a)') ' '
683              write(weighttype(1:80),'(a)') "wshifwflx"
684              call ctrl_set_pack_xy(
685         &         cunit, ivartype, fname_shifwflx(ictrlgrad),
686         &         "maskCtrlI", weighttype, lxxadxx, mythid)
687    #endif
688    
689    #ifdef ALLOW_GENARR2D_CONTROL
690           do iarr = 1, maxCtrlArr2D
691              call ctrl_set_fname( xx_genarr2d_file(iarr),
692         O                         fname_local, mythid )
693              ivartype    = 100+iarr
694              write(weighttype(1:80),'(80a)') ' '
695              write(weighttype(1:80),'(a)') "wunit"
696              call ctrl_set_pack_xy(
697         &         cunit, ivartype, fname_local(ictrlgrad),
698         &         "maskCtrlC", weighttype, lxxadxx, mythid)
699           enddo
700    #endif
701    
702    #ifdef ALLOW_GENARR3D_CONTROL
703           do iarr = 1, maxCtrlArr3D
704              call ctrl_set_fname( xx_genarr3d_file(iarr),
705         O                         fname_local, mythid )
706              ivartype    = 200+iarr
707              write(weighttype(1:80),'(80a)') ' '
708              write(weighttype(1:80),'(a)') "wunit"
709              call ctrl_set_pack_xyz(
710         &         cunit, ivartype, fname_local(ictrlgrad),
711         &         "maskCtrlC", weighttype, wunit, lxxadxx, mythid)
712           enddo
713    #endif
714    
715    #ifdef ALLOW_PACKUNPACK_METHOD2
716          _BEGIN_MASTER( mythid )
717          IF ( myProcId .eq. 0 ) THEN
718    #endif
719    
720           close ( cunit )
721           ENDIF !IF ( myProcId .eq. 0 )
722           _END_MASTER( mythid )
723          _BARRIER
724    #endif /* (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) */
725  #endif /* EXCLUDE_CTRL_PACK */  #endif /* EXCLUDE_CTRL_PACK */
726    
727        return        return
728        end        end
   
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.47
  ViewVC Help
Powered by ViewVC 1.1.22