/[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.5 by heimbach, Sat Jul 13 02:47:32 2002 UTC revision 1.22 by heimbach, Thu Jul 28 19:51:22 2005 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
6    
7  CBOP        subroutine ctrl_pack( first, mythid )
8  C     !ROUTINE: ctrl_pack  
9  C     !INTERFACE:  c     ==================================================================
10        subroutine ctrl_pack( myiter, mytime, mythid )  c     SUBROUTINE ctrl_pack
11    c     ==================================================================
12  C     !DESCRIPTION: \bv  c
13  c     *=================================================================  c     o Compress the control vector such that only ocean points are
14  c     | SUBROUTINE ctrl_pack  c       written to file.
15  c     | Pack the control vector  c
16  c     | * All control variable and adjoint variable fields are  c     started: Christian Eckert eckert@mit.edu  10-Mar=2000
17  c     |   read from disk.  c
18  c     | * Wet points are extracted, and elements are  c     changed: Patrick Heimbach heimbach@mit.edu 06-Jun-2000
19  c     |   normalized (optional)  c              - Transferred some filename declarations
20  c     | * A single control vector containing only (normalized  c                from here to namelist in ctrl_init
21  c     |   wet points is written to file.  c  
22  c     *=================================================================  c              Patrick Heimbach heimbach@mit.edu 16-Jun-2000
23  C     \ev  c              - single file name convention with or without
24    c                ALLOW_ECCO_OPTIMIZATION
25    c
26    c              G. Gebbie, added open boundary control packing,
27    c                  gebbie@mit.edu  18 -Mar- 2003
28    c
29    c              heimbach@mit.edu totally restructured 28-Oct-2003
30    c
31    c     ==================================================================
32    c     SUBROUTINE ctrl_pack
33    c     ==================================================================
34    
 C     !USES:  
35        implicit none        implicit none
36    
37  c     == global variables ==  c     == global variables ==
# Line 29  c     == global variables == Line 41  c     == global variables ==
41  #include "PARAMS.h"  #include "PARAMS.h"
42  #include "GRID.h"  #include "GRID.h"
43    
 #include "ecco.h"  
44  #include "ctrl.h"  #include "ctrl.h"
 #include "cost.h"  
   
 #ifdef ALLOW_ECCO_OPTIMIZATION  
45  #include "optim.h"  #include "optim.h"
46    
47    #ifdef ALLOW_COST
48    # include "cost.h"
49    #endif
50    #ifdef ALLOW_ECCO
51    # include "ecco_cost.h"
52    #else
53    # include "ctrl_weights.h"
54  #endif  #endif
55    
56  c     == routine arguments ==  c     == routine arguments ==
57    
58        integer myiter        logical first
       _RL     mytime  
59        integer mythid        integer mythid
60    
61    #ifndef EXCLUDE_CTRL_PACK
62  c     == local variables ==  c     == local variables ==
63    
64  #ifndef ALLOW_ECCO_OPTIMIZATION        _RL    fcloc
       integer optimcycle  
 #endif  
65    
66        integer i, j, k        integer i, j, k
67        integer ii        integer ii
# Line 60  c     == local variables == Line 74  c     == local variables ==
74        logical doglobalread        logical doglobalread
75        logical ladinit        logical ladinit
76        integer cbuffindex        integer cbuffindex
77          logical lxxadxx
78          
79        integer cunit        integer cunit
80        _RL     tmpvar        integer ictrlgrad
81    
82        character*(128) cfile        character*(128) cfile
83        character*( 80) weighttype        character*( 80) weighttype
84    
       character*( 80) fname_theta  
       character*( 80) fname_salt  
       character*( 80) fname_hflux  
       character*( 80) fname_sflux  
       character*( 80) fname_tauu  
       character*( 80) fname_tauv  
       character*( 80) adfname_theta  
       character*( 80) adfname_salt  
       character*( 80) adfname_hflux  
       character*( 80) adfname_sflux  
       character*( 80) adfname_tauu  
       character*( 80) adfname_tauv  
       character*( 80)   fname_atemp  
       character*( 80) adfname_atemp  
       character*( 80)   fname_aqh  
       character*( 80) adfname_aqh  
       character*( 80)   fname_uwind  
       character*( 80) adfname_uwind  
       character*( 80)   fname_vwind  
       character*( 80) adfname_vwind  
       character*( 80)   fname_obcsn  
       character*( 80) adfname_obcsn  
       character*( 80)   fname_obcss  
       character*( 80) adfname_obcss  
       character*( 80)   fname_obcsw  
       character*( 80) adfname_obcsw  
       character*( 80)   fname_obcse  
       character*( 80) adfname_obcse  
       character*( 80)   fname_diffkr  
       character*( 80) adfname_diffkr  
       character*( 80)   fname_kapgm  
       character*( 80) adfname_kapgm  
       character*( 80)   fname_tr1  
       character*( 80) adfname_tr1  
       character*( 80)   fname_efluxy  
       character*( 80) adfname_efluxy  
       character*( 80)   fname_efluxp  
       character*( 80) adfname_efluxp  
   
       logical lxxadxx  
   
85  c     == external ==  c     == external ==
86    
87        integer  ilnblnk        integer  ilnblnk
# Line 116  c     == external == Line 90  c     == external ==
90  c     == end of interface ==  c     == end of interface ==
91    
92  #ifndef ALLOW_ECCO_OPTIMIZATION  #ifndef ALLOW_ECCO_OPTIMIZATION
93        optimcycle = 0        fmin       = 0. _d 0
94  #endif  #endif
95    
       tmpvar = -9999. _d 0  
   
96  c--   Tiled files are used.  c--   Tiled files are used.
97        doglobalread = .false.        doglobalread = .false.
98    
99  c--   Initialise adjoint variables on active files.  c--   Initialise adjoint variables on active files.
100        ladinit = .false.        ladinit = .false.
101    
102    c--   Initialise global buffer index
103          nbuffglobal = 0
104    
105  c--   Assign file names.  c--   Assign file names.
106    
107        call ctrl_set_fname(        call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
108       I     xx_theta_file, fname_theta, adfname_theta, mythid )        call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
109        call ctrl_set_fname(        call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
110       I     xx_salt_file, fname_salt, adfname_salt, mythid )        call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
111        call ctrl_set_fname(        call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
112       I     xx_hflux_file, fname_hflux, adfname_hflux, mythid )        call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
113        call ctrl_set_fname(        call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
114       I     xx_sflux_file, fname_sflux, adfname_sflux, mythid )        call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
115        call ctrl_set_fname(        call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
116       I     xx_tauu_file, fname_tauu, adfname_tauu, mythid )        call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
117        call ctrl_set_fname(        call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
118       I     xx_tauv_file, fname_tauv, adfname_tauv, mythid )        call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
119        call ctrl_set_fname(        call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
120       I     xx_atemp_file, fname_atemp, adfname_atemp, mythid )        call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
121        call ctrl_set_fname(        call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
122       I     xx_aqh_file, fname_aqh, adfname_aqh, mythid )        call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
123        call ctrl_set_fname(        call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
124       I     xx_uwind_file, fname_uwind, adfname_uwind, mythid )        call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
125        call ctrl_set_fname(        call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
126       I     xx_vwind_file, fname_vwind, adfname_vwind, mythid )        call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
127        call ctrl_set_fname(        call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
128       I     xx_obcsn_file, fname_obcsn, adfname_obcsn, mythid )        call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)
129        call ctrl_set_fname(        call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
130       I     xx_obcss_file, fname_obcss, adfname_obcss, mythid )        call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
131        call ctrl_set_fname(        call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
132       I     xx_obcsw_file, fname_obcsw, adfname_obcsw, mythid )        call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
133        call ctrl_set_fname(        call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
134       I     xx_obcse_file, fname_obcse, adfname_obcse, mythid )        call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
135        call ctrl_set_fname(        call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
136       I     xx_diffkr_file, fname_diffkr, adfname_diffkr, mythid )        call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
137        call ctrl_set_fname(        call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
138       I     xx_kapgm_file, fname_kapgm, adfname_kapgm, mythid )        call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
       call ctrl_set_fname(  
      I     xx_tr1_file, fname_tr1, adfname_tr1, mythid )  
       call ctrl_set_fname(  
      I     xx_efluxy_file, fname_efluxy, adfname_efluxy, mythid )  
       call ctrl_set_fname(  
      I     xx_efluxp_file, fname_efluxp, adfname_efluxp, mythid )  
139    
140  c  c--   Only the master thread will do I/O.
 c--     Only the master thread will do I/O.  
141        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
142    
143  c     >>> Write control vector <<<        if ( first ) then
144    c     >>> Initialise control vector for optimcycle=0 <<<
145  cph   this part was removed since it's not necessary            lxxadxx   = .TRUE.
146  cph   and causes huge amounts of wall clock time on parallel machines            ictrlgrad = 1
147              fcloc     = fmin
148              write(cfile(1:128),'(4a,i4.4)')
149         &         ctrlname(1:9),'_',yctrlid(1:10),
150         &         yctrlpospack, optimcycle
151              print *, 'ph-pack: packing ', ctrlname(1:9)
152          else
153  c     >>> Write gradient vector <<<  c     >>> Write gradient vector <<<
154        lxxadxx = .FALSE.            lxxadxx   = .FALSE.
155              ictrlgrad = 2
156            call mdsfindunit( cunit, mythid )            fcloc     = fc
157            write(cfile(1:128),'(4a,i4.4)')            write(cfile(1:128),'(4a,i4.4)')
158       &    costname(1:9),'_',yctrlid(1:10),'.opt',       &         costname(1:9),'_',yctrlid(1:10),
159       &    optimcycle       &         yctrlpospack, optimcycle
160              print *, 'ph-pack: packing ', costname(1:9)
161            open( cunit, file   = cfile,         endif
162       &               status = 'unknown',  
163       &               form   = 'unformatted',         call mdsfindunit( cunit, mythid )
164       &               access  = 'sequential'   )         open( cunit, file   = cfile,
165         &      status = 'unknown',
166         &      form   = 'unformatted',
167         &      access  = 'sequential'   )
168    
169  c--       Header information.  c--       Header information.
170            write(cunit) nvartype            write(cunit) nvartype
# Line 198  c--       Header information. Line 172  c--       Header information.
172            write(cunit) yctrlid            write(cunit) yctrlid
173            write(cunit) optimCycle            write(cunit) optimCycle
174            write(cunit) fc            write(cunit) fc
175    C     place holder of obsolete variable iG
176            write(cunit) 1            write(cunit) 1
177    C     place holder of obsolete variable jG
178            write(cunit) 1            write(cunit) 1
179            write(cunit) 1            write(cunit) nsx
180            write(cunit) 1            write(cunit) nsy
181            write(cunit) (nWetcGlobal(k), k=1,nr)            write(cunit) (nWetcGlobal(k), k=1,nr)
182            write(cunit) (nWetsGlobal(k), k=1,nr)            write(cunit) (nWetsGlobal(k), k=1,nr)
183            write(cunit) (nWetwGlobal(k), k=1,nr)            write(cunit) (nWetwGlobal(k), k=1,nr)
184    #ifdef ALLOW_CTRL_WETV
185            write(cunit) (nWetvGlobal(k), k=1,nr)            write(cunit) (nWetvGlobal(k), k=1,nr)
186    #endif
187    
188  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
189            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)            write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
190  #endif  #endif
# Line 220  c--       Header information. Line 199  c--       Header information.
199  #endif  #endif
200            write(cunit) (ncvarindex(i), i=1,maxcvars)            write(cunit) (ncvarindex(i), i=1,maxcvars)
201            write(cunit) (ncvarrecs(i),  i=1,maxcvars)            write(cunit) (ncvarrecs(i),  i=1,maxcvars)
202            write(cunit) (nx,  i=1,maxcvars)            write(cunit) (ncvarxmax(i),  i=1,maxcvars)
203            write(cunit) (ny,  i=1,maxcvars)            write(cunit) (ncvarymax(i),  i=1,maxcvars)
204            write(cunit) (ncvarnrmax(i), i=1,maxcvars)            write(cunit) (ncvarnrmax(i), i=1,maxcvars)
205            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
206            write(cunit)            write(cunit)
207    
208  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
209            ivartype = 1            ivartype = 1
210              write(weighttype(1:80),'(80a)') ' '
211              write(weighttype(1:80),'(a)') "wtheta"
212            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
213       &         cunit, ivartype, adfname_theta, "hFacC",       &         cunit, ivartype, fname_theta(ictrlgrad), "maskCtrlC",
214       &         wtheta, lxxadxx, mythid)       &         weighttype, wtheta, lxxadxx, mythid)
215  #endif  #endif
216    
217  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
218            ivartype = 2            ivartype = 2
219              write(weighttype(1:80),'(80a)') ' '
220              write(weighttype(1:80),'(a)') "wsalt"
221            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
222       &         cunit, ivartype, adfname_salt, "hFacC",       &         cunit, ivartype, fname_salt(ictrlgrad), "maskCtrlC",
223       &         wsalt, lxxadxx, mythid)       &         weighttype, wsalt, lxxadxx, mythid)
224  #endif  #endif
225    
226  #if (defined (ALLOW_HFLUX_CONTROL) || \  #if (defined (ALLOW_HFLUX_CONTROL) || \
# Line 246  c--       Header information. Line 229  c--       Header information.
229            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
230            write(weighttype(1:80),'(a)') "whflux"            write(weighttype(1:80),'(a)') "whflux"
231            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
232       &         cunit, ivartype, adfname_hflux, "hFacC", weighttype,       &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",
233       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
234  #endif  #endif
235    
236  #if (defined (ALLOW_SFLUX_CONTROL) || \  #if (defined (ALLOW_SFLUX_CONTROL) || \
# Line 256  c--       Header information. Line 239  c--       Header information.
239            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
240            write(weighttype(1:80),'(a)') "wsflux"            write(weighttype(1:80),'(a)') "wsflux"
241            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
242       &         cunit, ivartype, adfname_sflux, "hFacC", weighttype,       &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",
243       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
244  #endif  #endif
245    
246  #if (defined (ALLOW_USTRESS_CONTROL) || \  #if (defined (ALLOW_USTRESS_CONTROL) || \
# Line 266  c--       Header information. Line 249  c--       Header information.
249            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
250            write(weighttype(1:80),'(a)') "wtauu"            write(weighttype(1:80),'(a)') "wtauu"
251            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
252       &         cunit, ivartype, adfname_tauu, "maskW", weighttype,       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
253       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
254  #endif  #endif
255    
256  #if (defined (ALLOW_VSTRESS_CONTROL) || \  #if (defined (ALLOW_VSTRESS_CONTROL) || \
# Line 276  c--       Header information. Line 259  c--       Header information.
259            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
260            write(weighttype(1:80),'(a)') "wtauv"            write(weighttype(1:80),'(a)') "wtauv"
261            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
262       &         cunit, ivartype, adfname_tauv, "maskS", weighttype,       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
263       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
264  #endif  #endif
265    
266  #ifdef ALLOW_ATEMP_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
# Line 285  c--       Header information. Line 268  c--       Header information.
268            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
269            write(weighttype(1:80),'(a)') "watemp"            write(weighttype(1:80),'(a)') "watemp"
270            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
271       &         cunit, ivartype, adfname_atemp, "hFacC", weighttype,       &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",
272       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
273  #endif  #endif
274    
275  #ifdef ALLOW_AQH_CONTROL  #ifdef ALLOW_AQH_CONTROL
# Line 294  c--       Header information. Line 277  c--       Header information.
277            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
278            write(weighttype(1:80),'(a)') "waqh"            write(weighttype(1:80),'(a)') "waqh"
279            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
280       &         cunit, ivartype, adfname_aqh, "hFacC", weighttype,       &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",
281       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
282  #endif  #endif
283    
284  #ifdef ALLOW_UWIND_CONTROL  #ifdef ALLOW_UWIND_CONTROL
# Line 303  c--       Header information. Line 286  c--       Header information.
286            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
287            write(weighttype(1:80),'(a)') "wuwind"            write(weighttype(1:80),'(a)') "wuwind"
288            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
289       &         cunit, ivartype, adfname_uwind, "maskW", weighttype,       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
290       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
291  #endif  #endif
292    
293  #ifdef ALLOW_VWIND_CONTROL  #ifdef ALLOW_VWIND_CONTROL
# Line 312  c--       Header information. Line 295  c--       Header information.
295            write(weighttype(1:80),'(80a)') ' '            write(weighttype(1:80),'(80a)') ' '
296            write(weighttype(1:80),'(a)') "wvwind"            write(weighttype(1:80),'(a)') "wvwind"
297            call ctrl_set_pack_xy(            call ctrl_set_pack_xy(
298       &         cunit, ivartype, adfname_vwind, "maskS", weighttype,       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
299       &         lxxadxx, mythid)       &         weighttype, lxxadxx, mythid)
300  #endif  #endif
301    
302  #ifdef ALLOW_OBCSN_CONTROL  #ifdef ALLOW_OBCSN_CONTROL
303            ivartype = 11            ivartype = 11
304              write(weighttype(1:80),'(80a)') ' '
305              write(weighttype(1:80),'(a)') "wobcsn"
306            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
307       &         cunit, ivartype, adfname_obcsn, "maskobcsn",       &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
308       &         wobcsn, lxxadxx, mythid)       &         weighttype, wobcsn, lxxadxx, mythid)
309  #endif  #endif
310    
311  #ifdef ALLOW_OBCSS_CONTROL  #ifdef ALLOW_OBCSS_CONTROL
312            ivartype = 12            ivartype = 12
313              write(weighttype(1:80),'(80a)') ' '
314              write(weighttype(1:80),'(a)') "wobcss"
315            call ctrl_set_pack_xz(            call ctrl_set_pack_xz(
316       &         cunit, ivartype, adfname_obcss, "maskobcss",       &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
317       &         wobcss, lxxadxx, mythid)       &         weighttype, wobcss, lxxadxx, mythid)
318  #endif  #endif
319    
320  #ifdef ALLOW_OBCSW_CONTROL  #ifdef ALLOW_OBCSW_CONTROL
321            ivartype = 13            ivartype = 13
322              write(weighttype(1:80),'(80a)') ' '
323              write(weighttype(1:80),'(a)') "wobcsw"
324            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
325       &         cunit, ivartype, adfname_obcsw, "maskobcsw",       &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
326       &         wobcsw, lxxadxx, mythid)       &         weighttype, wobcsw, lxxadxx, mythid)
327  #endif  #endif
328    
329  #ifdef ALLOW_OBCSE_CONTROL  #ifdef ALLOW_OBCSE_CONTROL
330            ivartype = 14            ivartype = 14
331              write(weighttype(1:80),'(80a)') ' '
332              write(weighttype(1:80),'(a)') "wobcse"
333            call ctrl_set_pack_yz(            call ctrl_set_pack_yz(
334       &         cunit, ivartype, adfname_obcse, "maskobcse",       &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
335       &         wobcse, lxxadxx, mythid)       &         weighttype, wobcse, lxxadxx, mythid)
336  #endif  #endif
337    
338  #ifdef ALLOW_DIFFKR_CONTROL  #ifdef ALLOW_DIFFKR_CONTROL
339            ivartype = 15            ivartype = 15
340              write(weighttype(1:80),'(80a)') ' '
341              write(weighttype(1:80),'(a)') "wdiffkr"
342            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
343       &         cunit, ivartype, adfname_diffkr, "hFacC",       &         cunit, ivartype, fname_diffkr(ictrlgrad), "maskCtrlC",
344       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
345  #endif  #endif
346    
347  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
348            ivartype = 16            ivartype = 16
349              write(weighttype(1:80),'(80a)') ' '
350              write(weighttype(1:80),'(a)') "wkapgm"
351            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
352       &         cunit, ivartype, adfname_kapgm, "hFacC",       &         cunit, ivartype, fname_kapgm(ictrlgrad), "maskCtrlC",
353       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
354  #endif  #endif
355    
356  #ifdef ALLOW_TR10_CONTROL  #ifdef ALLOW_TR10_CONTROL
357            ivartype = 17            ivartype = 17
358              write(weighttype(1:80),'(80a)') ' '
359              write(weighttype(1:80),'(a)') "wtr1"
360              call ctrl_set_pack_xyz(
361         &         cunit, ivartype, fname_tr1(ictrlgrad), "maskCtrlC",
362         &         weighttype, wunit, lxxadxx, mythid)
363    #endif
364    
365    #ifdef ALLOW_SST0_CONTROL
366              ivartype = 18
367              write(weighttype(1:80),'(80a)') ' '
368              write(weighttype(1:80),'(a)') "wsst0"
369              call ctrl_set_pack_xy(
370         &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",
371         &         weighttype, lxxadxx, mythid)
372    #endif
373    
374    #ifdef ALLOW_SSS0_CONTROL
375              ivartype = 19
376              write(weighttype(1:80),'(80a)') ' '
377              write(weighttype(1:80),'(a)') "wsss0"
378              call ctrl_set_pack_xy(
379         &         cunit, ivartype, fname_sss(ictrlgrad), "maskCtrlC",
380         &         weighttype, lxxadxx, mythid)
381    #endif
382    
383    #ifdef ALLOW_HFACC_CONTROL
384              ivartype = 20
385              write(weighttype(1:80),'(80a)') ' '
386              write(weighttype(1:80),'(a)') "whfacc"
387    # ifdef ALLOW_HFACC3D_CONTROL
388            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
389       &         cunit, ivartype, adfname_tr1, "hFacC",       &         cunit, ivartype, fname_hfacc(ictrlgrad), "maskCtrlC",
390       &         wunit, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
391    # else
392              call ctrl_set_pack_xy(
393         &         cunit, ivartype, fname_hfacc(ictrlgrad), "maskCtrlC",
394         &         weighttype, lxxadxx, mythid)
395    # endif
396  #endif  #endif
397    
 cph(  
           print *, 'ph-nondim bef. vor 21'  
           print *, 'ph-nondim aft. vor 21'  
 cph)  
