/[MITgcm]/MITgcm/pkg/ptracers/ptracers_readparms.F
ViewVC logotype

Contents of /MITgcm/pkg/ptracers/ptracers_readparms.F

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


Revision 1.16 - (show annotations) (download)
Mon Dec 13 21:29:14 2004 UTC (19 years, 5 months ago) by edhill
Branch: MAIN
Changes since 1.15: +1 -3 lines
 o fix IO flag error introduced by me (EH3) and found by JMC

1 C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_readparms.F,v 1.15 2004/12/05 22:22:06 jmc Exp $
2 C $Name: $
3
4 #include "PTRACERS_OPTIONS.h"
5
6 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7 CBOP
8 C !ROUTINE: PTRACERS_READPARMS
9
10 C !INTERFACE:
11 SUBROUTINE PTRACERS_READPARMS( myThid )
12
13 C !DESCRIPTION:
14 C Initialize PTRACERS parameters, read in data.ptracers
15
16 C !USES:
17 IMPLICIT NONE
18 #include "SIZE.h"
19 #include "EEPARAMS.h"
20 #include "PTRACERS_SIZE.h"
21 #include "PTRACERS.h"
22 #include "PARAMS.h"
23
24 C !INPUT PARAMETERS:
25 INTEGER myThid
26 CEOP
27
28 #ifdef ALLOW_PTRACERS
29
30 C !LOCAL VARIABLES:
31 C k,iTracer :: loop indices
32 C iUnit :: unit number for I/O
33 C msgBuf :: message buffer
34 INTEGER k, iTracer
35 INTEGER iUnit
36 INTEGER ic
37 CHARACTER*(MAX_LEN_MBUF) msgBuf
38 _RL PTRACERS_diffKr(PTRACERS_num)
39
40 C PTRACERS_taveFreq :: Frequency with which time-averaged PTRACERS
41 C are written to post-processing files.
42 NAMELIST /PTRACERS_PARM01/
43 & PTRACERS_dumpFreq,
44 & PTRACERS_taveFreq,
45 & PTRACERS_monitorFreq,
46 & PTRACERS_advScheme,
47 & PTRACERS_ImplVertAdv,
48 & PTRACERS_diffKh,
49 & PTRACERS_diffK4,
50 & PTRACERS_diffKr,
51 & PTRACERS_diffKrNr,
52 & PTRACERS_useGMRedi,
53 & PTRACERS_useKPP,
54 & PTRACERS_numInUse,
55 & PTRACERS_initialFile,
56 & PTRACERS_useRecords,
57 & PTRACERS_names,
58 & PTRACERS_long_names,
59 & PTRACERS_units,
60 & PTRACERS_read_mnc,
61 & PTRACERS_write_mnc
62
63 C This routine has been called by the main model so we set our
64 C internal flag to indicate we are in business
65 PTRACERSisON=.TRUE.
66
67 C Set defaults values for parameters in PTRACERS.h
68 PTRACERS_taveFreq = dumpFreq
69 PTRACERS_taveFreq = taveFreq
70 PTRACERS_monitorFreq = monitorFreq
71 PTRACERS_numInUse=-1
72 DO iTracer=1,PTRACERS_num
73 PTRACERS_advScheme(iTracer)=saltAdvScheme
74 PTRACERS_ImplVertAdv(iTracer) = .FALSE.
75 PTRACERS_diffKh(iTracer)=diffKhS
76 PTRACERS_diffK4(iTracer)=diffK4S
77 PTRACERS_diffKr(iTracer)=UNSET_RL
78 DO k=1,Nr
79 PTRACERS_diffKrNr(k,iTracer)=diffKrNrS(k)
80 ENDDO
81 PTRACERS_useGMRedi(iTracer)=useGMRedi
82 PTRACERS_useKPP(iTracer)=useKPP
83 PTRACERS_initialFile(iTracer)=' '
84 DO ic = 1,MAX_LEN_FNAM
85 PTRACERS_names(iTracer)(ic:ic) = ' '
86 PTRACERS_long_names(iTracer)(ic:ic) = ' '
87 PTRACERS_units(iTracer)(ic:ic) = ' '
88 ENDDO
89 ENDDO
90 PTRACERS_useRecords = .FALSE.
91 PTRACERS_read_mdsio = .TRUE.
92 PTRACERS_read_mnc = .FALSE.
93 PTRACERS_write_mdsio = .TRUE.
94 PTRACERS_write_mnc = .FALSE.
95
96 C Open and read the data.ptracers file
97 _BEGIN_MASTER(myThid)
98 WRITE(msgBuf,'(A)') ' PTRACERS_READPARMS: opening data.ptracers'
99 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
100 & SQUEEZE_RIGHT , 1)
101 CALL OPEN_COPY_DATA_FILE(
102 I 'data.ptracers', 'PTRACERS_READPARMS',
103 O iUnit,
104 I myThid )
105 READ(UNIT=iUnit,NML=PTRACERS_PARM01)
106 WRITE(msgBuf,'(A)')
107 & ' PTRACERS_READPARMS: finished reading data.ptracers'
108 CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
109 & SQUEEZE_RIGHT , 1)
110
111 C Close the open data file
112 CLOSE(iUnit)
113 _END_MASTER(myThid)
114
115 C Everyone else must wait for the parameters to be loaded
116 _BARRIER
117
118 C Now set-up any remaining parameters that result from the input
119 C parameters
120
121 C If PTRACERS_numInUse was not set in data.ptracers then we can
122 C assume that all PTRACERS fields will be in use
123 IF (PTRACERS_numInUse.LT.0) THEN
124 PTRACERS_numInUse=PTRACERS_num
125 ENDIF
126 C Check we are not trying to use more tracers than allowed
127 IF (PTRACERS_numInUse.GT.PTRACERS_num) THEN
128 WRITE(msgBuf,'(A,I2,A,I2,A)')
129 & ' PTRACERS_READPARMS: You requested ',PTRACERS_numInUse,
130 & ' tracers at run time when only ',PTRACERS_num,
131 & ' were specified at compile time. Naughty! '
132 CALL PRINT_ERROR(msgBuf, 1)
133 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
134 ENDIF
135 C Check that enough parameters were specified
136 DO iTracer=1,PTRACERS_numInUse
137 IF (PTRACERS_advScheme(iTracer).EQ.0) THEN
138 WRITE(msgBuf,'(A,A,I2)')
139 & ' PTRACERS_READPARMS: ',
140 & 'No advect. scheme specified for tracer #',
141 & iTracer
142 CALL PRINT_ERROR(msgBuf, 1)
143 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
144 ENDIF
145 ENDDO
146 #ifndef INCLUDE_IMPLVERTADV_CODE
147 DO iTracer=1,PTRACERS_numInUse
148 IF ( PTRACERS_ImplVertAdv(iTracer) ) THEN
149 WRITE(msgBuf,'(A)')
150 & 'PTRACERS_READPARMS: #undef INCLUDE_IMPLVERTADV_CODE'
151 CALL PRINT_ERROR( msgBuf , myThid)
152 WRITE(msgBuf,'(2A,I2,A)') 'PTRACERS_READPARMS:',
153 & ' but pTracers_ImplVertAdv(',iTracer,' ) is TRUE'
154 CALL PRINT_ERROR( msgBuf , myThid)
155 STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
156 ENDIF
157 ENDDO
158 #endif
159 DO iTracer=1,PTRACERS_numInUse
160 PTRACERS_useGMRedi(iTracer) = PTRACERS_useGMRedi(iTracer)
161 & .AND.useGMRedi
162 PTRACERS_useKPP(iTracer) = PTRACERS_useKPP(iTracer)
163 & .AND.useKPP
164 IF ( PTRACERS_diffKr(iTracer).NE.UNSET_RL ) THEN
165 DO k=1,Nr
166 PTRACERS_diffKrNr(k,iTracer)=PTRACERS_diffKr(iTracer)
167 ENDDO
168 ENDIF
169 ENDDO
170
171 #ifdef ALLOW_MNC
172 IF (useMNC) THEN
173 C Set the default I/O Types
174 IF (PTRACERS_read_mnc) PTRACERS_read_mdsio = .FALSE.
175 IF ( (.NOT. outputTypesInclusive)
176 & .AND. PTRACERS_write_mnc ) PTRACERS_write_mdsio = .FALSE.
177
178 C Initialize the MNC variable types for PTRACERS
179 CALL PTRACERS_MNC_INIT( myThid )
180 ENDIF
181 #endif /* ALLOW_MNC */
182
183 C-- Print a summary of pTracer parameter values:
184 iUnit = standardMessageUnit
185 WRITE(msgBuf,'(A)') '// ==================================='
186 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
187 WRITE(msgBuf,'(A)') '// PTRACERS parameters '
188 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
189 WRITE(msgBuf,'(A)') '// ==================================='
190 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
191 CALL WRITE_0D_I( PTRACERS_numInUse, INDEX_NONE,
192 & 'PTRACERS_numInUse =',
193 & ' /* number of tracers */')
194 CALL WRITE_0D_R8(PTRACERS_dumpFreq, INDEX_NONE,
195 & 'PTRACERS_dumpFreq =',
196 & ' /* Frequency^-1 for snapshot output (s) */')
197 CALL WRITE_0D_R8(PTRACERS_taveFreq, INDEX_NONE,
198 & 'PTRACERS_taveFreq =',
199 & ' /* Frequency^-1 for time-Aver. output (s) */')
200 CALL WRITE_0D_L( PTRACERS_useRecords, INDEX_NONE,
201 & 'PTRACERS_useRecords =', ' /* all tracers in 1 file */')
202 CALL WRITE_0D_L( PTRACERS_write_mdsio, INDEX_NONE,
203 & 'PTRACERS_write_mdsio =', ' /* write mdsio files */')
204 CALL WRITE_0D_L( PTRACERS_write_mnc, INDEX_NONE,
205 & 'PTRACERS_write_mnc =', ' /* write mnc files */')
206
207 DO iTracer=1,PTRACERS_numInUse
208 WRITE(msgBuf,'(A)') ' -----------------------------------'
209 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
210 WRITE(msgBuf,'(A,I4)') ' tracer number : ',iTracer
211 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
212 CALL WRITE_0D_I( PTRACERS_advScheme(iTracer), INDEX_NONE,
213 & 'PTRACERS_advScheme =', ' /* Advection Scheme */')
214 CALL WRITE_0D_L( PTRACERS_ImplVertAdv(iTracer), INDEX_NONE,
215 & 'PTRACERS_ImplVertAdv =',
216 & ' /* implicit vert. advection flag */')
217 CALL WRITE_0D_R8( PTRACERS_diffKh(iTracer), INDEX_NONE,
218 & 'PTRACERS_diffKh =', ' /* Laplacian Diffusivity */')
219 CALL WRITE_0D_R8( PTRACERS_diffK4(iTracer), INDEX_NONE,
220 & 'PTRACERS_diffK4 =', ' /* Biharmonic Diffusivity */')
221 CALL WRITE_1D_R8( PTRACERS_diffKrNr(1,iTracer), Nr, INDEX_K,
222 & 'PTRACERS_diffKrNr =', ' /* Vertical Diffusivity */')
223 CALL WRITE_0D_L( PTRACERS_useGMRedi(iTracer), INDEX_NONE,
224 & 'PTRACERS_useGMRedi =', ' /* apply GM-Redi */')
225 CALL WRITE_0D_L( PTRACERS_useKPP(iTracer), INDEX_NONE,
226 & 'PTRACERS_useKPP =', ' /* apply KPP scheme */')
227
228 ENDDO
229 WRITE(msgBuf,'(A)') ' -----------------------------------'
230 CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
231 #endif /* ALLOW_PTRACERS */
232
233 RETURN
234 END
235

  ViewVC Help
Powered by ViewVC 1.1.22