pkg/dic/dic_read_co2_pickup.F

C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_read_co2_pickup.F,v 1.1 2010/04/11 20:59:27 jmc Exp $
C $Name:  $

#include "DIC_OPTIONS.h"

      SUBROUTINE DIC_READ_CO2_PICKUP(
     I                                myIter, myThid )

      IMPLICIT NONE
C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DIC_VARS.h"
#include "DIC_ATMOS.h"

C     == Routine arguments ==
C     myThid  :: my Thread Id number
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_DIC

#ifdef USE_ATMOSCO2
C if coupled to atmsopheric model, use the
C CO2 value passed from the coupler

#else /* USE_ATMOSCO2 */

C     !FUNCTIONS
      INTEGER  MDS_RECLEN
      EXTERNAL MDS_RECLEN

C     !LOCAL VARIABLES:
C     == Local variables ==
      INTEGER fp, ioUnit
      CHARACTER*(MAX_LEN_FNAM) fn, filNam
      CHARACTER*(MAX_LEN_MBUF) msgBuf
      LOGICAL useCurrentDir, fileExist
      REAL*8 tmpFld(2)
      INTEGER length_of_rec
CEOP

      IF ( dic_int1.EQ.3 ) THEN

        IF (pickupSuff.EQ.' ') THEN
          WRITE(fn,'(A,I10.10)') 'pickup_dic_co2atm.', myIter
        ELSE
          WRITE(fn,'(A,A10)') 'pickup_dic_co2atm.', pickupSuff
        ENDIF
        fp = precFloat64

C--   First check if pickup file exist
#ifdef ALLOW_MDSIO
        useCurrentDir = .FALSE.
        CALL MDS_CHECK4FILE(
     I                       fn, '.data', 'DIC_READ_CO2_PICKUP',
     O                       filNam, fileExist,
     I                       useCurrentDir, myThid )
#else
        STOP 'ABNORMAL END: S/R DIC_READ_CO2_PICKUP: Needs MDSIO pkg'
#endif
        IF ( .NOT.fileExist ) THEN
          WRITE(msgBuf,'(4A)') 'DIC_READ_CO2_PICKUP: ',
     &      'with dic_int1=3, needs CO2-atmos pickup to restart'
          CALL PRINT_ERROR( msgBuf, myThid )
          STOP 'ABNORMAL END: S/R DIC_READ_CO2_PICKUP'
        ENDIF
        _BEGIN_MASTER(myThid)
        CALL MDSFINDUNIT( ioUnit, myThid )
        length_of_rec = MDS_RECLEN( fp, 2, myThid )
        OPEN( ioUnit, file=filNam, status='old',
     &        access='direct', recl=length_of_rec )
        READ(ioUnit,rec=1) tmpFld
#ifdef _BYTESWAPIO
        CALL MDS_BYTESWAPR8( 2, tmpFld )
#endif
        total_atmos_carbon = tmpFld(1)
        atpco2 = tmpFld(2)

       _END_MASTER(myThid)
c      _BARRIER
      ENDIF

#endif /* ndef USE_ATMOSCO2 */

#endif /*  ALLOW_DIC  */

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/pkg/dic/dic_read_co2_pickup.F,v 1.1 2010/04/11 20:59:27 jmc Exp $
2	C $Name: $
3
4	#include "DIC_OPTIONS.h"
5
6	SUBROUTINE DIC_READ_CO2_PICKUP(
7	I myIter, myThid )
8
9	IMPLICIT NONE
10	C === Global variables ===
11	#include "SIZE.h"
12	#include "EEPARAMS.h"
13	#include "PARAMS.h"
14	#include "DIC_VARS.h"
15	#include "DIC_ATMOS.h"
16
17	C == Routine arguments ==
18	C myThid :: my Thread Id number
19	INTEGER myIter
20	INTEGER myThid
21
22	#ifdef ALLOW_DIC
23
24	#ifdef USE_ATMOSCO2
25	C if coupled to atmsopheric model, use the
26	C CO2 value passed from the coupler
27
28	#else /* USE_ATMOSCO2 */
29
30	C !FUNCTIONS
31	INTEGER MDS_RECLEN
32	EXTERNAL MDS_RECLEN
33
34	C !LOCAL VARIABLES:
35	C == Local variables ==
36	INTEGER fp, ioUnit
37	CHARACTER*(MAX_LEN_FNAM) fn, filNam
38	CHARACTER*(MAX_LEN_MBUF) msgBuf
39	LOGICAL useCurrentDir, fileExist
40	REAL*8 tmpFld(2)
41	INTEGER length_of_rec
42	CEOP
43
44	IF ( dic_int1.EQ.3 ) THEN
45
46	IF (pickupSuff.EQ.' ') THEN
47	WRITE(fn,'(A,I10.10)') 'pickup_dic_co2atm.', myIter
48	ELSE
49	WRITE(fn,'(A,A10)') 'pickup_dic_co2atm.', pickupSuff
50	ENDIF
51	fp = precFloat64
52
53	C-- First check if pickup file exist
54	#ifdef ALLOW_MDSIO
55	useCurrentDir = .FALSE.
56	CALL MDS_CHECK4FILE(
57	I fn, '.data', 'DIC_READ_CO2_PICKUP',
58	O filNam, fileExist,
59	I useCurrentDir, myThid )
60	#else
61	STOP 'ABNORMAL END: S/R DIC_READ_CO2_PICKUP: Needs MDSIO pkg'
62	#endif
63	IF ( .NOT.fileExist ) THEN
64	WRITE(msgBuf,'(4A)') 'DIC_READ_CO2_PICKUP: ',
65	& 'with dic_int1=3, needs CO2-atmos pickup to restart'
66	CALL PRINT_ERROR( msgBuf, myThid )
67	STOP 'ABNORMAL END: S/R DIC_READ_CO2_PICKUP'
68	ENDIF
69	_BEGIN_MASTER(myThid)
70	CALL MDSFINDUNIT( ioUnit, myThid )
71	length_of_rec = MDS_RECLEN( fp, 2, myThid )
72	OPEN( ioUnit, file=filNam, status='old',
73	& access='direct', recl=length_of_rec )
74	READ(ioUnit,rec=1) tmpFld
75	#ifdef _BYTESWAPIO
76	CALL MDS_BYTESWAPR8( 2, tmpFld )
77	#endif
78	total_atmos_carbon = tmpFld(1)
79	atpco2 = tmpFld(2)
80
81	_END_MASTER(myThid)
82	c _BARRIER
83	ENDIF
84
85	#endif /* ndef USE_ATMOSCO2 */
86
87	#endif /* ALLOW_DIC */
88
89	RETURN
90	END