/[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.8 by heimbach, Tue Nov 16 05:42:12 2004 UTC
# Line 1  Line 1 
1    
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,       &     cunit, ivartype, fname, masktype, weighttype,
6       &     weightfld, nwetglobal, mythid)       &     weightfld, nwetglobal, mythid)
7    
8  c     ==================================================================  c     ==================================================================
9  c     SUBROUTINE ctrl_set_unpack_xyz  c     SUBROUTINE ctrl_set_unpack_xyz
10  c     ==================================================================  c     ==================================================================
11  c  c
12  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.
13  c       in.  c
14    c     o Use a more precise nondimensionalization that depends on (x,y)
15    c       Added weighttype to the argument list so that I can geographically
16    c       vary the nondimensionalization.
17    c       gebbie@mit.edu, 18-Mar-2003
18  c  c
19  c     ==================================================================  c     ==================================================================
20    
# Line 25  c     == global variables == Line 28  c     == global variables ==
28  #include "GRID.h"  #include "GRID.h"
29    
30  #include "ctrl.h"  #include "ctrl.h"
 #include "cost.h"  
   
 #ifdef ALLOW_ECCO_OPTIMIZATION  
31  #include "optim.h"  #include "optim.h"
 #endif  
32    
33  c     == routine arguments ==  c     == routine arguments ==
34    
# Line 37  c     == routine arguments == Line 36  c     == routine arguments ==
36        integer ivartype        integer ivartype
37        character*( 80)   fname        character*( 80)   fname
38        character*  (5) masktype        character*  (5) masktype
39          character*( 80) weighttype
40        _RL     weightfld( nr,nsx,nsy )        _RL     weightfld( nr,nsx,nsy )
41        integer nwetglobal(nr)        integer nwetglobal(nr)
42        integer mythid        integer mythid
43    
44  c     == local variables ==  c     == local variables ==
45    
 #ifndef ALLOW_ECCO_OPTIMIZATION  
       integer optimcycle  
 #endif  
   
46        integer bi,bj        integer bi,bj
47        integer ip,jp        integer ip,jp
48        integer i,j,k        integer i,j,k
# Line 60  c     == local variables == Line 56  c     == local variables ==
56    
57        integer cbuffindex        integer cbuffindex
58    
59        _RL     cbuff    ( snx*nsx*npx*sny*nsy*npy )        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
63          _RL   weightfld3d( snx,nsx,npx,sny,nsy,npy,nr )
64    #endif
65    
66        character*(128)   cfile        character*(128)   cfile
67          character*(80) weightname
       integer        filenvartype  
       integer        filenvarlength  
       character*(10) fileExpId  
       integer        fileOptimCycle  
       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)  
68    
69  c     == external ==  c     == external ==
70    
# Line 120  c     Initialise temporary file Line 100  c     Initialise temporary file
100           enddo           enddo
101        enddo        enddo
102    
 #ifndef ALLOW_ECCO_OPTIMIZATION  
       optimcycle = 0  
 #endif  
   
103  c--   Only the master thread will do I/O.  c--   Only the master thread will do I/O.
104        _BEGIN_MASTER( mythid )        _BEGIN_MASTER( mythid )
105    
106    #ifdef CTRL_UNPACK_PRECISE
107          il=ilnblnk( weighttype)
108          write(weightname(1:80),'(80a)') ' '
109          write(weightname(1:80),'(a)') weighttype(1:il)
110    
111          call MDSREADFIELD_3D_GL(
112         &     weightname, ctrlprec, 'RL',
113         &     Nr, weightfld3d, 1, mythid)
114    #endif
115    
116        call MDSREADFIELD_3D_GL(        call MDSREADFIELD_3D_GL(
117       &     masktype, ctrlprec, 'RL',       &     masktype, ctrlprec, 'RL',
118       &     Nr, globmsk, 1, mythid)       &     Nr, globmsk, 1, mythid)
# Line 171  c--   Only the master thread will do I/O Line 157  c--   Only the master thread will do I/O
157  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO  #ifdef ALLOW_NONDIMENSIONAL_CONTROL_IO
158                       globfld3d(i,bi,ip,j,bj,jp,k) =                       globfld3d(i,bi,ip,j,bj,jp,k) =
159       &                    globfld3d(i,bi,ip,j,bj,jp,k)/       &                    globfld3d(i,bi,ip,j,bj,jp,k)/
160    # ifdef CTRL_UNPACK_PRECISE
161         &                    sqrt(weightfld3d(i,bi,ip,j,bj,jp,k))
162    # else
163       &                    sqrt(weightfld(k,bi,bj))       &                    sqrt(weightfld(k,bi,bj))
164  #endif  # endif
165    #endif /* ALLOW_NONDIMENSIONAL_CONTROL_IO */
166                    else                    else
167                       globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0                       globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0
168                    endif                    endif
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.8
  ViewVC Help
Powered by ViewVC 1.1.22