/[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.1 - (hide annotations) (download)
Fri Aug 11 19:35:30 2006 UTC (18 years, 11 months ago) by jscott
Branch: MAIN
atm2d package

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

  ViewVC Help
Powered by ViewVC 1.1.22