/[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.4 by heimbach, Fri Sep 28 15:15:55 2001 UTC revision 1.37 by heimbach, Sun Mar 13 22:25:56 2011 UTC
# Line 1  Line 1 
1  C $Header$  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 ==
38    
39  #include "EEPARAMS.h"  #include "EEPARAMS.h"
40  #include "SIZE.h"  #include "SIZE.h"
41  #include "PARAMS.h"  #include "PARAMS.h"
42  #include "GRID.h"  #include "GRID.h"
43    
44  #include "ctrl.h"  #include "ctrl.h"
 #include "cost.h"  
45  #include "optim.h"  #include "optim.h"
46    
47  C     !INPUT/OUTPUT PARAMETERS:  #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
55    
56  c     == routine arguments ==  c     == routine arguments ==
57        integer myiter  
58        _RL     mytime        logical first
59        integer mythid        integer mythid
60    
61  C     !LOCAL VARIABLES:  #ifndef EXCLUDE_CTRL_PACK
62  c     == local variables ==  c     == local variables ==
63    
64        integer bi,bj        _RL    fcloc
65        integer ip,jp  
66        integer i,j,k        integer i, j, k
67        integer ii        integer ii
68        integer il        integer il
69        integer irec        integer irec
70        integer itlo,ithi        integer ig,jg
71        integer jtlo,jthi        integer ivartype
72        integer jmin,jmax        integer iobcs
       integer imin,imax  
       integer cbuffindex  
       integer cunit  
       integer prec  
73    
74        logical doglobalread        logical doglobalread
75        logical ladinit        logical ladinit
76          integer cbuffindex
77        _RL     cbuff( snx*nsx*npx*sny*nsy*npy )        logical lxxadxx
78        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )        
79        _RL     globfld2d( snx,nsx,npx,sny,nsy,npy )        integer cunit
80        _RL     globmsk( snx,nsx,npx,sny,nsy,npy,nr )        integer ictrlgrad
       _RL     tmpvar  
81    
82        character*(128) cfile        character*(128) cfile
83        character*( 80) fname        character*( 80) weighttype
84    
85  c     == external ==  c     == external ==
86    
87        integer  ilnblnk        integer  ilnblnk
88        external ilnblnk        external ilnblnk
89    
90  c     == end of interface ==  c     == end of interface ==
 CEOP  
91    
92        prec           = precFloat64  #ifndef ALLOW_ECCO_OPTIMIZATION
93        tmpvar         = -9999. _d 0        fmin       = 0. _d 0
94    #endif
       jtlo = 1  
       jthi = nsy  
       itlo = 1  
       ithi = nsx  
       jmin = 1  
       jmax = sny  
       imin = 1  
       imax = snx  
