pkg/ptracers/ptracers_readparms.F

C $Header: /u/gcmpack/MITgcm/pkg/ptracers/ptracers_readparms.F,v 1.13 2004/11/28 23:50:59 mlosch Exp $
C $Name:  $

#include "PTRACERS_OPTIONS.h"

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP
C     !ROUTINE: PTRACERS_READPARMS
      
C     !INTERFACE:
      SUBROUTINE PTRACERS_READPARMS( myThid )
      
C     !DESCRIPTION:
C     Initialize PTRACERS parameters, read in data.ptracers

C     !USES:
      IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PTRACERS_SIZE.h"
#include "PTRACERS.h"
#include "PARAMS.h"

C     !INPUT PARAMETERS:
      INTEGER myThid
CEOP

#ifdef ALLOW_PTRACERS

C     !LOCAL VARIABLES:
C     k,iTracer  :: loop indices
C     iUnit      :: unit number for I/O
C     msgBuf     :: message buffer
      INTEGER k, iTracer
      INTEGER iUnit
      INTEGER ic
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      _RL PTRACERS_diffKr(PTRACERS_num)

C     PTRACERS_taveFreq :: Frequency with which time-averaged PTRACERS
C                          are written to post-processing files.
      NAMELIST /PTRACERS_PARM01/
     &     PTRACERS_dumpFreq,
     &     PTRACERS_taveFreq,
     &     PTRACERS_monitorFreq,
     &     PTRACERS_advScheme,
     &     PTRACERS_diffKh,
     &     PTRACERS_diffK4,
     &     PTRACERS_diffKr,
     &     PTRACERS_diffKrNr,
     &     PTRACERS_useGMRedi,
     &     PTRACERS_useKPP,
     &     PTRACERS_numInUse,
     &     PTRACERS_initialFile,
     &     PTRACERS_useRecords,
     &     PTRACERS_names,
     &     PTRACERS_long_names,
     &     PTRACERS_units,
     &     PTRACERS_read_mnc,
     &     PTRACERS_write_mnc

C     This routine has been called by the main model so we set our
C     internal flag to indicate we are in business
      PTRACERSisON=.TRUE.

C     Set defaults values for parameters in PTRACERS.h
      PTRACERS_taveFreq    = dumpFreq
      PTRACERS_taveFreq    = taveFreq
      PTRACERS_monitorFreq = monitorFreq
      PTRACERS_numInUse=-1
      DO iTracer=1,PTRACERS_num
        PTRACERS_advScheme(iTracer)=saltAdvScheme
        PTRACERS_diffKh(iTracer)=diffKhS
        PTRACERS_diffK4(iTracer)=diffK4S
        PTRACERS_diffKr(iTracer)=UNSET_RL
        DO k=1,Nr
          PTRACERS_diffKrNr(k,iTracer)=diffKrNrS(k)
        ENDDO
        PTRACERS_useGMRedi(iTracer)=useGMRedi
        PTRACERS_useKPP(iTracer)=useKPP
        PTRACERS_initialFile(iTracer)=' '
        DO ic = 1,MAX_LEN_FNAM
          PTRACERS_names(iTracer)(ic:ic) = ' '
          PTRACERS_long_names(iTracer)(ic:ic) = ' '
          PTRACERS_units(iTracer)(ic:ic) = ' '
        ENDDO
      ENDDO
      PTRACERS_useRecords  = .FALSE.
      PTRACERS_read_mdsio  = .TRUE.
      PTRACERS_read_mnc    = .FALSE.
      PTRACERS_write_mdsio = .TRUE.
      PTRACERS_write_mnc   = .FALSE.

C     Open and read the data.ptracers file
      _BEGIN_MASTER(myThid)
      WRITE(msgBuf,'(A)') ' PTRACERS_READPARMS: opening data.ptracers'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT , 1)
      CALL OPEN_COPY_DATA_FILE(
     I                   'data.ptracers', 'PTRACERS_READPARMS',
     O                   iUnit,
     I                   myThid )
      READ(UNIT=iUnit,NML=PTRACERS_PARM01)
      WRITE(msgBuf,'(A)')
     &  ' PTRACERS_READPARMS: finished reading data.ptracers'
      CALL PRINT_MESSAGE(msgBuf, standardMessageUnit,
     &                   SQUEEZE_RIGHT , 1)

C     Close the open data file
      CLOSE(iUnit)
      _END_MASTER(myThid)

C     Everyone else must wait for the parameters to be loaded
      _BARRIER

C     Now set-up any remaining parameters that result from the input
C     parameters

C     If PTRACERS_numInUse was not set in data.ptracers then we can
C     assume that all PTRACERS fields will be in use
      IF (PTRACERS_numInUse.LT.0) THEN
        PTRACERS_numInUse=PTRACERS_num
      ENDIF
C     Check we are not trying to use more tracers than allowed
      IF (PTRACERS_numInUse.GT.PTRACERS_num) THEN
        WRITE(msgBuf,'(A,I2,A,I2,A)')
     &       ' PTRACERS_READPARMS: You requested ',PTRACERS_numInUse,
     &       ' tracers at run time when only ',PTRACERS_num,
     &       ' were specified at compile time. Naughty! '
        CALL PRINT_ERROR(msgBuf, 1)
        STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
      ENDIF
