pkg/aim_v23/aim_do_co2.F

C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_do_co2.F,v 1.7 2010/03/15 01:05:51 dfer Exp $
C $Name:  $

#include "AIM_OPTIONS.h"

CBOP
C     !ROUTINE: AIM_DO_CO2
C     !INTERFACE:
      SUBROUTINE AIM_DO_CO2( myTime, myIter, myThid )

C     !DESCRIPTION: \bv
C     *==========================================================*
C     | S/R AIM_DO_CO2
C     | o CO2 budget of the atmosphere
C     *==========================================================*
C     \ev
C     !USES:
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"

#include "AIM_CO2.h"
C-- Coupled to the Ocean :
#ifdef COMPONENT_MODULE
#include "CPL_PARAMS.h"
#include "ATMCPL.h"
#endif

C     !INPUT/OUTPUT PARAMETERS:
C     myTime :: Current time of simulation ( s )
C     myIter :: Current iteration number in simulation
C     myThid :: Number of this instance of the routine
      _RL myTime
      INTEGER myIter, myThid
CEOP

#ifdef ALLOW_AIM
#ifdef ALLOW_AIM_CO2
C     !FUNCTIONS:
      INTEGER  ILNBLNK, IFNBLNK
      EXTERNAL ILNBLNK, IFNBLNK
      LOGICAL  DIFFERENT_MULTIPLE
      EXTERNAL DIFFERENT_MULTIPLE

C     !LOCAL VARIABLES:
C     bi,bj  - Tile index
C     i,j    - loop counters
      INTEGER bi, bj, i, j
      _RL total_flux, atpco2_check
      _RL flxCO2tile(nSx,nSy)
      LOGICAL permCheckPoint
      INTEGER iUnit, iLo, iHi
      _RS dummyRS(1)
      _RL tmpco2(2)
      CHARACTER*(MAX_LEN_FNAM) fn
      CHARACTER*(MAX_LEN_MBUF) msgBuf

#ifdef COMPONENT_MODULE
      IF ( useCoupler .AND. useImportFlxCO2 ) THEN
       DO bj=myByLo(myThid),myByHi(myThid)
        DO bi=myBxLo(myThid),myBxHi(myThid)
         DO j=1,sNy
          DO i=1,sNx
           aimflxCo2(i,j,bi,bj) = flxCO2ocn(i,j,bi,bj)
          ENDDO
         ENDDO
        ENDDO
       ENDDO
      ENDIF
#endif /* COMPONENT_MODULE */

      IF ( Aim_CO2_Flag .EQ. 1 .AND. myTime .EQ. startTime ) THEN
        _BEGIN_MASTER(myThid)
        atm_pCO2 = atmpCO2init
        _END_MASTER(myThid)
        _BARRIER

      ELSEIF ( Aim_CO2_Flag .EQ. 2 ) THEN

C- First compute global mole flux at air-sea interface
        DO bj=myByLo(myThid),myByHi(myThid)
         DO bi=myBxLo(myThid),myBxHi(myThid)
          flxCO2tile(bi,bj) = 0. _d 0
          DO j=1,sNy
           DO i=1,sNx
            flxCO2tile(bi,bj)=flxCO2tile(bi,bj) + aimflxCo2(i,j,bi,bj)
     &                      * rA(i,j,bi,bj) * deltaT
           ENDDO
          ENDDO
         ENDDO
        ENDDO
        CALL GLOBAL_SUM_TILE_RL(flxCO2tile,total_flux,myThid)

        _BARRIER
        _BEGIN_MASTER(myThid)
        IF ( startTime.EQ.baseTime .AND. myTime.EQ.0 ) THEN
C- If  first iteration, use atmpCO2init as initial condition
          atm_pCO2 = atmpCO2init
          Atm_CO2_Moles = atm_pCO2 * total_atmos_moles

        ELSEIF ( myTime .EQ. startTime ) THEN
C- If restart, read moles number from pickup
          WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.',nIter0
          iUnit = 0
          CALL MDS_READVEC_LOC(  fn, precFloat64, iUnit, 'RL', 2,
     O                           tmpco2, dummyRS,
     I                           0, 0, 1, myThid )
          Atm_CO2_Moles = tmpco2(1)
          atpco2_check  = tmpco2(2)
          atm_pCO2 = Atm_CO2_Moles / total_atmos_moles

          iUnit = standardMessageUnit
          iLo = IFNBLNK(fn)
          iHi = ILNBLNK(fn)
          WRITE(msgBuf,'(A)') ' '
          CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
          WRITE(msgBuf,'(A)') '// ==================================='
          CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
          WRITE(msgBuf,'(2A)') '// AIM_DO_CO2: Read pickup ',fn(iLo:iHi)
          CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)

          CALL WRITE_0D_RL( atpco2_check, INDEX_NONE, 'atpco2_check =',
     &                     ' /* pCo2 from pickup file */')
          CALL WRITE_0D_RL( atm_pCO2, INDEX_NONE, 'atm_pCO2 =',
     &                     ' /* pCo2 from Atm_CO2_Moles */')

