/[MITgcm]/MITgcm/pkg/mdsio/mdsio_wr_rec_rs.F
ViewVC logotype

Contents of /MITgcm/pkg/mdsio/mdsio_wr_rec_rs.F

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

Revision 1.1 - (show annotations) (download)
Tue Dec 30 02:00:51 2008 UTC (15 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62w, checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62y, checkpoint62x, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y 
Read/Write one reccord from already opened io-unit (S/R:MDS_RD/WR_REC_RL/RS)
- replace set of 4 S/R MDS_READ/WRITE_RL/RS_VEC
- honor filePrec option ; _BYTESWAPIO implemented
1 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_read_rs_vec.F,v 1.3 2004/11/30 16:11:10 heimbach Exp $
2 C $Name: $
3
4 #include "MDSIO_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP 0
8 C !ROUTINE: MDS_WR_REC_RS
9
10 C !INTERFACE:
11 SUBROUTINE MDS_WR_REC_RS(
12 I arr,
13 O r4Buf, r8Buf,
14 I fPrec, dUnit, iRec, nArr, myThid )
15
16 C !DESCRIPTION:
17 C Write one reccord to already opened io-unit "dUnit", from RS array "arr"
18
19 C !USES:
20 IMPLICIT NONE
21 #include "EEPARAMS.h"
22 #include "SIZE.h"
23 #include "PARAMS.h"
24
25 C !INPUT PARAMETERS:
26 C arr RS :: vector array to write
27 C fPrec integer :: file precision
28 C dUnit integer :: 'Opened' I/O channel
29 C iRec integer :: record number to WRITE
30 C nArr integer :: dimension off array "arr"
31 C myThid integer :: my Thread Id number
32 C !OUTPUT PARAMETERS:
33 C r4Buf real*4 :: buffer array
34 C r8Buf real*8 :: buffer array
35 INTEGER fPrec
36 INTEGER dUnit
37 INTEGER iRec
38 INTEGER nArr
39 INTEGER myThid
40 _RS arr(nArr)
41 Real*4 r4Buf(nArr)
42 Real*8 r8Buf(nArr)
43 CEOP
44
45 C !LOCAL VARIABLES:
46 CHARACTER*(MAX_LEN_MBUF) msgBuf
47 INTEGER k
48
49 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
50 IF ( debugLevel.GT.debLevB ) THEN
51 WRITE(msgBuf,'(A,I9,2x,I9)')
52 & ' MDS_WR_REC_RS: iRec,Dim = ', iRec, nArr
53 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
54 & SQUEEZE_RIGHT , myThid )
55 ENDIF
56
57 IF ( fPrec.EQ.precFloat32 ) THEN
58 DO k=1,nArr
59 r4Buf(k) = arr(k)
60 ENDDO
61 #ifdef _BYTESWAPIO
62 CALL MDS_BYTESWAPR4( nArr, r4Buf )
63 #endif
64 WRITE( dUnit, rec=iRec ) r4Buf
65 ELSEIF ( fPrec.EQ.precFloat64 ) THEN
66 DO k=1,nArr
67 r8Buf(k) = arr(k)
68 ENDDO
69 #ifdef _BYTESWAPIO
70 CALL MDS_BYTESWAPR8( nArr, r8Buf )
71 #endif
72 WRITE( dUnit, rec=iRec ) r8Buf
73 ELSE
74 WRITE(msgBuf,'(A,I9)')
75 & ' MDS_WR_REC_RS: illegal value for fPrec=',fPrec
76 CALL PRINT_ERROR( msgBuf, myThid )
77 STOP 'ABNORMAL END: S/R MDS_WR_REC_RS'
78 ENDIF
79
80 RETURN
81 END
  ViewVC Help
Powered by ViewVC 1.1.22