/[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.1 by heimbach, Sun Mar 25 22:33:55 2001 UTC revision 1.12 by heimbach, Thu Nov 6 22:05:08 2003 UTC
# Line 1  Line 1 
1    C
2  C $Header$  C $Header$
3    C $Name$
4    
5    #include "PACKAGES_CONFIG.h"
6  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
7    
8          subroutine ctrl_pack( first, mythid )
       subroutine ctrl_pack(  
      I                      myiter,  
      I                      mytime,  
      I                      mythid  
      &                    )  
9    
10  c     ==================================================================  c     ==================================================================
11  c     SUBROUTINE ctrl_pack  c     SUBROUTINE ctrl_pack
# Line 26  c              Patrick Heimbach heimbach Line 24  c              Patrick Heimbach heimbach
24  c              - single file name convention with or without  c              - single file name convention with or without
25  c                ALLOW_ECCO_OPTIMIZATION  c                ALLOW_ECCO_OPTIMIZATION
26  c  c
27    c              G. Gebbie, added open boundary control packing,
28    c                  gebbie@mit.edu  18 -Mar- 2003
29    c
30    c              heimbach@mit.edu totally restructured 28-Oct-2003
31  c  c
32  c     ==================================================================  c     ==================================================================
33  c     SUBROUTINE ctrl_pack  c     SUBROUTINE ctrl_pack
# Line 43  c     == global variables == Line 45  c     == global variables ==
45  #include "ctrl.h"  #include "ctrl.h"
46  #include "cost.h"  #include "cost.h"
47    
48    #ifdef ALLOW_ECCO
49    # include "ecco_cost.h"
50    #else
51    # include "ctrl_weights.h"
52    #endif
53    
54    #ifdef ALLOW_ECCO_OPTIMIZATION
55    # include "optim.h"
56    #endif
57    
58  c     == routine arguments ==  c     == routine arguments ==
59    
60        integer myiter        logical first
       _RL     mytime  
61        integer mythid        integer mythid
62    
63    #ifndef EXCLUDE_CTRL_PACK
64  c     == local variables ==  c     == local variables ==
65    
66        integer bi,bj  #ifndef ALLOW_ECCO_OPTIMIZATION
67        integer ip,jp        integer optimcycle
68        integer i,j,k        _RL    fmin
69    #endif
70    
71          _RL    fcloc
72    
73          integer i, j, k
74        integer ii        integer ii
75        integer il        integer il
76        integer irec        integer irec
77        integer itlo,ithi        integer ig,jg
78        integer jtlo,jthi        integer ivartype
79        integer jmin,jmax        integer iobcs
       integer imin,imax  
80    
81        logical doglobalread        logical doglobalread
82        logical ladinit        logical ladinit
83        integer cbuffindex        integer cbuffindex
84          logical lxxadxx
85          
86        integer cunit        integer cunit
87        _RL     cbuff( snx*nsx*npx*sny*nsy*npy )        integer ictrlgrad
       _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )  
       _RL     globfld2d( snx,nsx,npx,sny,nsy,npy )  
       _RL     globmsk( snx,nsx,npx,sny,nsy,npy,nr )  
       _RL     tmpvar  
88    
89        character*(128) cfile        character*(128) cfile
90        character*( 80) fname        character*( 80) weighttype
   
       integer prec  
91    
92  c     == external ==  c     == external ==
93    
# Line 85  c     == external == Line 96  c     == external ==
96    
97  c     == end of interface ==  c     == end of interface ==
98    
99        prec           = precFloat64  #ifndef ALLOW_ECCO_OPTIMIZATION
100        tmpvar         = -9999. _d 0        optimcycle = 0
101          fmin       = 0. _d 0
102        jtlo = 1  #endif
       jthi = nsy  
       itlo = 1  
       ithi = nsx  
       jmin = 1  
       jmax = sny  
       imin = 1  
       imax = snx  
