/[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.41 by jmc, Fri Jul 6 23:10:28 2012 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 "CTRL_CPPOPTIONS.h"  #include "CTRL_OPTIONS.h"
5  #include "AD_CONFIG.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 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  #if (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN))  c     == external ==
69          integer  ilnblnk
70          external ilnblnk
71    
72  c     == local variables ==  c     == local variables ==
73    
74        _RL    fcloc        _RL    fcloc
# Line 71  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
# Line 83  c     == local variables == Line 99  c     == local variables ==
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 122  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 149  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
       call ctrl_set_fname(xx_shifwflx_file, fname_shifwflx, mythid)  
166    
167  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
168        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
# Line 170  c     >>> Initialise control vector for Line 180  c     >>> Initialise control vector for
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
# Line 258  c          write(cunit) nWetiGlobal(1) Line 272  c          write(cunit) nWetiGlobal(1)
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 267  c          write(cunit) nWetiGlobal(1) Line 282  c          write(cunit) nWetiGlobal(1)
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  #ifndef ALLOW_ROTATE_UV_CONTROLS  #ifndef ALLOW_ROTATE_UV_CONTROLS
299       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, forcingPrecond,
300         &         fname_tauu(ictrlgrad), "maskCtrlW",
301  #else  #else
302       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
303         &         fname_tauu(ictrlgrad), "maskCtrlC",
304  #endif  #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  #ifndef ALLOW_ROTATE_UV_CONTROLS  #ifndef ALLOW_ROTATE_UV_CONTROLS
320       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, forcingPrecond,
321         &         fname_tauv(ictrlgrad), "maskCtrlS",
322  #else  #else
323       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, forcingPrecond,
324         &         fname_tauv(ictrlgrad), "maskCtrlC",
325  #endif  #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 302  c          write(cunit) nWetiGlobal(1) Line 334  c          write(cunit) nWetiGlobal(1)
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 311  c          write(cunit) nWetiGlobal(1) Line 344  c          write(cunit) nWetiGlobal(1)
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 401  c          write(cunit) nWetiGlobal(1) Line 449  c          write(cunit) nWetiGlobal(1)
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 410  c          write(cunit) nWetiGlobal(1) Line 459  c          write(cunit) nWetiGlobal(1)
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 419  c          write(cunit) nWetiGlobal(1) Line 469  c          write(cunit) nWetiGlobal(1)
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 446  c          write(cunit) nWetiGlobal(1) Line 497  c          write(cunit) nWetiGlobal(1)
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 455  c          write(cunit) nWetiGlobal(1) Line 507  c          write(cunit) nWetiGlobal(1)
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 498  c          write(cunit) nWetiGlobal(1) Line 551  c          write(cunit) nWetiGlobal(1)
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 507  c          write(cunit) nWetiGlobal(1) Line 561  c          write(cunit) nWetiGlobal(1)
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 516  c          write(cunit) nWetiGlobal(1) Line 571  c          write(cunit) nWetiGlobal(1)
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 525  c          write(cunit) nWetiGlobal(1) Line 581  c          write(cunit) nWetiGlobal(1)
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 534  c          write(cunit) nWetiGlobal(1) Line 591  c          write(cunit) nWetiGlobal(1)
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 543  c          write(cunit) nWetiGlobal(1) Line 601  c          write(cunit) nWetiGlobal(1)
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 552  c          write(cunit) nWetiGlobal(1) Line 611  c          write(cunit) nWetiGlobal(1)
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 561  c          write(cunit) nWetiGlobal(1) Line 621  c          write(cunit) nWetiGlobal(1)
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 570  c          write(cunit) nWetiGlobal(1) Line 631  c          write(cunit) nWetiGlobal(1)
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 579  c          write(cunit) nWetiGlobal(1) Line 641  c          write(cunit) nWetiGlobal(1)
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 588  c          write(cunit) nWetiGlobal(1) Line 651  c          write(cunit) nWetiGlobal(1)
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 597  c          write(cunit) nWetiGlobal(1) Line 661  c          write(cunit) nWetiGlobal(1)
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 606  c          write(cunit) nWetiGlobal(1) Line 671  c          write(cunit) nWetiGlobal(1)
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 615  c          write(cunit) nWetiGlobal(1) Line 681  c          write(cunit) nWetiGlobal(1)
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 624  c          write(cunit) nWetiGlobal(1) Line 691  c          write(cunit) nWetiGlobal(1)
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    
# Line 642  c          write(cunit) nWetiGlobal(1) Line 710  c          write(cunit) nWetiGlobal(1)
710            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
711            write(weighttype(1:80),'(a)') "wshifwflx"            write(weighttype(1:80),'(a)') "wshifwflx"
712            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
713       &         cunit, ivartype, fname_shifwflx(ictrlgrad),       &         cunit, ivartype, forcingPrecond,
714         &         fname_shifwflx(ictrlgrad),
715       &         "maskCtrlI", weighttype, lxxadxx, mythid)       &         "maskCtrlI", weighttype, lxxadxx, mythid)
716  #endif  #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  #ifdef ALLOW_PACKUNPACK_METHOD2  #ifdef ALLOW_PACKUNPACK_METHOD2
763        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
764        IF ( myProcId .eq. 0 ) THEN        IF ( myProcId .eq. 0 ) THEN
# Line 655  c          write(cunit) nWetiGlobal(1) Line 768  c          write(cunit) nWetiGlobal(1)
768         ENDIF !IF ( myProcId .eq. 0 )         ENDIF !IF ( myProcId .eq. 0 )
769         _END_MASTER( mythid )         _END_MASTER( mythid )
770        _BARRIER        _BARRIER
 #endif /* (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) */  
771  #endif /* EXCLUDE_CTRL_PACK */  #endif /* EXCLUDE_CTRL_PACK */
772    
773        return        return
Legend:
Removed from v.1.41  
changed lines
  Added in v.1.50
  ViewVC Help
Powered by ViewVC 1.1.22