pkg/mdsio/mdsio_write_rl_vec.F

C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_rl_vec.F,v 1.4 2004/11/30 16:11:10 heimbach Exp $
C $Name:  $

#include "MDSIO_OPTIONS.h"

      subroutine MDS_WRITE_RL_VEC( dUnit, irec, narr, arr, mythid )
C IN:
C   dunit       integer - 'Opened' I/O channel
C   irec        integer - record number to write
C   narr        integer - dimension off array "arr"
C   arr         _RL     - model tiled vector
C   mythid      integer - thread id
C
C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu

      implicit none

#include "EEPARAMS.h"
#include "SIZE.h"
#include "PARAMS.h"

C Arguments
      integer dUnit
      integer irec
      integer narr
      integer mythid
      _RL arr(narr)
C Local
      character*(max_len_mbuf) msgbuf
C     ------------------------------------------------------------------
      if ( debugLevel .GE. debLevB ) then
       write(msgbuf,'(a,i9.8,2x,i9.8)')
     &  ' MDS_WRITE_RL_VEC: irec = ',irec,narr
cab change start
#ifndef ALLOW_FLT
       call print_message( msgbuf, standardmessageunit,
     &                    SQUEEZE_RIGHT , mythid)
#endif
can change end
      endif

      write(dUnit,rec=irec) arr
C     ------------------------------------------------------------------
      return
      end
1	jmc	1.5	C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_write_rl_vec.F,v 1.4 2004/11/30 16:11:10 heimbach Exp $
2	adcroft	1.2	C $Name: $
3	adcroft	1.1
4			#include "MDSIO_OPTIONS.h"
5
6			subroutine MDS_WRITE_RL_VEC( dUnit, irec, narr, arr, mythid )
7			C IN:
8			C dunit integer - 'Opened' I/O channel
9			C irec integer - record number to write
10			C narr integer - dimension off array "arr"
11			C arr _RL - model tiled vector
12			C mythid integer - thread id
13			C
14			C Created: 03/29/99 eckert@mit.edu + adcroft@mit.edu
15
16			implicit none
17
18			#include "EEPARAMS.h"
19	heimbach	1.3	#include "SIZE.h"
20			#include "PARAMS.h"
21	adcroft	1.1
22			C Arguments
23			integer dUnit
24			integer irec
25			integer narr
26			integer mythid
27			_RL arr(narr)
28			C Local
29			character*(max_len_mbuf) msgbuf
30			C ------------------------------------------------------------------
31	heimbach	1.4	if ( debugLevel .GE. debLevB ) then
32	heimbach	1.3	write(msgbuf,'(a,i9.8,2x,i9.8)')
33	adcroft	1.1	& ' MDS_WRITE_RL_VEC: irec = ',irec,narr
34	adcroft	1.2	cab change start
35			#ifndef ALLOW_FLT
36	heimbach	1.3	call print_message( msgbuf, standardmessageunit,
37	adcroft	1.1	& SQUEEZE_RIGHT , mythid)
38	adcroft	1.2	#endif
39			can change end
40	heimbach	1.3	endif
41
42	adcroft	1.1	write(dUnit,rec=irec) arr
43			C ------------------------------------------------------------------
44			return
45			end