95    
96  c--   Tiled files are used.  c--   Tiled files are used.
97        doglobalread = .false.        doglobalread = .false.
# Line 92  c--   Tiled files are used. Line 99  c--   Tiled files are used.
99  c--   Initialise adjoint variables on active files.  c--   Initialise adjoint variables on active files.
100        ladinit = .false.        ladinit = .false.
101    
102  c  c--   Initialise global buffer index
103          nbuffglobal = 0
104    
105    c--   Assign file names.
106    
107          call ctrl_set_fname(xx_theta_file, fname_theta, mythid)
108          call ctrl_set_fname(xx_salt_file, fname_salt, mythid)
109          call ctrl_set_fname(xx_hflux_file, fname_hflux, mythid)
110          call ctrl_set_fname(xx_sflux_file, fname_sflux, mythid)
111          call ctrl_set_fname(xx_tauu_file, fname_tauu, mythid)
112          call ctrl_set_fname(xx_tauv_file, fname_tauv, mythid)
113          call ctrl_set_fname(xx_atemp_file, fname_atemp, mythid)
114          call ctrl_set_fname(xx_aqh_file, fname_aqh, mythid)
115          call ctrl_set_fname(xx_precip_file, fname_precip, mythid)
116          call ctrl_set_fname(xx_swflux_file, fname_swflux, mythid)
117          call ctrl_set_fname(xx_swdown_file, fname_swdown, mythid)
118          call ctrl_set_fname(xx_lwflux_file, fname_lwflux, mythid)
119          call ctrl_set_fname(xx_lwdown_file, fname_lwdown, mythid)
120          call ctrl_set_fname(xx_evap_file, fname_evap, mythid)
121          call ctrl_set_fname(xx_snowprecip_file, fname_snowprecip, mythid)
122          call ctrl_set_fname(xx_apressure_file, fname_apressure, mythid)
123          call ctrl_set_fname(xx_runoff_file, fname_runoff, mythid)
124    
125          call ctrl_set_fname(xx_uwind_file, fname_uwind, mythid)
126          call ctrl_set_fname(xx_vwind_file, fname_vwind, mythid)
127          call ctrl_set_fname(xx_obcsn_file, fname_obcsn, mythid)
128          call ctrl_set_fname(xx_obcss_file, fname_obcss, mythid)
129          call ctrl_set_fname(xx_obcsw_file, fname_obcsw, mythid)
130          call ctrl_set_fname(xx_obcse_file, fname_obcse, mythid)
131          call ctrl_set_fname(xx_diffkr_file, fname_diffkr, mythid)
132          call ctrl_set_fname(xx_kapgm_file, fname_kapgm, mythid)
133          call ctrl_set_fname(xx_kapredi_file, fname_kapredi, mythid)
134          call ctrl_set_fname(xx_tr1_file, fname_tr1, mythid)
135          call ctrl_set_fname(xx_sst_file, fname_sst, mythid)
136          call ctrl_set_fname(xx_sss_file, fname_sss, mythid)
137          call ctrl_set_fname(xx_depth_file, fname_depth, mythid)
138          call ctrl_set_fname(xx_efluxy_file, fname_efluxy, mythid)
139          call ctrl_set_fname(xx_efluxp_file, fname_efluxp, mythid)
140          call ctrl_set_fname(xx_bottomdrag_file, fname_bottomdrag, mythid)
141          call ctrl_set_fname(xx_edtaux_file, fname_edtaux, mythid)
142          call ctrl_set_fname(xx_edtauy_file, fname_edtauy, mythid)
143          call ctrl_set_fname(xx_uvel_file, fname_uvel, mythid)
144          call ctrl_set_fname(xx_vvel_file, fname_vvel, mythid)
145          call ctrl_set_fname(xx_etan_file, fname_etan, mythid)
146          call ctrl_set_fname(xx_relaxsst_file, fname_relaxsst, mythid)
147          call ctrl_set_fname(xx_relaxsss_file, fname_relaxsss, mythid)
148          call ctrl_set_fname(xx_siarea_file, fname_siarea, mythid)
149          call ctrl_set_fname(xx_siheff_file, fname_siheff, mythid)
150          call ctrl_set_fname(xx_sihsnow_file, fname_sihsnow, mythid)
151    cHFLUXM_CONTROL
152          call ctrl_set_fname(xx_hfluxm_file, fname_hfluxm, mythid)
153    cHFLUXM_CONTROL
154    
155  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
156        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
157    
158  c--   read global mask file        if ( first ) then
159            call MDSREADFIELD_3D_GL( "hFacC",  c     >>> Initialise control vector for optimcycle=0 <<<
160       &                           prec, 'RL', Nr, globmsk,            lxxadxx   = .TRUE.
161       &                           1,  mythid)            ictrlgrad = 1
162              fcloc     = fmin
163              write(cfile(1:128),'(4a,i4.4)')
164  c     >>> Write control vector <<<       &         ctrlname(1:9),'_',yctrlid(1:10),
165         &         yctrlpospack, optimcycle
166            call mdsfindunit( cunit, mythid )            print *, 'ph-pack: packing ', ctrlname(1:9)
167            write(cfile(1:128),'(2a,i4.4)')        else
168       &      ctrlname(1:9),'.opt',  c     >>> Write gradient vector <<<
169       &      optimcycle            lxxadxx   = .FALSE.
170              ictrlgrad = 2
171            open( cunit, file   = cfile,            fcloc     = fc
172       &                 status = 'unknown',            write(cfile(1:128),'(4a,i4.4)')
173       &                 form   = 'unformatted',       &         costname(1:9),'_',yctrlid(1:10),
174       &                 access = 'sequential'   )       &         yctrlpospack, optimcycle
175              print *, 'ph-pack: packing ', costname(1:9)
176           endif
177    
178    c--   Only Proc 0 will do I/O.
179          IF ( myProcId .eq. 0 ) THEN
180    
181           call mdsfindunit( cunit, mythid )
182           open( cunit, file   = cfile,
183         &      status = 'unknown',
184         &      form   = 'unformatted',
185         &      access  = 'sequential'   )
186    
187  c--       Header information.  c--       Header information.
             
188            write(cunit) nvartype            write(cunit) nvartype
189            write(cunit) nvarlength            write(cunit) nvarlength
190            write(cunit) expId            write(cunit) yctrlid
191            write(cunit) optimCycle            write(cunit) optimCycle
192            write(cunit) tmpvar            write(cunit) fc
193            write(cunit) 1  C     place holder of obsolete variable iG
           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)  
           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_TR10_CONTROL  
   
           il=ilnblnk( xx_tr1_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_tr1_file(1:il),'.',optimcycle  
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr, globfld3d,  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(9)  
           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)  
 cph     &                      * sqrt(wtr1(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)  
           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_SST0_CONTROL  
   
           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  
   
 #endif  
   
 #ifdef ALLOW_SSS0_CONTROL  
   
           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)  