C     Check that enough parameters were specified
      DO iTracer=1,PTRACERS_numInUse
        IF (PTRACERS_advScheme(iTracer).EQ.0) THEN
          WRITE(msgBuf,'(A,A,I2)')
     &         ' PTRACERS_READPARMS: ',
     &         'No advect. scheme specified for tracer #',
     &         iTracer
          CALL PRINT_ERROR(msgBuf, 1)
          STOP 'ABNORMAL END: S/R PTRACERS_READPARMS'
        ENDIF
      ENDDO
      DO iTracer=1,PTRACERS_numInUse
        PTRACERS_useGMRedi(iTracer) = PTRACERS_useGMRedi(iTracer)
     &                           .AND.useGMRedi
        PTRACERS_useKPP(iTracer) = PTRACERS_useKPP(iTracer)
     &                        .AND.useKPP
        IF ( PTRACERS_diffKr(iTracer).NE.UNSET_RL ) THEN
         DO k=1,Nr
          PTRACERS_diffKrNr(k,iTracer)=PTRACERS_diffKr(iTracer)
         ENDDO
        ENDIF
      ENDDO

#ifdef ALLOW_MNC
      IF (useMNC) THEN
C       Set the default I/O Types
        IF (PTRACERS_read_mnc) PTRACERS_read_mdsio = .FALSE.
        IF ( (.NOT. outputTypesInclusive) 
     &       .AND. PTRACERS_write_mnc ) pickup_write_mdsio = .FALSE.
        IF ( (.NOT. outputTypesInclusive) 
     &       .AND. PTRACERS_write_mnc ) PTRACERS_write_mdsio = .FALSE.
        
C       Initialize the MNC variable types for PTRACERS 
        CALL PTRACERS_MNC_INIT( myThid )
      ENDIF
#endif /*  ALLOW_MNC  */
      
C--   Print a summary of pTracer parameter values:
      iUnit = standardMessageUnit
      WRITE(msgBuf,'(A)') '// ==================================='
      CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
      WRITE(msgBuf,'(A)') '// PTRACERS parameters '
      CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
      WRITE(msgBuf,'(A)') '// ==================================='
      CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
      CALL WRITE_0D_I( PTRACERS_numInUse, INDEX_NONE,
     &   'PTRACERS_numInUse =',
     &   ' /* number of tracers */')
      CALL WRITE_0D_R8(PTRACERS_dumpFreq, INDEX_NONE,
     &   'PTRACERS_dumpFreq =',
     &   ' /* Frequency^-1 for snapshot output (s) */')
      CALL WRITE_0D_R8(PTRACERS_taveFreq, INDEX_NONE,
     &   'PTRACERS_taveFreq =',
     &   ' /* Frequency^-1 for time-Aver. output (s) */')
      CALL WRITE_0D_L( PTRACERS_useRecords, INDEX_NONE,
     &   'PTRACERS_useRecords =', ' /* all tracers in 1 file */')
      CALL WRITE_0D_L( PTRACERS_write_mdsio, INDEX_NONE,
     &   'PTRACERS_write_mdsio =', ' /* write mdsio files */')
      CALL WRITE_0D_L( PTRACERS_write_mnc, INDEX_NONE,
     &   'PTRACERS_write_mnc =', ' /* write mnc files */')

      DO iTracer=1,PTRACERS_numInUse
        WRITE(msgBuf,'(A)') ' -----------------------------------'
        CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
        WRITE(msgBuf,'(A,I4)') ' tracer number : ',iTracer
        CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
        CALL WRITE_0D_I( PTRACERS_advScheme(iTracer), INDEX_NONE,
     &     'PTRACERS_advScheme =', ' /* Advection Scheme */')
        CALL WRITE_0D_R8( PTRACERS_diffKh(iTracer), INDEX_NONE,
     &     'PTRACERS_diffKh =', ' /* Laplacian Diffusivity */')
        CALL WRITE_0D_R8( PTRACERS_diffK4(iTracer), INDEX_NONE,
     &     'PTRACERS_diffK4 =', ' /* Biharmonic Diffusivity */')
        CALL WRITE_1D_R8( PTRACERS_diffKrNr(1,iTracer), Nr, INDEX_K,
     &     'PTRACERS_diffKrNr =', ' /* Vertical Diffusivity */')
        CALL WRITE_0D_L( PTRACERS_useGMRedi(iTracer), INDEX_NONE,
     &     'PTRACERS_useGMRedi =', ' /* apply GM-Redi */')
        CALL WRITE_0D_L( PTRACERS_useKPP(iTracer), INDEX_NONE,
     &     'PTRACERS_useKPP =', ' /* apply KPP scheme */')

      ENDDO
        WRITE(msgBuf,'(A)') ' -----------------------------------'
        CALL PRINT_MESSAGE( msgBuf, iUnit, SQUEEZE_RIGHT , 1)
#endif /* ALLOW_PTRACERS */

      RETURN
      END

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