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

Annotation of /MITgcm/pkg/ctrl/ctrl_set_globfld_xy.F

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


Revision 1.11 - (hide annotations) (download)
Wed May 16 00:03:36 2007 UTC (17 years ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62c, checkpoint62a, checkpoint60, checkpoint61, checkpoint62, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint62b, checkpoint61f, checkpoint61n, checkpoint59j, checkpoint61q, checkpoint61e, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61z, checkpoint61x, checkpoint61y
Changes since 1.10: +22 -27 lines
Fix overlap and check in Matts last set of I/O changes.

1 edhill 1.5 C
2 heimbach 1.9 C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_set_globfld_xy.F,v 1.8 2004/11/16 05:42:12 heimbach Exp $
3 heimbach 1.11 C $Name: $
4 edhill 1.5
5 heimbach 1.2 #include "CTRL_CPPOPTIONS.h"
6    
7     subroutine ctrl_set_globfld_xy(
8     I fname, ivartype, mythid )
9    
10     c ==================================================================
11     c SUBROUTINE ctrl_set_globfld_xy
12     c ==================================================================
13     c
14     c o initialise field
15     c
16     c started: heimbach@mit.edu, 16-Aug-2001
17     c
18 heimbach 1.4 c changed: heimbach@mit.edu 17-Jun-2003
19     c merged Armin's changes to replace write of
20     c nr * globfld2d by 1 * globfld3d
21     c (ad hoc fix to speed up global I/O)
22     c
23 heimbach 1.2 c ==================================================================
24    
25     implicit none
26    
27     c == global variables ==
28    
29     #include "EEPARAMS.h"
30     #include "SIZE.h"
31     #include "PARAMS.h"
32     #include "GRID.h"
33    
34     #include "ctrl.h"
35     #include "optim.h"
36    
37     c == routine arguments ==
38    
39     character*( 80) fname
40     integer ivartype
41     integer mythid
42    
43     c == local variables ==
44    
45     integer bi,bj
46     integer ip,jp
47 heimbach 1.4 integer i,j,k
48 heimbach 1.2 integer itlo,ithi
49     integer jtlo,jthi
50     integer jmin,jmax
51     integer imin,imax
52 heimbach 1.4 integer irec,nrec_nl
53 heimbach 1.2
54 heimbach 1.11 _RL globfld2d(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nSx,nSy)
55     _RL globfld3d(1-oLx:sNx+oLx,1-oLy:sNy+oLy,nr,nSx,nSy)
56 heimbach 1.2
57     c == external ==
58    
59     c == end of interface ==
60    
61     jtlo = 1
62     jthi = nsy
63     itlo = 1
64     ithi = nsx
65 heimbach 1.11 jmin = 1-oLy
66     jmax = sny+oLy
67     imin = 1-oLx
68     imax = snx+oLx
69 heimbach 1.2
70     c Initialise temporary file
71 heimbach 1.11 do bj = jtlo,jthi
72     do bi = itlo,ithi
73 heimbach 1.2 do j = jmin,jmax
74 heimbach 1.11 do i = imin,imax
75     globfld2d(i,j,bi,bj) = 0. _d 0
76 heimbach 1.4 enddo
77     enddo
78 heimbach 1.10 enddo
79 heimbach 1.4 enddo
80     c Initialise temporary file
81 heimbach 1.11 do bj = jtlo,jthi
82     do bi = itlo,ithi
83     do k = 1,nr
84 heimbach 1.4 do j = jmin,jmax
85 heimbach 1.11 do i = imin,imax
86     globfld3d(i,j,k,bi,bj) = 0. _d 0
87 heimbach 1.10 enddo
88 heimbach 1.2 enddo
89     enddo
90 heimbach 1.10 enddo
91 heimbach 1.2 enddo
92    
93     c-- Only the master thread will do I/O.
94     _BEGIN_MASTER( mythid )
95    
96 heimbach 1.4 nrec_nl=int(ncvarrecs(ivartype)/Nr)
97     do irec = 1, nrec_nl
98 heimbach 1.11 call MDSWRITEFIELD( fname, ctrlprec, .FALSE., 'RL',
99 heimbach 1.4 & Nr, globfld3d,
100     & irec, optimcycle, mythid)
101     enddo
102    
103 heimbach 1.11 CMM( add one for good measure
104     CMM do irec = nrec_nl*Nr+1, ncvarrecs(ivartype)
105     do irec = nrec_nl*Nr+1, ncvarrecs(ivartype)+1
106     CMM)
107     call MDSWRITEFIELD( fname, ctrlprec, .FALSE., 'RL',
108 heimbach 1.2 & 1, globfld2d,
109     & irec, optimcycle, mythid)
110     enddo
111    
112     _END_MASTER( mythid )
113    
114     end

  ViewVC Help
Powered by ViewVC 1.1.22