/[MITgcm]/MITgcm/pkg/ctrl/ctrl_set_unpack_xyz.F
ViewVC logotype

Diff of /MITgcm/pkg/ctrl/ctrl_set_unpack_xyz.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.6 by heimbach, Thu Nov 6 22:05:08 2003 UTC revision 1.12 by heimbach, Thu Jun 16 15:31:50 2005 UTC
# Line 2  Line 2 
2  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
3    
4        subroutine ctrl_set_unpack_xyz(        subroutine ctrl_set_unpack_xyz(
5       &     cunit, ivartype, fname, masktype, weighttype,       &     lxxadxx, cunit, ivartype, fname, masktype, weighttype,
6       &     weightfld, nwetglobal, mythid)       &     weightfld, nwetglobal, mythid)
7    
8  c     ==================================================================  c     ==================================================================
# Line 28  c     == global variables == Line 28  c     == global variables ==
28  #include "GRID.h"  #include "GRID.h"
29    
30  #include "ctrl.h"  #include "ctrl.h"
   
 #ifdef ALLOW_ECCO_OPTIMIZATION  
31  #include "optim.h"  #include "optim.h"
 #endif  
32    
33  c     == routine arguments ==  c     == routine arguments ==
34    
35          logical lxxadxx
36        integer cunit        integer cunit
37        integer ivartype        integer ivartype
38        character*( 80)   fname        character*( 80)   fname
39        character*  (5) masktype        character*(  9) masktype
40        character*( 80) weighttype        character*( 80) weighttype
41        _RL     weightfld( nr,nsx,nsy )        _RL     weightfld( nr,nsx,nsy )
42        integer nwetglobal(nr)        integer nwetglobal(nr)
# Line 46  c     == routine arguments == Line 44  c     == routine arguments ==
44    
45  c     == local variables ==  c     == local variables ==
46    
 #ifndef ALLOW_ECCO_OPTIMIZATION  
       integer optimcycle  
 #endif  
   
47        integer bi,bj        integer bi,bj
48        integer ip,jp        integer ip,jp
49        integer i,j,k        integer i,j,k
# Line 63  c     == local variables == Line 57  c     == local variables ==
57    
58        integer cbuffindex        integer cbuffindex
59    
       real*4     cbuff    ( snx*nsx*npx*sny*nsy*npy )  
60        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )
61        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )
62  #ifdef CTRL_UNPACK_PRECISE  #ifdef CTRL_UNPACK_PRECISE
63        _RL   weightfld3d( snx,nsx,npx,sny,nsy,npy,nr )        _RL   weightfld3d( snx,nsx,npx,sny,nsy,npy,nr )
64  #endif  #endif
65          real*4 cbuff      ( snx*nsx*npx*sny*nsy*npy )
66          real*4 globfldtmp2( snx,nsx,npx,sny,nsy,npy )
67          real*4 globfldtmp3( snx,nsx,npx,sny,nsy,npy )
68    
69        character*(128)   cfile        character*(128)   cfile
70        character*(80) weightname        character*(80) weightname
71    
72        integer        filenvartype        _RL delZnorm
73        integer        filenvarlength        integer reclen, irectrue
74        character*(10) fileExpId        integer cunit2, cunit3
75        integer        fileOptimCycle        character*(80) cfile2, cfile3
       integer        filencbuffindex  
       _RL            fileDummy  
       integer        fileIg  
       integer        fileJg  
       integer        fileI  
       integer        fileJ  
       integer        filensx  
       integer        filensy  
       integer        filek  
       integer        filencvarindex(maxcvars)  
       integer        filencvarrecs(maxcvars)  
       integer        filencvarxmax(maxcvars)  
       integer        filencvarymax(maxcvars)  
       integer        filencvarnrmax(maxcvars)  
       character*( 1) filencvargrd(maxcvars)  
76    
77  c     == external ==  c     == external ==
78    
# Line 109  cc     == end of interface == Line 90  cc     == end of interface ==
90        imin = 1        imin = 1
91        imax = snx        imax = snx
92    
93    #ifdef CTRL_DELZNORM
94          delZnorm = 0.
95          do k = 1, Nr
96             delZnorm = delZnorm + delR(k)/FLOAT(Nr)
97          enddo
98    #endif
99    
100  c     Initialise temporary file  c     Initialise temporary file
101        do k = 1,nr        do k = 1,nr
102           do jp = 1,nPy           do jp = 1,nPy
# Line 117  c     Initialise temporary file Line 105  c     Initialise temporary file
105                    do ip = 1,nPx                    do ip = 1,nPx
106                       do bi = itlo,ithi                       do bi = itlo,ithi
107                          do i = imin,imax                          do i = imin,imax
108                             globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0                             globfld3d  (i,bi,ip,j,bj,jp,k) = 0. _d 0
109                             globmsk  (i,bi,ip,j,bj,jp,k) = 0. _d 0                             globmsk    (i,bi,ip,j,bj,jp,k) = 0. _d 0
110                               globfldtmp2(i,bi,ip,j,bj,jp)   = 0.
111                               globfldtmp3(i,bi,ip,j,bj,jp)   = 0.
112                          enddo                          enddo
113                       enddo                       enddo
114                    enddo                    enddo
# Line 127  c     Initialise temporary file Line 117  c     Initialise temporary file
117           enddo           enddo
118        enddo        enddo
119    
 #ifndef ALLOW_ECCO_OPTIMIZATION  
       optimcycle = 0  
 #endif  
   