398  #ifdef ALLOW_EFLUXY0_CONTROL  #ifdef ALLOW_EFLUXY0_CONTROL
399            ivartype = 21            ivartype = 21
400              write(weighttype(1:80),'(80a)') ' '
401              write(weighttype(1:80),'(a)') "wefluxy0"
402            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
403       &         cunit, ivartype, adfname_efluxy, "hFacS",       &         cunit, ivartype, fname_efluxy(ictrlgrad), "maskCtrlS",
404       &         wefluxy, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
405  #endif  #endif
406    
 cph(  
           print *, 'ph-nondim bef. vor 22'  
           print *, 'ph-nondim aft. vor 22'  
 cph)  
407  #ifdef ALLOW_EFLUXP0_CONTROL  #ifdef ALLOW_EFLUXP0_CONTROL
408            ivartype = 22            ivartype = 22
409              write(weighttype(1:80),'(80a)') ' '
410              write(weighttype(1:80),'(a)') "wefluxp0"
411              call ctrl_set_pack_xyz(
412         &         cunit, ivartype, fname_efluxp(ictrlgrad), "maskhFacV",
413         &         weighttype, wunit, lxxadxx, mythid)
414    #endif
415    
416    #ifdef ALLOW_BOTTOMDRAG_CONTROL
417              ivartype = 23
418              write(weighttype(1:80),'(80a)') ' '
419              write(weighttype(1:80),'(a)') "wbottomdrag"
420              call ctrl_set_pack_xy(
421         &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",
422         &      weighttype, lxxadxx, mythid)
423    #endif
424    
425    #ifdef ALLOW_EDTAUX_CONTROL
426              ivartype = 25
427              write(weighttype(1:80),'(80a)') ' '
428              write(weighttype(1:80),'(a)') "wedtaux"
429              call ctrl_set_pack_xyz(
430         &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
431         &         weighttype, wunit, lxxadxx, mythid)
432    #endif
433    
434    #ifdef ALLOW_EDTAUY_CONTROL
435              ivartype = 26
436              write(weighttype(1:80),'(80a)') ' '
437              write(weighttype(1:80),'(a)') "wedtauy"
438              call ctrl_set_pack_xyz(
439         &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskCtrlS",
440         &         weighttype, wunit, lxxadxx, mythid)
441    #endif
442    
443    #ifdef ALLOW_UVEL0_CONTROL
444              ivartype = 27
445              write(weighttype(1:80),'(80a)') ' '
446              write(weighttype(1:80),'(a)') "wuvel"
447              call ctrl_set_pack_xyz(
448         &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
449         &         weighttype, wunit, lxxadxx, mythid)
450    #endif
451    
452    #ifdef ALLOW_VVEL0_CONTROL
453              ivartype = 28
454              write(weighttype(1:80),'(80a)') ' '
455              write(weighttype(1:80),'(a)') "wvvel"
456            call ctrl_set_pack_xyz(            call ctrl_set_pack_xyz(
457       &         cunit, ivartype, adfname_efluxp, "hFacV",       &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
458       &         wefluxp, lxxadxx, mythid)       &         weighttype, wunit, lxxadxx, mythid)
459    #endif
460    
461    #ifdef ALLOW_ETAN0_CONTROL
462              ivartype = 29
463              write(weighttype(1:80),'(80a)') ' '
464              write(weighttype(1:80),'(a)') "wetan"
465              call ctrl_set_pack_xy(
466         &         cunit, ivartype, fname_etan(ictrlgrad), "maskCtrlC",
467         &         weighttype, lxxadxx, mythid)
468    #endif
469    
470    #ifdef ALLOW_RELAXSST_CONTROL
471              ivartype = 30
472              write(weighttype(1:80),'(80a)') ' '
473              write(weighttype(1:80),'(a)') "wrelaxsst"
474              call ctrl_set_pack_xy(
475         &         cunit, ivartype, fname_relaxsst(ictrlgrad), "maskCtrlC",
476         &         weighttype, lxxadxx, mythid)
477    #endif
478    
479    #ifdef ALLOW_RELAXSSS_CONTROL
480              ivartype = 31
481              write(weighttype(1:80),'(80a)') ' '
482              write(weighttype(1:80),'(a)') "wrelaxsss"
483              call ctrl_set_pack_xy(
484         &         cunit, ivartype, fname_relaxsss(ictrlgrad), "maskCtrlC",
485         &         weighttype, lxxadxx, mythid)
486    #endif
487    
488    #ifdef ALLOW_PRECIP_CONTROL
489              ivartype = 32
490              write(weighttype(1:80),'(80a)') ' '
491              write(weighttype(1:80),'(a)') "wprecip"
492              call ctrl_set_pack_xy(
493         &         cunit, ivartype, fname_precip(ictrlgrad), "maskCtrlC",
494         &         weighttype, lxxadxx, mythid)
495    #endif
496    
497    #ifdef ALLOW_SWFLUX_CONTROL
498              ivartype = 33
499              write(weighttype(1:80),'(80a)') ' '
500              write(weighttype(1:80),'(a)') "wswflux"
501              call ctrl_set_pack_xy(
502         &         cunit, ivartype, fname_swflux(ictrlgrad), "maskCtrlC",
503         &         weighttype, lxxadxx, mythid)
504  #endif  #endif
505    
 cph(  
           print *, 'ph-nondim bef. ende'  
           print *, 'ph-nondim aft. ende'  
 cph)  
506            close ( cunit )            close ( cunit )
507    
508          _END_MASTER( mythid )          _END_MASTER( mythid )
509    
510    #endif /* EXCLUDE_CTRL_PACK */
511    
512        return        return
513        end        end
514    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22