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