103    
104  c--   Tiled files are used.  c--   Tiled files are used.
105        doglobalread = .false.        doglobalread = .false.
# Line 103  c--   Tiled files are used. Line 107  c--   Tiled files are used.
107  c--   Initialise adjoint variables on active files.  c--   Initialise adjoint variables on active files.
108        ladinit = .false.        ladinit = .false.
109    
110    c--   Assign file names.
111    
112          call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
113          call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
114          call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
115          call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
116          call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
117          call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
118          call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
119          call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
120          call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
121          call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
122          call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
123          call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
124          call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
125          call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
126          call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
127          call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
128          call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
129          call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
130          call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
131          call ctrl_set_fname(xx_hfacc_file, fname_hfacc, mythid)
132          call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
133          call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
134          call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
135    
136  c  c
137  c--   Only the master thread will do I/O.  c--     Only the master thread will do I/O.
138        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
139    
140  c--   read global mask file        if ( first .AND. optimcycle .EQ. 0 ) then
141            call MDSREADFIELD_3D_GL( "hFacC",  c     >>> Initialise control vector for optimcycle=0 <<<
142       &                           prec, 'RL', Nr, globmsk,            lxxadxx   = .TRUE.
143       &                           1,  mythid)            ictrlgrad = 1
144              fcloc     = fmin
145              write(cfile(1:128),'(4a,i4.4)')
146  c     >>> Write control vector <<<       &      ctrlname(1:9),'_',yctrlid(1:10),'.opt', optimcycle
147          else
148            call mdsfindunit( cunit, mythid )  c     >>> Write gradient vector <<<
149            write(cfile(1:128),'(2a,i4.4)')            lxxadxx   = .FALSE.
150       &      ctrlname(1:9),'.opt',            ictrlgrad = 2
151       &      optimcycle            fcloc     = fc
152              write(cfile(1:128),'(4a,i4.4)')
153            open( cunit, file   = cfile,       &    costname(1:9),'_',yctrlid(1:10),'.opt', optimcycle
154       &                 status = 'unknown',         endif
155       &                 form   = 'unformatted',  
156       &                 access = 'sequential'   )         call mdsfindunit( cunit, mythid )
157           open( cunit, file   = cfile,
158         &      status = 'unknown',
159         &      form   = 'unformatted',
160         &      access  = 'sequential'   )
161    
162  c--       Header information.  c--       Header information.
             
