C**** OIJ070.FOR Make Ocean IxJ File of Diagnostics 2001/02/16 C**** C**** Compile: FCE OIJ070.FOR C**** C**** OIJ070 reads Climate Model restartfiles, calculates diagnostic C**** quantities from the accumulating array OIJL, and writes scaled C**** data to an output disk file. Each record of the output file C**** has the format: TITLE(80),Q(IM,JM) . C**** INCLUDE '/u/cmrun/C070.COM' PARAMETER (KDINT = 15 + 1 + 4 + 2*4 + 42*50, * KAIJ0 = JM*KAJ*6 + JM*LMA*KAJL + JM*3*4, * KOIJL0= KAIJ0 + IM*JM*KAIJ + IM*JM*LMA*KAIJL, * KOLNS0= KOIJL0 + IM*JM*LMO*KOIJL, * KDACC = KOLNS0 + LMO*NMST*KOLNST + 24*50*4 + JM*KCON) INTEGER*4 IPARM(300),IDIAG(KDINT) REAL*4 DIAGR4(KDACC) EQUIVALENCE (IPARM,IM$) C**** INTEGER*4 KVMF(LMO),KCMF(LMO),KVDC(LMO), * LMINT,LMAXT, LMINMF,LMAXMF, LMINEF,LMAXEF, LMINSF,LMAXSF LOGICAL*4 QHSO,QTSO,QSSO, QMO,QMOSI,QMS, QMLAK, QCOHT, QTO, * QL(KOIJL), QMFEW,QMFNS, QEFEW,QEFNS, QSFEW,QSFNS CHARACTER NAME*50,NAMEL*50, FILEIN*80,TITLE*80, OUTYR*4,OUTMON*4 COMMON Q(IM,JM) COMMON /OFUNCB/ VGSP(-2:40,0:40,0:39),TGS(-2:40,0:40) COMMON /NAMECB/ NAME(8),NAMEL(KOIJL) EQUIVALENCE (QMFEW,QL(2)),(QMFNS,QL(3)),(QEFEW,QL(6)), * (QEFNS,QL(7)),(QSFEW,QL(10)),(QSFNS,QL(11)) C**** NAMELIST /INPUTZ/ QHSO,QTSO,QSSO, QMO,QMOSI,QMS, QMLAK, QCOHT,QTO, * KVMF,KCMF,KVDC, QMFEW, QMFNS, QEFEW, QEFNS, QSFEW, QSFNS, * LMINT,LMAXT, LMINMF,LMAXMF, LMINEF,LMAXEF, LMINSF,LMAXSF DATA KVMF/LMO*0/, KCMF/LMO*0/, KVDC/LMO*0/, LMINT,LMAXT/1,LMO/, * LMINMF,LMAXMF/1,LMO/, LMINEF,LMAXEF/1,LMO/, LMINSF,LMAXSF/1,LMO/ C**** NARGS = IARGC() IF(NARGS.le.0) GO TO 800 C**** C**** Determine output quantities from Namelist input file C**** FILEIN = 'OIJ070.I ' OPEN (5,FILE=FILEIN,STATUS='OLD',ERR=810) READ (5,INPUTZ) CLOSE (5) OPEN (6,FILE='OIJ070.PRT') C**** C**** Read in Ocean Function Tables C**** FILEIN = '/u/cmrun/OFTABLE' OPEN (22,FILE=FILEIN,FORM='UNFORMATTED',STATUS='OLD',ERR=810) READ (22) TITLE,VGSP WRITE (6,*) 'Read from unit 22: ',TITLE READ (22) TITLE,TGS WRITE (6,*) 'Read from unit 22: ',TITLE CLOSE (22) C**** C**** Read in FOCEAN C**** FILEIN = '/u/cmrun/Z72X46N' OPEN (11,FILE=FILEIN,FORM='UNFORMATTED',STATUS='OLD',ERR=810) CALL READR4 (11,IM*JM,FOCEAN,FOCEAN) CLOSE (11) C**** C**** Zero out summing arrays C**** DO 10 N=1,15 10 IDACC(N) = 0 DO 20 I=1,IM*JM AIJ(I,1,16) = 0. 20 AIJ(I,1,29) = 0. DO 30 I=1,IM*JM*LMO*KOIJL 30 OIJL(I,1,1,1) = 0. DO 40 L=1,LMO*NMST*3 40 OLNST(L,1,1) = 0. C**** C**** Loop over the input disk files C**** KFILE=0 100 KFILE=KFILE+1 IF(KFILE.gt.NARGS) GO TO 200 CALL GETARG (KFILE,FILEIN) C**** Open and read input file OPEN (1,FILE=FILEIN,FORM='UNFORMATTED',STATUS='OLD',ERR=810) READ (1) IHOURX,LABEL,IPARM,IDIAG,DIAGR4,IHOURY CLOSE (1) IF(IHOURX.ne.IHOURY) GO TO 820 CALL STORYM (JYEAR0,JMON0, JYEAR,JMON) WRITE (6,911) JYEAR0,JMON0, JYEAR,JMON, FILEIN(1:60) C**** Accumulate diagnostics for time averaging, DO 110 N=1,15 110 IDACC(N) = IDACC(N) + IDIAG(N) DO 120 I=1,IM*JM AIJ(I,1,16) = AIJ(I,1,16) + DIAGR4(KAIJ0+IM*JM*15+I) 120 AIJ(I,1,29) = AIJ(I,1,29) + DIAGR4(KAIJ0+IM*JM*28+I) DO 130 I=1,IM*JM*LMO*KOIJL 130 OIJL(I,1,1,1) = OIJL(I,1,1,1) + DIAGR4(KOIJL0+I) DO 140 L=1,LMO*NMST*3 140 OLNST(L,1,1) = OLNST(L,1,1) + DIAGR4(KOLNS0+L) GO TO 100 C**** C**** End of input files: print table of input years and months C**** 200 CALL PRNTYM (OUTYR,OUTMON) CALL SGEOM OPEN (2,FILE='OIJ070.O',FORM='UNFORMATTED') C**** C**** Ocean Surface Height (cm) C**** IF(.not.QHSO) GO TO 220 RHOW = 1000. DO 211 I=1,IM*(JM-1)+1 Q(I,1) = -999999. IF(FOCEAN(I,1).le..5) GO TO 211 Q(I,1) = 1.e2*(AIJ(I,1,29)/GRAV + AIJ(I,1,16)/RHOW) / IDACC(1) 211 continue CALL WRITED (NAME(1),LABEL,OUTMON,OUTYR) C**** C**** Ocean Surface Temperature (C) C**** 220 IF(.not.QTSO) GO TO 230 DO 221 J=1,JM DO 221 I=1,IM Q(I,J) = -999999. IF(FOCEAN(I,J).le..5) GO TO 221 GOS = OIJL(I,J,1,5) / (OIJL(I,J,1,1)*DXYP(J)) SOS = OIJL(I,J,1,9) / (OIJL(I,J,1,1)*DXYP(J)) Q(I,J) = TEMGS(GOS,SOS) 221 continue CALL WRITED (NAME(2),LABEL,OUTMON,OUTYR) C**** C**** Ocean Surface Salinity (per mil) C**** 230 IF(.not.QSSO) GO TO 240 DO 231 J=1,JM DO 231 I=1,IM Q(I,J) = -999999. IF(FOCEAN(I,J).le..5) GO TO 231 Q(I,J) = 1.e3*OIJL(I,J,1,9) / (OIJL(I,J,1,1)*DXYP(J)) 231 continue CALL WRITED (NAME(3),LABEL,OUTMON,OUTYR) C**** C**** Ocean Column Mass (1000 kg/m^2) C**** 240 IF(.not.QMO) GO TO 250 DO 242 I=1,IM*(JM-1)+1 Q(I,1) = 0. IF(FOCEAN(I,1).le..5) GO TO 242 DO 241 L=1,LMO 241 Q(I,1) = Q(I,1) + OIJL(I,1,L,1) Q(I,1) = Q(I,1)*1.d-3/IDACC(5) 242 continue CALL WRITED (NAME(4),LABEL,OUTMON,OUTYR) C**** C**** Ocean Column and Sea Ice Mass (1000 kg/m^2) C**** 250 IF(.not.QMOSI) GO TO 260 DO 252 I=1,IM*(JM-1)+1 Q(I,1) = 0. IF(FOCEAN(I,1).le..5) GO TO 252 DO 251 L=1,LMO 251 Q(I,1) = Q(I,1) + OIJL(I,1,L,1) Q(I,1) = (Q(I,1)/IDACC(5) + AIJ(I,1,16)/IDACC(1)) * 1.d-3 252 continue CALL WRITED (NAME(5),LABEL,OUTMON,OUTYR) C**** C**** Ocean Column Salt (1000 kg/m^2) C**** 260 IF(.not.QMS) GO TO 270 DO 262 J=1,JM DO 262 I=1,IM Q(I,J) = 0. IF(FOCEAN(I,J).le..5) GO TO 262 DO 261 L=1,LMO 261 Q(I,J) = Q(I,J) + OIJL(I,J,L,9) Q(I,J) = Q(I,J)*1.d-3 / (IDACC(5)*DXYP(J)) 262 continue CALL WRITED (NAME(6),LABEL,OUTMON,OUTYR) C**** C**** Lake Mass (kg/m^2) C**** 270 IF(.not.QMLAK) GO TO 280 DO 272 J=1,JM DO 272 I=1,IM Q(I,J) = 0. IF(FOCEAN(I,J).gt..5) GO TO 272 DO 271 L=1,LMO 271 Q(I,J) = Q(I,J) + OIJL(I,J,L,1) Q(I,J) = Q(I,J) / (IDACC(5)*DXYP(J)) 272 continue CALL WRITED (NAME(7),LABEL,OUTMON,OUTYR) C**** C**** Converged Ocean Heat Transport (J/m^2) C**** 280 IF(.not.QCOHT) GO TO 290 IM1 = IM DO 282 J=2,JM-1 DO 282 I=1,IM Q(I,J) = 0. DO 281 L=1,LMO 281 Q(I,J) = Q(I,J) + (OIJL(IM1,J,L,6)-OIJL(I,J,L,6) + + OIJL(I,J-1,L,7)-OIJL(I,J,L,7)) Q(I,J) = Q(I,J) / (IDACC(1)*DTS*DXYP(J)) 282 IM1=I Q(1,1) = 0. Q(1,JM) = 0. DO 283 I=1,IM DO 283 L=1,LMO 283 Q(1,JM) = Q(1,JM) + OIJL(I,JM-1,L,7) Q(1,JM) = Q(1,JM) / (IDACC(1)*DTS*DXYP(JM)*IM) DO 285 N=1,NMST EFST = 0. DO 284 L=1,LMST(N) 284 EFST = EFST + OLNST(L,N,2) Q(IST(N,1),JST(N,1)) = Q(IST(N,1),JST(N,1)) + - EFST / (IDACC(1)*DTS*2.*DXYP(JST(N,1))) 285 Q(IST(N,2),JST(N,2)) = Q(IST(N,2),JST(N,2)) + + EFST / (IDACC(1)*DTS*2.*DXYP(JST(N,2))) CALL WRITED (NAME(8),LABEL,OUTMON,OUTYR) C**** C**** Ocean Potential Temperature (C) C**** 290 IF(.not.QTO) GO TO 300 DO 293 J=1,JM DO 293 I=1,IM Q(I,J) = -999999. IF(FOCEAN(I,J).le..5) GO TO 293 SOM = 0. SOMT = 0. DO 291 L=LMINT,LMAXT IF(OIJL(I,J,L,1).le.0.) GO TO 292 GO = OIJL(I,J,L,5) / (OIJL(I,J,L,1)*DXYP(J)) SO = OIJL(I,J,L,9) / (OIJL(I,J,L,1)*DXYP(J)) SOM = SOM + OIJL(I,J,L,1) 291 SOMT = SOMT + OIJL(I,J,L,1)*TEMGS(GO,SO) 292 IF(SOM.gt.0.) Q(I,J) = SOMT/SOM 293 continue IF(LMINT.eq.LMAXT) WRITE (NAMEL(5)(39:41),933) LMINT IF(LMINT.lt.LMAXT) WRITE (NAMEL(5)(39:47),934) LMINT,LMAXT CALL WRITED (NAMEL(5),LABEL,OUTMON,OUTYR) C**** C**** East-West or North-South Mass Flux (10^9 kg/s) C**** 300 DO 340 K=2,3 IF(.not.QL(K)) GO TO 340 DO 310 I=1,IM*JM 310 Q(I,1) = 0. DO 330 I=1,IM*(JM-1) DO 320 L=LMINMF,LMAXMF 320 Q(I,1) = Q(I,1) + OIJL(I,1,L,K) 330 Q(I,1) = 2.D-6*Q(I,1) / (IDACC(1)*NDYNO) IF(LMINMF.eq.LMAXMF) WRITE (NAMEL(K)(41:43),933) LMINMF IF(LMINMF.lt.LMAXMF) WRITE (NAMEL(K)(41:49),934) LMINMF,LMAXMF CALL WRITED (NAMEL(K),LABEL,OUTMON,OUTYR) 340 continue C**** C**** Vertical Mass Flux (10^-2 kg/s*mý) C**** DO 370 K=1,LMO IF(KVMF(K).le.0) GO TO 370 L =KVMF(K) DO 360 J=1,JM IMAX=IM IF(J.eq.1 .or. J.eq.JM) IMAX=1 DO 360 I=1,IMAX 360 Q(I,J) = 2.e2*OIJL(I,J,L,4) / (IDACC(1)*NDYNO*DXYP(J)) WRITE (NAMEL(4)(43:45),933) L CALL WRITED (NAMEL(4),LABEL,OUTMON,OUTYR) 370 continue C**** C**** East-West or North-South Heat Flux (10^15 W) C**** DO 440 K=6,7 IF(.not.QL(K)) GO TO 440 DO 410 I=1,IM*JM 410 Q(I,1) = 0. DO 430 I=1,IM*(JM-1) DO 420 L=LMINEF,LMAXEF 420 Q(I,1) = Q(I,1) + OIJL(I,1,L,K) 430 Q(I,1) = 1.D-15*Q(I,1) / (IDACC(1)*DTS) IF(LMINEF.eq.LMAXEF) WRITE (NAMEL(K)(39:41),933) LMINEF IF(LMINEF.lt.LMAXEF) WRITE (NAMEL(K)(39:47),934) LMINEF,LMAXEF CALL WRITED (NAMEL(K),LABEL,OUTMON,OUTYR) 440 continue C**** C**** East-West or North-South Salt Flux (10^6 kg/s) C**** DO 540 K=10,11 IF(.not.QL(K)) GO TO 540 DO 510 I=1,IM*JM 510 Q(I,1) = 0. DO 530 I=1,IM*(JM-1) DO 520 L=LMINSF,LMAXSF 520 Q(I,1) = Q(I,1) + OIJL(I,1,L,K) 530 Q(I,1) = 1.D-6*Q(I,1) / (IDACC(1)*DTS) IF(LMINSF.eq.LMAXSF) WRITE (NAMEL(K)(41:43),933) LMINSF IF(LMINSF.lt.LMAXSF) WRITE (NAMEL(K)(41:49),934) LMINSF,LMAXSF CALL WRITED (NAMEL(K),LABEL,OUTMON,OUTYR) 540 continue C**** C**** Convective Mass Flux (10^-2 kg/s*m^2) C**** DO 620 K=1,LMO IF(KCMF(K).le.0) GO TO 620 L =KCMF(K) DO 610 J=1,JM IMAX=IM IF(J.eq.1 .or. J.eq.JM) IMAX=1 DO 610 I=1,IMAX 610 Q(I,J) = 1.e2*OIJL(I,J,L,13) / (IDACC(1)*DTS*DXYP(J)) WRITE (NAMEL(13)(44:46),933) L CALL WRITED (NAMEL(13),LABEL,OUTMON,OUTYR) 620 continue C**** C**** Vertical Diffusion Coefficient (cmý/s) C**** DO 720 K=1,LMO IF(KVDC(K).le.0) GO TO 720 L =KVDC(K) DO 710 I=IM+1,IM*(JM-1)+1 710 Q(I,1) = 1.e4*.00097*.00097*OIJL(I,1,L,14) / (IDACC(1)*4.) WRITE (NAMEL(14)(45:47),933) L CALL WRITED (NAMEL(14),LABEL,OUTMON,OUTYR) 720 continue CLOSE (2) CLOSE (6) GO TO 999 C**** 800 WRITE (0,*) 'Usage: OIJ070 /raid1/C070/DJa* ', * 'make Ocean IxJ data files' WRITE (0,*) 'Check the input file: OIJ070.I 2000/07/31' GO TO 999 810 WRITE (0,*) 'Error accessing ',FILEIN STOP 810 820 WRITE (0,*) 'IHOURX and IHOURY do not match:',IHOURX,IHOURY STOP 820 C**** 911 FORMAT (' From',I6,A6,'to',I6,A6,' FILEIN= ',A) 933 FORMAT (I3) 934 FORMAT ('s',I3,' -',I3) 999 END SUBROUTINE SGEOM IMPLICIT REAL*8 (A-H,M,O-Z) PARAMETER (IM=72,JM=46, * TWOPI=6.283185307179586477d0, RADIUS=6375000.) COMMON /GEOMCB/ DXYP(JM),DXP(JM),DYP(JM),DXV(JM) C**** C**** Calculates the spherical geometry for the C grid C**** DLON = TWOPI/IM DLAT = TWOPI*NINT(360./(JM-1))/720. FJEQ = .5*(1+JM) C**** Geometric parameters centered at secondary latitudes PLATS = -TWOPI/4. PSINS = SIN(PLATS) DO 10 J=1,JM-1 PLATN = DLAT*(J+1.-FJEQ) IF(J.eq.JM-1) PLATN = TWOPI/4. PSINN = SIN(PLATN) DXV(J) = DLON*RADIUS*(PSINN-PSINS) / (PLATN-PLATS) PLATS = PLATN 10 PSINS = PSINN C**** Geometric parameters centered at primary latitudes VLATS = -TWOPI/4. VSINS = SIN(VLATS) DO 20 J=1,JM VLATN = DLAT*(J+.5-FJEQ) IF(J.eq.JM) VLATN = TWOPI/4. VSINN = SIN(VLATN) DXYP(J)= DLON*RADIUS*RADIUS*(VSINN-VSINS) DXP(J) =.5*(DXV(J-1)+DXV(J)) DYP(J) = (VLATN-VLATS)*RADIUS VLATS = VLATN 20 VSINS = VSINN RETURN END SUBROUTINE STORYM (JYEAR0,JMON0, JYEAR,JMON) C**** C**** STORYM receives years and months and stores them in an array. C**** C**** Start of accumulation period: JYEAR0, JMON0, day 1, hour 0 C**** End of accumulation period: JYEAR, JMON, day 1, hour 0 C**** INTEGER*4 NYofM(12) CHARACTER*1 QMY(12,0:2500) CHARACTER*4 JMON0,JMON, MON(12), OUTYR,OUTMON DATA QMY /30012*' '/, NYofM/12*0/, MINYR/2501/, MAXYR/-1/ DATA MON /'Jan','Feb','Mar','Apr','May','Jun', * 'Jul','Aug','Sep','Oct','Nov','Dec'/ C**** IF(JMON0.eq.'Ann ') JMON0 = 'Jan ' ! compatible with prior vers IF(JYEAR0.gt.2500) JYEAR0 = 1900 + JYEAR0/100 DO 10 I=1,12 10 IF(JMON0.eq.MON(I)) GO TO 20 WRITE (6,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON0 is not a month.' WRITE (0,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON0 is not a month.' STOP 10 20 IMON0 = I DO 30 I=1,12 30 IF(JMON.eq.MON(I)) GO TO 40 WRITE (6,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON is not a month.' WRITE (0,901) JYEAR0,JMON0, JYEAR,JMON, 'JMON is not a month.' STOP 30 40 IMON = I IF(IMON.gt.IMON0) then IMON = IMON-1 IYEAR = JYEAR else IMON = IMON+11 IYEAR = JYEAR-1 endif C**** DO 50 IY=JYEAR0,IYEAR DO 50 IM=IMON0 ,IMON IF(QMY(IM,IY).eq.'*') GO TO 805 QMY(IM,IY) = '*' JM = 1 + MOD(IM-1,12) NYofM(JM) = NYofM(JM) + 1 IF(JYEAR0.lt.MINYR) MINYR = JYEAR0 50 IF(JYEAR .gt.MAXYR) MAXYR = JYEAR RETURN C**** C**** C**** ENTRY PRNTYM (OUTYR,OUTMON) C**** C**** PRNTYM prints a table of input years and month, and C**** calculates OUTYR and OUTMON C**** C**** Output: OUTYR = character describing input years C**** OUTMON = character describing input months C**** C**** Produce printer table of months and years received C**** WRITE (6,910) DO 110 IY=MINYR,MAXYR 110 WRITE (6,911) IY,(QMY(IM,IY),IM=1,12) C**** C**** Determine output month: a single month, three months, or an annual C**** DO 210 M=1,12 210 IF(NYofM(M).gt.0) GO TO 220 GO TO 800 C**** Is output month a single month ? 220 M1 = M DO 230 M=M1+1,12 230 IF(NYofM(M).gt.0) GO TO 240 OUTMON = MON(M1) GO TO 400 C**** Is output twelve months ? 240 IF(M1.ne.1) GO TO 260 DO 250 M=2,12 250 IF(NYofM(M).ne.NYofM(M1)) GO TO 260 OUTMON = 'Ann ' GO TO 400 C**** Is output month three consecutive months ? 260 IF(M1.ge.11) GO TO 800 IF(NYofM(M1+1).ne.NYofM(M1)) GO TO 280 IF(NYofM(M1+2).ne.NYofM(M1)) GO TO 300 DO 270 M=M1+3,12 270 IF(NYofM(M).ne.0) GO TO 800 OUTMON = MON(M1)(1:1) // MON(M1+1)(1:1) // MON(M1+2)(1:1) // ' ' GO TO 400 C**** Is output 3 months November, December and January ? 280 IF(NYofM(11).ne.NYofM(1) .or. NYofM(12).ne.NYofM(1)) GO TO 800 DO 290 M=2,10 290 IF(NYofM(M).ne.0) GO TO 800 OUTMON = 'NDJ ' GO TO 400 C**** Is output 3 months December, January and February ? 300 IF(NYofM(12).ne.NYofM(1) .or. NYofM(2).ne.NYofM(1)) GO TO 800 DO 310 M=3,11 310 IF(NYofM(M).ne.0) GO TO 800 OUTMON = 'DJF ' C**** C**** Calculate the first and last years received, C**** and determine a character string describing those years C**** 400 MAXYR = MINYR + NYofM(M1) - 1 WRITE (OUTYR,940) MINYR IF(MINYR.lt.MAXYR) * WRITE (OUTYR,941) MOD(MINYR,100),MOD(MAXYR,100) IF(MINYR+8.le.MAXYR .and. MINYR/10.eq.MAXYR/10) * WRITE (OUTYR,942) MINYR/10 WRITE (6,943) OUTYR,OUTMON RETURN C**** 800 WRITE (6,*) 'From OIJ070: inconsistant year and months received' WRITE (0,*) 'From OIJ070: inconsistant year and months received' STOP 800 805 WRITE (6,901) JYEAR0,JMON0, JYEAR,JMON, 'accumulated already' WRITE (0,901) JYEAR0,JMON0, JYEAR,JMON, 'accumulated already' STOP 805 C**** 901 FORMAT (' From',I6,A5,' to',I6,A5,1X,A) 910 FORMAT ('0The following months and years were received:' / '0', * 9X,'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec') 911 FORMAT (1X,I6,21A5) 940 FORMAT (I4) 941 FORMAT (2I2.2) 942 FORMAT (I3,'X') 943 FORMAT ('0Description of the years and months above:',2A5) END SUBROUTINE WRITED (NAME,LABEL,OUTMON,OUTYR) C**** C**** Write a record to a data file whose format is: TITLE(80),A(IM,JM) C**** Input: NAME = name of quantity C**** LABEL = run number C**** OUTMON = character month C**** OUTYR = character year C**** PARAMETER (IM=72,JM=46) CHARACTER NAME*50,LABEL*5,OUTMON*4,OUTYR*4, TITLE*80 REAL*8 Q COMMON Q(IM,JM) C**** Replicate I=1 value to all longitudes at the poles DO 10 I=2,IM Q(I, 1) = Q(1, 1) 10 Q(I,JM) = Q(1,JM) C**** Build TITLE WRITE (TITLE,901) NAME,LABEL,OUTYR,OUTMON C**** Write record to disk WRITE (2) TITLE,(SNGL(Q(I,1)),I=1,IM*JM) WRITE (6,902) TITLE,(Q(IM/2+1,J),J=1,JM) RETURN C**** 901 FORMAT (A50,A5,9X,A4,1X,A3) 902 FORMAT ('0',A72/(12F11.3)) END SUBROUTINE READR4 (IUNIT,NM,DATAR4,DATAR8) C**** C**** READR4 reads a record from unit IUNIT containing TITLE,DATAR4, C**** converts the REAL*4 array DATAR4 to the REAL*8 array DATAR8, and C**** writes a line to unit 6 containing the TITLE just read. C**** REAL*4 DATAR4(NM) REAL*8 DATAR8(NM) CHARACTER*80 TITLE C**** READ (IUNIT) TITLE,DATAR4 DO 10 I=NM,1,-1 10 DATAR8(I) = DATAR4(I) WRITE (6,901) IUNIT,TITLE RETURN C**** 901 FORMAT (' Read on unit',I3,': ',A80) END BLOCK DATA C**** C**** Names of quantities C**** CHARACTER*50 NAME,NAMEL COMMON /NAMECB/ NAME(8),NAMEL(14) DATA NAME/ 1'OCEAN SURFACE HEIGHT (cm)', 2'OCEAN SURFACE TEMPERATURE (C)', 3'OCEAN SURFACE SALINITY (per mil)', 4'OCEAN COLUMN MASS (1000 kg/m^2)', 5'OCEAN COLUMN and SEA ICE MASS (1000 kg/m^2)', 6'OCEAN COLUMN SALT (1000 kg/m^2)', 7'LAKE MASS (kg/m^2)', 8'CONVERGED OCEAN HEAT TRANSPORT (W/m^2)'/ DATA NAMEL/ 1' ', 2'EAST-WEST MASS FLUX (10^6 kg/s), Layer 1', 3'NORTH-SOUTH MASS FLUX (10^6 kg/s), Layer 1', 4'VERTICAL MASS FLUX (10^-2 kg/s*m^2), Layer 1', 5'OCEAN POTENTIAL TEMPERATURE (C), Layer 1', 6'EAST-WEST HEAT FLUX (10^15 W), Layer 1', 7'NORTH-SOUTH HEAT FLUX (10^15 W), Layer 1', 8' ', 9' ', 1O'EAST-WEST SALT FLUX (10^6 kg/s), Layer 1', 11'NORTH-SOUTH SALT FLUX (10^6 kg/s), Layer 1', 12' ', 13'CONVECTV MASS FLUX (10^-2 kg/s*m^2), Layer 1', 14'VERTICAL DIFFUSION COEFFNT. (cm^2/s), Layer 1'/ END BLOCK DATA PARMBD C**** C**** Default parameters for model common block C**** INCLUDE '/u/cmrun/C070.COM' C**** C**** Strait From To LM Width C**** ------ ---- -- -- ----- C**** 1 Fury & Hecla 19,42 ES 20,40 WN 2 20000 C**** 2 Nares 22,43 EN 24,44 WS 5 30000 ! 50000 C**** 3 Gibraltar 35,32 EN 37,33 WS 5 25000 C**** 4 English 36,36 EN 37,37 WS 2 35000 C**** 5 Kattegat 38,38 EN 40,38 WS 2 60000 C**** 6 Bosporous 42,33 EN 43,34 WS 2 6000 C**** 7 Red Sea 44,29 ES 45,28 WN 6 250000 C**** 8 Bab al Mandab 45,28 ES 46,27 WN 6 25000 C**** 9 Hormuz 47,30 ES 49,29 WN 2 50000 C**** 10 Malacca 56,25 EN 58,24 WS 3 50000 C**** 11 Korea 62,32 EN 63,33 WS 4 170000 C**** 12 Soya-kaikyo 64,34 EN 65,35 WS 2 40000 C**** DATA IST /19, 22, 35, 36, 38, 42, 44, 45, 47, 56, 62, 64, * 20, 24, 37, 37, 40, 43, 45, 46, 49, 58, 63, 65/, * JST /42, 43, 32, 36, 38, 33, 29, 28, 30, 25, 32, 34, * 40, 44, 33, 37, 38, 34, 28, 27, 29, 24, 33, 35/, * LMST/ 2, 5, 5, 2, 2, 2, 6, 6, 2, 3, 4, 2/ END