/[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.2 by heimbach, Sat Jul 13 02:47:32 2002 UTC revision 1.3 by heimbach, Tue Jun 24 16:07:07 2003 UTC
# Line 3  Line 3 
3    
4    
5        subroutine ctrl_set_unpack_xyz(        subroutine ctrl_set_unpack_xyz(
6       &     cunit, ivartype, fname, masktype,       &     cunit, ivartype, fname, masktype, weighttype,
7       &     weightfld, nwetglobal, mythid)       &     weightfld, nwetglobal, mythid)
8    
9  c     ==================================================================  c     ==================================================================
10  c     SUBROUTINE ctrl_set_unpack_xyz  c     SUBROUTINE ctrl_set_unpack_xyz
11  c     ==================================================================  c     ==================================================================
12  c  c
13  c     o Unpack the control vector such that the land points are filled  c     o Unpack the control vector such that land points are filled in.
14  c       in.  c
15    c     o Use a more precise nondimensionalization that depends on (x,y)
16    c       Added weighttype to the argument list so that I can geographically
17    c       vary the nondimensionalization.
18    c       gebbie@mit.edu, 18-Mar-2003
19  c  c
20  c     ==================================================================  c     ==================================================================
21    
# Line 37  c     == routine arguments == Line 41  c     == routine arguments ==
41        integer ivartype        integer ivartype
42        character*( 80)   fname        character*( 80)   fname
43        character*  (5) masktype        character*  (5) masktype
44          character*( 80) weighttype
45        _RL     weightfld( nr,nsx,nsy )        _RL     weightfld( nr,nsx,nsy )
46        integer nwetglobal(nr)        integer nwetglobal(nr)
47        integer mythid        integer mythid
# Line 63  c     == local variables == Line 68  c     == local variables ==
68        _RL     cbuff    ( snx*nsx*npx*sny*nsy*npy )        _RL     cbuff    ( snx*nsx*npx*sny*nsy*npy )
69        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globmsk  ( snx,nsx,npx,sny,nsy,npy,nr )
70        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )        _RL     globfld3d( snx,nsx,npx,sny,nsy,npy,nr )
71    #ifdef CTRL_UNPACK_PRECISE
72          _RL   weightfld3d( snx,nsx,npx,sny,nsy,npy,nr )
73    #endif
74    
75        character*(128)   cfile        character*(128)   cfile
76          character*(80) weightname
77    
78        integer        filenvartype        integer        filenvartype
79        integer        filenvarlength        integer        filenvarlength
# Line 127  c     Initialise temporary file Line 136  c     Initialise temporary file
136  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
137        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
138    
139    #ifdef CTRL_UNPACK_PRECISE
140          il=ilnblnk( weighttype)
141          write(weightname(1:80),'(80a)') ' '
142          write(weightname(1:80),'(a)') weighttype(1:il)
143    
144          call MDSREADFIELD_3D_GL(
145         &     weightname, ctrlprec, 'RL',
146         &     Nr, weightfld3d, 1, mythid)
147    #endif
148    
149        call MDSREADFIELD_3D_GL(        call MDSREADFIELD_3D_GL(
150       &     masktype, ctrlprec, 'RL',       &     masktype, ctrlprec, 'RL',
151       &     Nr, globmsk, 1, mythid)       &     Nr, globmsk, 1, mythid)
# Line 171  c--   Only the master thread will do I/O Line 190  c--   Only the master thread will do I/O
190  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
191                       globfld3d(i,bi,ip,j,bj,jp,k) =                       globfld3d(i,bi,ip,j,bj,jp,k) =
192       &                    globfld3d(i,bi,ip,j,bj,jp,k)/       &                    globfld3d(i,bi,ip,j,bj,jp,k)/
193    # ifdef CTRL_UNPACK_PRECISE
194         &                    sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
195    # else
196       &                    sqrt(weightfld(k,bi,bj))       &                    sqrt(weightfld(k,bi,bj))
197  #endif  # endif
198    #endif /* ALLOW_NONDIMENSIONAL_CONTROL_IO */
199                    else                    else
200                       globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0                       globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0
201                    endif                    endif
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22