pkg/cfc/cfc11_forcing.F

8ac664a04c Step*0001 C modified for external_forcing_DIC.F  August 1999
                0002 C
c3d79d3528 Jean*0003 C modified swd Oct 01 and Feb 02, for use as package for c40_patch1
                0004 C modified to use with c44 and ptracers: swd May 2002
                0005 C modified to have carbonate and biological influences: swd June 2002
                0006 C modified for cfc: swd Sep 2003
8ac664a04c Step*0007
                0008 #include "GCHEM_OPTIONS.h"
3247fa4f0b Jean*0009 #define OCMIP_GRAD
                0010 #undef STEPH_GRAD
8ac664a04c Step*0011
b47b5cf35c Jean*0012 CBOP
                0013 C     !ROUTINE: CFC11_FORCING
                0014 C     !INTERFACE:
                0015       SUBROUTINE CFC11_FORCING(
                0016      I                          pTr_CFC11,
c3d79d3528 Jean*0017      U                          gCFC11,
b47b5cf35c Jean*0018      I                          bi, bj, iMin, iMax, jMin, jMax,
                0019      I                          myTime, myIter, myThid )
8ac664a04c Step*0020
b47b5cf35c Jean*0021 C     !DESCRIPTION:
c3d79d3528 Jean*0022 C     *==========================================================*
                0023 C     | SUBROUTINE CFC11_FORCING
                0024 C     | o Calculate the changes to CFC11 through air-sea  fluxes
                0025 C     *==========================================================*
8ac664a04c Step*0026
b47b5cf35c Jean*0027 C     !USES:
                0028       IMPLICIT NONE
8ac664a04c Step*0029 C     == GLobal variables ==
                0030 #include "SIZE.h"
                0031 #include "EEPARAMS.h"
                0032 #include "PARAMS.h"
                0033 #include "GRID.h"
                0034 #include "CFC.h"
b47b5cf35c Jean*0035 #include "CFC_ATMOS.h"
8ac664a04c Step*0036
b47b5cf35c Jean*0037 C     !INPUT/OUTPUT PARAMETERS:
                0038 C     pTr_CFC11  :: ocean CFC11 concentration
                0039 C     gCFC11     :: CFC11 tendency
                0040 C     bi, bj     :: current tile indices
                0041 C     iMin,iMax  :: computation domain, 1rst index bounds
                0042 C     jMin,jMax  :: computation domain, 2nd  index bounds
                0043 C     myTime     :: current time in simulation
                0044 C     myIter     :: current iteration number
                0045 C     myThid     :: my Thread Id number