194            write(cunit) 1            write(cunit) 1
195    C     place holder of obsolete variable jG
196            write(cunit) 1            write(cunit) 1
197            k = 1            write(cunit) nsx
198             cbuffindex = 0            write(cunit) nsy
199              do jp = 1,nPy            write(cunit) (nWetcGlobal(k), k=1,nr)
200               do bj = jtlo,jthi            write(cunit) (nWetsGlobal(k), k=1,nr)
201                do j = jmin,jmax            write(cunit) (nWetwGlobal(k), k=1,nr)
202                 do ip = 1,nPx  #ifdef ALLOW_CTRL_WETV
203                  do bi = itlo,ithi            write(cunit) (nWetvGlobal(k), k=1,nr)
                  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)  
204  #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  
205    
206    #ifdef ALLOW_OBCSN_CONTROL
207              write(cunit) ((nWetobcsnGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
208  #endif  #endif
209    #ifdef ALLOW_OBCSS_CONTROL
210  #ifdef ALLOW_DIFFKR_CONTROL            write(cunit) ((nWetobcssGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
   
           il=ilnblnk( xx_diffkr_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_diffkr_file(1:il),'.',optimcycle  
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr, globfld3d,  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(15)  
           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)  
 cph     &                      * sqrt(wdiffkr(k,bi,bj))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
211  #endif  #endif
212                      endif  #ifdef ALLOW_OBCSW_CONTROL
213                   enddo            write(cunit) ((nWetobcswGlo(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  
          enddo  
               
214  #endif  #endif
215    #ifdef ALLOW_OBCSE_CONTROL
216  #ifdef ALLOW_KAPGM_CONTROL            write(cunit) ((nWetobcseGlo(k,iobcs), k=1,nr),iobcs= 1,nobcs)
   
           il=ilnblnk( xx_kapgm_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(2a,i10.10)')  
      &         xx_kapgm_file(1:il),'.',optimcycle  
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr, globfld3d,  
      &                          1,  mythid)  
   
           write(cunit) ncvarindex(16)  
           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)  
 cph     &                      * sqrt(wkapgm(k,bi,bj))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
217  #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  
          enddo  
               
 #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)  
218            write(cunit) (ncvarindex(i), i=1,maxcvars)            write(cunit) (ncvarindex(i), i=1,maxcvars)
219            write(cunit) (ncvarrecs(i),  i=1,maxcvars)            write(cunit) (ncvarrecs(i),  i=1,maxcvars)
220            write(cunit) (nx,  i=1,maxcvars)            write(cunit) (ncvarxmax(i),  i=1,maxcvars)
221            write(cunit) (ny,  i=1,maxcvars)            write(cunit) (ncvarymax(i),  i=1,maxcvars)
222            write(cunit) (ncvarnrmax(i), i=1,maxcvars)            write(cunit) (ncvarnrmax(i), i=1,maxcvars)
223            write(cunit) (ncvargrd(i),   i=1,maxcvars)            write(cunit) (ncvargrd(i),   i=1,maxcvars)
224            write(cunit)            write(cunit)
225    
226  #ifdef ALLOW_THETA0_CONTROL  #ifdef ALLOW_PACKUNPACK_METHOD2
227          ENDIF
228            il=ilnblnk( xx_theta_file)        _END_MASTER( mythid )
229            write(fname(1:80),'(80a)') ' '        _BARRIER
           write(fname(1:80),'(3a,i10.10)')  
      &         yadmark,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)  
230  #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  
          enddo  
231    
232    #ifdef ALLOW_THETA0_CONTROL
233              ivartype = 1
234              write(weighttype(1:80),'(80a)') ' '
235              write(weighttype(1:80),'(a)') "wthetaLev"
236              call ctrl_set_pack_xyz(
237         &         cunit, ivartype, fname_theta(ictrlgrad), "maskCtrlC",
238         &         weighttype, wtheta, lxxadxx, mythid)
239  #endif  #endif
240    
241  #ifdef ALLOW_SALT0_CONTROL  #ifdef ALLOW_SALT0_CONTROL
242              ivartype = 2
243            il=ilnblnk( xx_salt_file)            write(weighttype(1:80),'(80a)') ' '
244            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "wsaltLev"
245            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xyz(
246       &         yadmark,xx_salt_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_salt(ictrlgrad), "maskCtrlC",
247         &         weighttype, wsalt, lxxadxx, mythid)
248            call MDSREADFIELD_3D_GL( fname,  #endif
249       &                          prec, 'RL', Nr,  
250       &                          globfld3d,  #if (defined (ALLOW_HFLUX_CONTROL) || defined (ALLOW_HFLUX0_CONTROL))
251       &                          1,  mythid)            ivartype = 3
252                        write(weighttype(1:80),'(80a)') ' '
253            write(cunit) ncvarindex(2)            write(weighttype(1:80),'(a)') "whflux"
254            write(cunit) 1            call ctrl_set_pack_xy(
255            write(cunit) 1       &         cunit, ivartype, fname_hflux(ictrlgrad), "maskCtrlC",
256            do k = 1,nr       &         weighttype, lxxadxx, mythid)
257             cbuffindex = 0  #endif
258              do jp = 1,nPy  
259               do bj = jtlo,jthi  #if (defined (ALLOW_SFLUX_CONTROL) || defined (ALLOW_SFLUX0_CONTROL))
260                do j = jmin,jmax            ivartype = 4
261                 do ip = 1,nPx            write(weighttype(1:80),'(80a)') ' '
262                  do bi = itlo,ithi            write(weighttype(1:80),'(a)') "wsflux"
263                   do i = imin,imax            call ctrl_set_pack_xy(
264                      if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then       &         cunit, ivartype, fname_sflux(ictrlgrad), "maskCtrlC",
265                         cbuffindex = cbuffindex + 1       &         weighttype, lxxadxx, mythid)
266  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #endif
267                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
268       &                      * sqrt(wsalt(k,bi,bj))  #if (defined (ALLOW_USTRESS_CONTROL) || defined (ALLOW_TAUU0_CONTROL))
269  #else            ivartype = 5
270                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)            write(weighttype(1:80),'(80a)') ' '
271  #endif            write(weighttype(1:80),'(a)') "wtauu"
272                      endif            call ctrl_set_pack_xy(
273                   enddo  #ifndef ALLOW_ROTATE_UV_CONTROLS
274                  enddo       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlW",
275                 enddo  #else
276                enddo       &         cunit, ivartype, fname_tauu(ictrlgrad), "maskCtrlC",
277               enddo  #endif
278              enddo       &         weighttype, lxxadxx, mythid)
279  c     --> check cbuffindex.  #endif
280              if ( cbuffindex .gt. 0) then  
281                 write(cunit) cbuffindex  #if (defined (ALLOW_VSTRESS_CONTROL) || defined (ALLOW_TAUV0_CONTROL))
282                 write(cunit) k            ivartype = 6
283                 write(cunit) (cbuff(ii), ii=1,cbuffindex)            write(weighttype(1:80),'(80a)') ' '
284              endif            write(weighttype(1:80),'(a)') "wtauv"
285           enddo            call ctrl_set_pack_xy(
286    #ifndef ALLOW_ROTATE_UV_CONTROLS
287  #endif       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlS",
288    #else
289  #ifdef ALLOW_TR10_CONTROL       &         cunit, ivartype, fname_tauv(ictrlgrad), "maskCtrlC",
290    #endif
291            il=ilnblnk( xx_tr1_file)       &         weighttype, lxxadxx, mythid)
292            write(fname(1:80),'(80a)') ' '  #endif
293            write(fname(1:80),'(3a,i10.10)')  
294       &         yadmark,xx_tr1_file(1:il),'.',optimcycle  #ifdef ALLOW_ATEMP_CONTROL
295              ivartype = 7
296            call MDSREADFIELD_3D_GL( fname,            write(weighttype(1:80),'(80a)') ' '
297       &                          prec, 'RL', Nr,            write(weighttype(1:80),'(a)') "watemp"
298       &                          globfld3d,            call ctrl_set_pack_xy(
299       &                          1,  mythid)       &         cunit, ivartype, fname_atemp(ictrlgrad), "maskCtrlC",
300                   &         weighttype, lxxadxx, mythid)
301            write(cunit) ncvarindex(9)  #endif
302            write(cunit) 1  
303            write(cunit) 1  #ifdef ALLOW_AQH_CONTROL
304            do k = 1,nr            ivartype = 8
305             cbuffindex = 0            write(weighttype(1:80),'(80a)') ' '
306              do jp = 1,nPy            write(weighttype(1:80),'(a)') "waqh"
307               do bj = jtlo,jthi            call ctrl_set_pack_xy(
308                do j = jmin,jmax       &         cunit, ivartype, fname_aqh(ictrlgrad), "maskCtrlC",
309                 do ip = 1,nPx       &         weighttype, lxxadxx, mythid)
310                  do bi = itlo,ithi  #endif
311                   do i = imin,imax  
312                      if (globmsk(i,bi,ip,j,bj,jp,k)  .ne. 0. ) then  #ifdef ALLOW_UWIND_CONTROL
313                         cbuffindex = cbuffindex + 1            ivartype = 9
314  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO            write(weighttype(1:80),'(80a)') ' '
315                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)            write(weighttype(1:80),'(a)') "wuwind"
316  cph     &                      * sqrt(wtr1(k,bi,bj))            call ctrl_set_pack_xy(
317  #else       &         cunit, ivartype, fname_uwind(ictrlgrad), "maskCtrlC",
318                         cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)       &         weighttype, lxxadxx, mythid)
319  #endif  #endif
320                      endif  
321                   enddo  #ifdef ALLOW_VWIND_CONTROL
322                  enddo            ivartype = 10
323                 enddo            write(weighttype(1:80),'(80a)') ' '
324                enddo            write(weighttype(1:80),'(a)') "wvwind"
325               enddo            call ctrl_set_pack_xy(
326              enddo       &         cunit, ivartype, fname_vwind(ictrlgrad), "maskCtrlC",
327  c     --> check cbuffindex.       &         weighttype, lxxadxx, mythid)
328              if ( cbuffindex .gt. 0) then  #endif
329                 write(cunit) cbuffindex  
330                 write(cunit) k  #ifdef ALLOW_OBCSN_CONTROL
331                 write(cunit) (cbuff(ii), ii=1,cbuffindex)            ivartype = 11
332              endif            write(weighttype(1:80),'(80a)') ' '
333           enddo            write(weighttype(1:80),'(a)') "wobcsn"
334              call ctrl_set_pack_xz(
335  #endif       &         cunit, ivartype, fname_obcsn(ictrlgrad), "maskobcsn",
336         &         weighttype, wobcsn, lxxadxx, mythid)
337  #ifdef ALLOW_HFLUX0_CONTROL  #endif
338    
339            il=ilnblnk( xx_hflux_file)  #ifdef ALLOW_OBCSS_CONTROL
340            write(fname(1:80),'(80a)') ' '            ivartype = 12
341            write(fname(1:80),'(3a,i10.10)')            write(weighttype(1:80),'(80a)') ' '
342       &         yadmark,xx_hflux_file(1:il),'.',optimcycle            write(weighttype(1:80),'(a)') "wobcss"
343  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO            call ctrl_set_pack_xz(
344            call MDSREADFIELD_2D_GL( "whflux",       &         cunit, ivartype, fname_obcss(ictrlgrad), "maskobcss",
345       &                          prec, 'RL', 1,       &         weighttype, wobcss, lxxadxx, mythid)
346       &                          globfld2d,  #endif
347       &                          1,  mythid)  
348  #endif  #ifdef ALLOW_OBCSW_CONTROL
349            call MDSREADFIELD_2D_GL( fname,            ivartype = 13
350       &                          prec, 'RL', 1,            write(weighttype(1:80),'(80a)') ' '
351       &                          globfld3d(1,1,1,1,1,1,1),            write(weighttype(1:80),'(a)') "wobcsw"
352       &                          1,  mythid)            call ctrl_set_pack_yz(
353         &         cunit, ivartype, fname_obcsw(ictrlgrad), "maskobcsw",
354            write(cunit) ncvarindex(3)       &         weighttype, wobcsw, lxxadxx, mythid)
355            write(cunit) 1  #endif
356            write(cunit) 1  
357            k = 1  #ifdef ALLOW_OBCSE_CONTROL
358             cbuffindex = 0            ivartype = 14
359              do jp = 1,nPy            write(weighttype(1:80),'(80a)') ' '
360               do bj = jtlo,jthi            write(weighttype(1:80),'(a)') "wobcse"
361                do j = jmin,jmax            call ctrl_set_pack_yz(
362                 do ip = 1,nPx       &         cunit, ivartype, fname_obcse(ictrlgrad), "maskobcse",
363                  do bi = itlo,ithi       &         weighttype, wobcse, lxxadxx, mythid)
                  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),'(3a,i10.10)')  
      &         yadmark,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),'(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  
   
 #endif  
   
 #ifdef ALLOW_SST0_CONTROL  
   
           il=ilnblnk( xx_sst_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(3a,i10.10)')  
      &         yadmark,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  
   
 #endif  
   
 #ifdef ALLOW_SSS0_CONTROL  
   
           il=ilnblnk( xx_sss_file)  
           write(fname(1:80),'(80a)') ' '  
           write(fname(1:80),'(3a,i10.10)')  
      &         yadmark,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)  
 #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  
   
