/[MITgcm]/MITgcm/model/src/open_copy_data_file.F
ViewVC logotype

Contents of /MITgcm/model/src/open_copy_data_file.F

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

Revision 1.5 - (show annotations) (download)
Fri Aug 5 23:44:28 2005 UTC (18 years, 10 months ago) by ce107
Branch: MAIN
CVS Tags: checkpoint57s_post, checkpoint58b_post, checkpoint57y_post, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint58y_post, checkpoint58t_post, checkpoint57t_post, checkpoint57v_post, checkpoint57x_post, checkpoint58w_post, checkpoint57y_pre, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, mitgcm_mapl_00, checkpoint58m_post, checkpoint58r_post, checkpoint58n_post, checkpoint59p, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpint57u_post, checkpoint57q_post, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint58g_post, checkpoint58x_post, checkpoint59j, checkpoint58h_post, checkpoint58j_post, checkpoint57w_post, checkpoint58i_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post
Changes since 1.4: +6 -1 lines 
Changed SCRATCH files to named files to avoid mysterious runtime error on
Blue Gene/L. Linux/PPC64 also complains at runtime but completes execution.
Introduce TARGET_BGL to avoid scraping scratch files.
1 C $Header: /u/gcmpack/MITgcm/model/src/open_copy_data_file.F,v 1.4 2004/02/24 16:54:46 cnh Exp $
2 C $Name: $
3
4 #include "CPP_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: OPEN_COPY_DATA_FILE
8 C !INTERFACE:
9 SUBROUTINE OPEN_COPY_DATA_FILE(
10 I data_file, caller_sub,
11 O iUnit,
12 I myThid )
13 C !DESCRIPTION: \bv
14 C *==========================================================*
15 C | SUBROUTINE OPEN_COPY_DATA_FILE
16 C | o Routine to open and copy a data.* file to STDOUT
17 C | and return the open unit in iUnit
18 C *==========================================================*
19 C \ev
20
21 C !USES:
22 IMPLICIT NONE
23 C === Global variables ===
24 #include "SIZE.h"
25 #include "EEPARAMS.h"
26
27 C !INPUT/OUTPUT PARAMETERS:
28 C === Routine arguments ===
29 C myThid - Number of this instance of INI_PARMS
30 CHARACTER*(*) data_file
31 CHARACTER*(*) caller_sub
32 INTEGER iUnit
33 INTEGER myThid
34
35 C !LOCAL VARIABLES:
36 C === Local variables ===
37 C msgBuf - Informational/error meesage buffer
38 CHARACTER*(MAX_LEN_MBUF) msgBuf
39 CHARACTER*(MAX_LEN_PREC) record
40 INTEGER ILNBLNK
41 EXTERNAL ILNBLNK
42 INTEGER errIO,IL
43 LOGICAL exst
44 CEOP
45
46 C
47 _BEGIN_MASTER(myThid)
48
49 C-- Open the parameter file
50 INQUIRE( FILE=data_file, EXIST=exst )
51 IF (exst) THEN
52 WRITE(msgbuf,'(A,A)')
53 & ' OPEN_COPY_DATA_FILE: opening file ',data_file
54 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
55 & SQUEEZE_RIGHT , mythid)
56 ELSE
57 WRITE(msgBuf,'(A,A,A)')
58 & 'File ',data_file,' does not exist!'
59 CALL PRINT_ERROR( msgBuf , 1)
60 WRITE(msgBuf,'(A,A)') 'S/R CALLED BY ',caller_sub
61 CALL PRINT_ERROR( msgBuf , 1)
62 STOP 'ABNORMAL END: S/R OPEN_COPY_DATA_FILE'
63 ENDIF
64
65 #ifdef TARGET_BGL
66 OPEN(UNIT=scrUnit1,FILE='scratch1',STATUS='UNKNOWN')
67 OPEN(UNIT=scrUnit2,FILE='scratch2',STATUS='UNKNOWN')
68 #else
69 OPEN(UNIT=scrUnit1,STATUS='SCRATCH')
70 OPEN(UNIT=scrUnit2,STATUS='SCRATCH')
71 #endif
72 OPEN(UNIT=modelDataUnit,FILE=data_file,STATUS='OLD',
73 & IOSTAT=errIO)
74 IF ( errIO .LT. 0 ) THEN
75 WRITE(msgBuf,'(A,A)')
76 & 'Unable to open data file: ',data_file
77 CALL PRINT_ERROR( msgBuf , 1)
78 WRITE(msgBuf,'(A,A)') 'S/R CALLED BY ',caller_sub
79 CALL PRINT_ERROR( msgBuf , 1)
80 STOP 'ABNORMAL END: S/R OPEN_COPY_DATA_FILE'
81 ENDIF
82
83 DO WHILE ( .TRUE. )
84 READ(modelDataUnit,FMT='(A)',END=1001) RECORD
85 IL = MAX(ILNBLNK(RECORD),1)
86 IF ( RECORD(1:1) .NE. commentCharacter ) THEN
87 CALL NML_SET_TERMINATOR( RECORD )
88 WRITE(UNIT=scrUnit1,FMT='(A)') RECORD(:IL)
89 ENDIF
90 WRITE(UNIT=scrUnit2,FMT='(A)') RECORD(:IL)
91 ENDDO
92 1001 CONTINUE
93 CLOSE(modelDataUnit)
94
95 C-- Report contents of model parameter file
96 WRITE(msgBuf,'(A)')
97 &'// ======================================================='
98 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
99 & SQUEEZE_RIGHT , 1)
100 WRITE(msgBuf,'(A,A,A)') '// Parameter file "',data_file,'"'
101 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
102 & SQUEEZE_RIGHT , 1)
103 WRITE(msgBuf,'(A)')
104 &'// ======================================================='
105 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
106 & SQUEEZE_RIGHT , 1)
107 iUnit = scrUnit2
108 REWIND(iUnit)
109 DO WHILE ( .TRUE. )
110 READ(UNIT=iUnit,FMT='(A)',END=2001) RECORD
111 IL = MAX(ILNBLNK(RECORD),1)
112 WRITE(msgBuf,'(A,A)') '>',RECORD(:IL)
113 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
114 & SQUEEZE_RIGHT , 1)
115 ENDDO
116 2001 CONTINUE
117 CLOSE(iUnit)
118 WRITE(msgBuf,'(A)') ' '
119 CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
120 & SQUEEZE_RIGHT , 1)
121
122
123 C-- Return open unit to caller
124 iUnit = scrUnit1
125 REWIND(iUnit)
126
127 _END_MASTER(myThid)
128
129
130 RETURN
131 END
132
  ViewVC Help
Powered by ViewVC 1.1.22