120  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
121        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
122    
123    #ifdef CTRL_DELZNORM
124          do k = 1, nr
125             print *, 'ph-delznorm ', k, delZnorm, delR(k)
126             print *, 'ph-weight   ', weightfld(k,1,1)
127          enddo
128    #endif
129    
130          if ( doPackDiag ) then
131             write(cfile2(1:80),'(80a)') ' '
132             write(cfile3(1:80),'(80a)') ' '
133             if ( lxxadxx ) then
134                write(cfile2(1:80),'(a,I2.2,a,I4.4,a)')
135         &           'diag_unpack_nondim_ctrl_',
136         &           ivartype, '_', optimcycle, '.bin'
137                write(cfile3(1:80),'(a,I2.2,a,I4.4,a)')
138         &           'diag_unpack_dimens_ctrl_',
139         &           ivartype, '_', optimcycle, '.bin'
140             else
141                write(cfile2(1:80),'(a,I2.2,a,I4.4,a)')
142         &           'diag_unpack_nondim_grad_',
143         &           ivartype, '_', optimcycle, '.bin'
144                write(cfile3(1:80),'(a,I2.2,a,I4.4,a)')
145         &           'diag_unpack_dimens_grad_',
146         &           ivartype, '_', optimcycle, '.bin'
147             endif
148    
149             reclen = FLOAT(snx*nsx*npx*sny*nsy*npy*4)
150             call mdsfindunit( cunit2, mythid )
151             open( cunit2, file=cfile2, status='unknown',
152         &        access='direct', recl=reclen )
153             call mdsfindunit( cunit3, mythid )
154             open( cunit3, file=cfile3, status='unknown',
155         &        access='direct', recl=reclen )
156          endif
157    
158  #ifdef CTRL_UNPACK_PRECISE  #ifdef CTRL_UNPACK_PRECISE
159        il=ilnblnk( weighttype)        il=ilnblnk( weighttype)
160        write(weightname(1:80),'(80a)') ' '        write(weightname(1:80),'(80a)') ' '
# Line 159  c--   Only the master thread will do I/O Line 180  c--   Only the master thread will do I/O
180           read(cunit) filej           read(cunit) filej
181           read(cunit) filei           read(cunit) filei
182           do k = 1, Nr           do k = 1, Nr
183             irectrue = (irec-1)*nr + k
184                if ( doZscaleUnpack ) then
185    cph               delZnorm = SQRT(delR(1)/delR(k))
186                   delZnorm = delR(1)/delR(k)
187                else
188                   delZnorm = 1. _d 0
189                endif
190              cbuffindex = nwetglobal(k)              cbuffindex = nwetglobal(k)
191              if ( cbuffindex .gt. 0 ) then              if ( cbuffindex .gt. 0 ) then
192                 read(cunit) filencbuffindex                 read(cunit) filencbuffindex
# Line 185  c--   Only the master thread will do I/O Line 213  c--   Only the master thread will do I/O
213                    if ( globmsk(i,bi,ip,j,bj,jp,k) .ne. 0. ) then                    if ( globmsk(i,bi,ip,j,bj,jp,k) .ne. 0. ) then
214                       cbuffindex = cbuffindex + 1                       cbuffindex = cbuffindex + 1
215                       globfld3d(i,bi,ip,j,bj,jp,k) = cbuff(cbuffindex)                       globfld3d(i,bi,ip,j,bj,jp,k) = cbuff(cbuffindex)
216    cph(
217                         globfldtmp2(i,bi,ip,j,bj,jp) = cbuff(cbuffindex)
218    cph)
219  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
220                       globfld3d(i,bi,ip,j,bj,jp,k) =                       if ( lxxadxx ) then
221       &                    globfld3d(i,bi,ip,j,bj,jp,k)/                          globfld3d(i,bi,ip,j,bj,jp,k) = delZnorm
222         &                       * globfld3d(i,bi,ip,j,bj,jp,k)
223  # ifdef CTRL_UNPACK_PRECISE  # ifdef CTRL_UNPACK_PRECISE
224       &                    sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))       &                       / sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
225  # else  # else
226       &                    sqrt(weightfld(k,bi,bj))       &                       / sqrt(weightfld(k,bi,bj))
227  # endif  # endif
228                         else
229                            globfld3d(i,bi,ip,j,bj,jp,k) = delZnorm
230         &                       * globfld3d(i,bi,ip,j,bj,jp,k)
231    # ifdef CTRL_UNPACK_PRECISE
232         &                       * sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
233    # else
234         &                       * sqrt(weightfld(k,bi,bj))
235    # endif
236                         endif
237  #endif /* ALLOW_NONDIMENSIONAL_CONTROL_IO */  #endif /* ALLOW_NONDIMENSIONAL_CONTROL_IO */
238                    else                    else
239                       globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0                       globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0
240                    endif                    endif
241    cph(
242                      globfldtmp3(i,bi,ip,j,bj,jp) =
243         &                 globfld3d(i,bi,ip,j,bj,jp,k)
244    cph)
245                   enddo                   enddo
246                  enddo                  enddo
247                 enddo                 enddo
# Line 204  c--   Only the master thread will do I/O Line 249  c--   Only the master thread will do I/O
249               enddo               enddo
250              enddo              enddo
251  c  c
252                if ( doPackDiag ) then
253                   write(cunit2,rec=irectrue) globfldtmp2
254                   write(cunit3,rec=irectrue) globfldtmp3
255                endif
256    c
257           enddo           enddo
258                            
259           call MDSWRITEFIELD_3D_GL( fname, ctrlprec, 'RL',           call MDSWRITEFIELD_3D_GL( fname, ctrlprec, 'RL',
# Line 212  c Line 262  c
262    
263        enddo        enddo
264    
265          if ( doPackDiag ) then
266             close ( cunit2 )
267             close ( cunit3 )
268          endif
269    
270        _END_MASTER( mythid )        _END_MASTER( mythid )
271    
272        return        return
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.12
  ViewVC Help
Powered by ViewVC 1.1.22