364  #endif  #endif
365    
366  #ifdef ALLOW_DIFFKR_CONTROL  #ifdef ALLOW_DIFFKR_CONTROL
367              ivartype = 15
368            il=ilnblnk( xx_diffkr_file)            write(weighttype(1:80),'(80a)') ' '
369            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "wdiffkr"
370            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xyz(
371       &         yadmark,xx_diffkr_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_diffkr(ictrlgrad), "maskCtrlC",
372         &         weighttype, wdiffkr, lxxadxx, mythid)
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr,  
      &                          globfld3d,  
      &                          1,  mythid)  
             
           write(cunit) ncvarindex(9)  
           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)  
 cph     &                      * sqrt(wdiffkr(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  
   
373  #endif  #endif
374    
375  #ifdef ALLOW_KAPGM_CONTROL  #ifdef ALLOW_KAPGM_CONTROL
376              ivartype = 16
377            il=ilnblnk( xx_kapgm_file)            write(weighttype(1:80),'(80a)') ' '
378            write(fname(1:80),'(80a)') ' '            write(weighttype(1:80),'(a)') "wkapgm"
379            write(fname(1:80),'(3a,i10.10)')            call ctrl_set_pack_xyz(
380       &         yadmark,xx_kapgm_file(1:il),'.',optimcycle       &         cunit, ivartype, fname_kapgm(ictrlgrad), "maskCtrlC",
381         &         weighttype, wkapgm, lxxadxx, mythid)
           call MDSREADFIELD_3D_GL( fname,  
      &                          prec, 'RL', Nr,  
      &                          globfld3d,  
      &                          1,  mythid)  
             
           write(cunit) ncvarindex(9)  
           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)  
 cph     &                      * sqrt(wkapgm(k,bi,bj))  
 #else  
                        cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)  
