File indexing completed on 2018-03-02 18:38:19 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
8ac664a04c Step*0001 #include "GCHEM_OPTIONS.h"
0002
1aee1b7f02 Jean*0003
0004
0005
8ac664a04c Step*0006 SUBROUTINE CFC_ATMOS( myThid )
1aee1b7f02 Jean*0007
0008
1646b1d296 Jean*0009
0010
1aee1b7f02 Jean*0011
1646b1d296 Jean*0012
1aee1b7f02 Jean*0013
0014
8ac664a04c Step*0015 IMPLICIT NONE
0016
0017
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
0025
0026
8ac664a04c Step*0027 INTEGER myThid
1aee1b7f02 Jean*0028
8ac664a04c Step*0029
1646b1d296 Jean*0030 #ifdef ALLOW_CFC
1aee1b7f02 Jean*0031
0032 INTEGER ILNBLNK
0033 EXTERNAL ILNBLNK
1646b1d296 Jean*0034
1aee1b7f02 Jean*0035
101216f222 Mart*0036
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
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
1aee1b7f02 Jean*0066 CALL MDSFINDUNIT( iUnit, myThid )
0067 OPEN(iUnit,FILE=atmCFC_inpFile(1:iL),STATUS='old')
8ac664a04c Step*0068
0069 DO i =1,6
1aee1b7f02 Jean*0070 READ(iUnit,*)
8ac664a04c Step*0071 ENDDO
0072
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
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
0124 _BARRIER
8ac664a04c Step*0125
1646b1d296 Jean*0126 #endif /* ALLOW_CFC */
8ac664a04c Step*0127
0128 RETURN
0129 END