/[MITgcm]/MITgcm/pkg/aim_v23/aim_do_co2.F
ViewVC logotype

Annotation of /MITgcm/pkg/aim_v23/aim_do_co2.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.11 - (hide annotations) (download)
Thu Jan 11 01:55:54 2018 UTC (6 years, 4 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint66o, checkpoint66n, HEAD
Changes since 1.10: +16 -23 lines 
- merge namelist "AIM_PAR_CO2" into "AIM_PARAMS" and replace Aim_CO2_Flag=2
  option with aim_select_pCO2=2 (using #define ALLOW_AIM_CO2);
- add option to derive LW absorption in CO2 band as function of pCO2,
  using either prescried pCO2 (aim_select_pCO2=1), or computed pCO2
  from well mixed atm-box (aim_select_pCO2=3).
1 jmc 1.11 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_do_co2.F,v 1.10 2017/03/24 23:31:41 jmc 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 jmc 1.9 #include "RESTART.h"
25 dfer 1.1 #include "GRID.h"
26    
27 jmc 1.11 #include "AIM_PARAMS.h"
28 dfer 1.1 #include "AIM_CO2.h"
29 dfer 1.4 C-- Coupled to the Ocean :
30     #ifdef COMPONENT_MODULE
31     #include "CPL_PARAMS.h"
32     #include "ATMCPL.h"
33     #endif
34    
35 jmc 1.8 C !INPUT/OUTPUT PARAMETERS:
36     C myTime :: Current time of simulation ( s )
37     C myIter :: Current iteration number in simulation
38     C myThid :: Number of this instance of the routine
39     _RL myTime
40 dfer 1.4 INTEGER myIter, myThid
41 jmc 1.8 CEOP
42 dfer 1.1
43     #ifdef ALLOW_AIM
44     #ifdef ALLOW_AIM_CO2
45 jmc 1.8 C !FUNCTIONS:
46     INTEGER ILNBLNK, IFNBLNK
47     EXTERNAL ILNBLNK, IFNBLNK
48     LOGICAL DIFFERENT_MULTIPLE
49     EXTERNAL DIFFERENT_MULTIPLE
50 dfer 1.4
51 jmc 1.8 C !LOCAL VARIABLES:
52 dfer 1.4 C bi,bj - Tile index
53     C i,j - loop counters
54     INTEGER bi, bj, i, j
55     _RL total_flux, atpco2_check
56     _RL flxCO2tile(nSx,nSy)
57 jmc 1.9 LOGICAL modelEnd
58     LOGICAL permPickup, tempPickup
59 jmc 1.8 INTEGER iUnit, iLo, iHi
60     _RS dummyRS(1)
61     _RL tmpco2(2)
62 jmc 1.10 CHARACTER*(10) suff
63 jmc 1.8 CHARACTER*(MAX_LEN_FNAM) fn
64     CHARACTER*(MAX_LEN_MBUF) msgBuf
65 dfer 1.1
66 dfer 1.4 #ifdef COMPONENT_MODULE
67 jmc 1.8 IF ( useCoupler .AND. useImportFlxCO2 ) THEN
68 dfer 1.4 DO bj=myByLo(myThid),myByHi(myThid)
69     DO bi=myBxLo(myThid),myBxHi(myThid)
70     DO j=1,sNy
71     DO i=1,sNx
72     aimflxCo2(i,j,bi,bj) = flxCO2ocn(i,j,bi,bj)
73 jmc 1.8 ENDDO
74 dfer 1.1 ENDDO
75     ENDDO
76 dfer 1.4 ENDDO
77     ENDIF
78     #endif /* COMPONENT_MODULE */
79    
80 jmc 1.11 IF ( aim_select_pCO2 .GE. 2 ) THEN
81 dfer 1.1
82     C- First compute global mole flux at air-sea interface
83 dfer 1.4 DO bj=myByLo(myThid),myByHi(myThid)
84     DO bi=myBxLo(myThid),myBxHi(myThid)
85     flxCO2tile(bi,bj) = 0. _d 0
86     DO j=1,sNy
87     DO i=1,sNx
88     flxCO2tile(bi,bj)=flxCO2tile(bi,bj) + aimflxCo2(i,j,bi,bj)
89     & * rA(i,j,bi,bj) * deltaT
90     ENDDO
91     ENDDO
92 dfer 1.1 ENDDO
93     ENDDO
94 dfer 1.4 CALL GLOBAL_SUM_TILE_RL(flxCO2tile,total_flux,myThid)
95 dfer 1.1
96 dfer 1.4 _BARRIER
97     _BEGIN_MASTER(myThid)
98 jmc 1.9 IF ( myIter.EQ.0 ) THEN
99 dfer 1.4 C- If first iteration, use atmpCO2init as initial condition
100 jmc 1.11 atm_CO2_Moles = atm_pCO2 * total_atmos_moles
101 dfer 1.1
102 jmc 1.9 ELSEIF ( myIter.EQ.nIter0 ) THEN
103 dfer 1.1 C- If restart, read moles number from pickup
104 jmc 1.9 IF ( pickupSuff.EQ.' ' ) THEN
105 jmc 1.10 IF ( rwSuffixType.EQ.0 ) THEN
106     WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.', myIter
107     ELSE
108     CALL RW_GET_SUFFIX( suff, myTime, myIter, myThid )
109     WRITE(fn,'(A,A)') 'pickup_aimCo2.', suff
110     ENDIF
111 jmc 1.9 ELSE
112     WRITE(fn,'(A,A10)') 'pickup_aimCo2.', pickupSuff
113     ENDIF
114 jmc 1.8 iUnit = 0
115     CALL MDS_READVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
116     O tmpco2, dummyRS,
117     I 0, 0, 1, myThid )
118 jmc 1.11 atm_CO2_Moles = tmpco2(1)
119 dfer 1.1 atpco2_check = tmpco2(2)
120 jmc 1.11 atm_pCO2 = atm_CO2_Moles / total_atmos_moles
121 dfer 1.1
122     iUnit = standardMessageUnit
123 jmc 1.8 iLo = IFNBLNK(fn)
124     iHi = ILNBLNK(fn)
125 dfer 1.1 WRITE(msgBuf,'(A)') ' '
126     CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
127     WRITE(msgBuf,'(A)') '// ==================================='
128     CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
129 jmc 1.8 WRITE(msgBuf,'(2A)') '// AIM_DO_CO2: Read pickup ',fn(iLo:iHi)
130 dfer 1.1 CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
131    
132 jmc 1.3 CALL WRITE_0D_RL( atpco2_check, INDEX_NONE, 'atpco2_check =',
133 dfer 1.4 & ' /* pCo2 from pickup file */')
134     CALL WRITE_0D_RL( atm_pCO2, INDEX_NONE, 'atm_pCO2 =',
135 jmc 1.11 & ' /* pCo2 from atm_CO2_Moles */')
136 dfer 1.1 ENDIF
137    
138     C- Calculate new atmos pCO2
139 jmc 1.11 atm_CO2_Moles = atm_CO2_Moles - total_flux
140     atm_pCO2 = atm_CO2_Moles / total_atmos_moles
141    
142     C- Set pCO2 for AIM Radiation:
143     IF ( aim_select_pCO2 .EQ. 3 ) THEN
144     aim_pCO2 = atm_pCO2
145     ENDIF
146 dfer 1.1
147     C- Write out if time for a new pickup
148 jmc 1.9 modelEnd = (myTime+deltaTClock).EQ.endTime
149     & .OR. (myIter+1).EQ.nEndIter
150     permPickup = .FALSE.
151     tempPickup = .FALSE.
152     permPickup =
153 jmc 1.8 & DIFFERENT_MULTIPLE(pChkptFreq,myTime+deltaTClock,deltaTClock)
154 jmc 1.9 tempPickup =
155     & DIFFERENT_MULTIPLE( chkptFreq,myTime+deltaTClock,deltaTClock)
156     IF ( (modelEnd.AND.writePickupAtEnd)
157     & .OR. permPickup .OR. tempPickup ) THEN
158     IF ( permPickup ) THEN
159 jmc 1.10 IF ( rwSuffixType.EQ.0 ) THEN
160     WRITE(fn,'(A,I10.10)') 'pickup_aimCo2.', myIter+1
161     ELSE
162     CALL RW_GET_SUFFIX( suff,
163     & myTime+deltaTClock, myIter+1, myThid )
164     WRITE(fn,'(A,A)') 'pickup_aimCo2.', suff
165     ENDIF
166 jmc 1.9 ELSE
167 jmc 1.10 WRITE(fn,'(A,A)') 'pickup_aimCo2.', checkPtSuff(nCheckLev)
168 jmc 1.9 ENDIF
169 dfer 1.1 C- write values to new pickup
170 jmc 1.11 tmpco2(1)= atm_CO2_Moles
171 dfer 1.4 tmpco2(2)= atm_pCO2
172 jmc 1.8 iUnit = 0
173     CALL MDS_WRITEVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
174     I tmpco2, dummyRS,
175     I 0, 0, -1, myIter, myThid )
176 dfer 1.1 ENDIF
177 dfer 1.4 _END_MASTER(myThid)
178     _BARRIER
179 dfer 1.1
180 jmc 1.11 C--- end if aim_select_pCO2 >= 2
181 dfer 1.1 ENDIF
182    
183     #endif /* ALLOW_AIM_CO2 */
184     #endif /* ALLOW_AIM */
185    
186     RETURN
187     END
  ViewVC Help
Powered by ViewVC 1.1.22