subroutine rdatmo(iyr,imo,atmco2) c c Reads atmospheric forcing data. c #include "gloparam.F.h" #include "ogrid.F.h" #include "mapping.h" #include "oforce.F.h" #include "ostate.F.h" #include "param.h" #include "radpth.h" #include "definebio.h" #include "combarr.h" parameter(iorg=360,jorg=180) parameter(isal=360,jsal=180) real x(len) real sstdata(len),ssalt(len) common /binti1/ iw(len),iw2(len),jw(len),jw2(len) common /binti2/ ih(len),ih2(len),jh(len),jh2(len) common /binti3/ ihs(len),ih2s(len),jhs(len),jh2s(len) common /bintr1/ delxw(len),delyw(len),delxh(len),delyh(len) common /bintr2/ delxs(len),delys(len) common /borg1/ saltorg(isal,jsal,12) real tauxc,tauyc,swrc,sstc,pcec integer imm,jmm #if CLIMATOLOGY #if SPINUP common /bctau/ tauxc(iorg,jorg),tauyc(iorg,jorg) common /bcswr/ swrc(iorg,jorg) common /bcsst/ sstc(iorg,jorg) common /bcice/ pcec(iorg,jorg) #else common /bctau/ tauxc(iorg,jorg,12),tauyc(iorg,jorg,12) common /bcswr/ swrc(iorg,jorg,12) common /bcsst/ sstc(iorg,jorg,12) common /bcice/ pcec(iorg,jorg,12) #endif #else common /bctau/ tauxc(iorg,jorg),tauyc(iorg,jorg) common /bcswr/ swrc(iorg,jorg) common /bcsst/ sstc(iorg,jorg) common /bcice/ pcec(iorg,jorg) common /bctau1/ tauxc1(iorg,jorg),tauyc1(iorg,jorg) common /bcswr1/ swrc1(iorg,jorg) common /bcsst1/ sstc1(iorg,jorg) common /bcice1/ pcec1(iorg,jorg) common /bctau2/ tauxc2(iorg,jorg,12),tauyc2(iorg,jorg,12) common /bcswr2/ swrc2(iorg,jorg,12) common /bcsst2/ sstc2(iorg,jorg,12) common /bcice2/ pcec2(iorg,jorg,12) common /bctau3/ tauxc3(iorg,jorg),tauyc3(iorg,jorg) common /bcswr3/ swrc3(iorg,jorg) common /bcsst3/ sstc3(iorg,jorg) common /bcice3/ pcec3(iorg,jorg) #endif real co2mon(32,12) !32 years 1979-2010, 12 months common /bicec/ picec(len) common /bfe/ atmFeorg(iorg,jorg) common /bwsplp/ wspdorg(iorg,jorg),slporg(iorg,jorg) data flag /-0.9E10/ data flag2 /999.0E9/ c c Initialize do i = 1,len x(i) = 0.0 !placeholder for Ufric ocn_taux(i) = 0.0 !wind stress x (N/m2) ocn_tauy(i) = 0.0 !wind stress y (N/m2) sstdata(i) = 0.0 !SST (deg. C) ssalt(i) = 0.0 !salinity from Levitus (ppt) ocn_Wev(i) = 0.0 !evaporation rate (kg/m2/s) ocn_Wrp(i) = 0.0 !precipitation as rainfall (kg/m2/s) ocn_Wsp(i) = 0.0 !precipitation as snowfall (kg/m2/s) Woc(i) = 0.0 !surface mass flux (kg/m2/s) ocn_Trp(i) = 0.0 !temp. of rainfall Fso(i) = 0.0 !surface salt flux (g/m2/s) ocn_Qao(i) = 0.0 !surface heat flux (W/m2) positive up ocn_dQao(i) = 0.0 !partial of Q wrt surface temp.(W/m2/s) ocn_qao_Tref(i) = 0.0 !temp at which Qao was evaluated (deg. C) ocn_Qrad(i) = 0.0 !net shortwave radiation (W/m2) Qrad_net(i) = 0.0 !net shortwave radiation (W/m2) Qsfc(i) = 0.0 !total surface heat flux Qoc(i) = 0.0 !surface flux modified by evap/precip ocn_Ufric(i) = 0.0 !surface friction U3(i) = 0.0 !surface friction cubed picec(i) = 0.0 !ice fraction atmFe(i) = 0.0 !atmospheric iron deposition wspd(i) = 0.0 !wind speed (m/s) slp(i) = 0.0 !surface pressure (mb) pnoice(i) = 0.0 !biological activity indicator in ice enddo c File name open(3,file='salt',status='old',form='unformatted') c Read data and place into correct fields do imt = 1,12 read(3)ahead read(3)((saltorg(i,j,imt),i=1,isal),j=1,jsal) enddo close(3) open(2,file='atmfe.dat',status='old',form='unformatted') read(2)atmFeorg close(2) #if CLIMATOLOGY atmco2 = 368.6 !uatm for year 2000 #else open(21,file='bcs/co2mon.dat',status='old',form='formatted') read(21,*)co2mon close(21) iiyr = (iyr-1979) + 1 atmco2 = co2mon(iiyr,imo) write(6,*)'iyr,atmco2 = ',iyr,atmco2 #endif open(1,file='wspd.dat',status='old',form='unformatted') read(1)iwspd,jwspd do imt = 1,imo read(1)wspdorg,slporg enddo close(1) write(6,*)'Using CDC monthly forcing data for month ',imo open(4,file='cdc2.dat',status='old',form='unformatted') read(4)imm,jmm #if CLIMATOLOGY #if SPINUP do imon = 1,imo read(4)tauxc,tauyc,swrc,sstc,pcec enddo #else do imon = 1,12 read(4)((tauxc(i,j,imon),i=1,iorg),j=1,jorg), * ((tauyc(i,j,imon),i=1,iorg),j=1,jorg), * ((swrc(i,j,imon),i=1,iorg),j=1,jorg), * ((sstc(i,j,imon),i=1,iorg),j=1,jorg), * ((pcec(i,j,imon),i=1,iorg),j=1,jorg) enddo #endif #else do imon = 1,12 read(4)((tauxc2(i,j,imon),i=1,iorg),j=1,jorg), * ((tauyc2(i,j,imon),i=1,iorg),j=1,jorg), * ((swrc2(i,j,imon),i=1,iorg),j=1,jorg), * ((sstc2(i,j,imon),i=1,iorg),j=1,jorg), * ((pcec2(i,j,imon),i=1,iorg),j=1,jorg) enddo open(3,file='cdc1.dat',status='old',form='unformatted') read(3)imm,jmm do imon = 1,12 read(3)((tauxc1(i,j),i=1,iorg),j=1,jorg), * ((tauyc1(i,j),i=1,iorg),j=1,jorg), * ((swrc1(i,j),i=1,iorg),j=1,jorg), * ((sstc1(i,j),i=1,iorg),j=1,jorg), * ((pcec1(i,j),i=1,iorg),j=1,jorg) enddo close(3) open(3,file='cdc3.dat',status='old',form='unformatted') read(3)imm,jmm do imon = 1,12 read(3)((tauxc3(i,j),i=1,iorg),j=1,jorg), * ((tauyc3(i,j),i=1,iorg),j=1,jorg), * ((swrc3(i,j),i=1,iorg),j=1,jorg), * ((sstc3(i,j),i=1,iorg),j=1,jorg), * ((pcec3(i,j),i=1,iorg),j=1,jorg) enddo close(3) close(4) #endif c c Get better lon/lat indicators nw = 0 alat1e = alat0 - dlat alat1h = alat0 - 0.5*dlat do j = 1,jm alat1e = alat1e + dlat alat1h = alat1h + dlat alon1e = along0 - dlong alon1h = along0 - 0.5*dlong do i = 1,im alon1e = alon1e + dlong alon1h = alon1h + dlong if (Depth(i,j) .gt. 200.0)then nw = nw+1 oc_lon_ne(nw) = alon1e oc_lat_ne(nw) = alat1e oc_lon(nw) = alon1h oc_lat(nw) = alat1h endif enddo enddo c c Get space interpolation factors dx0 = 1.0 dy0 = 1.0 x0 = -180.0 + 0.5*dx0 y0 = -90.0 + 0.5*dy0 #if CLIMATOLOGY call alignocn(nwater,iorg,jorg,tauxc,oc_lon_ne, *oc_lat_ne,dx0,dy0,x0,y0,iw,iw2,jw,jw2,delxw,delyw) call alignocn(nwater,iorg,jorg,sstc,oc_lon, *oc_lat,dx0,dy0,x0,y0,ih,ih2,jh,jh2,delxh,delyh) #else call alignocn(nwater,iorg,jorg,tauxc2(1,1,imo),oc_lon_ne, *oc_lat_ne,dx0,dy0,x0,y0,iw,iw2,jw,jw2,delxw,delyw) call alignocn(nwater,iorg,jorg,sstc2(1,1,imo),oc_lon, *oc_lat,dx0,dy0,x0,y0,ih,ih2,jh,jh2,delxh,delyh) #endif dx0 = 1.0 dy0 = 1.0 x0 = 0.0 + 0.5*dx0 y0 = -90.0 + 0.5*dy0 call alignocn(nwater,isal,jsal,saltorg(1,1,1),oc_lon, *oc_lat,dx0,dy0,x0,y0,ihs,ih2s,jhs,jh2s,delxs,delys) c return end