/[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.43 by gforget, Tue Sep 4 14:58:15 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
# Line 166  c     >>> Write gradient vector <<< Line 178  c     >>> Write gradient vector <<<
178            ictrlgrad = 2            ictrlgrad = 2
179            fcloc     = fc            fcloc     = fc
180            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
181       &         costname(1:9),'_',yctrlid(1:10),       &         costname(1:9),'_',yctrlid(1:10),
182       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
183            print *, 'ph-pack: packing ', costname(1:9)            print *, 'ph-pack: packing ', costname(1:9)
184         endif         endif
185    
186    c--   Only Proc 0 will do I/O.
187          IF ( myProcId .eq. 0 ) THEN
188    
189         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
190         open( cunit, file   = cfile,         open( cunit, file   = cfile,
191       &      status = 'unknown',       &      status = 'unknown',
# Line 195  C     place holder of obsolete variable Line 210  C     place holder of obsolete variable
210  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
211            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
212  #endif  #endif
213    #ifdef ALLOW_SHIFWFLX_CONTROL
214              write(cunit) (nWetiGlobal(k), k=1,nr)
215    c          write(cunit) nWetiGlobal(1)
216    #endif
217    
218  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
219            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 235  C     place holder of obsolete variable
235            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
236            write(cunit)            write(cunit)
237    
238    #ifdef ALLOW_PACKUNPACK_METHOD2
239          ENDIF
240          _END_MASTER( mythid )
241          _BARRIER
242    #endif
243    
244  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
245            ivartype = 1            ivartype = 1
246            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
# Line 253  C     place holder of obsolete variable Line 278  C     place holder of obsolete variable
278  #endif  #endif
279    
280  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
281    #ifdef ALLOW_EXF
282          IF ( .NOT.useAtmWind ) THEN
283    #endif
284            ivartype = 5            ivartype = 5
285            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
286            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
287            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
288    #ifndef ALLOW_ROTATE_UV_CONTROLS
289       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
290    #else
291         &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlC",
292    #endif
293       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
294    #ifdef ALLOW_EXF
295          ENDIF
296    #endif
297  #endif  #endif
298    
299  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
300    #ifdef ALLOW_EXF
301          IF ( .NOT.useAtmWind ) THEN
302    #endif
303            ivartype = 6            ivartype = 6
304            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
305            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
306            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
307    #ifndef ALLOW_ROTATE_UV_CONTROLS
308       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
309    #else
310         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlC",
311    #endif
312       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
313    #ifdef ALLOW_EXF
314          ENDIF
315    #endif
316  #endif  #endif
317    
318  #ifdef ALLOW_ATEMP_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
# Line 289  C     place holder of obsolete variable Line 334  C     place holder of obsolete variable
334  #endif  #endif
335    
336  #ifdef ALLOW_UWIND_CONTROL  #ifdef ALLOW_UWIND_CONTROL
337    #ifdef ALLOW_EXF
338          IF ( useAtmWind ) THEN
339    #endif
340            ivartype = 9            ivartype = 9
341            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
342            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
343            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
344       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
345       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
346    #ifdef ALLOW_EXF
347          ENDIF
348    #endif
349  #endif  #endif
350    
351  #ifdef ALLOW_VWIND_CONTROL  #ifdef ALLOW_VWIND_CONTROL
352    #ifdef ALLOW_EXF
353          IF ( useAtmWind ) THEN
354    #endif
355            ivartype = 10            ivartype = 10
356            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
357            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
358            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
359       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
360       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
361    #ifdef ALLOW_EXF
362          ENDIF
363    #endif
364  #endif  #endif
365    
366  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
# Line 423  C     place holder of obsolete variable Line 480  C     place holder of obsolete variable
480       &      weighttype, lxxadxx, mythid)       &      weighttype, lxxadxx, mythid)
481  #endif  #endif
482    
483  #ifdef ALLOW_EDTAUX_CONTROL  #ifdef ALLOW_HFLUXM_CONTROL
484              ivartype = 24
485              write(weighttype(1:80),'(80a)') ' '
486              write(weighttype(1:80),'(a)') "whfluxm"
487              call ctrl_set_pack_xy(
488         &         cunit, ivartype, fname_hfluxm(ictrlgrad), "maskCtrlC",
489         &         weighttype, lxxadxx, mythid)
490    #endif
491    
492    #ifdef ALLOW_EDDYPSI_CONTROL
493            ivartype = 25            ivartype = 25
494            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
495            write(weighttype(1:80),'(a)') "wedtaux"            write(weighttype(1:80),'(a)') "wedtaux"
496            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
497       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
498       &         weighttype, wedtaux, lxxadxx, mythid)       &         weighttype, wedtaux, lxxadxx, mythid)
 #endif  
499    
 #ifdef ALLOW_EDTAUY_CONTROL  
500            ivartype = 26            ivartype = 26
501            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
502            write(weighttype(1:80),'(a)') "wedtauy"            write(weighttype(1:80),'(a)') "wedtauy"
# Line 447  C     place holder of obsolete variable Line 511  C     place holder of obsolete variable
511            write(weighttype(1:80),'(a)') "wuvel"            write(weighttype(1:80),'(a)') "wuvel"
512            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
513       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
514       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wuvel, lxxadxx, mythid)
515  #endif  #endif
516    
517  #ifdef ALLOW_VVEL0_CONTROL  #ifdef ALLOW_VVEL0_CONTROL
# Line 456  C     place holder of obsolete variable Line 520  C     place holder of obsolete variable
520            write(weighttype(1:80),'(a)') "wvvel"            write(weighttype(1:80),'(a)') "wvvel"
521            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
522       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
523       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wvvel, lxxadxx, mythid)
524  #endif  #endif
525    
526  #ifdef ALLOW_ETAN0_CONTROL  #ifdef ALLOW_ETAN0_CONTROL
# Line 594  C     place holder of obsolete variable Line 658  C     place holder of obsolete variable
658       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
659  #endif  #endif
660    
661            close ( cunit )  #ifdef ALLOW_KAPREDI_CONTROL
662              ivartype = 44
663              write(weighttype(1:80),'(80a)') ' '
664              write(weighttype(1:80),'(a)') "wkapredi"
665              call ctrl_set_pack_xyz(
666         &         cunit, ivartype, fname_kapredi(ictrlgrad), "maskCtrlC",
667         &         weighttype, wkapredi, lxxadxx, mythid)
668    #endif
669    
670          _END_MASTER( mythid )  #ifdef ALLOW_SHIFWFLX_CONTROL
671              ivartype = 45
672              write(weighttype(1:80),'(80a)') ' '
673              write(weighttype(1:80),'(a)') "wshifwflx"
674              call ctrl_set_pack_xy(
675         &         cunit, ivartype, fname_shifwflx(ictrlgrad),
676         &         "maskCtrlI", weighttype, lxxadxx, mythid)
677    #endif
678    
679    #ifdef ALLOW_PACKUNPACK_METHOD2
680          _BEGIN_MASTER( mythid )
681          IF ( myProcId .eq. 0 ) THEN
682    #endif
683    
684           close ( cunit )
685           ENDIF !IF ( myProcId .eq. 0 )
686           _END_MASTER( mythid )
687          _BARRIER
688    #endif /* (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) */
689  #endif /* EXCLUDE_CTRL_PACK */  #endif /* EXCLUDE_CTRL_PACK */
690    
691        return        return
692        end        end
   
Legend:
Removed from v.1.30  
changed lines
  Added in v.1.43
  ViewVC Help
Powered by ViewVC 1.1.22