/[MITgcm]/MITgcm_contrib/jscott/igsm/src/daily_ocean.F
ViewVC logotype

Annotation of /MITgcm_contrib/jscott/igsm/src/daily_ocean.F

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


Revision 1.2 - (hide annotations) (download)
Mon Apr 23 21:20:18 2007 UTC (18 years, 3 months ago) by jscott
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +4 -2 lines
bring igsm atmos code up to date

1 jscott 1.1
2     #include "ctrparam.h"
3    
4     ! ==========================================================
5     !
6     ! MD2G04.F: Lots of utility functions.
7     !
8     ! ----------------------------------------------------------
9     !
10     ! Revision History:
11     !
12     ! When Who What
13     ! ---- ---------- -------
14     ! 073100 Chien Wang repack based on CliChem3 & M24x11,
15     ! and add cpp.
16     !
17     ! ==========================================================
18    
19    
20     SUBROUTINE DAILY_OCEAN 1001.
21     C**** 1002.
22     C**** THIS SUBROUTINE PERFORMS THOSE FUNCTIONS OF THE PROGRAM WHICH 1003.
23     C**** TAKE PLACE AT THE BEGINNING OF A NEW DAY. 1004.
24     C**** 1005.
25    
26     #include "BD2G04.COM" 1006.
27    
28     COMMON/SPEC2/KM,KINC,COEK,C3LAND(IO0,JM0),C3OICE(IO0,JM0) 1006.1
29     * ,C3LICE(IO0,JM0),WMGE(IO0,JM0),TSSFC(IM0,JM0,4) 1006.2
30     COMMON U,V,T,P,Q 1007.
31     COMMON/WORK2/Z1OOLD(IO0,JM0),XO(IO0,JM0,3),XZO(IO0,JM0) 1008.
32     COMMON/OLDZO/ZMLOLD(IO0,JM0)
33     DIMENSION AMONTH(12),JDOFM(13) 1009.
34     CHARACTER*4 AMONTH 1009.1
35     DIMENSION XA(1,JM0),XB(1,JM0),OI(IO0,JM0),XOI(IO0,JM0) 1009.5
36     dimension sst1(JM0,3),sst2(JM0,3),dsst(JM0,3),intem(3),
37     & sstmin(12,2)
38     & ,miceo(JM0)
39     common/qfl/QFLUX(JM0,0:13),ZOAV(JM0),QFLUXT(JM0)
40 jscott 1.2 ! common/TSUR/TSURFC(JM0,0:13),TSURFT(JM0),TSURFD(JM0),DTSURF(JM0)
41     #include "TSRF.COM"
42 jscott 1.1 common/fixcld/cldssm(JM0,LM0,0:13),cldmcm(JM0,LM0,0:13),
43     & CLDSST(JM0,LM0),
44     & CLDMCT(JM0,LM0)
45     common/surps/srps(JM0+3),nsrps
46     LOGICAL HPRNT
47     common/conprn/HPRNT,JPR,LPR
48     data ifirst /1/
49     data intem /1,4,5/
50     data sstmin /-1.56,-1.56,-0.75,6*0.0,2*-0.75,-1.56,
51     * 3*0.0,2*-0.75,3*-1.56,-0.75,3*0.0/
52     DATA AMONTH/'JAN','FEB','MAR','APR','MAY','JUNE','JULY','AUG', 1010.
53     * 'SEP','OCT','NOV','DEC'/ 1011.
54     DATA JDOFM/0,31,59,90,120,151,181,212,243,273,304,334,365/ 1012.
55     DATA JDPERY/365/,JMPERY/12/,EDPERY/365./,Z1I/.1/,RHOI/916.6/ 1013.
56     C**** ORBITAL PARAMETERS FOR EARTH FOR YEAR 2000 A.D. 1014.
57     DATA SOLS/173./,APHEL/186./,OBLIQ/23.44/,ECCN/.0167/ 1015.
58     c DATA SOLS/173./,APHEL/186./,OBLIQ/25.00/,ECCN/.0167/ 1015.
59     C**** 1016.
60     C**** CALCULATE THE DAILY CALENDAR 1035.
61     C**** 1036.
62     200 JYEAR=IYEAR+(IDAY-1)/JDPERY 1037.
63     JDAY=IDAY-(JYEAR-IYEAR)*JDPERY 1038.
64     DO 210 MONTH=1,JMPERY 1039.
65     IF(JDAY.LE.JDOFM(MONTH+1)) GO TO 220 1040.
66     210 CONTINUE 1041.
67     220 JDATE=JDAY-JDOFM(MONTH) 1042.
68     JMONTH=AMONTH(MONTH) 1043.
69     if(ifirst.eq.1.or.HPRNT)then
70     print *,' DAILY_OCEAN IDAY=',IDAY,' IYEAR=',IYEAR
71     print *,' JYEAR=',JYEAR,' JDAY=',JDAY
72     print *,' JDATE=',JDATE,' JMONTH=',JMONTH
73     if(KOCEAN.eq.1)ifirst=0
74     endif
75     c
76     IF(KOCEAN.EQ.1) GO TO 500 1048.1
77     C**** 1049.
78     C**** CALCULATE DAILY OCEAN DATA FROM CLIMATOLOGY 1050.
79     C**** 1051.
80     C**** ODATA 1 OCEAN TEMPERATURE (C) 1052.
81     C**** 2 RATIO OF OCEAN ICE COVERAGE TO WATER COVERAGE (1) 1053.
82     C**** 3 OCEAN ICE AMOUNT OF SECOND LAYER (KG/M**2) 1054.
83     C**** 1055.
84     C**** READ IN TWO MONTHS OF OCEAN DATA 1056.
85     do 385 j=1,JM
86     miceo(j)=ODATA(1,j,3)*ODATA(1,j,2)
87     385 continue
88     IF(JDAY.GE.16) GO TO 310 1057.
89     MD=JDATE+15 1058.
90     GO TO 320 1059.
91     310 IF(JDAY.LE.350) GO TO 340 1060.
92     MD=JDATE-16 1061.
93     320 READ (515) M,XO 1062.
94     MDMAX=31 1063.
95     DO 330 MX=1,10 1064.
96     330 READ (515) M 1065.
97     READ (515) M,(((ODATA(I,J,K),I=1,IO),J=1,JM),K=1,3) 1066.
98     GO TO 400 1067.
99     340 DO 350 MX=1,12 1068.
100     READ (515) M,(((ODATA(I,J,K),I=1,IO),J=1,JM),K=1,3) 1069.
101     IF(M.EQ.MONTH) GO TO 360 1070.
102     IF(M+1.EQ.MONTH.AND.JDATE.LT.16) GO TO 370 1071.
103     350 CONTINUE 1072.
104     STOP 2 1073.
105     360 IF(JDATE.EQ.16) GO TO 480 1074.
106     MDMAX=JDOFM(MONTH+1)-JDOFM(MONTH) 1075.
107     MD=JDATE-16 1076.
108     GO TO 380 1077.
109     370 MDMAX=JDOFM(MONTH)-JDOFM(MONTH-1) 1078.
110     MD=MDMAX+JDATE-16 1079.
111     380 READ (515) M,XO 1080.
112     C**** INTERPOLATE OCEAN DATA TO CURRENT DAY 1081.
113     400 X1=FLOAT(MDMAX-MD)/MDMAX 1082.
114     X2=1.-X1 1083.
115     DO 420 K=1,3 1084.
116     DO 420 J=1,JM 1085.
117     DO 420 I=1,IO 1086.
118     420 ODATA(I,J,K)=X1*ODATA(I,J,K)+X2*XO(I,J,K) 1087.
119     480 REWIND 515 1088.
120     DO 255 J=1,JM 1088.5
121     SUM1=0. 1088.51
122     SUM2=0. 1088.511
123     SUM3=0. 1088.512
124     CONT1=0. 1088.52
125     DO 256 I=1,IO 1088.53
126     PLAND=C3LAND(I,J) 1088.54
127     POICE= ODATA(I,J,2)*(1.-PLAND) 1088.55
128     C3OICE(I,J)=POICE 1088.56
129     PWATER=1.-PLAND 1088.57
130     IF(PWATER.LE.0.) GO TO 256 1088.58
131     CONT1=CONT1+PWATER 1088.59
132     SUM1=SUM1+PWATER*ODATA(I,J,1) 1088.6
133     SUM2=SUM2+PWATER*ODATA(I,J,4) 1088.601
134     SUM3=SUM3+PWATER*ODATA(I,J,5) 1088.602
135     256 CONTINUE 1088.61
136     IF(CONT1.EQ.0.) GO TO 255 1088.62
137     IF (J.EQ.1.OR.J.EQ.JM) GO TO 255 1088.63
138     SUM1=SUM1/CONT1 1088.64
139     SUM2=SUM2/CONT1 1088.642
140     SUM3=SUM3/CONT1 1088.643
141     DO 258 I=1,IO 1088.65
142     ODATA(I,J,4)=SUM2 1088.651
143     ODATA(I,J,5)=SUM3 1088.652
144     258 ODATA(I,J,1)=SUM1 1088.66
145     255 CONTINUE 1088.67
146     DO 257 J=2,JMM1 1088.68
147     SUM1=0. 1088.69
148     SUM2=0. 1088.7
149     CONT1=0. 1088.71
150     DO 254 I=1,IO 1088.72
151     POICE=ODATA(I,J,2)*(1.-C3LAND(I,J)) 1088.73
152     SUM1=SUM1+POICE 1088.74
153     SUM2=SUM2+POICE*ODATA(I,J,3) 1088.75
154     254 CONT1=CONT1+(1.-C3LAND(I,J)) 1088.76
155     IF(SUM1.LE.0.) GO TO 425 1088.77
156     SUM2=SUM2/SUM1 1088.78
157     DO 423 I=1,IO 1088.79
158     423 ODATA(I,J,3)=SUM2 1088.8
159     425 CONTINUE 1088.81
160     IF(CONT1.LE.0.) GO TO 257 1088.82
161     RATIO=SUM1/CONT1 1088.83
162     DO 253 I=1,IO 1088.84
163     253 ODATA(I,J,2)=RATIO 1088.85
164     257 CONTINUE 1088.86
165     go to 678
166     DO 251 J=1,2 1088.87
167     DO 251 I=1,IO 1088.88
168     ODATA(I,J,1)=ODATA(I,3,1) 1088.881
169     251 ODATA(I,J,2)=1. 1088.89
170     DO 428 J=1,2 1088.9
171     DO 428 I=1,IO 1088.91
172     ODATA(I,J,4)=ODATA(I,3,4) 1088.911
173     ODATA(I,J,5)=ODATA(I,3,5) 1088.912
174     428 ODATA(I,J,3)=ODATA(I,3,3) 1088.92
175     678 continue
176     c print *,'ICE FractionS'
177     c print *,(ODATA(1,J,2),j=1,jm)
178     C Skip adjustment
179     c go to 950
180     if(JDATE.eq.46)then
181     print *,' before'
182     do 567 M=1,5
183     print *,' '
184     print *,' ODATA ',M
185     print *,(ODATA(1,J,M),J=1,JM)
186     567 continue
187     endif
188     do 558 J=1,JM
189     do 559 ntem=1,3
190     ITEM=intem(ntem)
191     sst1(J,ntem)=ODATA(1,J,ITEM)
192     sst2(J,ntem)=ODATA(1,J,ITEM)
193     dsst(J,ntem)=0.
194     559 continue
195     if(ODATA(1,J,2).ge.0.2)then
196     dmice=ODATA(1,J,3)*ODATA(1,j,2)-miceo(J)
197     if(dmice.ge.0.0)then
198     do 561 ntem=1,3
199     if(sst1(J,ntem).gt.-1.56)then
200     sst2(J,ntem)=-1.56
201     dsst(J,ntem)=-1.56-sst1(J,ntem)
202     endif
203     561 continue
204     else
205     do 569 ntem=1,3
206     if(sst1(J,ntem).gt.0.0)then
207     sst2(J,ntem)=0.0
208     dsst(J,ntem)=-sst1(J,ntem)
209     endif
210     569 continue
211     endif
212     else
213     ODATA(1,J,2)=0.
214     ODATA(1,J,3)=0.
215     endif
216     558 continue
217     do 562 j=2,JM/2
218     jnr=JM-j+1
219     do 563 ntem=1,3
220     if(dsst(j+1,ntem).eq.0.0.and.dsst(j,ntem).eq.0.0
221     * .and.dsst(j-1,ntem).ne.0.0) then
222     sst2(j,ntem)=sst1(j,ntem)+0.5*dsst(j-1,ntem)
223     sst2(j+1,ntem)=sst1(j+1,ntem)+0.25*dsst(j-1,ntem)
224     endif
225     if(dsst(jnr-1,ntem).eq.0.0.and.dsst(jnr,ntem).eq.0.0
226     * .and.dsst(jnr+1,ntem).ne.0.0) then
227     sst2(jnr,ntem)=sst1(jnr,ntem)+0.5*dsst(jnr+1,ntem)
228     sst2(jnr-1,ntem)=sst1(jnr-1,ntem)+0.25*dsst(jnr+1,ntem)
229     endif
230     563 continue
231     562 continue
232     do 663 J=1,JM
233     do 664 ntem=1,3
234     ITEM=intem(ntem)
235     ODATA(1,J,ITEM)=sst2(J,ntem)
236     664 continue
237     663 continue
238     if(JDATE.eq.46)then
239     print *,' after'
240     do 557 M=1,5
241     print *,' '
242     print *,' ODATA ',M
243     print *,(ODATA(1,J,M),J=1,JM)
244     557 continue
245     endif
246     C
247     go to 955
248     950 continue
249     if(ifirst.eq.1)then
250     print *,' Adjustment of SST and sea ice is skiped'
251     print *,' Adjustment of SST and sea ice is skiped'
252     print *,' Adjustment of SST and sea ice is skiped'
253     ifirst=0
254     endif
255     955 continue
256     if(ifirst.eq.1)then
257     print *,' With adjustment of SST and sea ice '
258     print *,' With adjustment of SST and sea ice '
259     print *,' With adjustment of SST and sea ice '
260     ifirst=0
261     endif
262     c JDAY=JDSAVE 1088.93
263     c JDATE=JDATES 1088.94
264     c MONTH=MONSAV 1088.95
265     C**** WHEN TGO IS NOT DEFINED, MAKE IT A REASONALBE VALUE 1089.
266     DO 426 J=1,JM 1090.
267     DO 426 I=1,IO 1091.
268     IF(ODATA(I,J,1).LT.-10.) ODATA(I,J,1)=-10. 1092.
269     426 CONTINUE 1093.
270     C**** REDUCE THE RATIO OF OCEAN ICE TO WATER BY .1*RHOI/ACEOI 1094.
271     DO 490 J=1,JM 1095.
272     DO 490 I=1,IO 1096.
273     IF(ODATA(I,J,2).LE.0.) GO TO 490 1097.
274     BYZICE=RHOI/(Z1I*RHOI+ODATA(I,J,3)) 1097.1
275     ODATA(I,J,2)=ODATA(I,J,2)*(1.-.06*(BYZICE-1./5.)) 1098.
276     490 CONTINUE 1099.
277     C**** ZERO OUT SNOWOI, TG1OI, TG2OI AND ACE2OI IF THERE IS NO OCEAN ICE 1100.
278     DO 620 J=1,JM 1101.
279     DO 620 I=1,IO 1102.
280     IF(ODATA(I,J,2).GT.0.) GO TO 620 1103.
281     GDATA(I,J,1)=0. 1104.
282     GDATA(I,J,3)=0. 1105.
283     GDATA(I,J,7)=0. 1106.
284     620 CONTINUE 1107.
285     RETURN 1108.
286     C**** 1108.01
287     C**** CALCULATE DAILY OCEAN MIXED LAYER DEPTHS FROM CLIMATOLOGY 1108.02
288     C**** 1108.03
289     C**** SAVE PREVIOUS DAY'S MIXED LAYER DEPTH IN WORK2 1108.04
290     500 DO 510 J=1,JM 1108.05
291     DO 510 I=1,IO 1108.06
292     ZMLOLD(I,J)=Z1O(I,J)
293     510 Z1OOLD(I,J)=Z1O(I,J) 1108.07
294     C**** READ IN TWO MONTHS OF OCEAN DATA 1108.08
295     IF(JDAY.GE.16) GO TO 520 1108.09
296     MD=JDATE+15 1108.1
297     GO TO 530 1108.11
298     520 IF(JDAY.LE.350) GO TO 550 1108.12
299     MD=JDATE-16 1108.13
300     530 READ (515) M,XZO,XOI,XZO,XZO 1108.14
301     MDMAX=31 1108.15
302     DO 540 MX=1,10 1108.16
303     540 READ (515) M 1108.17
304     READ (515) M,Z1O,OI,Z1O,Z1O 1108.18
305     GO TO 600 1108.19
306     550 DO 560 MX=1,12 1108.2
307     READ (515) M,Z1O,OI,Z1O,Z1O 1108.21
308     IF(M.EQ.MONTH) GO TO 570 1108.22
309     IF(M+1.EQ.MONTH.AND.JDATE.LT.16) GO TO 580 1108.23
310     560 CONTINUE 1108.24
311     STOP 2 1108.25
312     570 IF(JDATE.EQ.16) GO TO 625 1108.26
313     MDMAX=JDOFM(MONTH+1)-JDOFM(MONTH) 1108.27
314     MD=JDATE-16 1108.28
315     GO TO 590 1108.29
316     580 MDMAX=JDOFM(MONTH)-JDOFM(MONTH-1) 1108.3
317     MD=MDMAX+JDATE-16 1108.31
318     590 READ (515) M,XZO,XOI,XZO,XZO 1108.32
319     C**** INTERPOLATE OCEAN DATA TO CURRENT DAY 1108.33
320     600 X1=FLOAT(MDMAX-MD)/MDMAX 1108.34
321     X2=1.-X1 1108.35
322     DO 610 J=1,JM 1108.36
323     DO 610 I=1,IO 1108.37
324     OI(I,J)=X1*OI(I,J)+X2*XOI(I,J) 1108.371
325     IF(OI(I,J).GT.0.) OI(I,J)=OI(I,J)* 1108.373
326     * (1.-.1*RHOI/(Z1I*RHOI+ODATA(I,J,3))) 1108.374
327     Z1O(I,J)=X1*Z1O(I,J)+X2*XZO(I,J) 1108.38
328     Z1OMIN=.09166+.001*(GDATA(I,J,1)+ODATA(I,J,3)) 1108.39
329     IF(Z1O(I,J).LT.Z1OMIN) Z1O(I,J)=Z1OMIN 1108.391
330     IF(Z1OMIN.GT.Z12O(I,J)-.1) WRITE(6,605)I,J,MONTH,Z1OMIN,XZO(I,J) 1108.4
331     605 FORMAT (' OCEAN ICE CLOSE TO MLD AT I,J,MONTH',3I3,2F10.3) 1108.41
332     IF(Z1OMIN.GT.Z12O(I,J)-.1) STOP 8148 1108.42
333     610 CONTINUE 1108.43
334     625 REWIND 515 1108.44
335     DO 628 J=1,JM 1108.441
336     SUM1=0. 1108.442
337     CONT1=0. 1108.444
338     DO 626 I=1,IO 1108.445
339     C3OICE(I,J)=OI(I,J)*(1.-C3LAND(I,J)) 1108.446
340     PWATER=1.-C3LAND(I,J) 1108.447
341     IF(PWATER.LE.0.) GO TO 626 1108.448
342     CONT1=CONT1+PWATER 1108.449
343     SUM1=SUM1+Z1O(I,J)*PWATER 1108.45
344     626 CONTINUE 1108.452
345     IF(CONT1.LE.0.) GO TO 628 1108.453
346     IF(J.EQ.1.OR.J.EQ.JM) GO TO 628 1108.454
347     SUM1=SUM1/CONT1 1108.455
348     DO 627 I=1,IO 1108.457
349     Z1O(I,J)=SUM1 1108.458
350     627 CONTINUE 1108.459
351     628 CONTINUE 1108.46
352     DO 629 J=1,2 1108.461
353     DO 629 I=1,IO 1108.462
354     Z1O(I,J)=Z1O(I,3) 1108.463
355     629 CONTINUE 1108.464
356     C**** PREVENT Z1O, THE MIXED LAYER DEPTH, FROM EXCEEDING Z12O 1108.491
357     DO 630 J=1,JM 1108.492
358     DO 630 I=1,IO 1108.493
359     CCC Z1O(I,J)=ZOAV(J)
360     IF(Z1O(I,J).GT.Z12O(I,J)-.01) Z1O(I,J)=Z12O(I,J) 1108.494
361     630 CONTINUE 1108.495
362     c print *,' DAILY JDATE=',JDATE,' MONTH=',MONTH
363     c print *,'TSURFD'
364     c print *,TSURFD
365     c print *,'TSURFT'
366     c print *,TSURFT
367     do 725 j=1,JM
368 jscott 1.2 ! DTSURF(j)=TSURFD(j)-TSURFT(j)
369     DT2MGL(j)=TSURFD(j)-TSURFT(j)
370 jscott 1.1 TSURFD(j)=0.
371     725 continue
372     if(JDATE.le.16)then
373     do 723 j=1,JM
374     QFLUXT(j)=((16-JDATE)*QFLUX(j,MONTH-1)+
375     * (JDATE+15)*QFLUX(j,MONTH))/31.
376     TSURFT(j)=((16-JDATE)*TSURFC(j,MONTH-1)+
377     * (JDATE+15)*TSURFC(j,MONTH))/31.
378     723 continue
379     else
380     do 724 j=1,JM
381     QFLUXT(j)=((JDATE-16)*QFLUX(j,MONTH+1)+
382     * (31-JDATE+16)*QFLUX(j,MONTH))/31.
383     TSURFT(j)=((JDATE-16)*TSURFC(j,MONTH+1)+
384     * (31-JDATE+16)*TSURFC(j,MONTH))/31.
385     724 continue
386     endif
387     c print *,' NEW TSURFT'
388     c print *,TSURFT
389     RETURN 1108.5
390     C**** 1109.
391     901 FORMAT ('0PRESSURE ADDED IN GMP IS',F10.6/) 1114.
392     902 FORMAT ('0MEAN SURFACE PRESSURE OF THE ATMOSPHERE IS',F10.4) 1115.
393     910 FORMAT('1',33A4/) 1116.
394     915 FORMAT (47X,'DAY',I5,', HR',I3,' (',I2,A5,I5,')',F8.1) 1117.
395     920 FORMAT('1') 1118.
396     END 1119.

  ViewVC Help
Powered by ViewVC 1.1.22