/[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.33 by gforget, Fri May 30 02:48:28 2008 UTC revision 1.50 by heimbach, Fri Feb 1 19:25:32 2013 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"  #ifdef ALLOW_EXF
6    # include "EXF_OPTIONS.h"
7    #endif
8    
9        subroutine ctrl_pack( first, mythid )        subroutine ctrl_pack( first, mythid )
10    
# Line 18  c Line 20  c
20  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
21  c              - Transferred some filename declarations  c              - Transferred some filename declarations
22  c                from here to namelist in ctrl_init  c                from here to namelist in ctrl_init
23  c    c
24  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000
25  c              - single file name convention with or without  c              - single file name convention with or without
26  c                ALLOW_ECCO_OPTIMIZATION  c                ALLOW_ECCO_OPTIMIZATION
# Line 42  c     == global variables == Line 44  c     == global variables ==
44  #include "GRID.h"  #include "GRID.h"
45    
46  #include "ctrl.h"  #include "ctrl.h"
47    #include "CTRL_SIZE.h"
48    #include "CTRL_GENARR.h"
49  #include "optim.h"  #include "optim.h"
50    
51  #ifdef ALLOW_COST  #ifdef ALLOW_COST
# Line 52  c     == global variables == Line 56  c     == global variables ==
56  #else  #else
57  # include "ctrl_weights.h"  # include "ctrl_weights.h"
58  #endif  #endif
59    #ifdef ALLOW_EXF
60    # include "EXF_PARAM.h"
61    #endif
62    
63  c     == routine arguments ==  c     == routine arguments ==
   
64        logical first        logical first
65        integer mythid        integer mythid
66    
67  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
68    c     == external ==
69          integer  ilnblnk
70          external ilnblnk
71    
72  c     == local variables ==  c     == local variables ==
73    
74        _RL    fcloc        _RL    fcloc
# Line 70  c     == local variables == Line 80  c     == local variables ==
80        integer ig,jg        integer ig,jg
81        integer ivartype        integer ivartype
82        integer iobcs        integer iobcs
83    #if (defined ALLOW_GENARR2D_CONTROL) || (defined ALLOW_GENARR3D_CONTROL) || (defined ALLOW_GENTIM2D_CONTROL)
84    C-    Provided we set the file name just before calling ctrl_set_pack,
85    C     the same local file name variable can be used for different variables.
86    C     This is how GENARR2/3D_CONTROL is implemented (+ provides an example)
87          integer iarr
88          character*(80) fname_local(3)
89    #endif
90    
91        logical doglobalread        logical doglobalread
92        logical ladinit        logical ladinit
93        integer cbuffindex        integer cbuffindex
94        logical lxxadxx        logical lxxadxx
95          
96        integer cunit        integer cunit
97        integer ictrlgrad        integer ictrlgrad
98    
99        character*(128) cfile        character*(128) cfile
100        character*( 80) weighttype        character*( 80) weighttype
101    
 c     == external ==  
   
       integer  ilnblnk  
       external ilnblnk  
   
102  c     == end of interface ==  c     == end of interface ==
103    
104  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
# Line 121  c--   Assign file names. Line 133  c--   Assign file names.
133        call ctrl_set_fname(xx_snowprecip_file, fname_snowprecip, mythid)        call ctrl_set_fname(xx_snowprecip_file, fname_snowprecip, mythid)
134        call ctrl_set_fname(xx_apressure_file, fname_apressure, mythid)        call ctrl_set_fname(xx_apressure_file, fname_apressure, mythid)
135        call ctrl_set_fname(xx_runoff_file, fname_runoff, mythid)        call ctrl_set_fname(xx_runoff_file, fname_runoff, mythid)
   
136        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
137        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
138        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
# Line 148  c--   Assign file names. Line 159  c--   Assign file names.
159        call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)        call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)
160        call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)        call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)
161        call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)        call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)
162          call ctrl_set_fname(xx_shifwflx_file, fname_shifwflx, mythid)
163  cHFLUXM_CONTROL  cHFLUXM_CONTROL
164        call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid)        call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid)
165  cHFLUXM_CONTROL  cHFLUXM_CONTROL
# Line 161  c     >>> Initialise control vector for Line 173  c     >>> Initialise control vector for
173            ictrlgrad = 1            ictrlgrad = 1
174            fcloc     = fmin            fcloc     = fmin
175            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
176       &         ctrlname(1:9),'_',yctrlid(1:10),       &         ctrlname(1:9),'_',yctrlid(1:10),
177       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
178            print *, 'ph-pack: packing ', ctrlname(1:9)            print *, 'ph-pack: packing ', ctrlname(1:9)
179        else        else
180  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
181            lxxadxx   = .FALSE.            lxxadxx   = .FALSE.
182            ictrlgrad = 2            ictrlgrad = 2
183    #ifdef ALLOW_AUTODIFF_OPENAD
184              fcloc     = fc%v
185    #else
186            fcloc     = fc            fcloc     = fc
187    #endif
188            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
189       &         costname(1:9),'_',yctrlid(1:10),       &         costname(1:9),'_',yctrlid(1:10),
190       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
191            print *, 'ph-pack: packing ', costname(1:9)            print *, 'ph-pack: packing ', costname(1:9)
192         endif         endif
193    
194    c--   Only Proc 0 will do I/O.
195          IF ( myProcId .eq. 0 ) THEN
196    
197         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
198         open( cunit, file   = cfile,         open( cunit, file   = cfile,
199       &      status = 'unknown',       &      status = 'unknown',
# Line 199  C     place holder of obsolete variable Line 218  C     place holder of obsolete variable
218  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
219            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
220  #endif  #endif
221    #ifdef ALLOW_SHIFWFLX_CONTROL
222              write(cunit) (nWetiGlobal(k), k=1,nr)
223    c          write(cunit) nWetiGlobal(1)
224    #endif
225    
226  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
227            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
# Line 220  C     place holder of obsolete variable Line 243  C     place holder of obsolete variable
243            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
244            write(cunit)            write(cunit)
245    
246    #ifdef ALLOW_PACKUNPACK_METHOD2
247          ENDIF
248          _END_MASTER( mythid )
249          _BARRIER
250    #endif
251    
252  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
253            ivartype = 1            ivartype = 1
254            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
# Line 243  C     place holder of obsolete variable Line 272  C     place holder of obsolete variable
272            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
273            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
274            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
275       &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
276         &         fname_hflux(ictrlgrad), "maskCtrlC",
277       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
278  #endif  #endif
279    
# Line 252  C     place holder of obsolete variable Line 282  C     place holder of obsolete variable
282            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
283            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
284            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
285       &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",       &         cunit, ivartype,  forcingPrecond,
286         &         fname_sflux(ictrlgrad), "maskCtrlC",
287       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
288  #endif  #endif
289    
290  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
291    #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), "maskCtrlW",  #ifndef ALLOW_ROTATE_UV_CONTROLS
299         &         cunit, ivartype, forcingPrecond,
300         &         fname_tauu(ictrlgrad), "maskCtrlW",
301    #else
302         &         cunit, ivartype, forcingPrecond,
303         &         fname_tauu(ictrlgrad), "maskCtrlC",
304    #endif
305       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
306    #ifdef ALLOW_EXF
307          ENDIF
308    #endif
309  #endif  #endif
310    
311  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
312    #ifdef ALLOW_EXF
313          IF ( .NOT.useAtmWind ) THEN
314    #endif
315            ivartype = 6            ivartype = 6
316            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
317            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
318            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
319       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",  #ifndef ALLOW_ROTATE_UV_CONTROLS
320         &         cunit, ivartype, forcingPrecond,
321         &         fname_tauv(ictrlgrad), "maskCtrlS",
322    #else
323         &         cunit, ivartype, forcingPrecond,
324         &         fname_tauv(ictrlgrad), "maskCtrlC",
325    #endif
326       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
327    #ifdef ALLOW_EXF
328          ENDIF
329    #endif
330  #endif  #endif
331    
332  #ifdef ALLOW_ATEMP_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
# Line 279  C     place holder of obsolete variable Line 334  C     place holder of obsolete variable
334            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
335            write(weighttype(1:80),'(a)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
336            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
337       &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
338         &         fname_atemp(ictrlgrad), "maskCtrlC",
339       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
340  #endif  #endif
341    
# Line 288  C     place holder of obsolete variable Line 344  C     place holder of obsolete variable
344            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
345            write(weighttype(1:80),'(a)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
346            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
347       &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
348         &         fname_aqh(ictrlgrad), "maskCtrlC",
349       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
350  #endif  #endif
351    
352  #ifdef ALLOW_UWIND_CONTROL  #ifdef ALLOW_UWIND_CONTROL
353    #ifdef ALLOW_EXF
354          IF ( useAtmWind ) THEN
355    #endif
356            ivartype = 9            ivartype = 9
357            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
358            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
359            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
360       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
361         &         fname_uwind(ictrlgrad), "maskCtrlC",
362       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
363    #ifdef ALLOW_EXF
364          ENDIF
365    #endif
366  #endif  #endif
367    
368  #ifdef ALLOW_VWIND_CONTROL  #ifdef ALLOW_VWIND_CONTROL
369    #ifdef ALLOW_EXF
370          IF ( useAtmWind ) THEN
371    #endif
372            ivartype = 10            ivartype = 10
373            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
374            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
375            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
376       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
377         &         fname_vwind(ictrlgrad), "maskCtrlC",
378       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
379    #ifdef ALLOW_EXF
380          ENDIF
381    #endif
382  #endif  #endif
383    
384  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 378  C     place holder of obsolete variable Line 449  C     place holder of obsolete variable
449            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
450            write(weighttype(1:80),'(a)') "wsst"            write(weighttype(1:80),'(a)') "wsst"
451            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
452       &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
453         &         fname_sst(ictrlgrad), "maskCtrlC",
454       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
455  #endif  #endif
456    
# Line 387  C     place holder of obsolete variable Line 459  C     place holder of obsolete variable
459            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
460            write(weighttype(1:80),'(a)') "wsss"            write(weighttype(1:80),'(a)') "wsss"
461            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
462       &         cunit, ivartype, fname_sss(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
463         &         fname_sss(ictrlgrad),
464       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
465  #endif  #endif
466    
# Line 396  C     place holder of obsolete variable Line 469  C     place holder of obsolete variable
469            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
470            write(weighttype(1:80),'(a)') "wdepth"            write(weighttype(1:80),'(a)') "wdepth"
471            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
472       &         cunit, ivartype, fname_depth(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
473         &         fname_depth(ictrlgrad),
474       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
475  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_DEPTH_CONTROL */
476    
# Line 423  C     place holder of obsolete variable Line 497  C     place holder of obsolete variable
497            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
498            write(weighttype(1:80),'(a)') "wbottomdrag"            write(weighttype(1:80),'(a)') "wbottomdrag"
499            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
500       &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
501       &      weighttype, lxxadxx, mythid)       &         fname_bottomdrag(ictrlgrad), "maskCtrlC",
502         &         weighttype, lxxadxx, mythid)
503  #endif  #endif
504    
505  #ifdef ALLOW_HFLUXM_CONTROL  #ifdef ALLOW_HFLUXM_CONTROL
# Line 432  C     place holder of obsolete variable Line 507  C     place holder of obsolete variable
507            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
508            write(weighttype(1:80),'(a)') "whfluxm"            write(weighttype(1:80),'(a)') "whfluxm"
509            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
510       &         cunit, ivartype, fname_hfluxm(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
511         &         fname_hfluxm(ictrlgrad), "maskCtrlC",
512       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
513  #endif  #endif
514    
# Line 458  C     place holder of obsolete variable Line 534  C     place holder of obsolete variable
534            write(weighttype(1:80),'(a)') "wuvel"            write(weighttype(1:80),'(a)') "wuvel"
535            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
536       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
537       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wuvel, lxxadxx, mythid)
538  #endif  #endif
539    
540  #ifdef ALLOW_VVEL0_CONTROL  #ifdef ALLOW_VVEL0_CONTROL
# Line 467  C     place holder of obsolete variable Line 543  C     place holder of obsolete variable
543            write(weighttype(1:80),'(a)') "wvvel"            write(weighttype(1:80),'(a)') "wvvel"
544            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
545       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
546       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wvvel, lxxadxx, mythid)
547  #endif  #endif
548    
549  #ifdef ALLOW_ETAN0_CONTROL  #ifdef ALLOW_ETAN0_CONTROL
# Line 475  C     place holder of obsolete variable Line 551  C     place holder of obsolete variable
551            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
552            write(weighttype(1:80),'(a)') "wetan"            write(weighttype(1:80),'(a)') "wetan"
553            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
554       &         cunit, ivartype, fname_etan(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
555         &         fname_etan(ictrlgrad),
556       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
557  #endif  #endif
558    
# Line 484  C     place holder of obsolete variable Line 561  C     place holder of obsolete variable
561            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
562            write(weighttype(1:80),'(a)') "wrelaxsst"            write(weighttype(1:80),'(a)') "wrelaxsst"
563            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
564       &         cunit, ivartype, fname_relaxsst(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
565         &         fname_relaxsst(ictrlgrad),
566       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
567  #endif  #endif
568    
# Line 493  C     place holder of obsolete variable Line 571  C     place holder of obsolete variable
571            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
572            write(weighttype(1:80),'(a)') "wrelaxsss"            write(weighttype(1:80),'(a)') "wrelaxsss"
573            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
574       &         cunit, ivartype, fname_relaxsss(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
575         &         fname_relaxsss(ictrlgrad),
576       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
577  #endif  #endif
578    
# Line 502  C     place holder of obsolete variable Line 581  C     place holder of obsolete variable
581            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
582            write(weighttype(1:80),'(a)') "wprecip"            write(weighttype(1:80),'(a)') "wprecip"
583            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
584       &         cunit, ivartype, fname_precip(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
585         &         fname_precip(ictrlgrad),
586       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
587  #endif  #endif
588    
# Line 511  C     place holder of obsolete variable Line 591  C     place holder of obsolete variable
591            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
592            write(weighttype(1:80),'(a)') "wswflux"            write(weighttype(1:80),'(a)') "wswflux"
593            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
594       &         cunit, ivartype, fname_swflux(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
595         &         fname_swflux(ictrlgrad),
596       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
597  #endif  #endif
598    
# Line 520  C     place holder of obsolete variable Line 601  C     place holder of obsolete variable
601            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
602            write(weighttype(1:80),'(a)') "wswdown"            write(weighttype(1:80),'(a)') "wswdown"
603            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
604       &         cunit, ivartype, fname_swdown(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
605         &         fname_swdown(ictrlgrad),
606       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
607  #endif  #endif
608    
# Line 529  C     place holder of obsolete variable Line 611  C     place holder of obsolete variable
611            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
612            write(weighttype(1:80),'(a)') "wlwflux"            write(weighttype(1:80),'(a)') "wlwflux"
613            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
614       &         cunit, ivartype, fname_lwflux(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
615         &         fname_lwflux(ictrlgrad),
616       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
617  #endif  #endif
618    
# Line 538  C     place holder of obsolete variable Line 621  C     place holder of obsolete variable
621            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
622            write(weighttype(1:80),'(a)') "wlwdown"            write(weighttype(1:80),'(a)') "wlwdown"
623            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
624       &         cunit, ivartype, fname_lwdown(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
625         &         fname_lwdown(ictrlgrad),
626       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
627  #endif  #endif
628    
# Line 547  C     place holder of obsolete variable Line 631  C     place holder of obsolete variable
631            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
632            write(weighttype(1:80),'(a)') "wevap"            write(weighttype(1:80),'(a)') "wevap"
633            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
634       &         cunit, ivartype, fname_evap(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
635         &         fname_evap(ictrlgrad),
636       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
637  #endif  #endif
638    
# Line 556  C     place holder of obsolete variable Line 641  C     place holder of obsolete variable
641            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
642            write(weighttype(1:80),'(a)') "wsnowprecip"            write(weighttype(1:80),'(a)') "wsnowprecip"
643            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
644       &         cunit, ivartype, fname_snowprecip(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
645         &         fname_snowprecip(ictrlgrad),
646       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
647  #endif  #endif
648    
# Line 565  C     place holder of obsolete variable Line 651  C     place holder of obsolete variable
651            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
652            write(weighttype(1:80),'(a)') "wapressure"            write(weighttype(1:80),'(a)') "wapressure"
653            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
654       &         cunit, ivartype, fname_apressure(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
655         &         fname_apressure(ictrlgrad),
656       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
657  #endif  #endif
658    
# Line 574  C     place holder of obsolete variable Line 661  C     place holder of obsolete variable
661            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
662            write(weighttype(1:80),'(a)') "wrunoff"            write(weighttype(1:80),'(a)') "wrunoff"
663            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
664       &         cunit, ivartype, fname_runoff(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
665         &         fname_runoff(ictrlgrad),
666       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
667  #endif  #endif
668    
# Line 583  C     place holder of obsolete variable Line 671  C     place holder of obsolete variable
671            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
672            write(weighttype(1:80),'(a)') "wunit"            write(weighttype(1:80),'(a)') "wunit"
673            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
674       &         cunit, ivartype, fname_siarea(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
675         &         fname_siarea(ictrlgrad),
676       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
677  #endif  #endif
678    
# Line 592  C     place holder of obsolete variable Line 681  C     place holder of obsolete variable
681            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
682            write(weighttype(1:80),'(a)') "wunit"            write(weighttype(1:80),'(a)') "wunit"
683            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
684       &         cunit, ivartype, fname_siheff(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
685         &         fname_siheff(ictrlgrad),
686       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
687  #endif  #endif
688    
# Line 601  C     place holder of obsolete variable Line 691  C     place holder of obsolete variable
691            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
692            write(weighttype(1:80),'(a)') "wunit"            write(weighttype(1:80),'(a)') "wunit"
693            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
694       &         cunit, ivartype, fname_sihsnow(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
695         &         fname_sihsnow(ictrlgrad),
696       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
697  #endif  #endif
698    
699  #ifdef ALLOW_KAPREDI_CONTROL  #ifdef ALLOW_KAPREDI_CONTROL
700            ivartype = 44            ivartype = 44
701            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
702            write(weighttype(1:80),'(a)') "wkapredi"            write(weighttype(1:80),'(a)') "wkapredi"
703            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
# Line 614  C     place holder of obsolete variable Line 705  C     place holder of obsolete variable
705       &         weighttype, wkapredi, lxxadxx, mythid)       &         weighttype, wkapredi, lxxadxx, mythid)
706  #endif  #endif
707    
708            close ( cunit )  #ifdef ALLOW_SHIFWFLX_CONTROL
709              ivartype = 45
710              write(weighttype(1:80),'(80a)') ' '
711              write(weighttype(1:80),'(a)') "wshifwflx"
712              call ctrl_set_pack_xy(
713         &         cunit, ivartype, forcingPrecond,
714         &         fname_shifwflx(ictrlgrad),
715         &         "maskCtrlI", weighttype, lxxadxx, mythid)
716    #endif
717    
718    #ifdef ALLOW_GENARR2D_CONTROL
719           do iarr = 1, maxCtrlArr2D
720              call ctrl_set_fname( xx_genarr2d_file(iarr),
721         O                         fname_local, mythid )
722              ivartype    = 100+iarr
723    cc          write(weighttype(1:80),'(80a)') ' '
724    cc          write(weighttype(1:80),'(a)') "wunit"
725              call ctrl_set_pack_xy(
726         &         cunit, ivartype, genarr2dPrecond(iarr),
727         &         fname_local(ictrlgrad), "maskCtrlC",
728         &         xx_genarr2d_weight(iarr),
729         &         lxxadxx, mythid)
730           enddo
731    #endif
732    
733    #ifdef ALLOW_GENARR3D_CONTROL
734           do iarr = 1, maxCtrlArr3D
735              call ctrl_set_fname( xx_genarr3d_file(iarr),
736         O                         fname_local, mythid )
737              ivartype    = 200+iarr
738    cc          write(weighttype(1:80),'(80a)') ' '
739    cc          write(weighttype(1:80),'(a)') "wunit"
740              call ctrl_set_pack_xyz(
741         &         cunit, ivartype, fname_local(ictrlgrad), "maskCtrlC",
742         &         xx_genarr3d_weight(iarr),
743         &         wunit, lxxadxx, mythid)
744           enddo
745    #endif
746    
747    #ifdef ALLOW_GENTIM2D_CONTROL
748           do iarr = 1, maxCtrlTim2D
749              call ctrl_set_fname( xx_gentim2d_file(iarr),
750         O                         fname_local, mythid )
751              ivartype    = 300+iarr
752    cc          write(weighttype(1:80),'(80a)') ' '
753    cc          write(weighttype(1:80),'(a)') "wunit"
754              call ctrl_set_pack_xy(
755         &         cunit, ivartype, gentim2dPrecond(iarr),
756         &         fname_local(ictrlgrad), "maskCtrlC",
757         &         xx_gentim2d_weight(iarr),
758         &         lxxadxx, mythid)
759           enddo
760    #endif
761    
762          _END_MASTER( mythid )  #ifdef ALLOW_PACKUNPACK_METHOD2
763          _BEGIN_MASTER( mythid )
764          IF ( myProcId .eq. 0 ) THEN
765    #endif
766    
767           close ( cunit )
768           ENDIF !IF ( myProcId .eq. 0 )
769           _END_MASTER( mythid )
770          _BARRIER
771  #endif /* EXCLUDE_CTRL_PACK */  #endif /* EXCLUDE_CTRL_PACK */
772    
773        return        return
774        end        end
   
Legend:
Removed from v.1.33  
changed lines
  Added in v.1.50
  ViewVC Help
Powered by ViewVC 1.1.22