pkg/mnc/mnc_cw_readwrite.template

C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_cw_readwrite.template,v 1.3 2004/02/05 00:13:47 edhill Exp $
C $Name:  $
      
#include "MNC_OPTIONS.h"
      
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      SUBROUTINE MNC_CW_RX_W_YY( 
     I     myThid, 
     I     fbname, bi,bj, 
     I     vtype, 
     I     indu, 
     I     var ) 

      implicit none

#include "netcdf.inc"
#include "mnc_common.h"
#include "EEPARAMS.h"
#include "SIZE.h"

#define mnc_rtype_YY

C     Arguments
      integer myThid, bi,bj, indu
      character*(*) fbname, vtype
      _RX var(*)

C     Functions
      integer IFNBLNK, ILNBLNK

C     Local Variables
      integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot
      integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids
      integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
      integer p(9),s(9),e(9), dimnc(9), vstart(9),vcount(9), udo(9)
      integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
      character*(MAX_LEN_MBUF) msgbuf
      character*(MNC_MAX_CHAR) fname

C     Temporary storage for the simultaneous type conversion and
C     re-shaping before passing to NetCDF
#ifdef  mnc_rtype_D
      REAL*8 resh( sNx + 2*OLx + sNy + 2*OLy )
#endif
#ifdef  mnc_rtype_R
      REAL*4 resh( sNx + 2*OLx + sNy + 2*OLy )
#endif

C     Only do I/O if I am the master thread
      _BEGIN_MASTER( myThid )

C     Check that the Variable Type exists
      nvf = IFNBLNK(vtype)
      nvl = ILNBLNK(vtype)
      CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, indv)
      IF (indv .LT. 1) THEN
        write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''', 
     &       vtype(nvf:nvl), ''' is not defined'
        CALL print_error(msgbuf, mythid)
        stop 'ABNORMAL END: S/R MNC_CW_RX_WRITES_YY'
      ENDIF
      igrid = mnc_cw_vgind(indv)

C     
      bis = bi
      bie = bi
      IF (bi .LT. 1) THEN
        bis = 1
        bie = nSx
      ENDIF
      bjs = bj
      bje = bj
      IF (bj .LT. 1) THEN
        bjs = 1
        bje = nSy
      ENDIF

      DO lbj = bjs,bje
        DO lbi = bis,bie

C         Create the file name
          CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)
          fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
          n1 = IFNBLNK(fbname)
          n2 = ILNBLNK(fbname)
          ntot = n2 - n1 + 1
          fname(1:ntot) = fbname(n1:n2)
          ntot = ntot + 1
          fname(ntot:ntot) = '.'
          write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'
          nfname = ntot+9

C         Append to an existing or create a new file
          CALL MNC_CW_FILE_AORC(myThid, fname, indf)
          fid = mnc_f_info(indf,2)

C         Ensure that all the NetCDF dimensions are defined and create a
C         local copy of them
          DO i = 1,9
            dimnc(i) = 1
          ENDDO
          DO i = 1,mnc_cw_ndim(igrid)
            IF (mnc_cw_dims(i,igrid) .EQ. -1) THEN
              dimnc(i) = -1
            ELSE
              dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1
            ENDIF
            CALL MNC_DIM_INIT(myThid,fname, 
     &           mnc_cw_dn(i,igrid), dimnc(i) )
          ENDDO

C         Ensure that the "grid" is defined
          CALL MNC_GRID_INIT(myThid,fname, mnc_cw_gname(igrid), 
     &        mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid))

C         Ensure that the variable is defined
#ifdef  mnc_rtype_D
      CALL MNC_VAR_INIT_DBL(myThid,fname,mnc_cw_gname(igrid),vtype)
#endif
#ifdef  mnc_rtype_R
      CALL MNC_VAR_INIT_REAL(myThid,fname,mnc_cw_gname(igrid),vtype)