382  #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  
          enddo  
383    
384    #ifdef ALLOW_TR10_CONTROL
385              ivartype = 17
386              write(weighttype(1:80),'(80a)') ' '
387              write(weighttype(1:80),'(a)') "wtr1"
388              call ctrl_set_pack_xyz(
389         &         cunit, ivartype, fname_tr1(ictrlgrad), "maskCtrlC",
390         &         weighttype, wunit, lxxadxx, mythid)
391    #endif
392    
393    #if (defined (ALLOW_SST_CONTROL) || defined (ALLOW_SST0_CONTROL))
394              ivartype = 18
395              write(weighttype(1:80),'(80a)') ' '
396              write(weighttype(1:80),'(a)') "wsst"
397              call ctrl_set_pack_xy(
398         &         cunit, ivartype, fname_sst(ictrlgrad), "maskCtrlC",
399         &         weighttype, lxxadxx, mythid)
400    #endif
401    
402    #if (defined (ALLOW_SSS_CONTROL) || defined (ALLOW_SSS0_CONTROL))
403              ivartype = 19
404              write(weighttype(1:80),'(80a)') ' '
405              write(weighttype(1:80),'(a)') "wsss"
406              call ctrl_set_pack_xy(
407         &         cunit, ivartype, fname_sss(ictrlgrad),
408         &         "maskCtrlC", weighttype, lxxadxx, mythid)
409    #endif
410    
411    #ifdef ALLOW_DEPTH_CONTROL
412              ivartype = 20
413              write(weighttype(1:80),'(80a)') ' '
414              write(weighttype(1:80),'(a)') "wdepth"
415              call ctrl_set_pack_xy(
416         &         cunit, ivartype, fname_depth(ictrlgrad),
417         &         "maskCtrlC", weighttype, lxxadxx, mythid)
418    #endif /* ALLOW_DEPTH_CONTROL */
419    
420    #ifdef ALLOW_EFLUXY0_CONTROL
421              ivartype = 21
422              write(weighttype(1:80),'(80a)') ' '
423              write(weighttype(1:80),'(a)') "wefluxy0"
424              call ctrl_set_pack_xyz(
425         &         cunit, ivartype, fname_efluxy(ictrlgrad), "maskCtrlS",
426         &         weighttype, wunit, lxxadxx, mythid)
427    #endif
428    
429    #ifdef ALLOW_EFLUXP0_CONTROL
430              ivartype = 22
431              write(weighttype(1:80),'(80a)') ' '
432              write(weighttype(1:80),'(a)') "wefluxp0"
433              call ctrl_set_pack_xyz(
434         &         cunit, ivartype, fname_efluxp(ictrlgrad), "maskhFacV",
435         &         weighttype, wunit, lxxadxx, mythid)
436    #endif
437    
438    #ifdef ALLOW_BOTTOMDRAG_CONTROL
439              ivartype = 23
440              write(weighttype(1:80),'(80a)') ' '
441              write(weighttype(1:80),'(a)') "wbottomdrag"
442              call ctrl_set_pack_xy(
443         &      cunit, ivartype, fname_bottomdrag(ictrlgrad), "maskCtrlC",
444         &      weighttype, lxxadxx, mythid)
445    #endif
446    
447    #ifdef ALLOW_HFLUXM_CONTROL
448              ivartype = 24
449              write(weighttype(1:80),'(80a)') ' '
450              write(weighttype(1:80),'(a)') "whfluxm"
451              call ctrl_set_pack_xy(
452         &         cunit, ivartype, fname_hfluxm(ictrlgrad), "maskCtrlC",
453         &         weighttype, lxxadxx, mythid)
454    #endif
455    
456    #ifdef ALLOW_EDDYPSI_CONTROL
457              ivartype = 25
458              write(weighttype(1:80),'(80a)') ' '
459              write(weighttype(1:80),'(a)') "wedtaux"
460              call ctrl_set_pack_xyz(
461         &         cunit, ivartype, fname_edtaux(ictrlgrad), "maskCtrlW",
462         &         weighttype, wedtaux, lxxadxx, mythid)
463    
464              ivartype = 26
465              write(weighttype(1:80),'(80a)') ' '
466              write(weighttype(1:80),'(a)') "wedtauy"
467              call ctrl_set_pack_xyz(
468         &         cunit, ivartype, fname_edtauy(ictrlgrad), "maskCtrlS",
469         &         weighttype, wedtauy, lxxadxx, mythid)
470    #endif
471    
472    #ifdef ALLOW_UVEL0_CONTROL
473              ivartype = 27
474              write(weighttype(1:80),'(80a)') ' '
475              write(weighttype(1:80),'(a)') "wuvel"
476              call ctrl_set_pack_xyz(
477         &         cunit, ivartype, fname_uvel(ictrlgrad), "maskCtrlW",
478         &         weighttype, wuvel, lxxadxx, mythid)
479    #endif
480    
481    #ifdef ALLOW_VVEL0_CONTROL
482              ivartype = 28
483              write(weighttype(1:80),'(80a)') ' '
484              write(weighttype(1:80),'(a)') "wvvel"
485              call ctrl_set_pack_xyz(
486         &         cunit, ivartype, fname_vvel(ictrlgrad), "maskCtrlS",
487         &         weighttype, wvvel, lxxadxx, mythid)
488    #endif
489    
490    #ifdef ALLOW_ETAN0_CONTROL
491              ivartype = 29
492              write(weighttype(1:80),'(80a)') ' '
493              write(weighttype(1:80),'(a)') "wetan"
494              call ctrl_set_pack_xy(
495         &         cunit, ivartype, fname_etan(ictrlgrad),
496         &         "maskCtrlC", weighttype, lxxadxx, mythid)
497    #endif
498    
499    #ifdef ALLOW_RELAXSST_CONTROL
500              ivartype = 30
501              write(weighttype(1:80),'(80a)') ' '
502              write(weighttype(1:80),'(a)') "wrelaxsst"
503              call ctrl_set_pack_xy(
504         &         cunit, ivartype, fname_relaxsst(ictrlgrad),
505         &         "maskCtrlC", weighttype, lxxadxx, mythid)
506    #endif
507    
508    #ifdef ALLOW_RELAXSSS_CONTROL
509              ivartype = 31
510              write(weighttype(1:80),'(80a)') ' '
511              write(weighttype(1:80),'(a)') "wrelaxsss"
512              call ctrl_set_pack_xy(
513         &         cunit, ivartype, fname_relaxsss(ictrlgrad),
514         &         "maskCtrlC", weighttype, lxxadxx, mythid)
515    #endif
516    
517    #ifdef ALLOW_PRECIP_CONTROL
518              ivartype = 32
519              write(weighttype(1:80),'(80a)') ' '
520              write(weighttype(1:80),'(a)') "wprecip"
521              call ctrl_set_pack_xy(
522         &         cunit, ivartype, fname_precip(ictrlgrad),
523         &         "maskCtrlC", weighttype, lxxadxx, mythid)
524    #endif
525    
526    #ifdef ALLOW_SWFLUX_CONTROL
527              ivartype = 33
528              write(weighttype(1:80),'(80a)') ' '
529              write(weighttype(1:80),'(a)') "wswflux"
530              call ctrl_set_pack_xy(
531         &         cunit, ivartype, fname_swflux(ictrlgrad),
532         &         "maskCtrlC", weighttype, lxxadxx, mythid)
533    #endif
534    
535    #ifdef ALLOW_SWDOWN_CONTROL
536              ivartype = 34
537              write(weighttype(1:80),'(80a)') ' '
538              write(weighttype(1:80),'(a)') "wswdown"
539              call ctrl_set_pack_xy(
540         &         cunit, ivartype, fname_swdown(ictrlgrad),
541         &         "maskCtrlC", weighttype, lxxadxx, mythid)
542    #endif
543    
544    #ifdef ALLOW_LWFLUX_CONTROL
545              ivartype = 35
546              write(weighttype(1:80),'(80a)') ' '
547              write(weighttype(1:80),'(a)') "wlwflux"
548              call ctrl_set_pack_xy(
549         &         cunit, ivartype, fname_lwflux(ictrlgrad),
550         &         "maskCtrlC", weighttype, lxxadxx, mythid)
551    #endif
552    
553    #ifdef ALLOW_LWDOWN_CONTROL
554              ivartype = 36
555              write(weighttype(1:80),'(80a)') ' '
556              write(weighttype(1:80),'(a)') "wlwdown"
557              call ctrl_set_pack_xy(
558         &         cunit, ivartype, fname_lwdown(ictrlgrad),
559         &         "maskCtrlC", weighttype, lxxadxx, mythid)
560    #endif
561    
562    #ifdef ALLOW_EVAP_CONTROL
563              ivartype = 37
564              write(weighttype(1:80),'(80a)') ' '
565              write(weighttype(1:80),'(a)') "wevap"
566              call ctrl_set_pack_xy(
567         &         cunit, ivartype, fname_evap(ictrlgrad),
568         &         "maskCtrlC", weighttype, lxxadxx, mythid)
569    #endif
570    
571    #ifdef ALLOW_SNOWPRECIP_CONTROL
572              ivartype = 38
573              write(weighttype(1:80),'(80a)') ' '
574              write(weighttype(1:80),'(a)') "wsnowprecip"
575              call ctrl_set_pack_xy(
576         &         cunit, ivartype, fname_snowprecip(ictrlgrad),
577         &         "maskCtrlC", weighttype, lxxadxx, mythid)
578    #endif
579    
580    #ifdef ALLOW_APRESSURE_CONTROL
581              ivartype = 39
582              write(weighttype(1:80),'(80a)') ' '
583              write(weighttype(1:80),'(a)') "wapressure"
584              call ctrl_set_pack_xy(
585         &         cunit, ivartype, fname_apressure(ictrlgrad),
586         &         "maskCtrlC", weighttype, lxxadxx, mythid)
587    #endif
588    
589    #ifdef ALLOW_RUNOFF_CONTROL
590              ivartype = 40
591              write(weighttype(1:80),'(80a)') ' '
592              write(weighttype(1:80),'(a)') "wrunoff"
593              call ctrl_set_pack_xy(
594         &         cunit, ivartype, fname_runoff(ictrlgrad),
595         &         "maskCtrlC", weighttype, lxxadxx, mythid)
596    #endif
597    
598    #ifdef ALLOW_SIAREA_CONTROL
599              ivartype = 41
600              write(weighttype(1:80),'(80a)') ' '
601              write(weighttype(1:80),'(a)') "wunit"
602              call ctrl_set_pack_xy(
603         &         cunit, ivartype, fname_siarea(ictrlgrad),
604         &         "maskCtrlC", weighttype, lxxadxx, mythid)
605    #endif
606    
607    #ifdef ALLOW_SIHEFF_CONTROL
608              ivartype = 42
609              write(weighttype(1:80),'(80a)') ' '
610              write(weighttype(1:80),'(a)') "wunit"
611              call ctrl_set_pack_xy(
612         &         cunit, ivartype, fname_siheff(ictrlgrad),
613         &         "maskCtrlC", weighttype, lxxadxx, mythid)
614    #endif
615    
616    #ifdef ALLOW_SIHSNOW_CONTROL
617              ivartype = 43
618              write(weighttype(1:80),'(80a)') ' '
619              write(weighttype(1:80),'(a)') "wunit"
620              call ctrl_set_pack_xy(
621         &         cunit, ivartype, fname_sihsnow(ictrlgrad),
622         &         "maskCtrlC", weighttype, lxxadxx, mythid)
623    #endif
624    
625    #ifdef ALLOW_KAPREDI_CONTROL
626              ivartype = 44
627              write(weighttype(1:80),'(80a)') ' '
628              write(weighttype(1:80),'(a)') "wkapredi"
629              call ctrl_set_pack_xyz(
630         &         cunit, ivartype, fname_kapredi(ictrlgrad), "maskCtrlC",
631         &         weighttype, wkapredi, lxxadxx, mythid)
632  #endif  #endif
633    
634    #ifdef ALLOW_PACKUNPACK_METHOD2
635          _BEGIN_MASTER( mythid )
636          IF ( myProcId .eq. 0 ) THEN
637    #endif
638    
639            close ( cunit )         close ( cunit )
640           ENDIF !IF ( myProcId .eq. 0 )
641           _END_MASTER( mythid )
642          _BARRIER
643    #endif /* EXCLUDE_CTRL_PACK */
644    
645        return        return
646        end        end
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.37
  ViewVC Help
Powered by ViewVC 1.1.22