/[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.41 by jmc, Fri Jul 6 23:10:28 2012 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
 #include "PACKAGES_CONFIG.h"  
4  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
5    #include "AD_CONFIG.h"
6    
7        subroutine ctrl_pack( first, mythid )        subroutine ctrl_pack( first, mythid )
8    
# Line 18  c Line 18  c
18  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
19  c              - Transferred some filename declarations  c              - Transferred some filename declarations
20  c                from here to namelist in ctrl_init  c                from here to namelist in ctrl_init
21  c    c
22  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000
23  c              - single file name convention with or without  c              - single file name convention with or without
24  c                ALLOW_ECCO_OPTIMIZATION  c                ALLOW_ECCO_OPTIMIZATION
# Line 59  c     == routine arguments == Line 59  c     == routine arguments ==
59        integer mythid        integer mythid
60    
61  #ifndef EXCLUDE_CTRL_PACK  #ifndef EXCLUDE_CTRL_PACK
62    #if (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN))
63  c     == local variables ==  c     == local variables ==
64    
65        _RL    fcloc        _RL    fcloc
# Line 75  c     == local variables == Line 76  c     == local variables ==
76        logical ladinit        logical ladinit
77        integer cbuffindex        integer cbuffindex
78        logical lxxadxx        logical lxxadxx
79          
80        integer cunit        integer cunit
81        integer ictrlgrad        integer ictrlgrad
82    
# Line 130  c--   Assign file names. Line 131  c--   Assign file names.
131        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
132        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
133        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
134          call ctrl_set_fname(xx_kapredi_file, fname_kapredi, mythid)
135        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
136        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
137        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 149  c--   Assign file names.
149        call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)        call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)
150        call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)        call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)
151        call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)        call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)
152    cHFLUXM_CONTROL
153          call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid)
154    cHFLUXM_CONTROL
155          call ctrl_set_fname(xx_shifwflx_file, fname_shifwflx, mythid)
156    
157  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
158        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
# Line 157  c     >>> Initialise control vector for Line 163  c     >>> Initialise control vector for
163            ictrlgrad = 1            ictrlgrad = 1
164            fcloc     = fmin            fcloc     = fmin
165            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
166       &         ctrlname(1:9),'_',yctrlid(1:10),       &         ctrlname(1:9),'_',yctrlid(1:10),
167       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
168            print *, 'ph-pack: packing ', ctrlname(1:9)            print *, 'ph-pack: packing ', ctrlname(1:9)
169        else        else
# Line 166  c     >>> Write gradient vector <<< Line 172  c     >>> Write gradient vector <<<
172            ictrlgrad = 2            ictrlgrad = 2
173            fcloc     = fc            fcloc     = fc
174            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
175       &         costname(1:9),'_',yctrlid(1:10),       &         costname(1:9),'_',yctrlid(1:10),
176       &         yctrlpospack, optimcycle       &         yctrlpospack, optimcycle
177            print *, 'ph-pack: packing ', costname(1:9)            print *, 'ph-pack: packing ', costname(1:9)
178         endif         endif
179    
180    c--   Only Proc 0 will do I/O.
181          IF ( myProcId .eq. 0 ) THEN
182    
183         call mdsfindunit( cunit, mythid )         call mdsfindunit( cunit, mythid )
184         open( cunit, file   = cfile,         open( cunit, file   = cfile,
185       &      status = 'unknown',       &      status = 'unknown',
# Line 195  C     place holder of obsolete variable Line 204  C     place holder of obsolete variable
204  #ifdef ALLOW_CTRL_WETV  #ifdef ALLOW_CTRL_WETV
205            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
206  #endif  #endif
207    #ifdef ALLOW_SHIFWFLX_CONTROL
208              write(cunit) (nWetiGlobal(k), k=1,nr)
209    c          write(cunit) nWetiGlobal(1)
210    #endif
211    
212  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
213            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 229  C     place holder of obsolete variable
229            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
230            write(cunit)            write(cunit)
231    
232    #ifdef ALLOW_PACKUNPACK_METHOD2
233          ENDIF
234          _END_MASTER( mythid )
235          _BARRIER
236    #endif
237    
238  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
239            ivartype = 1            ivartype = 1
240            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
# Line 257  C     place holder of obsolete variable Line 276  C     place holder of obsolete variable
276            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
277            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
278            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
279    #ifndef ALLOW_ROTATE_UV_CONTROLS
280       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
281    #else
282         &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlC",
283    #endif
284       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
285  #endif  #endif
286    
# Line 266  C     place holder of obsolete variable Line 289  C     place holder of obsolete variable
289            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
290            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
291            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
292    #ifndef ALLOW_ROTATE_UV_CONTROLS
293       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
294    #else
295         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlC",
296    #endif
297       &         weighttype, lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
298  #endif  #endif
299    
# Line 423  C     place holder of obsolete variable Line 450  C     place holder of obsolete variable
450       &      weighttype, lxxadxx, mythid)       &      weighttype, lxxadxx, mythid)
451  #endif  #endif
452    
453  #ifdef ALLOW_EDTAUX_CONTROL  #ifdef ALLOW_HFLUXM_CONTROL
454              ivartype = 24
455              write(weighttype(1:80),'(80a)') ' '
456              write(weighttype(1:80),'(a)') "whfluxm"
457              call ctrl_set_pack_xy(
458         &         cunit, ivartype, fname_hfluxm(ictrlgrad), "maskCtrlC",
459         &         weighttype, lxxadxx, mythid)
460    #endif
461    
462    #ifdef ALLOW_EDDYPSI_CONTROL
463            ivartype = 25            ivartype = 25
464            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
465            write(weighttype(1:80),'(a)') "wedtaux"            write(weighttype(1:80),'(a)') "wedtaux"
466            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
467       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
468       &         weighttype, wedtaux, lxxadxx, mythid)       &         weighttype, wedtaux, lxxadxx, mythid)
 #endif  