#endif
          DO i = 1,mnc_fv_ids(indf,1)
            j = 2 + 3*(i - 1)
            IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vtype) THEN
              idv = mnc_fv_ids(indf,j+1)
              indvids = mnc_fd_ind(indf, mnc_f_info(indf, 
     &             (mnc_fv_ids(indf,j+2) + 1)) )
              GOTO 10
            ENDIF
          ENDDO
          write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_WRITES_YY ERROR: ', 
     &         'cannot reference variable ''', vtype, ''''
          CALL print_error(msgbuf, mythid)
          stop 'ABNORMAL END: package MNC'
 10       CONTINUE

C         Check for bi,bj indicies
          bidim = mnc_cw_vbij(1,indv)
          bjdim = mnc_cw_vbij(2,indv)
CEH3      write(*,*) 'bidim,bjdim = ', bidim,bjdim

C         Set the dimensions for the in-memory array
          ndim = mnc_cw_ndim(igrid)
          k = mnc_cw_dims(1,igrid)
          IF (k .GT. 0) THEN
            p(1) = k
          ELSE
            p(1) = 1
          ENDIF
          DO i = 2,9
            k = mnc_cw_dims(i,igrid)
            IF (k .LT. 1) THEN
              k = 1
            ENDIF
            IF ((bidim .GT. 0) .AND. (i .EQ. bidim)) THEN
              p(i) = nSx * p(i-1)
            ELSEIF ((bjdim .GT. 0) .AND. (i .EQ. bjdim)) THEN
              p(i) = nSy * p(i-1)
            ELSE
              p(i) = k * p(i-1)
            ENDIF
          ENDDO

C         Set starting and ending indicies for the in-memory array and
C         the unlimited dimension offset for the NetCDF array
          DO i = 1,9
            udo(i) = 0
            s(i) = 1
            e(i) = 1
            IF (i .LE. ndim) THEN
              s(i) = mnc_cw_is(i,igrid)
              e(i) = mnc_cw_ie(i,igrid)
            ENDIF
C           Check for the unlimited dimension
            IF ((i .EQ. ndim) 
     &           .AND. (mnc_cw_dims(i,igrid) .EQ. -1)) THEN
              IF (indu .GT. 0) THEN
C               Use the indu value
                udo(i) = indu - 1
              ELSEIF (indu .EQ. -1) THEN
C               Append one to the current unlimited dim size
                CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
                udo(i) = unlim_sz
              ELSE
C               Use the current unlimited dim size
                CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
                udo(i) = unlim_sz - 1
              ENDIF
            ENDIF
          ENDDO
          IF (bidim .GT. 0) THEN
            s(bidim) = lbi
            e(bidim) = lbi
          ENDIF
          IF (bjdim .GT. 0) THEN
            s(bjdim) = lbj
            e(bjdim) = lbj
          ENDIF
CEH3      DO i = 1,9
CEH3        write(*,*) 'i,p(i),s(i),e(i) = ', i,p(i),s(i),e(i)
CEH3      ENDDO

C         Add the global attributes
          CALL MNC_CW_SET_GATTR(myThid, fname, lbi,lbj, uniq_tnum)

C         Add the per-variable attributes
          DO i = 1,mnc_cw_vnat(1,indv)
            CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vtype, 
     &           mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv))
          ENDDO
          DO i = 1,mnc_cw_vnat(2,indv)
            CALL MNC_VAR_ADD_ATTR_INT(myThid, fname, vtype, 
     &           mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv))
          ENDDO
          DO i = 1,mnc_cw_vnat(3,indv)
            CALL MNC_VAR_ADD_ATTR_DBL(myThid, fname, vtype, 
     &           mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv))
          ENDDO

          CALL MNC_FILE_ENDDEF(myThid,fname)

C         Write the variable one vector at a time
          DO j7 = s(7),e(7)
            k7 = (j7 - 1)*p(6)
            vstart(7) = udo(7) + j7 - s(7) + 1
            vcount(7) = 1
            DO j6 = s(6),e(6)
              k6 = (j6 - 1)*p(5) + k7
              vstart(6) = udo(6) + j6 - s(6) + 1
              vcount(6) = 1
              DO j5 = s(5),e(5)
                k5 = (j5 - 1)*p(4) + k6
                vstart(5) = udo(5) + j5 - s(5) + 1
                vcount(5) = 1
                DO j4 = s(4),e(4)
                  k4 = (j4 - 1)*p(3) + k5
                  vstart(4) = udo(4) + j4 - s(4) + 1
                  vcount(4) = 1
                  DO j3 = s(3),e(3)
                    k3 = (j3 - 1)*p(2) + k4
                    vstart(3) = udo(3) + j3 - s(3) + 1
                    vcount(3) = 1
                    DO j2 = s(2),e(2)
                      k2 = (j2 - 1)*p(1) + k3
                      vstart(2) = udo(2) + j2 - s(2) + 1
                      vcount(2) = 1

CEH3      write(*,*) 's/e: ', k2+s(1), k2+e(1)
      
      kr = 0
      DO j1 = s(1),e(1)
        k1 = k2 + j1
        kr = kr + 1
        resh(kr) = var(k1)
      ENDDO
      
      vstart(1) = udo(1) + 1
      vcount(1) = e(1) - s(1) + 1

#ifdef  mnc_rtype_D
      err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh)
#endif
#ifdef  mnc_rtype_R
      err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)
#endif

                    ENDDO
                  ENDDO
                ENDDO
              ENDDO
            ENDDO
          ENDDO

C         Sync the file
          err = NF_SYNC(fid)
          write(msgbuf,'(3a)') 'sync for file ''', fname, 
     &         ''' in S/R MNC_CW_RX_WRITES_YY'
          CALL MNC_HANDLE_ERR(myThid, err, msgbuf)

        ENDDO
      ENDDO

      _END_MASTER( myThid )

      RETURN
      END

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

CEH3 ;;; Local Variables: ***
CEH3 ;;; mode:fortran ***
CEH3 ;;; End: ***
1	edhill	1.4	C $Header: /u/u3/gcmpack/MITgcm/pkg/mnc/mnc_cw_readwrite.template,v 1.3 2004/02/05 00:13:47 edhill Exp $
2	edhill	1.1	C $Name: $
3
4			#include "MNC_OPTIONS.h"
5
6			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
7
8	edhill	1.3	SUBROUTINE MNC_CW_RX_W_YY(
9	edhill	1.1	I myThid,
10			I fbname, bi,bj,
11			I vtype,
12			I indu,
13			I var )
14
15			implicit none
16
17			#include "netcdf.inc"
18			#include "mnc_common.h"
19			#include "EEPARAMS.h"
20	edhill	1.2	#include "SIZE.h"
21
22			#define mnc_rtype_YY
23	edhill	1.1
24			C Arguments
25			integer myThid, bi,bj, indu
26			character() fbname, vtype
27			_RX var(*)
28
29			C Functions
30			integer IFNBLNK, ILNBLNK
31
32			C Local Variables
33	edhill	1.3	integer i,j,k, indv,nvf,nvl, n1,n2, igrid, ntot
34	edhill	1.2	integer bis,bie, bjs,bje, uniq_tnum, nfname, fid, idv, indvids
35	edhill	1.3	integer ndim, indf, err, lbi,lbj, bidim,bjdim, unlim_sz, kr
36			integer p(9),s(9),e(9), dimnc(9), vstart(9),vcount(9), udo(9)
37			integer j1,j2,j3,j4,j5,j6,j7, k1,k2,k3,k4,k5,k6,k7
38	edhill	1.1	character*(MAX_LEN_MBUF) msgbuf
39			character*(MNC_MAX_CHAR) fname
40
41			C Temporary storage for the simultaneous type conversion and
42			C re-shaping before passing to NetCDF
43			#ifdef mnc_rtype_D
44			REAL8 resh( sNx + 2OLx + sNy + 2*OLy )
45			#endif
46			#ifdef mnc_rtype_R
47			REAL4 resh( sNx + 2OLx + sNy + 2*OLy )
48			#endif
49
50			C Only do I/O if I am the master thread
51			_BEGIN_MASTER( myThid )
52
53			C Check that the Variable Type exists
54			nvf = IFNBLNK(vtype)
55			nvl = ILNBLNK(vtype)
56			CALL MNC_GET_IND(myThid, MNC_MAX_ID, vtype, mnc_cw_vname, indv)
57	edhill	1.2	IF (indv .LT. 1) THEN
58	edhill	1.1	write(msgbuf,'(3a)') 'MNC_CW_RX_WRITES_YY ERROR: vtype ''',
59	edhill	1.2	& vtype(nvf:nvl), ''' is not defined'
60	edhill	1.1	CALL print_error(msgbuf, mythid)
61			stop 'ABNORMAL END: S/R MNC_CW_RX_WRITES_YY'
62			ENDIF
63	edhill	1.2	igrid = mnc_cw_vgind(indv)
64	edhill	1.1
65	edhill	1.3	C
66	edhill	1.2	bis = bi
67			bie = bi
68	edhill	1.1	IF (bi .LT. 1) THEN
69			bis = 1
70			bie = nSx
71			ENDIF
72	edhill	1.2	bjs = bj
73			bje = bj
74	edhill	1.1	IF (bj .LT. 1) THEN
75			bjs = 1
76			bje = nSy
77			ENDIF
78
79	edhill	1.2	DO lbj = bjs,bje
80			DO lbi = bis,bie
81	edhill	1.1
82			C Create the file name
83	edhill	1.2	CALL MNC_CW_GET_TILE_NUM(myThid, lbi,lbj, uniq_tnum)
84	edhill	1.1	fname(1:MNC_MAX_CHAR) = mnc_blank_name(1:MNC_MAX_CHAR)
85			n1 = IFNBLNK(fbname)
86			n2 = ILNBLNK(fbname)
87			ntot = n2 - n1 + 1
88			fname(1:ntot) = fbname(n1:n2)
89			ntot = ntot + 1
90			fname(ntot:ntot) = '.'
91			write(fname((ntot+1):(ntot+9)),'(i6.6,a3)') uniq_tnum, '.nc'
92	edhill	1.2	nfname = ntot+9
93
94			C Append to an existing or create a new file
95			CALL MNC_CW_FILE_AORC(myThid, fname, indf)
96			fid = mnc_f_info(indf,2)
97
98	edhill	1.3	C Ensure that all the NetCDF dimensions are defined and create a
99			C local copy of them
100	edhill	1.2	DO i = 1,9
101			dimnc(i) = 1
102			ENDDO
103			DO i = 1,mnc_cw_ndim(igrid)
104	edhill	1.3	IF (mnc_cw_dims(i,igrid) .EQ. -1) THEN
105			dimnc(i) = -1
106			ELSE
107			dimnc(i) = mnc_cw_ie(i,igrid) - mnc_cw_is(i,igrid) + 1
108			ENDIF
109	edhill	1.2	CALL MNC_DIM_INIT(myThid,fname,
110			& mnc_cw_dn(i,igrid), dimnc(i) )
111			ENDDO
112
113			C Ensure that the "grid" is defined
114			CALL MNC_GRID_INIT(myThid,fname, mnc_cw_gname(igrid),
115			& mnc_cw_ndim(igrid), mnc_cw_dn(1,igrid))
116
117			C Ensure that the variable is defined
118			#ifdef mnc_rtype_D
119			CALL MNC_VAR_INIT_DBL(myThid,fname,mnc_cw_gname(igrid),vtype)
120			#endif
121			#ifdef mnc_rtype_R
122			CALL MNC_VAR_INIT_REAL(myThid,fname,mnc_cw_gname(igrid),vtype)
123			#endif
124			DO i = 1,mnc_fv_ids(indf,1)
125			j = 2 + 3*(i - 1)
126			IF (mnc_v_names(mnc_fv_ids(indf,j)) .EQ. vtype) THEN
127			idv = mnc_fv_ids(indf,j+1)
128			indvids = mnc_fd_ind(indf, mnc_f_info(indf,
129			& (mnc_fv_ids(indf,j+2) + 1)) )
130			GOTO 10
131			ENDIF
132			ENDDO
133			write(msgbuf,'(4a)') 'MNC_MNC_CW_RX_WRITES_YY ERROR: ',
134			& 'cannot reference variable ''', vtype, ''''
135			CALL print_error(msgbuf, mythid)
136			stop 'ABNORMAL END: package MNC'
137			10 CONTINUE
138
139	edhill	1.3	C Check for bi,bj indicies
140			bidim = mnc_cw_vbij(1,indv)
141			bjdim = mnc_cw_vbij(2,indv)
142	edhill	1.4	CEH3 write(,) 'bidim,bjdim = ', bidim,bjdim
143	edhill	1.3
144	edhill	1.2	C Set the dimensions for the in-memory array
145			ndim = mnc_cw_ndim(igrid)
146	edhill	1.3	k = mnc_cw_dims(1,igrid)
147			IF (k .GT. 0) THEN
148			p(1) = k
149			ELSE
150			p(1) = 1
151			ENDIF
152	edhill	1.2	DO i = 2,9
153	edhill	1.3	k = mnc_cw_dims(i,igrid)
154			IF (k .LT. 1) THEN
155			k = 1
156			ENDIF
157			IF ((bidim .GT. 0) .AND. (i .EQ. bidim)) THEN
158			p(i) = nSx * p(i-1)
159			ELSEIF ((bjdim .GT. 0) .AND. (i .EQ. bjdim)) THEN
160			p(i) = nSy * p(i-1)
161			ELSE
162			p(i) = k * p(i-1)
163			ENDIF
164	edhill	1.2	ENDDO
165
166	edhill	1.3	C Set starting and ending indicies for the in-memory array and
167			C the unlimited dimension offset for the NetCDF array
168	edhill	1.2	DO i = 1,9
169	edhill	1.3	udo(i) = 0
170			s(i) = 1
171			e(i) = 1
172			IF (i .LE. ndim) THEN
173			s(i) = mnc_cw_is(i,igrid)
174			e(i) = mnc_cw_ie(i,igrid)
175			ENDIF
176			C Check for the unlimited dimension
177			IF ((i .EQ. ndim)
178			& .AND. (mnc_cw_dims(i,igrid) .EQ. -1)) THEN
179			IF (indu .GT. 0) THEN
180			C Use the indu value
181			udo(i) = indu - 1
182			ELSEIF (indu .EQ. -1) THEN
183			C Append one to the current unlimited dim size
184			CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
185			udo(i) = unlim_sz
186	edhill	1.2	ELSE
187	edhill	1.3	C Use the current unlimited dim size
188			CALL MNC_DIM_UNLIM_SIZE(myThid, fname, unlim_sz)
189			udo(i) = unlim_sz - 1
190	edhill	1.2	ENDIF
191			ENDIF
192			ENDDO
193	edhill	1.3	IF (bidim .GT. 0) THEN
194			s(bidim) = lbi
195			e(bidim) = lbi
196			ENDIF
197			IF (bjdim .GT. 0) THEN
198			s(bjdim) = lbj
199			e(bjdim) = lbj
200			ENDIF
201	edhill	1.4	CEH3 DO i = 1,9
202			CEH3 write(,) 'i,p(i),s(i),e(i) = ', i,p(i),s(i),e(i)
203			CEH3 ENDDO
204	edhill	1.3
205			C Add the global attributes
206			CALL MNC_CW_SET_GATTR(myThid, fname, lbi,lbj, uniq_tnum)
207
208			C Add the per-variable attributes
209			DO i = 1,mnc_cw_vnat(1,indv)
210			CALL MNC_VAR_ADD_ATTR_STR(myThid, fname, vtype,
211			& mnc_cw_vtnm(i,indv), mnc_cw_vtat(i,indv))
212			ENDDO
213			DO i = 1,mnc_cw_vnat(2,indv)
214			CALL MNC_VAR_ADD_ATTR_INT(myThid, fname, vtype,
215			& mnc_cw_vinm(i,indv), 1, mnc_cw_viat(i,indv))
216			ENDDO
217			DO i = 1,mnc_cw_vnat(3,indv)
218			CALL MNC_VAR_ADD_ATTR_DBL(myThid, fname, vtype,
219			& mnc_cw_vdnm(i,indv), 1, mnc_cw_vdat(i,indv))
220			ENDDO
221	edhill	1.2
222			CALL MNC_FILE_ENDDEF(myThid,fname)
223
224			C Write the variable one vector at a time
225	edhill	1.3	DO j7 = s(7),e(7)
226	edhill	1.4	k7 = (j7 - 1)*p(6)
227	edhill	1.3	vstart(7) = udo(7) + j7 - s(7) + 1
228			vcount(7) = 1
229			DO j6 = s(6),e(6)
230	edhill	1.4	k6 = (j6 - 1)*p(5) + k7
231	edhill	1.3	vstart(6) = udo(6) + j6 - s(6) + 1
232			vcount(6) = 1
233			DO j5 = s(5),e(5)
234	edhill	1.4	k5 = (j5 - 1)*p(4) + k6
235	edhill	1.3	vstart(5) = udo(5) + j5 - s(5) + 1
236			vcount(5) = 1
237			DO j4 = s(4),e(4)
238	edhill	1.4	k4 = (j4 - 1)*p(3) + k5
239	edhill	1.3	vstart(4) = udo(4) + j4 - s(4) + 1
240			vcount(4) = 1
241			DO j3 = s(3),e(3)
242	edhill	1.4	k3 = (j3 - 1)*p(2) + k4
243	edhill	1.3	vstart(3) = udo(3) + j3 - s(3) + 1
244			vcount(3) = 1
245			DO j2 = s(2),e(2)
246	edhill	1.4	k2 = (j2 - 1)*p(1) + k3
247	edhill	1.3	vstart(2) = udo(2) + j2 - s(2) + 1
248			vcount(2) = 1
249	edhill	1.1
250	edhill	1.3	CEH3 write(,) 's/e: ', k2+s(1), k2+e(1)
251
252			kr = 0
253			DO j1 = s(1),e(1)
254			k1 = k2 + j1
255			kr = kr + 1
256			resh(kr) = var(k1)
257			ENDDO
258
259			vstart(1) = udo(1) + 1
260			vcount(1) = e(1) - s(1) + 1
261	edhill	1.2
262			#ifdef mnc_rtype_D
263			err = NF_PUT_VARA_DOUBLE(fid, idv, vstart, vcount, resh)
264			#endif
265			#ifdef mnc_rtype_R
266			err = NF_PUT_VARA_REAL(fid, idv, vstart, vcount, resh)
267			#endif
268	edhill	1.1
269	edhill	1.3	ENDDO
270			ENDDO
271	edhill	1.2	ENDDO
272			ENDDO
273			ENDDO
274			ENDDO
275
276			C Sync the file
277			err = NF_SYNC(fid)
278			write(msgbuf,'(3a)') 'sync for file ''', fname,
279			& ''' in S/R MNC_CW_RX_WRITES_YY'
280			CALL MNC_HANDLE_ERR(myThid, err, msgbuf)
281	edhill	1.1
282			ENDDO
283			ENDDO
284
285			_END_MASTER( myThid )
286
287			RETURN
288			END
289
290			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
291
292			CEH3 ;;; Local Variables: ***
293			CEH3 ;;; mode:fortran ***
294			CEH3 ;;; End: ***