c        ELSE
c          WRITE(msgBuf,'(A)') 'AIM_DO_CO2: How did you end up here?'
c          CALL PRINT_ERROR( msgBuf , myThid)
c          STOP 'ABNORMAL END: S/R AIM_DO_CO2'
        ENDIF

C- Calculate new atmos pCO2
        Atm_CO2_Moles = Atm_CO2_Moles - total_flux
        atm_pCO2 = Atm_CO2_Moles / total_atmos_moles

C- Write out if time for a new pickup
        permCheckPoint = myTime.NE.startTime
        permCheckPoint = permCheckPoint .AND.
     &    DIFFERENT_MULTIPLE(pChkptFreq,myTime+deltaTClock,deltaTClock)
        IF (permCheckPoint) THEN
          WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.',myIter+1
C- write values to new pickup
          tmpco2(1)= Atm_CO2_Moles
          tmpco2(2)= atm_pCO2
          iUnit = 0
          CALL MDS_WRITEVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
     I                           tmpco2, dummyRS,
     I                           0, 0, -1, myIter, myThid )
        ENDIF
        _END_MASTER(myThid)
        _BARRIER

C--- end of Aim_CO2_Flag IF.
      ENDIF

#endif /* ALLOW_AIM_CO2 */
#endif /* ALLOW_AIM */

      RETURN
      END
