/[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.30 by heimbach, Thu Jun 21 04:06:21 2007 UTC revision 1.44 by heimbach, Tue Sep 11 01:32:02 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 52  c     == global variables == Line 55  c     == global variables ==
55  #else  #else
56  # include "ctrl_weights.h"  # include "ctrl_weights.h"
57  #endif  #endif
58    #ifdef ALLOW_EXF
59    # include "EXF_PARAM.h"
60    #endif
61    
62  c     == routine arguments ==  c     == routine arguments ==
63    
# Line 59  c     == routine arguments == Line 65  c     == routine arguments ==
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))
69  c     == local variables ==  c     == local variables ==
70    
71        _RL    fcloc        _RL    fcloc
# Line 75  c     == local variables == Line 82  c     == local variables ==
82        logical ladinit        logical ladinit
83        integer cbuffindex        integer cbuffindex
84        logical lxxadxx        logical lxxadxx
85          
86        integer cunit        integer cunit
87        integer ictrlgrad        integer ictrlgrad
88    
# Line 130  c--   Assign file names. Line 137  c--   Assign file names.
137        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
138        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
139        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
140          call ctrl_set_fname(xx_kapredi_file, fname_kapredi, mythid)
141        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
142        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
143        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
# Line 147  c--   Assign file names. Line 155  c--   Assign file names.
155        call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)        call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)
156        call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)        call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)
157        call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)        call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)
158    cHFLUXM_CONTROL
159          call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid)
160    cHFLUXM_CONTROL
161          call ctrl_set_fname(xx_shifwflx_file, fname_shifwflx, mythid)
162    
163  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
164        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
# Line 157  c     >>> Initialise control vector for Line 169  c     >>> Initialise control vector for
169            ictrlgrad = 1            ictrlgrad = 1
170            fcloc     = fmin            fcloc     = fmin
171            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
172       &         ctrlname(1:9),'_',yctrlid(1:10),       &         ctrlname(1:9),'_',yctrlid(1:10),
173       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
174            print *, 'ph-pack: packing ', ctrlname(1:9)            print *, 'ph-pack: packing ', ctrlname(1:9)
175        else        else
176  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
177            lxxadxx   = .FALSE.            lxxadxx   = .FALSE.
178            ictrlgrad = 2            ictrlgrad = 2
179    #ifdef ALLOW_AUTODIFF_OPENAD
180              fcloc     = fc%v
181    #else
182            fcloc     = fc            fcloc     = fc
183    #endif
184            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
185       &         costname(1:9),'_',yctrlid(1:10),       &         costname(1:9),'_',yctrlid(1:10),
186       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
187            print *, 'ph-pack: packing ', costname(1:9)            print *, 'ph-pack: packing ', costname(1:9)
188         endif         endif
189    
190    c--   Only Proc 0 will do I/O.
191          IF ( myProcId .eq. 0 ) THEN
192    
193         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
194         open( cunit, file   = cfile,         open( cunit, file   = cfile,
195       &      status = 'unknown',       &      status = 'unknown',
# Line 195  C     place holder of obsolete variable Line 214  C     place holder of obsolete variable
214  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
215            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
216  #endif  #endif
217    #ifdef ALLOW_SHIFWFLX_CONTROL
218              write(cunit) (nWetiGlobal(k), k=1,nr)
219    c          write(cunit) nWetiGlobal(1)
220    #endif
221    
222  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
223            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
# Line 216  C     place holder of obsolete variable Line 239  C     place holder of obsolete variable
239            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
240            write(cunit)            write(cunit)
241    
242    #ifdef ALLOW_PACKUNPACK_METHOD2
243          ENDIF
244          _END_MASTER( mythid )
245          _BARRIER
246    #endif
247    
248  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
249            ivartype = 1            ivartype = 1
250            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
# Line 253  C     place holder of obsolete variable Line 282  C     place holder of obsolete variable
282  #endif  #endif
283    
284  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
285    #ifdef ALLOW_EXF
286          IF ( .NOT.useAtmWind ) THEN
287    #endif
288            ivartype = 5            ivartype = 5
289            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
290            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
291            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
292    #ifndef ALLOW_ROTATE_UV_CONTROLS
293       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
294    #else
295         &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlC",
296    #endif
297       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
298    #ifdef ALLOW_EXF
299          ENDIF
300    #endif
301  #endif  #endif
302    
303  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
304    #ifdef ALLOW_EXF
305          IF ( .NOT.useAtmWind ) THEN
306    #endif
307            ivartype = 6            ivartype = 6
308            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
309            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
310            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
311    #ifndef ALLOW_ROTATE_UV_CONTROLS
312       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
313    #else
314         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlC",
315    #endif
316       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
317    #ifdef ALLOW_EXF
318          ENDIF
319    #endif
320  #endif  #endif
321    
322  #ifdef ALLOW_ATEMP_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
# Line 289  C     place holder of obsolete variable Line 338  C     place holder of obsolete variable
338  #endif  #endif
339    
340  #ifdef ALLOW_UWIND_CONTROL  #ifdef ALLOW_UWIND_CONTROL
341    #ifdef ALLOW_EXF
342          IF ( useAtmWind ) THEN
343    #endif
344            ivartype = 9            ivartype = 9
345            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
346            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
347            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
348       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
349       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
350    #ifdef ALLOW_EXF
351          ENDIF
352    #endif
353  #endif  #endif
354    
355  #ifdef ALLOW_VWIND_CONTROL  #ifdef ALLOW_VWIND_CONTROL
356    #ifdef ALLOW_EXF
357          IF ( useAtmWind ) THEN
358    #endif
359            ivartype = 10            ivartype = 10
360            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
361            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
362            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
363       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
364       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
365    #ifdef ALLOW_EXF
366          ENDIF
367    #endif
368  #endif  #endif
369    
370  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 423  C     place holder of obsolete variable Line 484  C     place holder of obsolete variable
484       &      weighttype, lxxadxx, mythid)       &      weighttype, lxxadxx, mythid)
485  #endif  #endif
486    
487  #ifdef ALLOW_EDTAUX_CONTROL  #ifdef ALLOW_HFLUXM_CONTROL
488              ivartype = 24
489              write(weighttype(1:80),'(80a)') ' '
490              write(weighttype(1:80),'(a)') "whfluxm"
491              call ctrl_set_pack_xy(
492         &         cunit, ivartype, fname_hfluxm(ictrlgrad), "maskCtrlC",
493         &         weighttype, lxxadxx, mythid)
494    #endif
495    
496    #ifdef ALLOW_EDDYPSI_CONTROL
497            ivartype = 25            ivartype = 25
498            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
499            write(weighttype(1:80),'(a)') "wedtaux"            write(weighttype(1:80),'(a)') "wedtaux"
500            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
501       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
502       &         weighttype, wedtaux, lxxadxx, mythid)       &         weighttype, wedtaux, lxxadxx, mythid)
 #endif  
