pkg/dic/dic_read_co2_pickup.F

175a18b00a Jean*0001 #include "DIC_OPTIONS.h"
                0002
                0003       SUBROUTINE DIC_READ_CO2_PICKUP(
                0004      I                                myIter, myThid )
                0005
                0006       IMPLICIT NONE
                0007 C     === Global variables ===
                0008 #include "SIZE.h"
                0009 #include "EEPARAMS.h"
                0010 #include "PARAMS.h"
                0011 #include "DIC_VARS.h"
                0012 #include "DIC_ATMOS.h"
                0013
                0014 C     == Routine arguments ==
                0015 C     myThid  :: my Thread Id number
                0016       INTEGER myIter
                0017       INTEGER myThid
                0018
                0019 #ifdef ALLOW_DIC
                0020
                0021 C     !FUNCTIONS
                0022       INTEGER  MDS_RECLEN
                0023       EXTERNAL MDS_RECLEN
                0024
                0025 C     !LOCAL VARIABLES:
                0026 C     == Local variables ==
                0027       INTEGER fp, ioUnit
df5a9764ba Jean*0028       CHARACTER*(10) suff
175a18b00a Jean*0029       CHARACTER*(MAX_LEN_FNAM) fn, filNam
                0030       CHARACTER*(MAX_LEN_MBUF) msgBuf
c8b148d42e Jean*0031       LOGICAL useCurrentDir, fileExist
175a18b00a Jean*0032       REAL*8 tmpFld(2)
                0033       INTEGER length_of_rec
                0034 CEOP
                0035
                0036       IF ( dic_int1.EQ.3 ) THEN
                0037
                0038         IF (pickupSuff.EQ.' ') THEN
df5a9764ba Jean*0039           IF ( rwSuffixType.EQ.0 ) THEN
                0040             WRITE(fn,'(A,I10.10)') 'pickup_dic_co2atm.', myIter
                0041           ELSE
                0042             CALL RW_GET_SUFFIX( suff, startTime, myIter, myThid )
                0043             WRITE(fn,'(A,A)') 'pickup_dic_co2atm.', suff
                0044           ENDIF
175a18b00a Jean*0045         ELSE
                0046           WRITE(fn,'(A,A10)') 'pickup_dic_co2atm.', pickupSuff
                0047         ENDIF
                0048         fp = precFloat64
                0049
                0050 C--   First check if pickup file exist
c8b148d42e Jean*0051 #ifdef ALLOW_MDSIO
                0052         useCurrentDir = .FALSE.
175a18b00a Jean*0053         CALL MDS_CHECK4FILE(
                0054      I                       fn, '.data', 'DIC_READ_CO2_PICKUP',
                0055      O                       filNam, fileExist,
c8b148d42e Jean*0056      I                       useCurrentDir, myThid )
                0057 #else
                0058         STOP 'ABNORMAL END: S/R DIC_READ_CO2_PICKUP: Needs MDSIO pkg'
                0059 #endif
175a18b00a Jean*0060         IF ( .NOT.fileExist ) THEN
                0061           WRITE(msgBuf,'(4A)') 'DIC_READ_CO2_PICKUP: ',
                0062      &      'with dic_int1=3, needs CO2-atmos pickup to restart'
                0063           CALL PRINT_ERROR( msgBuf, myThid )
                0064           STOP 'ABNORMAL END: S/R DIC_READ_CO2_PICKUP'
                0065         ENDIF
                0066         _BEGIN_MASTER(myThid)
                0067         CALL MDSFINDUNIT( ioUnit, myThid )
                0068         length_of_rec = MDS_RECLEN( fp, 2, myThid )
                0069         OPEN( ioUnit, file=filNam, status='old',
                0070      &        access='direct', recl=length_of_rec )
                0071         READ(ioUnit,rec=1) tmpFld
                0072 #ifdef _BYTESWAPIO
                0073         CALL MDS_BYTESWAPR8( 2, tmpFld )
                0074 #endif
                0075         total_atmos_carbon = tmpFld(1)
                0076         atpco2 = tmpFld(2)
                0077
                0078        _END_MASTER(myThid)
                0079 c      _BARRIER
                0080       ENDIF
                0081
                0082 #endif /*  ALLOW_DIC  */
                0083
                0084       RETURN
                0085       END