1	jmc	1.8	C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_do_co2.F,v 1.7 2010/03/15 01:05:51 dfer Exp $
2	dfer	1.1	C $Name: $
3
4			#include "AIM_OPTIONS.h"
5
6	jmc	1.8	CBOP
7			C !ROUTINE: AIM_DO_CO2
8			C !INTERFACE:
9			SUBROUTINE AIM_DO_CO2( myTime, myIter, myThid )
10
11			C !DESCRIPTION: \bv
12	dfer	1.1	C ==========================================================
13	jmc	1.8	C \| S/R AIM_DO_CO2
14			C \| o CO2 budget of the atmosphere
15	dfer	1.1	C ==========================================================
16	jmc	1.8	C \ev
17			C !USES:
18	dfer	1.1	IMPLICIT NONE
19
20			C == Global data ==
21	jmc	1.8	#include "SIZE.h"
22	dfer	1.1	#include "EEPARAMS.h"
23			#include "PARAMS.h"
24			#include "GRID.h"
25
26			#include "AIM_CO2.h"
27	dfer	1.4	C-- Coupled to the Ocean :
28			#ifdef COMPONENT_MODULE
29			#include "CPL_PARAMS.h"
30			#include "ATMCPL.h"
31			#endif
32
33	jmc	1.8	C !INPUT/OUTPUT PARAMETERS:
34			C myTime :: Current time of simulation ( s )
35			C myIter :: Current iteration number in simulation
36			C myThid :: Number of this instance of the routine
37			_RL myTime
38	dfer	1.4	INTEGER myIter, myThid
39	jmc	1.8	CEOP
40	dfer	1.1
41			#ifdef ALLOW_AIM
42			#ifdef ALLOW_AIM_CO2
43	jmc	1.8	C !FUNCTIONS:
44			INTEGER ILNBLNK, IFNBLNK
45			EXTERNAL ILNBLNK, IFNBLNK
46			LOGICAL DIFFERENT_MULTIPLE
47			EXTERNAL DIFFERENT_MULTIPLE
48	dfer	1.4
49	jmc	1.8	C !LOCAL VARIABLES:
50	dfer	1.4	C bi,bj - Tile index
51			C i,j - loop counters
52			INTEGER bi, bj, i, j
53			_RL total_flux, atpco2_check
54			_RL flxCO2tile(nSx,nSy)
55	dfer	1.1	LOGICAL permCheckPoint
56	jmc	1.8	INTEGER iUnit, iLo, iHi
57			_RS dummyRS(1)
58			_RL tmpco2(2)
59			CHARACTER*(MAX_LEN_FNAM) fn
60			CHARACTER*(MAX_LEN_MBUF) msgBuf
61	dfer	1.1
62	dfer	1.4	#ifdef COMPONENT_MODULE
63	jmc	1.8	IF ( useCoupler .AND. useImportFlxCO2 ) THEN
64	dfer	1.4	DO bj=myByLo(myThid),myByHi(myThid)
65			DO bi=myBxLo(myThid),myBxHi(myThid)
66			DO j=1,sNy
67			DO i=1,sNx
68			aimflxCo2(i,j,bi,bj) = flxCO2ocn(i,j,bi,bj)
69	jmc	1.8	ENDDO
70	dfer	1.1	ENDDO
71			ENDDO
72	dfer	1.4	ENDDO
73			ENDIF
74			#endif /* COMPONENT_MODULE */
75
76	dfer	1.7	IF ( Aim_CO2_Flag .EQ. 1 .AND. myTime .EQ. startTime ) THEN
77	dfer	1.4	_BEGIN_MASTER(myThid)
78			atm_pCO2 = atmpCO2init
79			_END_MASTER(myThid)
80			_BARRIER
81	dfer	1.1
82			ELSEIF ( Aim_CO2_Flag .EQ. 2 ) THEN
83
84			C- First compute global mole flux at air-sea interface
85	dfer	1.4	DO bj=myByLo(myThid),myByHi(myThid)
86			DO bi=myBxLo(myThid),myBxHi(myThid)
87			flxCO2tile(bi,bj) = 0. _d 0
88			DO j=1,sNy
89			DO i=1,sNx
90			flxCO2tile(bi,bj)=flxCO2tile(bi,bj) + aimflxCo2(i,j,bi,bj)
91			& * rA(i,j,bi,bj) * deltaT
92			ENDDO
93			ENDDO
94	dfer	1.1	ENDDO
95			ENDDO
96	dfer	1.4	CALL GLOBAL_SUM_TILE_RL(flxCO2tile,total_flux,myThid)
97	dfer	1.1
98	dfer	1.4	_BARRIER
99			_BEGIN_MASTER(myThid)
100	dfer	1.7	IF ( startTime.EQ.baseTime .AND. myTime.EQ.0 ) THEN
101	dfer	1.4	C- If first iteration, use atmpCO2init as initial condition
102			atm_pCO2 = atmpCO2init
103	dfer	1.6	Atm_CO2_Moles = atm_pCO2 * total_atmos_moles
104	dfer	1.1
105	dfer	1.7	ELSEIF ( myTime .EQ. startTime ) THEN
106	dfer	1.1	C- If restart, read moles number from pickup
107			WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.',nIter0
108	jmc	1.8	iUnit = 0
109			CALL MDS_READVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
110			O tmpco2, dummyRS,
111			I 0, 0, 1, myThid )
112	dfer	1.1	Atm_CO2_Moles = tmpco2(1)
113			atpco2_check = tmpco2(2)
114	dfer	1.4	atm_pCO2 = Atm_CO2_Moles / total_atmos_moles
115	dfer	1.1
116			iUnit = standardMessageUnit
117	jmc	1.8	iLo = IFNBLNK(fn)
118			iHi = ILNBLNK(fn)
119	dfer	1.1	WRITE(msgBuf,'(A)') ' '
120			CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
121			WRITE(msgBuf,'(A)') '// ==================================='
122			CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
123	jmc	1.8	WRITE(msgBuf,'(2A)') '// AIM_DO_CO2: Read pickup ',fn(iLo:iHi)
124	dfer	1.1	CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
125
126	jmc	1.3	CALL WRITE_0D_RL( atpco2_check, INDEX_NONE, 'atpco2_check =',
127	dfer	1.4	& ' /* pCo2 from pickup file */')
128			CALL WRITE_0D_RL( atm_pCO2, INDEX_NONE, 'atm_pCO2 =',
129			& ' /* pCo2 from Atm_CO2_Moles */')
130	dfer	1.1
131			c ELSE
132			c WRITE(msgBuf,'(A)') 'AIM_DO_CO2: How did you end up here?'
133			c CALL PRINT_ERROR( msgBuf , myThid)
134			c STOP 'ABNORMAL END: S/R AIM_DO_CO2'
135			ENDIF
136
137			C- Calculate new atmos pCO2
138			Atm_CO2_Moles = Atm_CO2_Moles - total_flux
139	dfer	1.4	atm_pCO2 = Atm_CO2_Moles / total_atmos_moles
140	dfer	1.1
141			C- Write out if time for a new pickup
142	jmc	1.8	permCheckPoint = myTime.NE.startTime
143			permCheckPoint = permCheckPoint .AND.
144			& DIFFERENT_MULTIPLE(pChkptFreq,myTime+deltaTClock,deltaTClock)
145	dfer	1.1	IF (permCheckPoint) THEN
146			WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.',myIter+1
147			C- write values to new pickup
148			tmpco2(1)= Atm_CO2_Moles
149	dfer	1.4	tmpco2(2)= atm_pCO2
150	jmc	1.8	iUnit = 0
151			CALL MDS_WRITEVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
152			I tmpco2, dummyRS,
153			I 0, 0, -1, myIter, myThid )
154	dfer	1.1	ENDIF
155	dfer	1.4	_END_MASTER(myThid)
156			_BARRIER
157	dfer	1.1
158			C--- end of Aim_CO2_Flag IF.
159			ENDIF
160
161			#endif /* ALLOW_AIM_CO2 */
162			#endif /* ALLOW_AIM */
163
164			RETURN
165			END