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

Contents 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 - (show annotations) (download)
Thu Jan 11 01:55:54 2018 UTC (6 years, 3 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 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/aim_do_co2.F,v 1.10 2017/03/24 23:31:41 jmc Exp $
2 C $Name: $
3
4 #include "AIM_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: AIM_DO_CO2
8 C !INTERFACE:
9 SUBROUTINE AIM_DO_CO2( myTime, myIter, myThid )
10
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | S/R AIM_DO_CO2
14 C | o CO2 budget of the atmosphere
15 C *==========================================================*
16 C \ev
17 C !USES:
18 IMPLICIT NONE
19
20 C == Global data ==
21 #include "SIZE.h"
22 #include "EEPARAMS.h"
23 #include "PARAMS.h"
24 #include "RESTART.h"
25 #include "GRID.h"
26
27 #include "AIM_PARAMS.h"
28 #include "AIM_CO2.h"
29 C-- Coupled to the Ocean :
30 #ifdef COMPONENT_MODULE
31 #include "CPL_PARAMS.h"
32 #include "ATMCPL.h"
33 #endif
34
35 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 INTEGER myIter, myThid
41 CEOP
42
43 #ifdef ALLOW_AIM
44 #ifdef ALLOW_AIM_CO2
45 C !FUNCTIONS:
46 INTEGER ILNBLNK, IFNBLNK
47 EXTERNAL ILNBLNK, IFNBLNK
48 LOGICAL DIFFERENT_MULTIPLE
49 EXTERNAL DIFFERENT_MULTIPLE
50
51 C !LOCAL VARIABLES:
52 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 LOGICAL modelEnd
58 LOGICAL permPickup, tempPickup
59 INTEGER iUnit, iLo, iHi
60 _RS dummyRS(1)
61 _RL tmpco2(2)
62 CHARACTER*(10) suff
63 CHARACTER*(MAX_LEN_FNAM) fn
64 CHARACTER*(MAX_LEN_MBUF) msgBuf
65
66 #ifdef COMPONENT_MODULE
67 IF ( useCoupler .AND. useImportFlxCO2 ) THEN
68 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 ENDDO
74 ENDDO
75 ENDDO
76 ENDDO
77 ENDIF
78 #endif /* COMPONENT_MODULE */
79
80 IF ( aim_select_pCO2 .GE. 2 ) THEN
81
82 C- First compute global mole flux at air-sea interface
83 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 ENDDO
93 ENDDO
94 CALL GLOBAL_SUM_TILE_RL(flxCO2tile,total_flux,myThid)
95
96 _BARRIER
97 _BEGIN_MASTER(myThid)
98 IF ( myIter.EQ.0 ) THEN
99 C- If first iteration, use atmpCO2init as initial condition
100 atm_CO2_Moles = atm_pCO2 * total_atmos_moles
101
102 ELSEIF ( myIter.EQ.nIter0 ) THEN
103 C- If restart, read moles number from pickup
104 IF ( pickupSuff.EQ.' ' ) THEN
105 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 ELSE
112 WRITE(fn,'(A,A10)') 'pickup_aimCo2.', pickupSuff
113 ENDIF
114 iUnit = 0
115 CALL MDS_READVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
116 O tmpco2, dummyRS,
117 I 0, 0, 1, myThid )
118 atm_CO2_Moles = tmpco2(1)
119 atpco2_check = tmpco2(2)
120 atm_pCO2 = atm_CO2_Moles / total_atmos_moles
121
122 iUnit = standardMessageUnit
123 iLo = IFNBLNK(fn)
124 iHi = ILNBLNK(fn)
125 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 WRITE(msgBuf,'(2A)') '// AIM_DO_CO2: Read pickup ',fn(iLo:iHi)
130 CALL PRINT_MESSAGE(msgBuf,iUnit,SQUEEZE_RIGHT,myThid)
131
132 CALL WRITE_0D_RL( atpco2_check, INDEX_NONE, 'atpco2_check =',
133 & ' /* pCo2 from pickup file */')
134 CALL WRITE_0D_RL( atm_pCO2, INDEX_NONE, 'atm_pCO2 =',
135 & ' /* pCo2 from atm_CO2_Moles */')
136 ENDIF
137
138 C- Calculate new atmos pCO2
139 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
147 C- Write out if time for a new pickup
148 modelEnd = (myTime+deltaTClock).EQ.endTime
149 & .OR. (myIter+1).EQ.nEndIter
150 permPickup = .FALSE.
151 tempPickup = .FALSE.
152 permPickup =
153 & DIFFERENT_MULTIPLE(pChkptFreq,myTime+deltaTClock,deltaTClock)
154 tempPickup =
155 & DIFFERENT_MULTIPLE( chkptFreq,myTime+deltaTClock,deltaTClock)
156 IF ( (modelEnd.AND.writePickupAtEnd)
157 & .OR. permPickup .OR. tempPickup ) THEN
158 IF ( permPickup ) THEN
159 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 ELSE
167 WRITE(fn,'(A,A)') 'pickup_aimCo2.', checkPtSuff(nCheckLev)
168 ENDIF
169 C- write values to new pickup
170 tmpco2(1)= atm_CO2_Moles
171 tmpco2(2)= atm_pCO2
172 iUnit = 0
173 CALL MDS_WRITEVEC_LOC( fn, precFloat64, iUnit, 'RL', 2,
174 I tmpco2, dummyRS,
175 I 0, 0, -1, myIter, myThid )
176 ENDIF
177 _END_MASTER(myThid)
178 _BARRIER
179
180 C--- end if aim_select_pCO2 >= 2
181 ENDIF
182
183 #endif /* ALLOW_AIM_CO2 */
184 #endif /* ALLOW_AIM */
185
186 RETURN
187 END

  ViewVC Help
Powered by ViewVC 1.1.22