469    
 #ifdef ALLOW_EDTAUY_CONTROL  
470            ivartype = 26            ivartype = 26
471            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
472            write(weighttype(1:80),'(a)') "wedtauy"            write(weighttype(1:80),'(a)') "wedtauy"
# Line 447  C     place holder of obsolete variable Line 481  C     place holder of obsolete variable
481            write(weighttype(1:80),'(a)') "wuvel"            write(weighttype(1:80),'(a)') "wuvel"
482            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
483       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",       &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
484       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wuvel, lxxadxx, mythid)
485  #endif  #endif
486    
487  #ifdef ALLOW_VVEL0_CONTROL  #ifdef ALLOW_VVEL0_CONTROL
# Line 456  C     place holder of obsolete variable Line 490  C     place holder of obsolete variable
490            write(weighttype(1:80),'(a)') "wvvel"            write(weighttype(1:80),'(a)') "wvvel"
491            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
492       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
493       &         weighttype, wunit, lxxadxx, mythid)       &         weighttype, wvvel, lxxadxx, mythid)
494  #endif  #endif
495    
496  #ifdef ALLOW_ETAN0_CONTROL  #ifdef ALLOW_ETAN0_CONTROL
# Line 594  C     place holder of obsolete variable Line 628  C     place holder of obsolete variable
628       &         "maskCtrlC", weighttype, lxxadxx, mythid)       &         "maskCtrlC", weighttype, lxxadxx, mythid)
629  #endif  #endif
630    
631            close ( cunit )  #ifdef ALLOW_KAPREDI_CONTROL
632              ivartype = 44
633              write(weighttype(1:80),'(80a)') ' '
634              write(weighttype(1:80),'(a)') "wkapredi"
635              call ctrl_set_pack_xyz(
636         &         cunit, ivartype, fname_kapredi(ictrlgrad), "maskCtrlC",
637         &         weighttype, wkapredi, lxxadxx, mythid)
638    #endif
639    
640    #ifdef ALLOW_SHIFWFLX_CONTROL
641              ivartype = 45
642              write(weighttype(1:80),'(80a)') ' '
643              write(weighttype(1:80),'(a)') "wshifwflx"
644              call ctrl_set_pack_xy(
645         &         cunit, ivartype, fname_shifwflx(ictrlgrad),
646         &         "maskCtrlI", weighttype, lxxadxx, mythid)
647    #endif
648    
649          _END_MASTER( mythid )  #ifdef ALLOW_PACKUNPACK_METHOD2
650          _BEGIN_MASTER( mythid )
651          IF ( myProcId .eq. 0 ) THEN
652    #endif
653    
654           close ( cunit )
655           ENDIF !IF ( myProcId .eq. 0 )
656           _END_MASTER( mythid )
657          _BARRIER
658    #endif /* (defined (ALLOW_ADJOINT_RUN)||defined (ALLOW_TANGENTLINEAR_RUN)) */
659  #endif /* EXCLUDE_CTRL_PACK */  #endif /* EXCLUDE_CTRL_PACK */
660    
661        return        return
662        end        end
   
Legend:
Removed from v.1.30  
changed lines
  Added in v.1.41
  ViewVC Help
Powered by ViewVC 1.1.22