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

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

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

revision 1.1.2.2 by heimbach, Fri Mar 7 03:06:41 2003 UTC revision 1.1.2.3 by heimbach, Thu Jun 19 15:18:49 2003 UTC
# Line 3  Line 3 
3    
4    
5        subroutine ctrl_set_pack_xyz(        subroutine ctrl_set_pack_xyz(
6       &     cunit, ivartype, fname, masktype,       &     cunit, ivartype, fname, masktype, weighttype,
7       &     weightfld, lxxadxx, mythid)       &     weightfld, lxxadxx, mythid)
8    
9  c     ==================================================================  c     ==================================================================
# Line 13  c Line 13  c
13  c     o Compress the control vector such that only ocean points are  c     o Compress the control vector such that only ocean points are
14  c       written to file.  c       written to file.
15  c  c
16    c     o Use a more precise nondimensionalization that depends on (x,y)
17    c       Added weighttype to the argument list so that I can geographically
18    c       vary the nondimensionalization.
19    c       gebbie@mit.edu, 18-Mar-2003
20    c
21  c     ==================================================================  c     ==================================================================
22    
23        implicit none        implicit none
# Line 37  c     == routine arguments == Line 42  c     == routine arguments ==
42        integer ivartype        integer ivartype
43        character*( 80) fname        character*( 80) fname
44        character*  (5) masktype        character*  (5) masktype
45          character*( 80) weighttype
46        _RL     weightfld( nr,nsx,nsy )        _RL     weightfld( nr,nsx,nsy )
47        logical lxxadxx        logical lxxadxx
48        integer mythid        integer mythid
# Line 63  c     == local variables == Line 69  c     == local variables ==
69        _RL     cbuff    ( snx*nsx*npx*sny*nsy*npy )        _RL     cbuff    ( snx*nsx*npx*sny*nsy*npy )
70        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )
71        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )
72    #ifdef CTRL_PACK_PRECISE
73          _RL   weightfld3d( snx,nsx,npx,sny,nsy,npy,nr )
74    #endif
75    
76          character*(80) weightname
77    
78  c     == external ==  c     == external ==
79    
# Line 105  c     Initialise temporary file Line 116  c     Initialise temporary file
116  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
117        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
118    
119    #ifdef CTRL_PACK_PRECISE
120          il=ilnblnk( weighttype)
121          write(weightname(1:80),'(80a)') ' '
122          write(weightname(1:80),'(a)') weighttype(1:il)
123    
124          call MDSREADFIELD_3D_GL(
125         &     weightname, ctrlprec, 'RL',
126         &     Nr, weightfld3d, 1, mythid)
127    #endif
128    
129        call MDSREADFIELD_3D_GL(        call MDSREADFIELD_3D_GL(
130       &     masktype, ctrlprec, 'RL',       &     masktype, ctrlprec, 'RL',
131       &     Nr, globmsk, 1, mythid)       &     Nr, globmsk, 1, mythid)
# Line 131  c--   Only the master thread will do I/O Line 152  c--   Only the master thread will do I/O
152                       if (lxxadxx) then                       if (lxxadxx) then
153                          cbuff(cbuffindex) =                          cbuff(cbuffindex) =
154       &                       globfld3d(i,bi,ip,j,bj,jp,k) *       &                       globfld3d(i,bi,ip,j,bj,jp,k) *
155    # ifdef CTRL_PACK_PRECISE
156         &                       sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
157    # else
158       &                       sqrt(weightfld(k,bi,bj))       &                       sqrt(weightfld(k,bi,bj))
159    # endif
160                       else                       else
161                          cbuff(cbuffindex) =                          cbuff(cbuffindex) =
162       &                       globfld3d(i,bi,ip,j,bj,jp,k) /       &                       globfld3d(i,bi,ip,j,bj,jp,k) /
163    # ifdef CTRL_PACK_PRECISE
164         &                       sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
165    # else
166       &                       sqrt(weightfld(k,bi,bj))       &                       sqrt(weightfld(k,bi,bj))
167    # endif
168                       endif                       endif
169  #else  #else /* ALLOW_NONDIMENSIONAL_CONTROL_IO undef */
170                       cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)                       cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
171  #endif  #endif /* ALLOW_NONDIMENSIONAL_CONTROL_IO */
172                    endif                    endif
173                   enddo                   enddo
174                  enddo                  enddo
Legend:
Removed from v.1.1.2.2  
changed lines
  Added in v.1.1.2.3
  ViewVC Help
Powered by ViewVC 1.1.22