/[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.10 - (hide annotations) (download)
Tue May 15 01:28:57 2007 UTC (17 years, 1 month ago) by heimbach
Branch: MAIN
Changes since 1.9: +16 -11 lines
Revert this change since it produces garbadge in global_ocean.90x40x15

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.10 C $Name: checkpoint59a $
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.10 _RL globfld2d( snx,nsx,npx,sny,nsy,npy )
55     _RL globfld3d( snx,nsx,npx,sny,nsy,npy,nr )
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     jmin = 1
66     jmax = sny
67     imin = 1
68     imax = snx
69    
70     c Initialise temporary file
71 heimbach 1.10 do jp = 1,nPy
72 heimbach 1.2 do bj = jtlo,jthi
73     do j = jmin,jmax
74 heimbach 1.10 do ip = 1,nPx
75 heimbach 1.2 do bi = itlo,ithi
76     do i = imin,imax
77 heimbach 1.10 globfld2d(i,bi,ip,j,bj,jp) = 0. _d 0
78 heimbach 1.4 enddo
79 heimbach 1.10 enddo
80 heimbach 1.4 enddo
81     enddo
82 heimbach 1.10 enddo
83 heimbach 1.4 enddo
84     c Initialise temporary file
85     do k = 1,nr
86 heimbach 1.10 do jp = 1,nPy
87 heimbach 1.4 do bj = jtlo,jthi
88     do j = jmin,jmax
89 heimbach 1.10 do ip = 1,nPx
90 heimbach 1.4 do bi = itlo,ithi
91     do i = imin,imax
92 heimbach 1.10 globfld3d(i,bi,ip,j,bj,jp,k) = 0. _d 0
93 heimbach 1.4 enddo
94 heimbach 1.2 enddo
95 heimbach 1.10 enddo
96 heimbach 1.2 enddo
97     enddo
98 heimbach 1.10 enddo
99 heimbach 1.2 enddo
100    
101     c-- Only the master thread will do I/O.
102     _BEGIN_MASTER( mythid )
103    
104 heimbach 1.4 nrec_nl=int(ncvarrecs(ivartype)/Nr)
105     do irec = 1, nrec_nl
106 heimbach 1.10 call MDSWRITEFIELD_3D_GL( fname, ctrlprec, 'RL',
107 heimbach 1.4 & Nr, globfld3d,
108     & irec, optimcycle, mythid)
109     enddo
110    
111 heimbach 1.10 do irec = nrec_nl*Nr+1, ncvarrecs(ivartype)
112     call MDSWRITEFIELD_2D_GL( fname, ctrlprec, 'RL',
113 heimbach 1.2 & 1, globfld2d,
114     & irec, optimcycle, mythid)
115     enddo
116    
117     _END_MASTER( mythid )
118    
119     end

  ViewVC Help
Powered by ViewVC 1.1.22