c3d79d3528 Jean*0046       _RL  pTr_CFC11(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
                0047       _RL  gCFC11(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
b47b5cf35c Jean*0048       INTEGER bi, bj
                0049       INTEGER iMin, iMax, jMin, jMax
                0050       _RL  myTime
                0051       INTEGER myIter
                0052       INTEGER myThid
                0053 CEOP
8ac664a04c Step*0054
                0055 #ifdef ALLOW_PTRACERS
                0056 #ifdef ALLOW_CFC
b47b5cf35c Jean*0057 C     !FUNCTIONS:
                0058       LOGICAL  DIFFERENT_MULTIPLE
                0059       EXTERNAL DIFFERENT_MULTIPLE
                0060
                0061 C     !LOCAL VARIABLES:
                0062 C     AtmosCFC11 :: atmospheric CFC11 field
                0063 C     fluxCFC11  :: air-sea CFC11 fluxes
                0064 C     msgBuf     :: message buffer
                0065       _RL  fluxCFC11(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0066       _RL  AtmosCFC11(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0067       INTEGER i, j
                0068       INTEGER intimeP, intime0, intime1, iRec0, iRec1
                0069       _RL cfcTime, aWght, bWght
                0070       _RL ACFC11north, ACFC11south
                0071       _RL recip_dLat, weight
                0072       CHARACTER*(MAX_LEN_MBUF) msgBuf
3247fa4f0b Jean*0073 #ifdef STEPH_GRAD
8ac664a04c Step*0074        _RL a1, a2
3247fa4f0b Jean*0075 #endif
85f77391e5 Jean*0076
b47b5cf35c Jean*0077 C--   Find atmospheric CFC :
                0078 C     assume that cfcTime=0 corresponds to the beginning of the 1rst record
                0079 C     time-period. This is consistent with 1rst record value = time-averaged
                0080 C     atmos-CFC over time period: cfcTime= 0 to cfcTime= 1 x atmCFC_recSepTime
                0081 C---------------------------
                0082        cfcTime = myTime + atmCFC_timeOffset
                0083        CALL GET_PERIODIC_INTERVAL(
                0084      O                   intimeP, intime0, intime1, bWght, aWght,
                0085      I                   zeroRL, atmCFC_recSepTime,
                0086      I                   deltaTclock, cfcTime, myThid )
                0087        iRec0 = MAX( 1, MIN( ACFCnRec, intime0 ) )
                0088        iRec1 = MAX( 1, MIN( ACFCnRec, intime1 ) )
                0089        ACFC11north = ACFC11( iRec0, 1 )*bWght
                0090      &             + ACFC11( iRec1, 1 )*aWght
                0091        ACFC11south = ACFC11( iRec0, 2 )*bWght
                0092      &             + ACFC11( iRec1, 2 )*aWght
8ac664a04c Step*0093
b47b5cf35c Jean*0094 C-    Print to check:
                0095        IF ( DIFFERENT_MULTIPLE( CFC_monFreq, myTime, deltaTClock )
                0096      &      .AND. bi*bj.EQ.1 ) THEN
                0097          WRITE(msgBuf,'(A,6X,I10,I6,F9.4,F7.1)')
                0098      &    'CFC11_FORCING: iter,rec0,w0,yr0 =', myIter,
                0099      &        intime0, bWght, ACFCyear(iRec0)
                0100          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0101      &                       SQUEEZE_RIGHT, myThid )
                0102          WRITE(msgBuf,'(A,1PE16.7,I6,0PF9.4,F7.1)')
                0103      &    'CFC11_FORCING: cfcT,rec1,w1,yr1 =', cfcTime,
                0104      &        intime1, aWght, ACFCyear(iRec1)
                0105          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0106      &                       SQUEEZE_RIGHT, myThid )
                0107          WRITE(msgBuf,'(2(A,F14.6))')
                0108      &    'CFC11_FORCING: aCFC11_N =', ACFC11north,
                0109      &                ' , aCFC11_S =', ACFC11south
                0110          CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,
                0111      &                       SQUEEZE_RIGHT, myThid )
                0112        ENDIF
3247fa4f0b Jean*0113
b47b5cf35c Jean*0114 C--   Provide gradient between N and S values
223afc2d39 Step*0115 #ifdef STEPH_GRAD
b47b5cf35c Jean*0116 C STEPH S INITIAL VERSION
8ac664a04c Step*0117        DO j=1-OLy,sNy+OLy
c5c3a74c50 Jean*0118         DO i=1-OLx,sNx+OLx
                0119           if ((j.gt.int(sNy/2)+3.and.j.le.sNy).or.j.lt.1) then
b47b5cf35c Jean*0120              AtmosCFC11(i,j)=ACFC11north
c5c3a74c50 Jean*0121           endif
                0122           if (j.ge.int(sNy/2)-3.and.j.le.int(sNy/2)+3) then
8ac664a04c Step*0123              a1=(float(j-int(sNy/2)+3)+.5)/7
                0124              a2=1.d0-a1
b47b5cf35c Jean*0125              AtmosCFC11(i,j)=a1*ACFC11south +
                0126      &                       a2*ACFC11north
c5c3a74c50 Jean*0127           endif
                0128           if ((j.lt.int(sNy/2)-3.and.j.gt.0).or.j.gt.sNy) then
b47b5cf35c Jean*0129              AtmosCFC11(i,j)=ACFC11south
c5c3a74c50 Jean*0130           endif
                0131         ENDDO
8ac664a04c Step*0132        ENDDO
223afc2d39 Step*0133 #endif
                0134 #ifdef OCMIP_GRAD
b47b5cf35c Jean*0135 C-    OCMIP VERSION
                0136 C     between N & S lat boundaries, do linear interpolation ; and
                0137 C     beyond N or S lat boundaries, just take the hemispheric value
                0138        recip_dLat = 1. _d 0 / ( atmCFC_yNorthBnd - atmCFC_ySouthBnd )
223afc2d39 Step*0139        DO j=1-OLy,sNy+OLy
c3d79d3528 Jean*0140         DO i=1-OLx,sNx+OLx
b47b5cf35c Jean*0141           weight = ( yC(i,j,bi,bj) - atmCFC_ySouthBnd )*recip_dLat
c3d79d3528 Jean*0142           weight = MAX( zeroRL, MIN( oneRL, weight ) )
b47b5cf35c Jean*0143           AtmosCFC11(i,j)= weight * ACFC11north
                0144      &         + ( oneRL - weight )*ACFC11south
8ac664a04c Step*0145
c3d79d3528 Jean*0146         ENDDO
223afc2d39 Step*0147 c         print*,'QQ cfc11', j, ATMOSCFC11(1,j,bi,bj)
                0148        ENDDO
                0149 #endif
b47b5cf35c Jean*0150 C--   cfc11 air-sea fluxes
                0151        CALL CFC11_SURFFORCING(
                0152      I                    pTr_CFC11, AtmosCFC11,
                0153      O                    fluxCFC11,
                0154      I                    bi, bj, iMin, iMax, jMin, jMax,
                0155      I                    myTime, myIter, myThid )
8ac664a04c Step*0156
b47b5cf35c Jean*0157 C--   update surface tendencies
                0158        DO j=jMin,jMax
                0159         DO i=iMin,iMax
                0160           gCFC11(i,j,1) = gCFC11(i,j,1)
                0161 c    &     + fluxCFC11(i,j)*recip_drF(1)*maskC(i,j,1,bi,bj)
                0162      &     + fluxCFC11(i,j)*recip_drF(1)*recip_hFacC(i,j,1,bi,bj)
c3d79d3528 Jean*0163         ENDDO
                0164        ENDDO
8ac664a04c Step*0165
c3d79d3528 Jean*0166 #endif /* ALLOW_CFC */
                0167 #endif /* ALLOW_PTRACERS */
8ac664a04c Step*0168
                0169        RETURN
                0170        END