503    
 #ifdef ALLOW_EDTAUY_CONTROL  
504            ivartype = 26            ivartype = 26
505            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
506            write(weighttype(1:80),'(a)') "wedtauy"            write(weighttype(1:80),'(a)') "wedtauy"
# Line 447  C     place holder of obsolete variable Line 515  C     place holder of obsolete variable
515            write(weighttype(1:80),'(a)') "wuvel"            write(weighttype(1:80),'(a)') "wuvel"
516            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
517       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
518       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wuvel, lxxadxx, mythid)
519  #endif  #endif
520    
521  #ifdef ALLOW_VVEL0_CONTROL  #ifdef ALLOW_VVEL0_CONTROL
# Line 456  C     place holder of obsolete variable Line 524  C     place holder of obsolete variable
524            write(weighttype(1:80),'(a)') "wvvel"            write(weighttype(1:80),'(a)') "wvvel"
525            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
526       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
527       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wvvel, lxxadxx, mythid)
528  #endif  #endif
529    
530  #ifdef ALLOW_ETAN0_CONTROL  #ifdef ALLOW_ETAN0_CONTROL
# Line 594  C     place holder of obsolete variable Line 662  C     place holder of obsolete variable
662       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
663  #endif  #endif
664    
665            close ( cunit )  #ifdef ALLOW_KAPREDI_CONTROL
666              ivartype = 44
667              write(weighttype(1:80),'(80a)') ' '
668              write(weighttype(1:80),'(a)') "wkapredi"
669              call ctrl_set_pack_xyz(
670         &         cunit, ivartype, fname_kapredi(ictrlgrad), "maskCtrlC",
671         &         weighttype, wkapredi, lxxadxx, mythid)
672    #endif
673    
674    #ifdef ALLOW_SHIFWFLX_CONTROL
675              ivartype = 45
676              write(weighttype(1:80),'(80a)') ' '
677              write(weighttype(1:80),'(a)') "wshifwflx"
678              call ctrl_set_pack_xy(
679         &         cunit, ivartype, fname_shifwflx(ictrlgrad),
680         &         "maskCtrlI", weighttype, lxxadxx, mythid)
681    #endif
682    
683          _END_MASTER( mythid )  #ifdef ALLOW_PACKUNPACK_METHOD2
684          _BEGIN_MASTER( mythid )
685          IF ( myProcId .eq. 0 ) THEN
686    #endif
687    
688           close ( cunit )
689           ENDIF !IF ( myProcId .eq. 0 )
690           _END_MASTER( mythid )
691          _BARRIER
692    #endif /* (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) */
693  #endif /* EXCLUDE_CTRL_PACK */  #endif /* EXCLUDE_CTRL_PACK */
694    
695        return        return
696        end        end
   
Legend:
Removed from v.1.30  
changed lines
  Added in v.1.44
  ViewVC Help
Powered by ViewVC 1.1.22