/[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.4 - (hide annotations) (download)
Tue Aug 21 16:06:21 2007 UTC (18 years, 4 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.3: +0 -0 lines
FILE REMOVED
remove old atm2d pkg repository

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 jscott 1.3 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 jscott 1.1 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 jscott 1.2 CALL THSICE_AVE( 1,1, myTime, myIter, myThid )
145 jscott 1.1 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 jscott 1.2 CALL DO_THE_MODEL_IO( myTime, myIter, myThid )
178 jscott 1.3 CALL DO_WRITE_PICKUP(
179     & .FALSE., myTime, myIter, myThid )
180 jscott 1.1 # endif
181     #endif
182     #ifdef ML_2D
183 jscott 1.2 CALL ocean_ml(dtocn,dtatm*3600.)
184 jscott 1.1 #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 jscott 1.3 C PRINT *,'***block at end of day'
200 jscott 1.1 #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 jscott 1.3 PRINT *,'***end of month reached'
210 jscott 1.1 #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 jscott 1.2 antemnep(j)=antemnep(j)+temnep(monid,j)
242 jscott 1.1 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 jscott 1.3 PRINT *,'***end of year reached'
275 jscott 1.1 #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 jscott 1.2 CALL wrrstrt_ocean
304 jscott 1.1 #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 jscott 1.3 C If necessary, next line can be moved outside OCEAN_3D for IGSM2.2 cleanups
313 jscott 1.1 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