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

Annotation 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.1 - (hide annotations) (download)
Fri Aug 11 18:55:50 2006 UTC (19 years, 7 months ago) by jscott
Branch: MAIN
new 2d atm package

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

  ViewVC Help
Powered by ViewVC 1.1.22