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

Annotation of /MITgcm/pkg/mdsio/mdsio_wr_rec_rl.F

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

Revision 1.2 - (hide annotations) (download)
Tue Dec 30 17:49:16 2008 UTC (15 years, 5 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
Changes since 1.1: +1 -2 lines 
remove the hack "#define REPRODUCE_BOTTOM_CTRL_OLDRESULTS":
 results of test-exp "bottom_ctrl_5x5" (AD) will change (drop to 4 digits
 matching for grad). However, low confidence in this test which already fail
 on eddy (fc5) at 6.digits. Note that differences are not due to _BYTESWAPIO
1 jmc 1.2 C $Header: /u/gcmpack/MITgcm/pkg/mdsio/mdsio_wr_rec_rl.F,v 1.1 2008/12/30 02:00:51 jmc Exp $
2 jmc 1.1 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_RL
9    
10     C !INTERFACE:
11     SUBROUTINE MDS_WR_REC_RL(
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 RL 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 RL :: 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     _RL 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_RL: 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     #ifdef REPRODUCE_BOTTOM_CTRL_OLDRESULTS
67     WRITE( dUnit, rec=iRec ) arr
68     #else /* REPRODUCE_BOTTOM_CTRL_OLDRESULTS */
69     DO k=1,nArr
70     r8Buf(k) = arr(k)
71     ENDDO
72     #ifdef _BYTESWAPIO
73     CALL MDS_BYTESWAPR8( nArr, r8Buf )
74     #endif
75     WRITE( dUnit, rec=iRec ) r8Buf
76     #endif /* REPRODUCE_BOTTOM_CTRL_OLDRESULTS */
77     ELSE
78     WRITE(msgBuf,'(A,I9)')
79     & ' MDS_WR_REC_RL: illegal value for fPrec=',fPrec
80     CALL PRINT_ERROR( msgBuf, myThid )
81     STOP 'ABNORMAL END: S/R MDS_WR_REC_RL'
82     ENDIF
83    
84     RETURN
85     END
  ViewVC Help
Powered by ViewVC 1.1.22