pkg/cfc/cfc_atmos.F

8ac664a04c Step*0001 #include "GCHEM_OPTIONS.h"
                0002
1aee1b7f02 Jean*0003 CBOP
                0004 C     !ROUTINE: CFC_ATMOS
                0005 C     !INTERFACE:
8ac664a04c Step*0006       SUBROUTINE CFC_ATMOS( myThid )
1aee1b7f02 Jean*0007
                0008 C     !DESCRIPTION: \bv
1646b1d296 Jean*0009 C     *==========================================================*
                0010 C     | SUBROUTINE CFC_ATMOS
1aee1b7f02 Jean*0011 C     | o read in time-series of atmoshperic CFC
1646b1d296 Jean*0012 C     *==========================================================*
1aee1b7f02 Jean*0013
                0014 C     !USES:
8ac664a04c Step*0015       IMPLICIT NONE
                0016
                0017 C     === Global variables ===
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "CFC.h"
1aee1b7f02 Jean*0022 #include "CFC_ATMOS.h"
8ac664a04c Step*0023
1aee1b7f02 Jean*0024 C     !INPUT/OUTPUT PARAMETERS:
                0025 C     === Routine arguments ===
                0026 C     myThid    :: My Thread Id. number
8ac664a04c Step*0027       INTEGER myThid
1aee1b7f02 Jean*0028 CEOP
8ac664a04c Step*0029
1646b1d296 Jean*0030 #ifdef ALLOW_CFC
1aee1b7f02 Jean*0031 C     !FUNCTIONS:
                0032       INTEGER  ILNBLNK
                0033       EXTERNAL ILNBLNK
1646b1d296 Jean*0034
1aee1b7f02 Jean*0035 C     !LOCAL VARIABLES:
101216f222 Mart*0036 C     msgBuf     :: message buffer
1aee1b7f02 Jean*0037       INTEGER iUnit, i, it, iL
                0038       LOGICAL exst
                0039       _RL tmpVar(5)
101216f222 Mart*0040       CHARACTER*(MAX_LEN_MBUF) msgBuf
8ac664a04c Step*0041
1aee1b7f02 Jean*0042       _BEGIN_MASTER( myThid )
1646b1d296 Jean*0043
8ac664a04c Step*0044 C read in CFC atmospheric timeseries data
1aee1b7f02 Jean*0045       iL = ILNBLNK(atmCFC_inpFile)
                0046       IF ( iL.EQ.0 ) THEN
                0047         WRITE(msgBuf,'(A)')
                0048      &       'CFC_ATMOS: File-name missing for atmos CFC time-series'
                0049         CALL PRINT_ERROR( msgBuf, myThid )
                0050        STOP 'ABNORMAL END: S/R CFC_ATMOS'
                0051       ENDIF
                0052       INQUIRE( FILE=atmCFC_inpFile(1:iL), EXIST=exst )
                0053       IF (exst) THEN
                0054        WRITE(msgBuf,'(3A)')
                0055      &   'CFC_ATMOS: opening file "', atmCFC_inpFile(1:iL), '"'
                0056        CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0057      &                     SQUEEZE_RIGHT, myThid )
                0058       ELSE
                0059        WRITE(msgBuf,'(3A)')
                0060      &   'CFC_ATMOS: File "', atmCFC_inpFile(1:iL),'" does not exist!'
                0061        CALL PRINT_ERROR( msgBuf, myThid )
                0062        STOP 'ABNORMAL END: S/R CFC_ATMOS'
                0063       ENDIF
                0064
1646b1d296 Jean*0065 C assign a free unit number as the I/O channel for this subroutine
1aee1b7f02 Jean*0066       CALL MDSFINDUNIT( iUnit, myThid )
                0067       OPEN(iUnit,FILE=atmCFC_inpFile(1:iL),STATUS='old')
8ac664a04c Step*0068 C skip 6 descriptor lines
                0069       DO i =1,6
1aee1b7f02 Jean*0070         READ(iUnit,*)
8ac664a04c Step*0071       ENDDO
                0072 C Read in CFC11 and CFC12, N and S Hemisphere time histories
1aee1b7f02 Jean*0073       it = 0
                0074       DO WHILE ( it.LE.ACFCrecSize )
                0075         READ(iUnit,*,END=1001) (tmpVar(i),i=1,5)
                0076         it = it + 1
                0077         IF ( it .LE. ACFCrecSize ) THEN
                0078           ACFCyear(it) = tmpVar(1)
                0079           ACFC11(it,1) = tmpVar(2)
                0080           ACFC12(it,1) = tmpVar(3)
                0081           ACFC11(it,2) = tmpVar(4)
                0082           ACFC12(it,2) = tmpVar(5)
                0083         ENDIF
8ac664a04c Step*0084       ENDDO
1aee1b7f02 Jean*0085       IF ( it.GT.ACFCrecSize ) THEN
                0086        CLOSE(iUnit)
                0087        WRITE(msgBuf,'(3A)')
                0088      &   'CFC_ATMOS: length of file "',atmCFC_inpFile(1:iL),'"'
                0089        CALL PRINT_ERROR( msgBuf, myThid )
                0090        WRITE(msgBuf,'(2A,I9)') 'CFC_ATMOS: exceeds max num',
                0091      &             ' of records: ACFCrecSize=', ACFCrecSize
                0092        CALL PRINT_ERROR( msgBuf, myThid )
                0093        STOP 'ABNORMAL END: S/R CFC_ATMOS'
                0094       ENDIF
                0095  1001 CONTINUE
1646b1d296 Jean*0096       CLOSE(iUnit)
1aee1b7f02 Jean*0097       ACFCnRec = it
                0098
                0099 C--  Print values to check:
                0100       WRITE(msgBuf,'(A,I8,A)')
                0101      &  'CFC_ATMOS: read', ACFCnRec, ' (=ACFCnRec) time records :'
                0102       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0103      &                    SQUEEZE_RIGHT, myThid )
                0104       WRITE(msgBuf,'(A)')
                0105      &  '  year , cfc11_N, cfc12_N, cfc11_S, cfc12_S'
                0106       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0107      &                    SQUEEZE_RIGHT, myThid )
                0108       DO it = 1,ACFCnRec
                0109         WRITE(msgBuf,'(F7.1,4F9.2)')
                0110      &        ACFCyear(it), ACFC11(it,1),ACFC12(it,1),
                0111      &                      ACFC11(it,2),ACFC12(it,2)
                0112         CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0113      &                      SQUEEZE_RIGHT, myThid )
                0114       ENDDO
                0115
                0116       WRITE(msgBuf,'(A)')
                0117      &  'CFC_ATMOS: Setting atmos CFC time series: done'
                0118       CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0119      &                    SQUEEZE_RIGHT, myThid )
1646b1d296 Jean*0120
8ac664a04c Step*0121       _END_MASTER(myThid)
                0122
1646b1d296 Jean*0123 C--   Everyone else must wait for the parameters to be loaded
                0124       _BARRIER
8ac664a04c Step*0125
1646b1d296 Jean*0126 #endif /* ALLOW_CFC */
8ac664a04c Step*0127
                0128       RETURN
                0129       END