163            write(cunit) nvartype            write(cunit) nvartype
164            write(cunit) nvarlength            write(cunit) nvarlength
165            write(cunit) expId            write(cunit) yctrlid
166            write(cunit) optimCycle            write(cunit) optimCycle
167            write(cunit) tmpvar            write(cunit) fcloc
           write(cunit) 1  
           write(cunit) 1  
           write(cunit) 1  
           write(cunit) 1  
           write(cunit) (nWetcTile(1,1,k), k=1,nr)  
           write(cunit) (nWetsTile(1,1,k), k=1,nr)  
           write(cunit) (nWetwTile(1,1,k), k=1,nr)  
           write(cunit) (ncvarindex(i), i=1,maxcvars)  
           write(cunit) (ncvarrecs(i),  i=1,maxcvars)  
           write(cunit) (nx,  i=1,maxcvars)  
           write(cunit) (ny,  i=1,maxcvars)  
           write(cunit) (ncvarnrmax(i), i=1,maxcvars)  
           write(cunit) (ncvargrd(i),   i=1,maxcvars)  
           write(cunit)  
   
 #ifdef ALLOW_THETA0_CONTROL  
   
           il=ilnblnk( xx_theta_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_theta_file(1:il),'.',optimcycle  
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr, globfld3d,  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(1)  
           write(cunit) 1  
           write(cunit) 1  
           do k = 1,nr  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(wtheta(k,bi,bj))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
          enddo  
   
 #endif  
   
 #ifdef ALLOW_SALT0_CONTROL  
   
           il=ilnblnk( xx_salt_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_salt_file(1:il),'.',optimcycle  
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr, globfld3d,  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(2)  
168            write(cunit) 1            write(cunit) 1
169            write(cunit) 1            write(cunit) 1
           do k = 1,nr  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(wsalt(k,bi,bj))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
          enddo  
               
 #endif  
   
 #ifdef ALLOW_HFLUX0_CONTROL  
   
           il=ilnblnk( xx_hflux_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_hflux_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "whflux",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(3)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
 #endif  
   
 #ifdef ALLOW_SFLUX0_CONTROL  
   
           il=ilnblnk( xx_sflux_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_sflux_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "wsflux",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(4)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
 #endif  
   
 #ifdef ALLOW_TAUU0_CONTROL  
   
           il=ilnblnk( xx_tauu_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_tauu_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "wtauu",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(5)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
 #endif  
   
 #ifdef ALLOW_TAUV0_CONTROL  
   
           il=ilnblnk( xx_tauv_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_tauv_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "wtauv",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(6)  
170            write(cunit) 1            write(cunit) 1
171            write(cunit) 1            write(cunit) 1
172            k = 1            write(cunit) (nWetcGlobal(k), k=1,nr)
173             cbuffindex = 0            write(cunit) (nWetsGlobal(k), k=1,nr)
174              do jp = 1,nPy            write(cunit) (nWetwGlobal(k), k=1,nr)
175               do bj = jtlo,jthi  #ifdef ALLOW_CTRL_WETV
176                do j = jmin,jmax            write(cunit) (nWetvGlobal(k), k=1,nr)
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
177  #endif  #endif
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
178    
179    #ifdef ALLOW_OBCSN_CONTROL
180              write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
181  #endif  #endif
182    #ifdef ALLOW_OBCSS_CONTROL
183  #ifdef ALLOW_SST0_CONTROL            write(cunit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
   
           il=ilnblnk( xx_sst_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_sst_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "wsst",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(7)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
184  #endif  #endif
185    #ifdef ALLOW_OBCSW_CONTROL
186  #ifdef ALLOW_SSS0_CONTROL            write(cunit) ((nWetobcswGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
   
           il=ilnblnk( xx_sss_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_sss_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "wsss",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(8)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
187  #endif  #endif
188                      endif  #ifdef ALLOW_OBCSE_CONTROL
189                   enddo            write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
190  #endif  #endif
   
   
           close ( cunit )  
   
         _END_MASTER( mythid )  
   
 c======================================================================  
   
 c--   read global mask file  
           call MDSREADFIELD_3D_GL( "hFacC",  
      &                           prec, 'RL', Nr, globmsk,  
      &                           1,  mythid)  
   
 c     >>> Write gradient vector <<<  
   
           call mdsfindunit( cunit, mythid )  
           write(cfile(1:128),'(2a,i4.4)')  
      &    costname(1:9),'.opt',  
      &    optimcycle  
   
           open( cunit, file   = cfile,  
      &               status = 'unknown',  
      &               form   = 'unformatted',  
      &               access  = 'sequential'   )  
   
 c--       Header information.  
           write(cunit) nvartype  
           write(cunit) nvarlength  
           write(cunit) expId  
           write(cunit) optimCycle  
           write(cunit) fc  
           write(cunit) 1  
           write(cunit) 1  
           write(cunit) 1  
           write(cunit) 1  
           write(cunit) (nWetcTile(1,1,k), k=1,nr)  
           write(cunit) (nWetsTile(1,1,k), k=1,nr)  
           write(cunit) (nWetwTile(1,1,k), k=1,nr)  
191            write(cunit) (ncvarindex(i), i=1,maxcvars)            write(cunit) (ncvarindex(i), i=1,maxcvars)
192            write(cunit) (ncvarrecs(i),  i=1,maxcvars)            write(cunit) (ncvarrecs(i),  i=1,maxcvars)
193            write(cunit) (nx,  i=1,maxcvars)            write(cunit) (nx,  i=1,maxcvars)
# Line 597  c--       Header information. Line 197  c--       Header information.
197            write(cunit)            write(cunit)
198    
199  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_THETA0_CONTROL
200              ivartype = 1
201            il=ilnblnk( xx_theta_file)            write(weighttype(1:80),'(80a)') ' '
202            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "wtheta"
203            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xyz(
204       &         yadmark,xx_theta_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_theta(ictrlgrad), "hFacC",
205         &         weighttype, wtheta, lxxadxx, mythid)
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr,  
      &                          globfld3d,  
      &                          1,  mythid)  
             
           write(cunit) ncvarindex(1)  
           write(cunit) 1  
           write(cunit) 1  
           do k = 1,nr  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(wtheta(k,bi,bj))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
          enddo  
   
206  #endif  #endif
207    
208  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
209              ivartype = 2
210            il=ilnblnk( xx_salt_file)            write(weighttype(1:80),'(80a)') ' '
211            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "wsalt"
212            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xyz(
213       &         yadmark,xx_salt_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_salt(ictrlgrad), "hFacC",
214         &         weighttype, wsalt, lxxadxx, mythid)
215            call MDSREADFIELD_3D_GL( fname,  #endif
216       &                          prec, 'RL', Nr,  
217       &                          globfld3d,  #if (defined (ALLOW_HFLUX_CONTROL) || \
218       &                          1,  mythid)       defined (ALLOW_HFLUX0_CONTROL))
219                        ivartype = 3
220            write(cunit) ncvarindex(2)            write(weighttype(1:80),'(80a)') ' '
221            write(cunit) 1            write(weighttype(1:80),'(a)') "whflux"
222            write(cunit) 1            call ctrl_set_pack_xy(
223            do k = 1,nr       &         cunit, ivartype, fname_hflux(ictrlgrad), "hFacC",
224             cbuffindex = 0       &         weighttype, lxxadxx, mythid)
225              do jp = 1,nPy  #endif
226               do bj = jtlo,jthi  
227                do j = jmin,jmax  #if (defined (ALLOW_SFLUX_CONTROL) || \
228                 do ip = 1,nPx       defined (ALLOW_SFLUX0_CONTROL))
229                  do bi = itlo,ithi            ivartype = 4
230                   do i = imin,imax            write(weighttype(1:80),'(80a)') ' '
231                      if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then            write(weighttype(1:80),'(a)') "wsflux"
232                         cbuffindex = cbuffindex + 1            call ctrl_set_pack_xy(
233  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO       &         cunit, ivartype, fname_sflux(ictrlgrad), "hFacC",
234                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)       &         weighttype, lxxadxx, mythid)
235       &                      * sqrt(wsalt(k,bi,bj))  #endif
236  #else  
237                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  #if (defined (ALLOW_USTRESS_CONTROL) || \
238  #endif       defined (ALLOW_TAUU0_CONTROL))
239                      endif            ivartype = 5
240                   enddo            write(weighttype(1:80),'(80a)') ' '
241                  enddo            write(weighttype(1:80),'(a)') "wtauu"
242                 enddo            call ctrl_set_pack_xy(
243                enddo       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskW",
244               enddo       &         weighttype, lxxadxx, mythid)
245              enddo  #endif
246  c     --> check cbuffindex.  
247              if ( cbuffindex .gt. 0) then  #if (defined (ALLOW_VSTRESS_CONTROL) || \
248                 write(cunit) cbuffindex       defined (ALLOW_TAUV0_CONTROL))
249                 write(cunit) k            ivartype = 6
250                 write(cunit) (cbuff(ii), ii=1,cbuffindex)            write(weighttype(1:80),'(80a)') ' '
251              endif            write(weighttype(1:80),'(a)') "wtauv"
252           enddo            call ctrl_set_pack_xy(
253         &         cunit, ivartype, fname_tauv(ictrlgrad), "maskS",
254  #endif       &         weighttype, lxxadxx, mythid)
255    #endif
256    
257  #ifdef ALLOW_HFLUX0_CONTROL  #ifdef ALLOW_ATEMP_CONTROL
258              ivartype = 7
259            il=ilnblnk( xx_hflux_file)            write(weighttype(1:80),'(80a)') ' '
260            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "watemp"
261            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xy(
262       &         yadmark,xx_hflux_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_atemp(ictrlgrad), "hFacC",
263  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO       &         weighttype, lxxadxx, mythid)
264            call MDSREADFIELD_2D_GL( "whflux",  #endif
265       &                          prec, 'RL', 1,  
266       &                          globfld2d,  #ifdef ALLOW_AQH_CONTROL
267       &                          1,  mythid)            ivartype = 8
268  #endif            write(weighttype(1:80),'(80a)') ' '
269            call MDSREADFIELD_2D_GL( fname,            write(weighttype(1:80),'(a)') "waqh"
270       &                          prec, 'RL', 1,            call ctrl_set_pack_xy(
271       &                          globfld3d(1,1,1,1,1,1,1),       &         cunit, ivartype, fname_aqh(ictrlgrad), "hFacC",
272       &                          1,  mythid)       &         weighttype, lxxadxx, mythid)
273    #endif
274            write(cunit) ncvarindex(3)  
275            write(cunit) 1  #ifdef ALLOW_UWIND_CONTROL
276            write(cunit) 1            ivartype = 9
277            k = 1            write(weighttype(1:80),'(80a)') ' '
278             cbuffindex = 0            write(weighttype(1:80),'(a)') "wuwind"
279              do jp = 1,nPy            call ctrl_set_pack_xy(
280               do bj = jtlo,jthi       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskW",
281                do j = jmin,jmax       &         weighttype, lxxadxx, mythid)
282                 do ip = 1,nPx  #endif
283                  do bi = itlo,ithi  
284                   do i = imin,imax  #ifdef ALLOW_VWIND_CONTROL
285                      if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then            ivartype = 10
286                         cbuffindex = cbuffindex + 1            write(weighttype(1:80),'(80a)') ' '
287  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO            write(weighttype(1:80),'(a)') "wvwind"
288                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)            call ctrl_set_pack_xy(
289       &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskS",
290  #else       &         weighttype, lxxadxx, mythid)
291                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  #endif
292  #endif  
293                      endif  #ifdef ALLOW_OBCSN_CONTROL
294                   enddo            ivartype = 11
295                  enddo            write(weighttype(1:80),'(80a)') ' '
296                 enddo            write(weighttype(1:80),'(a)') "wobcsn"
297                enddo            call ctrl_set_pack_xz(
298               enddo       &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
299              enddo       &         weighttype, wobcsn, lxxadxx, mythid)
300  c     --> check cbuffindex.  #endif
301              if ( cbuffindex .gt. 0) then  
302                 write(cunit) cbuffindex  #ifdef ALLOW_OBCSS_CONTROL
303                 write(cunit) k            ivartype = 12
304                 write(cunit) (cbuff(ii), ii=1,cbuffindex)            write(weighttype(1:80),'(80a)') ' '
305              endif            write(weighttype(1:80),'(a)') "wobcss"
306              call ctrl_set_pack_xz(
307  #endif       &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
308         &         weighttype, wobcss, lxxadxx, mythid)
309  #ifdef ALLOW_SFLUX0_CONTROL  #endif
310    
311            il=ilnblnk( xx_sflux_file)  #ifdef ALLOW_OBCSW_CONTROL
312            write(fname(1:80),'(80a)') ' '            ivartype = 13
313            write(fname(1:80),'(3a,i10.10)')            write(weighttype(1:80),'(80a)') ' '
314       &         yadmark,xx_sflux_file(1:il),'.',optimcycle            write(weighttype(1:80),'(a)') "wobcsw"
315  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO            call ctrl_set_pack_yz(
316            call MDSREADFIELD_2D_GL( "wsflux",       &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
317       &                          prec, 'RL', 1,       &         weighttype, wobcsw, lxxadxx, mythid)
318       &                          globfld2d,  #endif
319       &                          1,  mythid)  
320  #endif  #ifdef ALLOW_OBCSE_CONTROL
321            call MDSREADFIELD_2D_GL( fname,            ivartype = 14
322       &                          prec, 'RL', 1,            write(weighttype(1:80),'(80a)') ' '
323       &                          globfld3d(1,1,1,1,1,1,1),            write(weighttype(1:80),'(a)') "wobcse"
324       &                          1,  mythid)            call ctrl_set_pack_yz(
325         &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
326            write(cunit) ncvarindex(4)       &         weighttype, wobcse, lxxadxx, mythid)
327            write(cunit) 1  #endif
328            write(cunit) 1  
329            k = 1  #ifdef ALLOW_DIFFKR_CONTROL
330             cbuffindex = 0            ivartype = 15
331              do jp = 1,nPy            write(weighttype(1:80),'(80a)') ' '
332               do bj = jtlo,jthi            write(weighttype(1:80),'(a)') "wdiffkr"
333                do j = jmin,jmax            call ctrl_set_pack_xyz(
334                 do ip = 1,nPx       &         cunit, ivartype, fname_diffkr(ictrlgrad), "hFacC",
335                  do bi = itlo,ithi       &         weighttype, wunit, lxxadxx, mythid)
336                   do i = imin,imax  #endif
337                      if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
338                         cbuffindex = cbuffindex + 1  #ifdef ALLOW_KAPGM_CONTROL
339  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO            ivartype = 16
340                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)            write(weighttype(1:80),'(80a)') ' '
341       &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))            write(weighttype(1:80),'(a)') "wkapgm"
342  #else            call ctrl_set_pack_xyz(
343                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)       &         cunit, ivartype, fname_kapgm(ictrlgrad), "hFacC",
344  #endif       &         weighttype, wunit, lxxadxx, mythid)
345                      endif  #endif
346                   enddo  
347                  enddo  #ifdef ALLOW_TR10_CONTROL
348                 enddo            ivartype = 17
349                enddo            write(weighttype(1:80),'(80a)') ' '
350               enddo            write(weighttype(1:80),'(a)') "wtr1"
351              enddo            call ctrl_set_pack_xyz(
352  c     --> check cbuffindex.       &         cunit, ivartype, fname_tr1(ictrlgrad), "hFacC",
353              if ( cbuffindex .gt. 0) then       &         weighttype, wunit, lxxadxx, mythid)
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
 #endif  
   
 #ifdef ALLOW_TAUU0_CONTROL  
   
           il=ilnblnk( xx_tauu_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(3a,i10.10)')  
      &         yadmark,xx_tauu_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "wtauu",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(5)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
 #endif  
   
 #ifdef ALLOW_TAUV0_CONTROL  
   
           il=ilnblnk( xx_tauv_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(3a,i10.10)')  
      &         yadmark,xx_tauv_file(1:il),'.',optimcycle  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
           call MDSREADFIELD_2D_GL( "wtauv",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(6)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
354  #endif  #endif
355    
356  #ifdef ALLOW_SST0_CONTROL  #ifdef ALLOW_SST0_CONTROL
357              ivartype = 18
358            il=ilnblnk( xx_sst_file)            write(weighttype(1:80),'(80a)') ' '
359            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "wsst0"
360            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xy(
361       &         yadmark,xx_sst_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_sst(ictrlgrad), "hFacC",
362  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO       &         weighttype, lxxadxx, mythid)
           call MDSREADFIELD_2D_GL( "wsst",  
      &                          prec, 'RL', 1,  
      &                          globfld2d,  
      &                          1,  mythid)  
 #endif  
           call MDSREADFIELD_2D_GL( fname,  
      &                          prec, 'RL', 1,  
      &                          globfld3d(1,1,1,1,1,1,1),  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(7)  
           write(cunit) 1  
           write(cunit) 1  
           k = 1  
            cbuffindex = 0  
             do jp = 1,nPy  
              do bj = jtlo,jthi  
               do j = jmin,jmax  
                do ip = 1,nPx  
                 do bi = itlo,ithi  
                  do i = imin,imax  
                     if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  
                        cbuffindex = cbuffindex + 1  
 #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
      &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
 #endif  
                     endif  
                  enddo  
                 enddo  
                enddo  
               enddo  
              enddo  
             enddo  
 c     --> check cbuffindex.  
             if ( cbuffindex .gt. 0) then  
                write(cunit) cbuffindex  
                write(cunit) k  
                write(cunit) (cbuff(ii), ii=1,cbuffindex)  
             endif  
   
363  #endif  #endif
364    
365  #ifdef ALLOW_SSS0_CONTROL  #ifdef ALLOW_SSS0_CONTROL
366              ivartype = 19
367            il=ilnblnk( xx_sss_file)            write(weighttype(1:80),'(80a)') ' '
368            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "wsss0"
369            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xy(
370       &         yadmark,xx_sss_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_sss(ictrlgrad), "hFacC",
371  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO       &         weighttype, lxxadxx, mythid)
372            call MDSREADFIELD_2D_GL( "wsss",  #endif
373       &                          prec, 'RL', 1,  
374       &                          globfld2d,  #ifdef ALLOW_HFACC_CONTROL
375       &                          1,  mythid)            ivartype = 20
376  #endif            write(weighttype(1:80),'(80a)') ' '
377            call MDSREADFIELD_2D_GL( fname,            write(weighttype(1:80),'(a)') "whfacc"
378       &                          prec, 'RL', 1,  # ifdef ALLOW_HFACC3D_CONTROL
379       &                          globfld3d(1,1,1,1,1,1,1),            call ctrl_set_pack_xyz(
380       &                          1,  mythid)       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
381         &         weighttype, wunit, lxxadxx, mythid)
382            write(cunit) ncvarindex(8)  # else
383            write(cunit) 1            call ctrl_set_pack_xy(
384            write(cunit) 1       &         cunit, ivartype, fname_hfacc(ictrlgrad), "hFacC",
385            k = 1       &         weighttype, lxxadxx, mythid)
386             cbuffindex = 0  # endif
387              do jp = 1,nPy  #endif
388               do bj = jtlo,jthi  
389                do j = jmin,jmax  #ifdef ALLOW_EFLUXY0_CONTROL
390                 do ip = 1,nPx            ivartype = 21
391                  do bi = itlo,ithi            write(weighttype(1:80),'(80a)') ' '
392                   do i = imin,imax            write(weighttype(1:80),'(a)') "wefluxy0"
393                      if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then            call ctrl_set_pack_xyz(
394                         cbuffindex = cbuffindex + 1       &         cunit, ivartype, fname_efluxy(ictrlgrad), "hFacS",
395  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO       &         weighttype, wunit, lxxadxx, mythid)
396                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  #endif
397       &                      * sqrt(globfld2d(i,bi,ip,j,bj,jp))  
398  #else  #ifdef ALLOW_EFLUXP0_CONTROL
399                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)            ivartype = 22
400  #endif            write(weighttype(1:80),'(80a)') ' '
401                      endif            write(weighttype(1:80),'(a)') "wefluxp0"
402                   enddo            call ctrl_set_pack_xyz(
403                  enddo       &         cunit, ivartype, fname_efluxp(ictrlgrad), "hFacV",
404                 enddo       &         weighttype, wunit, lxxadxx, mythid)
405                enddo  #endif
406               enddo  
407              enddo  #ifdef ALLOW_BOTTOMDRAG_CONTROL
408  c     --> check cbuffindex.            ivartype = 23
409              if ( cbuffindex .gt. 0) then            write(weighttype(1:80),'(80a)') ' '
410                 write(cunit) cbuffindex            write(weighttype(1:80),'(a)') "wbottomdrag"
411                 write(cunit) k            call ctrl_set_pack_xy(
412                 write(cunit) (cbuff(ii), ii=1,cbuffindex)       &         cunit, ivartype, fname_bottomdrag(ictrlgrad), "hFacC",
413              endif       &         weighttype, lxxadxx, mythid)
   
414  #endif  #endif
415    
416            close ( cunit )            close ( cunit )
417    
418            _END_MASTER( mythid )
419    
420    #endif /* EXCLUDE_CTRL_PACK */
421    
422        return        return
423        end        end
424    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22