/[MITgcm]/MITgcm_contrib/jscott/pkg_atm2d/forward_step_atm2d.F
ViewVC logotype

Contents of /MITgcm_contrib/jscott/pkg_atm2d/forward_step_atm2d.F

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


Revision 1.4 - (show annotations) (download)
Tue Aug 21 16:06:21 2007 UTC (18 years, 6 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +0 -0 lines
FILE REMOVED
remove old atm2d pkg repository

1 #include "ctrparam.h"
2 #ifdef OCEAN_3D
3 # include "ATM2D_OPTIONS.h"
4 #endif
5 C
6 SUBROUTINE FORWARD_STEP_ATM2D(iloop, myTime, myIter, myThid)
7 C |==========================================================|
8 C | Does time loop for one coupled period. The main loop |
9 C | this is the MITGCM main loop OR a separate driver for |
10 C | IGSM 2.2 |
11 C \==========================================================/
12 IMPLICIT NONE
13
14 #include "ATMSIZE.h"
15 #include "DRIVER.h"
16
17 #ifdef OCEAN_3D
18 # include "SIZE.h"
19 # include "EEPARAMS.h"
20 # include "PARAMS.h"
21 # include "ATM2D_VARS.h"
22 #endif
23
24 C !INPUT/OUTPUT PARAMETERS:
25 C == Routine arguments ==
26 C iloop - loop counter for coupled period time steps (main time loop)
27 C myIter - iteration counter for this thread (ocean times steps +nIter0)
28 C myTime - time counter for this thread (ocean time, from starttTime)
29 C myThid - thread number for this instance of the routine.
30 INTEGER iloop
31 REAL*8 myTime
32 INTEGER myIter
33 INTEGER myThid
34
35 C === Local variables ===
36 INTEGER idyear ! year # of simulation, starting at year 1
37 INTEGER iyr ! year # of simulation, starting from specified inyear
38 INTEGER inyr ! hours into the current year, end of coupled period
39 INTEGER monid ! current month of the year
40 INTEGER inday ! hour of the day, end of the coupled period
41 INTEGER dayid ! day of the current month
42 INTEGER j,mn,na,no !loop counters
43 INTEGER jdofmhr(0:12)
44 DATA jdofmhr/0,744,1416,2160,2880,3624,4344,5088,
45 & 5832,6552,7296,8016,8760/
46 C i.e. 0,31*24,59*24,90*24,120*24,151*24,181*24,
47 C 212*24,243*24,273*24,304*24,334*24,365*24
48 #ifdef CPL_TEM
49 INTEGER ndmonth(12)
50 DATA ndmonth/31,28,31,30,31,30,31,31,30,31,30,31/
51 CHARACTER *8 f14tem,f14clm
52 DATA f14tem/'data4tem'/
53 DATA f14clm/'data4clm'/
54 CHARACTER *40 f4tem,f4clm
55 CHARACTER *4 cfile
56 REAL*4 totup, aduptt
57 #endif
58 #ifdef OCEAN_3D
59 INTEGER iloop_ocn
60 #endif
61
62 print *,'***Top of forwrdstep_atm',iloop,myTime,myIter
63 idyear= int((iloop-1)*dtcouple/365.0/24.0) + 1
64 iyr= idyear + startYear -1
65 inyr = mod(iloop*dtcouple, 365*24)
66 DO mn=1,12
67 IF ((inyr.GT.jdofmhr(mn-1)).AND.(inyr.LE.jdofmhr(mn))) monid=mn
68 ENDDO
69 inday= mod(iloop*dtcouple, 24)
70 dayid= int((inyr-dtcouple-jdofmhr(monid-1))/24.0) +1
71 print *,'*** idyear,iyr,inyr,monid,inday,dayid',
72 & idyear,iyr,inyr,monid,inday,dayid
73
74 IF (inyr.EQ.dtcouple) THEN !do this block at start of new year
75 PRINT *,'*** Starting a new year'
76 #ifdef DATA4TEM
77 IF (nfile.gt.1)THEN
78 CLOSE(935)
79 CLOSE(937)
80 ENDIF
81 IF(iyr.gt.1000) THEN
82 nfile=iyr
83 ELSE
84 nfile=1000+iyr
85 ENDIF
86 WRITE (cfile,'i4'),nfile
87 f4tem=f14tem//cfile
88 f4clm=f14clm//cfile
89 OPEN(935,file=f4clm,form='unformatted',status='new')
90 OPEN(937,file=f4tem,form='unformatted',status='new')
91 nfile=nfile+1
92 #endif
93 #ifdef CPL_TEM
94 nepan=0.0
95 ch4ann=0.0
96 n2oann=0.0
97 xco2ann=0.0
98 #endif
99 #ifdef CPL_OCEANCO2
100 ncallatm=0
101 temuptann=0.
102 DO j=1,jm0
103 co24ocnan(j)=0.0
104 ENDDO
105 #endif
106 #ifdef CPL_TEM
107 DO j=1,jm0
108 antemnep(j)=0.
109 ENDDO
110 # ifndef CPL_CHEM
111 CALL robso3(iyr)
112 # endif
113 C For land use
114 CALL updatelcluc(idyear)
115 #endif
116 ENDIF !end block done at year-start
117
118 IF (inyr.EQ.jdofmhr(monid-1)+dtcouple) THEN !do this block month start
119 PRINT *,'***Starting a new month'
120 #ifdef CPL_TEM
121 CALL zclimate2tem
122 #endif
123 #ifdef CPL_OCEANCO2
124 ocumn=0.0
125 DO j=1,jm0
126 fluxco2mn(j)=0.0
127 ENDDO
128 #endif
129 ENDIF !end block at start of the month
130 C
131 C------------------- Top of Coupled Period Loop --------------------------
132 C
133
134 #ifdef OCEAN_3D
135 # ifdef ATM2D_MPI_ON
136 CALL CPL_RECV_OCN_FIELDS
137 # endif
138 CALL GET_OCNVARS( myTime, myIter, myThid)
139 IF ( (iloop.NE.1).OR. (iloop.EQ.1.AND.
140 & (startTime.NE.baseTime .OR. nIter0.NE.0)) ) THEN
141 C don't run the ice growth/melt on step 1 if "cold" start
142 CALL THSICE_STEP_FWD(1,1,1,sNx,1,sNy, pass_prcAtm,
143 & myTime, myIter, myThid)
144 CALL THSICE_AVE( 1,1, myTime, myIter, myThid )
145 ENDIF
146 CALL CALC_ZONAL_MEANS(.TRUE.,myThid)
147 CALL PUT_OCNVARS(myTime,myIter,myThid)
148 # ifdef ATM2D_MPI_ON
149 CALL CPL_SEND_OCN_FIELDS
150 # endif
151 #endif
152
153 PRINT *,'Top of ncall_atm Loop'
154 DO na=1,ncall_atm !loop for atmos forward time steps
155 CALL atmosphere(dtatm,monid)
156 #ifdef OCEAN_3D
157 CALL ATM2OCN_MAIN(iloop, na, monid, myIter, myThid)
158 CALL SUM_OCN_FLUXES(myThid)
159 CALL PASS_SEAICE_FLUXES(myThid)
160 CALL THSICE_STEP_TEMP(1,1,1,sNx,1,sNy,
161 & myTime, myIter, myThid)
162 CALL SUM_SEAICE_OUT(myThid)
163 CALL CALC_ZONAL_MEANS(.FALSE.,myThid) !just mean Tsrf recalculated
164 #endif
165 ENDDO ! ncall_atm loop
166
167 PRINT *,'Top of ncall_ocean Loop'
168 DO no=1,ncall_ocean !loop for each ocean forward step
169
170 #ifdef OCEAN_3D
171 iloop_ocn = nint((iloop-1)*dtcouplo/deltaTClock) + no
172 # ifndef ATM2D_MPI_ON
173 CALL FORWARD_STEP(iloop_ocn, myTime, myIter, myThid )
174 # else
175 myIter = nIter0 + iloop_ocn
176 myTime = startTime + deltaTClock *float (iloop_ocn)
177 CALL DO_THE_MODEL_IO( myTime, myIter, myThid )
178 CALL DO_WRITE_PICKUP(
179 & .FALSE., myTime, myIter, myThid )
180 # endif
181 #endif
182 #ifdef ML_2D
183 CALL ocean_ml(dtocn,dtatm*3600.)
184 #endif
185
186 ENDDO ! ncall_ocean loop
187
188 C Start of code done at the end of every coupled period
189
190 #ifdef OCEAN_3D
191 CALL NORM_OCN_FLUXES(myThid)
192 CALL ATM2D_WRITE_PICKUP(.FALSE., myTime, myIter, myThid)
193 #endif
194
195 C
196 C--------------------- End of coupled period loop --------------------
197 C
198 IF (inday.EQ.0) THEN !do this block if end-of-day
199 C PRINT *,'***block at end of day'
200 #ifdef CPL_OCEANCO2
201 DO j=1,jm0
202 ocumn=ocumn+fluxco2(j)
203 fluxco2mn(j)=fluxco2mn(j)+fluxco2(j)
204 ENDDO
205 #endif
206 ENDIF !end block end-of-day
207
208 IF (inyr.EQ.jdofmhr(monid).OR.(inyr.EQ.0)) THEN !do block if month-end
209 PRINT *,'***end of month reached'
210 #ifdef CLM
211 # ifdef CPL_TEM
212 CALL climate2tem(monid,ndmonth(monid))
213 c PRINT *,'From driver before call tem',' idyear=',idyear
214 CALL tem(idyear,monid-1)
215 CALL tem2climate(idyear,monid-1)
216 ch4mn=0.0
217 n2omn=0.0
218 nepmn=0.0
219 DO j=1,jm0
220 ch4mn=ch4mn+temch4(j)
221 n2omn=n2omn+temn2o(j)
222 nepmn=nepmn+temco2(j)
223 ENDDO
224 # ifdef CPL_NEM
225 PRINT *,'Month=',monid
226 PRINT *,'CH4=',ch4mn/1.e9,' N2O=',n2omn/1.e9
227 write (277)iyr,monid,ch4mn,n2omn,nepmn,
228 & temch4,temn2o,temco2
229 # endif
230 DO j=1,jm0
231 temnep(monid,j)=temco2(j)
232 ENDDO ! j
233 c PRINT *,'After tem2climate'
234 c PRINT *,'TEMNEP'
235 c PRINT *,(temco2(j),j=1,jm0)
236 c PRINT *,'CH4'
237 c PRINT *,(temch4(j),j=1,jm0)
238 c PRINT *,'N2O'
239 c PRINT *,(temn2o(j),j=1,jm0)
240 DO j=1,jm0
241 antemnep(j)=antemnep(j)+temnep(monid,j)
242 nepan=nepan+temnep(nn,j)
243 ch4ann=ch4ann+temch4(j)
244 n2oann=n2oann+temn2o(j)
245 ENDDO ! j
246
247 # endif
248 #endif
249
250 #ifdef OCEAN_3D
251 CALL MONTH_END_DIAGS( monid, myTime, myIter, myThid)
252 #endif
253
254 #ifdef CPL_OCEANCO2
255 IF (monid.EQ.12) THEN
256 ocupt=ocupt*12.e-15
257 c 12.e-15 from moles to Gt carbon
258 ocuptp=ocupt
259 ocupt=0.0
260 ENDIF
261 #endif
262
263 #ifdef IPCC_EMI
264 PRINT *,'Month=',monid
265 nepmn=nepmn/1000.
266 ocumn=ocumn*12.e-15
267 C tnow= jyear + (jday-.5)/365.
268 C CALL emissipcc(tnow,nepmn,ocumn,CO2,xco2ann,nemis)
269 CALL emissipcc_mn(nepmn,ocumn,xco2ann,nemis)
270 #endif
271 ENDIF !end block done at month-end
272
273 IF (inyr.EQ.0) THEN ! do this block at year-end
274 PRINT *,'***end of year reached'
275 #ifdef CPL_TEM
276 nepan=nepan/1000.
277 IF (iyr.ge.1981.and.iyr.le.1990) THEN
278 PRINT *,'Uptake avegaging year=',iyr
279 nepav=nepav+nepan
280 aocuav=aocuav+OCUPTP
281 IF (iyr.eq.1990) THEN
282 nepav=nepav/10.
283 aocuav=aocuav/10.
284 totup=nepav+aocuav
285 aduptt=4.1-totup
286 PRINT *,' Carbon uptake for spinup'
287 PRINT *,' totup=',totup,' aocuav=',aocuav
288 PRINT *,' nepav=',nepav,' aduptt=',aduptt
289 ENDIF
290 ENDIF
291
292 IF (iyr.eq.endYear) THEN
293 C NEM emissions and NEP for start of climate-chemistry run
294 adupt=aduptt
295 WRITE (367),adupt,temco2
296 CALL wr_rstrt_nem
297 ENDIF
298
299 #endif
300
301 #ifdef ML_2D
302 C Data for the restart of the 2D ML model
303 CALL wrrstrt_ocean
304 #endif
305
306 #ifdef OCEAN_3D
307 IF ((mod(iyr,taveDump).EQ.0).AND.(idyear.GE.taveDump)) THEN
308 CALL TAVE_END_DIAGS( taveDump, myTime, myIter, myThid)
309 ELSEIF (mod(iyr,taveDump).EQ.0) THEN
310 CALL TAVE_END_DIAGS( idyear, myTime, myIter, myThid)
311 ENDIF
312 C If necessary, next line can be moved outside OCEAN_3D for IGSM2.2 cleanups
313 IF (iloop.EQ.nTimeSteps) CALL ATM2D_FINISH(myThid)
314 #endif
315
316 #ifdef CPL_TEM
317 # ifdef CPL_OCEANCO2
318 PRINT 'a6,i6,2(a5,f10.4)','Year=',iyr,
319 & ' NEP=',nepan,' OCU=',ocuptp
320 # else
321 PRINT 'a6,i6,2(a5,f10.4)','Year=',iyr,
322 & ' NEP=',nepan
323 # endif
324 # ifdef IPCC_EMI
325 PRINT 'a6,i6,(a5,f10.4)','Year=',iyr,
326 & ' CO2AN=',xco2ann/12.
327 C REWIND 861
328 C WRITE (861,*)co2*ghgbgr(1)
329 CALL emissipcc_yr
330 # endif
331 # ifdef CPL_NEM
332 PRINT *,' CH4=',ch4ann,' N2O=',n2oann
333 # endif
334 C WRITE(333,'(2f9.5)')nepan,ocuptp
335 WRITE(333,*)iyr,nepan,ocuptp
336 # if defined (CPL_OCEANCO2) && defined (ML_2D)
337 WRITE(602)iyr
338 CALL wrgary
339 CALL zerogary
340 # endif
341 #endif
342 #ifdef CPL_OCEANCO2
343 DO j=1,jm0
344 co24ocnan(j)=co24ocnan(j)/365.0
345 ENDDO
346 PRINT *,' CO2 for ocean model',' ncallatm=',ncall_atm
347 PRINT '12f7.1,/,2(11f7.1,/),12f7.1',co24ocnan
348 #endif
349 #ifdef CPL_CHEM
350 PRINT *,' TEMUPTANN=',temuptann,' TOTAL UPTAKE='
351 & ,ocuptp+temuptann
352 #endif
353 ENDIF !year-end block
354
355 RETURN
356 END

  ViewVC Help
Powered by ViewVC 1.1.22