/[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.9 - (hide annotations) (download)
Mon May 14 23:06:13 2007 UTC (17 years ago) by heimbach
Branch: MAIN
Changes since 1.8: +11 -16 lines
Cleanup suggested by M. Mazloff

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.6 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.9 _RL globfld2d( snx,sny,nsx,nsy )
55     _RL globfld3d( snx,sny,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     jmin = 1
66     jmax = sny
67     imin = 1
68     imax = snx
69    
70     c Initialise temporary file
71     do bj = jtlo,jthi
72     do j = jmin,jmax
73     do bi = itlo,ithi
74     do i = imin,imax
75 heimbach 1.9 globfld2d(i,j,bi,bj) = 0. _d 0
76 heimbach 1.4 enddo
77     enddo
78     enddo
79     enddo
80     c Initialise temporary file
81     do k = 1,nr
82     do bj = jtlo,jthi
83     do j = jmin,jmax
84     do bi = itlo,ithi
85     do i = imin,imax
86 heimbach 1.9 globfld3d(i,j,k,bi,bj) = 0. _d 0
87 heimbach 1.4 enddo
88 heimbach 1.2 enddo
89     enddo
90     enddo
91     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.9 call MDSWRITEFIELD( fname, ctrlprec, .FALSE., 'RL',
99 heimbach 1.4 & Nr, globfld3d,
100     & irec, optimcycle, mythid)
101     enddo
102    
103 heimbach 1.9 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