/[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.1 by heimbach, Tue Feb 5 20:23:58 2002 UTC revision 1.6 by heimbach, Thu Oct 30 19:09:05 2003 UTC
# Line 1  Line 1 
1    C
2    C $Header$
3    C $Name$
4    
5  #include "CTRL_CPPOPTIONS.h"  #include "CTRL_CPPOPTIONS.h"
6    
7    
8        subroutine ctrl_set_pack_xyz(        subroutine ctrl_set_pack_xyz(
9       &     cunit, ivartype, fname, masktype,       &     cunit, ivartype, fname, masktype, weighttype,
10       &     weightfld, lxxadxx, mythid)       &     weightfld, lxxadxx, mythid)
11    
12  c     ==================================================================  c     ==================================================================
# Line 13  c Line 16  c
16  c     o Compress the control vector such that only ocean points are  c     o Compress the control vector such that only ocean points are
17  c       written to file.  c       written to file.
18  c  c
19    c     o Use a more precise nondimensionalization that depends on (x,y)
20    c       Added weighttype to the argument list so that I can geographically
21    c       vary the nondimensionalization.
22    c       gebbie@mit.edu, 18-Mar-2003
23    c
24  c     ==================================================================  c     ==================================================================
25    
26        implicit none        implicit none
# Line 24  c     == global variables == Line 32  c     == global variables ==
32  #include "PARAMS.h"  #include "PARAMS.h"
33  #include "GRID.h"  #include "GRID.h"
34    
 #include "cal.h"  
 #include "ecco.h"  
35  #include "ctrl.h"  #include "ctrl.h"
36  #include "cost.h"  #include "cost.h"
37    
# Line 39  c     == routine arguments == Line 45  c     == routine arguments ==
45        integer ivartype        integer ivartype
46        character*( 80) fname        character*( 80) fname
47        character*  (5) masktype        character*  (5) masktype
48          character*( 80) weighttype
49        _RL     weightfld( nr,nsx,nsy )        _RL     weightfld( nr,nsx,nsy )
50        logical lxxadxx        logical lxxadxx
51        integer mythid        integer mythid
# Line 65  c     == local variables == Line 72  c     == local variables ==
72        _RL     cbuff    ( snx*nsx*npx*sny*nsy*npy )        _RL     cbuff    ( snx*nsx*npx*sny*nsy*npy )
73        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )
74        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )
75    #ifdef CTRL_PACK_PRECISE
76          _RL   weightfld3d( snx,nsx,npx,sny,nsy,npy,nr )
77    #endif
78    
79          character*(80) weightname
80    
81  c     == external ==  c     == external ==
82    
# Line 107  c     Initialise temporary file Line 119  c     Initialise temporary file
119  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
120        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
121    
122    #ifdef CTRL_PACK_PRECISE
123          il=ilnblnk( weighttype)
124          write(weightname(1:80),'(80a)') ' '
125          write(weightname(1:80),'(a)') weighttype(1:il)
126    
127          call MDSREADFIELD_3D_GL(
128         &     weightname, ctrlprec, 'RL',
129         &     Nr, weightfld3d, 1, mythid)
130    #endif
131    
132        call MDSREADFIELD_3D_GL(        call MDSREADFIELD_3D_GL(
133       &     masktype, ctrlprec, 'RL',       &     masktype, ctrlprec, 'RL',
134       &     Nr, globmsk, 1, mythid)       &     Nr, globmsk, 1, mythid)
# Line 133  c--   Only the master thread will do I/O Line 155  c--   Only the master thread will do I/O
155                       if (lxxadxx) then                       if (lxxadxx) then
156                          cbuff(cbuffindex) =                          cbuff(cbuffindex) =
157       &                       globfld3d(i,bi,ip,j,bj,jp,k) *       &                       globfld3d(i,bi,ip,j,bj,jp,k) *
158    # ifdef CTRL_PACK_PRECISE
159         &                       sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
160    # else
161       &                       sqrt(weightfld(k,bi,bj))       &                       sqrt(weightfld(k,bi,bj))
162    # endif
163                       else                       else
164                          cbuff(cbuffindex) =                          cbuff(cbuffindex) =
165       &                       globfld3d(i,bi,ip,j,bj,jp,k) /       &                       globfld3d(i,bi,ip,j,bj,jp,k) /
166    # ifdef CTRL_PACK_PRECISE
167         &                       sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
168    # else
169       &                       sqrt(weightfld(k,bi,bj))       &                       sqrt(weightfld(k,bi,bj))
170    # endif
171                       endif                       endif
172  #else  #else /* ALLOW_NONDIMENSIONAL_CONTROL_IO undef */
173                       cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)                       cbuff(cbuffindex) = globfld3d(i,bi,ip,j,bj,jp,k)
174  #endif  #endif /* ALLOW_NONDIMENSIONAL_CONTROL_IO */
175                    endif                    endif
176                   enddo                   enddo
177                  enddo                  enddo
Legend:
Removed from v.1.1.2.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22