module io use const use var use comm implicit real*8 (a-h,o-z) # include "pnetcdf.inc" ! integer(kind=mpi_offset_kind) nn,ns_kji,nc_kji,ns_tji,nc_tji,ns_ji,nc_ji,ns_1,nc_1,nf_kji ! dimension nn(6),ns_kji(3),nc_kji(3),ns_tji(3),nc_tji(3),ns_ji(2),nc_ji(2),ns_1,nc_1,nf_kji(3) ! integer(kind=mpi_offset_kind) ns_kji2,nc_kji2,ns_tji2,nc_tji2,ns_ji2,nc_ji2,nf_kji2 ! dimension ns_kji2(3),nc_kji2(3),ns_tji2(3),nc_tji2(3),ns_ji2(2),nc_ji2(2),nf_kji2(3) logical, parameter :: ldiag_budgets = .false. logical, parameter :: ldiag_budgets2 = .false. contains subroutine init_io open(14,file='log/glo'//grd,form='formatted') if (myid==0) then !printing volumetric avgT avgS. k=1,5 for surface layer open(20,file='data/allS',form='formatted') open(21,file='data/surfS',form='formatted') open(22,file='data/surfT',form='formatted') open(23,file='data/allT',form='formatted') open(24,file='data/qdot',form='formatted') open(25,file='data/qdot2',form='formatted') open(26,file='data/lwdn',form='formatted') open(27,file='data/lwup',form='formatted') open(28,file='data/senh',form='formatted') open(29,file='data/lath',form='formatted') open(30,file='data/snow_f',form='formatted') open(31,file='data/ioff',form='formatted') open(32,file='data/melth',form='formatted') open(33,file='data/GTK0',form='formatted') open(34,file='data/term1',form='formatted') open(35,file='data/h_mix_tracer',form='formatted') open(40,file='data/t1',form='formatted') open(41,file='data/term2',form='formatted') open(42,file='data/term3',form='formatted') open(43,file='data/test1',form='formatted') open(44,file='data/test2',form='formatted') open(45,file='data/test3',form='formatted') open(99,file='data/ij',form='formatted') endif end subroutine ! ---------------------------------------------------------------------- subroutine write_hist use ice, only: QFLUX, tlast_ice, ice_cpl_flag, liceform use blocks, only: nx_block, ny_block use time_management, only: check_time_flag, nsteps_run parameter(i01=i0+1,j01=j0+1,nbg0=nb0*ngy0,nbg1=nbg0-1,ibir=i2t/ngy0) character fn*24 integer*2 nbf real*8 rhoavg real*8 lwupavg,lwdnavg,lathavg,kpp_src_t,kpp_src_s,ioffavg, & meltavg,meltHavg,ioffFavg,kappa_isopavg,kappa_thicavg, & hor_diffavg common/histavg/pavg(i0,j0,k1),uavg(i0,j0,k1), & vavg(i0,j0,k1),tavg(i0,j0,k1),cavg(i0,j0,k1), & savg(i0,j0,k1),wcavg(i0,j0,k0), & evavg(i0,j0,k0),hvavg(i0,j0,k0),vdcsavg(i0,j0,k0), & dmxavg(i0,j0,k1),dmyavg(i0,j0,k1),rhoavg(i0,j0,k1),& tauxavg(i2,j2,1),tauyavg(i2,j2,1),lathavg(i2,j2,1),& senhavg(i2,j2,1),qdot2avg(i2,j2,1),qdotavg(i2,j2,1),& evapoavg(i2,j2,1),precavg(i2,j2,1),& kpp_src_t(i0,j0,k1),kpp_src_s(i0,j0,k1), & rainavg(i2,j2,1),roffavg(i2,j1,1),ioffavg(i2,j2,1),& meltavg(i2,j2,1),snowavg(i2,j2,1),lwupavg(i2,j2,1),& lwdnavg(i2,j2,1),meltHavg(i2,j2,1),snowFavg(i2,j2,1),& ioffFavg(i2,j2,1),saltavg(i2,j2,1),qflxavg(i2,j2,1),& hbltavg(i2,j2,1), vdc_gmavg(i0,j0,k0), & kappa_isopavg(i0,j0,k1),kappa_thicavg(i0,j0,k1),& hor_diffavg(i0,j0,k1),gtk0_tavg(i0,j0,k1),gtk0_savg(i0,j0,k1),& uisopavg(i0,j0,k1), visopavg(i0,j0,k1), wisopavg(i0,j0,k0),& advtisopavg(i2,j2,1), advsisopavg(i2,j2,1),& vntisopavg(i0,j0,k1), vnsisopavg(i0,j0,k1),& hdife_temp(i0,j0,k1), hdife_salt(i0,j0,k1),& hdifn_temp(i0,j0,k1), hdifn_salt(i0,j0,k1),& hdifb_temp(i0,j0,k0), hdifb_salt(i0,j0,k0),& wtsavg(i0,j0,k0), wttavg(i0,j0,k0),& uesavg(i0,j0,k1), uetavg(i0,j0,k1),& vnsavg(i0,j0,k1), vntavg(i0,j0,k1),& hdifsavg(i2,j2,1), hdiftavg(i2,j2,1) dimension nd(1),nbf(i2*j2*k1),nda(3),ndb(2),ndc(3),rbf(i2*j2*k1),rbfw(i2*j2*k0),rmbf(i2*j2*12) real*8 drbf(i2*j2*k1) real*8, dimension(i2,j2,1) :: hblt_tmp, ADVT_ISOP_tmp, ADVS_ISOP_tmp, & HDIFT_tmp, HDIFS_tmp ! for attributes character(50)name,long_name,units,coords integer(kind=mpi_offset_kind) length call timeavg(p,pavg,k1,wopt) call timeavg(u2,uavg,k1,wopt) call timeavg(v2,vavg,k1,wopt) call timeavg(t2,tavg,k1,wopt) call timeavg(s2,savg,k1,wopt) call timeavg(dmx,dmxavg,k1,wopt) call timeavg(dmy,dmyavg,k1,wopt) call timeavg(rho,rhoavg,k1,wopt) !yc call timeavg(c2,cavg,k1,wopt) !yc call timeavg(kpp_src(:,:,:,1),kpp_src_t,k1,wopt) call timeavg(kpp_src(:,:,:,2),kpp_src_s,k1,wopt) call timeavg(0.5d0*(KAPPA_ISOP(:,:,1,:)+KAPPA_ISOP(:,:,2,:)),& kappa_isopavg,k1,wopt) call timeavg(0.5d0*(KAPPA_THIC(:,:,1,:)+KAPPA_THIC(:,:,2,:)),& kappa_thicavg,k1,wopt) call timeavg(0.5d0*(HOR_DIFF(:,:,1,:)+HOR_DIFF(:,:,2,:)),& hor_diffavg,k1,wopt) call timeavg(GTK0_T,gtk0_tavg,k1,wopt) call timeavg(GTK0_S,gtk0_savg,k1,wopt) call timeavg(UISOP,uisopavg,k1,wopt) call timeavg(VISOP,visopavg,k1,wopt) if (ldiag_budgets) then call timeavg(VNT_ISOP,vntisopavg,k1,wopt) call timeavg(VNS_ISOP,vnsisopavg,k1,wopt) call timeavg(HDIFE(:,:,:,1),hdife_temp,k1,wopt) call timeavg(HDIFE(:,:,:,2),hdife_salt,k1,wopt) call timeavg(HDIFN(:,:,:,1),hdifn_temp,k1,wopt) call timeavg(HDIFN(:,:,:,2),hdifn_salt,k1,wopt) endif if (ldiag_budgets2) then call timeavg(UET,uetavg,k1,wopt) call timeavg(UES,uesavg,k1,wopt) call timeavg(VNT,vntavg,k1,wopt) call timeavg(VNS,vnsavg,k1,wopt) endif if (ldiag_budgets) then ADVT_ISOP_tmp(:,:,1)=ADVT_ISOP(2:i1,2:j1) ADVS_ISOP_tmp(:,:,1)=ADVS_ISOP(2:i1,2:j1) call timeavg_2d(ADVT_ISOP_tmp,advtisopavg,wopt) call timeavg_2d(ADVS_ISOP_tmp,advsisopavg,wopt) endif if (ldiag_budgets2) then HDIFT_tmp(:,:,1)=HDIFT(2:i1,2:j1) HDIFS_tmp(:,:,1)=HDIFS(2:i1,2:j1) call timeavg_2d(HDIFT_tmp,hdiftavg,wopt) call timeavg_2d(HDIFS_tmp,hdifsavg,wopt) endif hblt_tmp(:,:,1) = kpp_hblt(2:i1,2:j1) call timeavg_2d(hblt_tmp,hbltavg,wopt) call timeavg_2d(tauxx,tauxavg,wopt) call timeavg_2d(tauyy,tauyavg,wopt) call timeavg_2d(lath,lathavg,wopt) call timeavg_2d(senh,senhavg,wopt) call timeavg_2d(qdot2,qdot2avg,wopt) call timeavg_2d(qdot,qdotavg,wopt) call timeavg_2d(evapo,evapoavg,wopt) call timeavg_2d(prec,precavg,wopt) call timeavg_2d(rain,rainavg,wopt) call timeavg_2d(roff,roffavg,wopt) call timeavg_2d(ioff,ioffavg,wopt) call timeavg_2d(melt,meltavg,wopt) call timeavg_2d(snow,snowavg,wopt) call timeavg_2d(lwup,lwupavg,wopt) call timeavg_2d(lwdn,lwdnavg,wopt) call timeavg_2d(meltH,meltHavg,wopt) call timeavg_2d(snow_F,snowFavg,wopt) call timeavg_2d(ioff_F,ioffFavg,wopt) call timeavg_2d(salt,saltavg,wopt) !WRITE(*,*)'write_hist_flag=',liceform, check_time_flag(ice_cpl_flag),nsteps_run if ( liceform .and. check_time_flag(ice_cpl_flag) ) then call timeavg_2d_qflux(QFLUX(3:nx_block-2,3:ny_block-2,1)& ,qflxavg,const=tlast_ice) endif do 103 k=1,k1 do 103 j=2,j1 do 103 i=2,i1 103 wisopavg(i,j,k)=wisopavg(i,j,k)+wopt*WISOP(i,j,k) do 100 k=1,k0 do 100 j=2,j1 do 100 i=2,i1 if (ldiag_budgets2) then wtsavg(i,j,k)=wtsavg(i,j,k)+wopt*WTS(i,j,k) wttavg(i,j,k)=wttavg(i,j,k)+wopt*WTT(i,j,k) endif 100 wcavg(i,j,k)=wcavg(i,j,k)+wopt*w(i,j,k) do 101 k=2,k1 do 101 j=2,j1 do 101 i=2,i1 ! evavg(i,j,k)=evavg(i,j,k)+wopt*ev(i-1,j-1,k-1) ! 101 hvavg(i,j,k)=hvavg(i,j,k)+wopt*hv(i-1,j-1,k-1) evavg(i,j,k)=evavg(i,j,k)+wopt*ev(i-1,j-1,k-1)/odzw(k) vdcsavg(i,j,k)=vdcsavg(i,j,k)+wopt*vdcs(i-1,j-1,k-1) ! 101 hvavg(i,j,k)=hvavg(i,j,k)+wopt*hv(i-1,j-1,k-1)/odzw(k) 101 hvavg(i,j,k)=hvavg(i,j,k)+wopt*vdct(i-1,j-1,k-1) do 102 k=2,k0 do 102 j=2,j1 do 102 i=2,i1 if (ldiag_budgets) then hdifb_temp(i,j,k)=hdifb_temp(i,j,k)+wopt*HDIFB(i,j,k-1,1) hdifb_salt(i,j,k)=hdifb_salt(i,j,k)+wopt*HDIFB(i,j,k-1,2) endif 102 vdc_gmavg(i,j,k)=vdc_gmavg(i,j,k)+wopt*VDC_GM(i,j,k-1) ! derive timeavg field only. !if (mod(itf,nopt*itfday) .ne. 0) return if (mod(syng_days,ttmon(nmon)) .ne. 0) return numy = nyr if (nmon == 12) numy = nyr-1 !write(fn,'(a11,i3.3,a1,i3.3,a3)'),'../output/data',nyr,'_',n360,'.nc' write(fn,'(a14,i4.4,i2.2,a3)'),'./output/DATA_',numy,nmon,'.nc' ierr=nfmpi_create(m_cart,fn,nf_64bit_offset,mpi_info_null,ncid) ierr=nfmpi_def_dim(ncid, "level-center", nn(1), kcid) ierr=nfmpi_def_dim(ncid, "level-face", nn(5), kfid) ierr=nfmpi_def_dim(ncid, "latitude", nn(2), jid) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), iid) ierr=nfmpi_def_dim(ncid, "month", nn(4), mid) ierr=nfmpi_def_dim(ncid, "time", nn(6), id1) nda(3) = kcid nda(2) = jid nda(1) = iid ierr=nfmpi_def_var(ncid, "pressure", nf_double, 3, nda, idp) units='dyne/cm^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,idp,'units',length,trim(units)) long_name='Pressure' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,idp,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "u-velocity", nf_double, 3, nda, idu) units='cm/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,idu,'units',length,trim(units)) long_name='Zonal velocity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,idu,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "v-velocity", nf_double, 3, nda, idv) units='cm/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,idv,'units',length,trim(units)) long_name='Meridional velocity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,idv,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "temperature", nf_double, 3, nda, idt) units='degree C' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,idt,'units',length,trim(units)) long_name='Temperature' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,idt,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "salinity", nf_double, 3, nda, ids) units='psu (g/kg)' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ids,'units',length,trim(units)) long_name='Salinity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ids,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "dmx", nf_double, 3, nda, idmx) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,idmx,'units',length,trim(units)) long_name='Zonal turbulent viscosity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,idmx,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "dmy", nf_double, 3, nda, idmy) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,idmy,'units',length,trim(units)) long_name='Meridional turbulent viscosity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,idmy,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "rho", nf_double, 3, nda, irho) units='g/cm^3' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,irho,'units',length,trim(units)) long_name='Density' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,irho,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "KAPPA_ISOP", nf_double, 3, nda, ikappaisop) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ikappaisop,'units',length,trim(units)) long_name='Isopycnal diffusion coefficient' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ikappaisop,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "KAPPA_THIC", nf_double, 3, nda, ikappathic) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ikappathic,'units',length,trim(units)) long_name='Thickness diffusion coefficient' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ikappathic,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "HOR_DIFF", nf_double, 3, nda, ihordiff) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihordiff,'units',length,trim(units)) long_name='Horizontal diffusion coefficient' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihordiff,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "GTK0_T", nf_double, 3, nda, igtk0t) units='degree C/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,igtk0t,'units',length,trim(units)) long_name='bolus advection for temperature' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,igtk0t,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "GTK0_S", nf_double, 3, nda, igtk0s) units='psu (g/kg)/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,igtk0s,'units',length,trim(units)) long_name='bolus advection for salinity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,igtk0s,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "UISOP", nf_double, 3, nda, iuisop) units='cm/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iuisop,'units',length,trim(units)) long_name='Bolus Velocity in grid-x direction' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iuisop,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "VISOP", nf_double, 3, nda, ivisop) units='cm/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ivisop,'units',length,trim(units)) long_name='Bolus Velocity in grid-y direction' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ivisop,'long_name',length,trim(long_name)) if (ldiag_budgets) then ierr=nfmpi_def_var(ncid, "VNT_ISOP", nf_double, 3, nda, ivntisop) units='degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ivntisop,'units',length,trim(units)) long_name='Heat Flux Tendency in y dir. due to Eddy-Induced Vel' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ivntisop,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "VNS_ISOP", nf_double, 3, nda, ivnsisop) units='gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ivnsisop,'units',length,trim(units)) long_name='Salt Flux Tendency in y dir. due to Eddy-Induced Vel' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ivnsisop,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "HDIFE_TEMP", nf_double, 3, nda, ihdifeT) units='degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdifeT,'units',length,trim(units)) long_name='Horizontal Diffusive Flux in x dir. for T' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdifeT,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "HDIFE_SALT", nf_double, 3, nda, ihdifeS) units='gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdifeS,'units',length,trim(units)) long_name='Horizontal Diffusive Flux in x dir. for S' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdifeS,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "HDIFN_TEMP", nf_double, 3, nda, ihdifnT) units='degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdifnT,'units',length,trim(units)) long_name='Horizontal Diffusive Flux in y dir. for T' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdifnT,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "HDIFN_SALT", nf_double, 3, nda, ihdifnS) units='gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdifnS,'units',length,trim(units)) long_name='Horizontal Diffusive Flux in y dir. for S' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdifnS,'long_name',length,trim(long_name)) endif if (ldiag_budgets2) then ierr=nfmpi_def_var(ncid, "UET", nf_double, 3, nda, iuet) units='degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iuet,'units',length,trim(units)) long_name='Heat Flux in grid-x direction' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iuet,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "UES", nf_double, 3, nda, iues) units='gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iues,'units',length,trim(units)) long_name='Salt Flux in grid-x direction' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iues,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "VNT", nf_double, 3, nda, ivnt) units='degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ivnt,'units',length,trim(units)) long_name='Heat Flux in grid-y direction' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ivnt,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "VNS", nf_double, 3, nda, ivns) units='gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ivns,'units',length,trim(units)) long_name='Salt Flux in grid-y direction' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ivns,'long_name',length,trim(long_name)) endif ndc(3) = kfid ndc(2) = jid ndc(1) = iid ierr=nfmpi_def_var(ncid, "w-velocity", nf_double, 3, ndc, idw) units='cm/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,idw,'units',length,trim(units)) long_name='Vertical velocity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,idw,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "vdc_S", nf_double, 3, ndc, ivdcs) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ivdcs,'units',length,trim(units)) long_name='Vertical turbulent diffusivity(S)' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ivdcs,'long_name',length,trim(long_name)) ! ierr=nfmpi_def_var(ncid, "hv", nf_double, 3, ndc, ihv) ! units='cm/s' ierr=nfmpi_def_var(ncid, "vdc_T", nf_double, 3, ndc, ihv) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihv,'units',length,trim(units)) long_name='Vertical turbulent diffusivity(T)' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihv,'long_name',length,trim(long_name)) ! ierr=nfmpi_def_var(ncid, "ev", nf_double, 3, ndc, iev) ! units='cm/s' ierr=nfmpi_def_var(ncid, "vvc", nf_double, 3, ndc, iev) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iev,'units',length,trim(units)) long_name='Vertical turbulent viscosity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iev,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "VDC_GM", nf_double, 3, ndc, ivdcgm) units='cm^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ivdcgm,'units',length,trim(units)) long_name='Bolus vertical diffusion coefficient' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ivdcgm,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "WISOP", nf_double, 3, ndc, iwisop) units='cm/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iwisop,'units',length,trim(units)) long_name='Vertical Bolus Velocity' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iwisop,'long_name',length,trim(long_name)) if (ldiag_budgets) then ierr=nfmpi_def_var(ncid, "HDIFB_TEMP", nf_double, 3, ndc, ihdifbT) units='degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdifbT,'units',length,trim(units)) long_name='Horizontal Diffusive Flux across Bot. Face for T' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdifbT,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "HDIFB_SALT", nf_double, 3, ndc, ihdifbS) units='gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdifbS,'units',length,trim(units)) long_name='Horizontal Diffusive Flux across Bot. Face for S' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdifbS,'long_name',length,trim(long_name)) endif if (ldiag_budgets2) then ierr=nfmpi_def_var(ncid, "WTS", nf_double, 3, ndc, iwts) units='gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iwts,'units',length,trim(units)) long_name='Salt Flux Across Top Face' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iwts,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "WTT", nf_double, 3, ndc, iwtt) units='degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iwtt,'units',length,trim(units)) long_name='Heat Flux Across Top Face' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iwtt,'long_name',length,trim(long_name)) endif ndc(3) = mid ndc(2) = jid ndc(1) = iid ! ierr=nfmpi_def_var(ncid, "qavg", nf_double, 3, ndc, iqavg) ndb(2) = jid ndb(1) = iid ierr=nfmpi_def_var(ncid, "taux", nf_double, 2, ndb, ITX) units='dync/cm^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ITX,'units',length,trim(units)) long_name='Zonal wind stress' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ITX,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "tauy", nf_double, 2, ndb, ITY) units='dyne/cm^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ITY,'units',length,trim(units)) long_name='Meridional wind stress' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ITY,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "lath", nf_double, 2, ndb, ILH) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ILH,'units',length,trim(units)) long_name='Latent heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ILH,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "senh", nf_double, 2, ndb, ISH) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ISH,'units',length,trim(units)) long_name='Sensible heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ISH,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "qdot2", nf_double, 2, ndb, ISW) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ISW,'units',length,trim(units)) long_name='Net short-wave radiation flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ISW,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "qdot", nf_double, 2, ndb, ILW) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ILW,'units',length,trim(units)) long_name='Total heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ILW,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "evapo", nf_double, 2, ndb, IEVP) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,IEVP,'units',length,trim(units)) long_name='Evaporation mass flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,IEVP,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "prec", nf_double, 2, ndb, IRA) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,IRA,'units',length,trim(units)) long_name='Total precipitaion flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,IRA,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "kpp_src_t", nf_double, 3, NDA, IDKPPT) units='degree C /s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,IDKPPT,'units',length,trim(units)) long_name='KPP temperature tendency' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,IDKPPT,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "kpp_src_s", nf_double, 3, NDA, IDKPPS) units='psu(g/kg) /s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,IDKPPS,'units',length,trim(units)) long_name='KPP salinity tendency' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,IDKPPS,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "rain", nf_double, 2, ndb, Irain) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Irain,'units',length,trim(units)) long_name='rain-water mass flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Irain,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "roff", nf_double, 2, ndb, Iroff) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Iroff,'units',length,trim(units)) long_name='River-runoff mass flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Iroff,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "ioff", nf_double, 2, ndb, Iioff) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Iioff,'units',length,trim(units)) long_name='Ice-runoff mass flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Iioff,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "melt", nf_double, 2, ndb, Imelt) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Imelt,'units',length,trim(units)) long_name='Snowmelt mass flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Imelt,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "snow", nf_double, 2, ndb, Isnow) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Isnow,'units',length,trim(units)) long_name='Snow mass flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Isnow,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "lwup", nf_double, 2, ndb, Ilwup) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Ilwup,'units',length,trim(units)) long_name='Upward long-wave radiation heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Ilwup,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "lwdn", nf_double, 2, ndb, Ilwdn) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Ilwdn,'units',length,trim(units)) long_name='Downward long-wave radiation heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Ilwdn,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "melth", nf_double, 2, ndb, Imelth) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Imelth,'units',length,trim(units)) long_name='Ice and snowmelt heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Imelth,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "snow_F", nf_double, 2, ndb, Isnowf) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Isnowf,'units',length,trim(units)) long_name='Snowmelt heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Isnowf,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "ioff_F", nf_double, 2, ndb, Iiofff) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Iiofff,'units',length,trim(units)) long_name='Ice-runoff heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Iiofff,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "virtsalt", nf_double, 2, ndb, Ivs) units='kg/m^2/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Ivs,'units',length,trim(units)) long_name='Virtual salt mass flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Ivs,'long_name',length,trim(long_name)) if (ldiag_budgets) then ierr=nfmpi_def_var(ncid, "ADVT_ISOP", nf_double, 2, ndb, iadvtisop) units='cm degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iadvtisop,'units',length,trim(units)) long_name='Vertically-Integrated T Eddy-Induced Advection Tendency' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iadvtisop,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "ADVS_ISOP", nf_double, 2, ndb, iadvsisop) units='cm gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iadvsisop,'units',length,trim(units)) long_name='Vertically-Integrated S Eddy-Induced Advection Tendency' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iadvsisop,'long_name',length,trim(long_name)) endif if (ldiag_budgets2) then ierr=nfmpi_def_var(ncid, "HDIFT", nf_double, 2, ndb, ihdift) units='cm degC/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdift,'units',length,trim(units)) long_name='Vertically Integrated Horz Mix T tendency' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdift,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "HDIFS", nf_double, 2, ndb, ihdifs) units='cm gram/kilogram/s' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,ihdifs,'units',length,trim(units)) long_name='Vertically Integrated Horz Diff S tendency' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,ihdifs,'long_name',length,trim(long_name)) endif ierr=nfmpi_def_var(ncid, "qflx", nf_double, 2, ndb, Iqflx) units='Watt/m^2' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Iqflx,'units',length,trim(units)) long_name='Total heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Iqflx,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "hblt", nf_double, 2, ndb, Ihblt) units='cm' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,Ihblt,'units',length,trim(units)) long_name='Boundary layer depth' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,Ihblt,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "cfc11", nf_double, 3, nda, idc) ierr=nfmpi_def_var(ncid, "qavg", nf_double, 3, ndc, iqavg) units='degC per timestep' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iqavg,'units',length,trim(units)) long_name='restoring heat flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iqavg,'long_name',length,trim(long_name)) ierr=nfmpi_def_var(ncid, "wavg", nf_double, 3, ndc, iwavg) units='psu per timestep' length=len(trim(units)) ierr=nfmpi_put_att_text(ncid,iwavg,'units',length,trim(units)) long_name='restoring salt flux' length=len(trim(long_name)) ierr=nfmpi_put_att_text(ncid,iwavg,'long_name',length,trim(long_name)) nd(1) = id1 ierr=nfmpi_def_var(ncid, "days", nf_double, 1, nd, i_days) ierr=nfmpi_enddef(ncid) call mtx2vec_c(pavg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, idp, ns_kji2, nc_kji2, rbf) call mtx2vec_c(uavg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, idu, ns_kji2, nc_kji2, rbf) call mtx2vec_c(vavg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, idv, ns_kji2, nc_kji2, rbf) call mtx2vec_c(tavg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, idt, ns_kji2, nc_kji2, rbf) call mtx2vec_c(savg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, ids, ns_kji2, nc_kji2, rbf) !yc call mtx2vec_c(cavg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, idc, ns_kji2, nc_kji2, rbf) !yc call mtx2vec_c(dmxavg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, idmx, ns_kji2, nc_kji2, rbf) call mtx2vec_c(dmyavg,in,rbf) ierr=nfmpi_put_vara_double_all(ncid, idmy, ns_kji2, nc_kji2, rbf) call mtx2vec_c(rhoavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,irho,ns_kji2,nc_kji2,drbf) call mtx2vec_c(kappa_isopavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ikappaisop,ns_kji2,nc_kji2,drbf) call mtx2vec_c(kappa_thicavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ikappathic,ns_kji2,nc_kji2,drbf) call mtx2vec_c(hor_diffavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ihordiff,ns_kji2,nc_kji2,drbf) call mtx2vec_c(gtk0_tavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,igtk0t,ns_kji2,nc_kji2,drbf) call mtx2vec_c(gtk0_savg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,igtk0s,ns_kji2,nc_kji2,drbf) call mtx2vec_c(uisopavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,iuisop,ns_kji2,nc_kji2,drbf) call mtx2vec_c(visopavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ivisop,ns_kji2,nc_kji2,drbf) if (ldiag_budgets) then call mtx2vec_c(vntisopavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ivntisop,ns_kji2,nc_kji2,drbf) call mtx2vec_c(vnsisopavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ivnsisop,ns_kji2,nc_kji2,drbf) call mtx2vec_c(hdife_temp,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ihdifeT,ns_kji2,nc_kji2,drbf) call mtx2vec_c(hdife_salt,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ihdifeS,ns_kji2,nc_kji2,drbf) call mtx2vec_c(hdifn_temp,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ihdifnT,ns_kji2,nc_kji2,drbf) call mtx2vec_c(hdifn_salt,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ihdifnS,ns_kji2,nc_kji2,drbf) endif if (ldiag_budgets2) then call mtx2vec_c(uetavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,iuet,ns_kji2,nc_kji2,drbf) call mtx2vec_c(uesavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,iues,ns_kji2,nc_kji2,drbf) call mtx2vec_c(vntavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ivnt,ns_kji2,nc_kji2,drbf) call mtx2vec_c(vnsavg,in,drbf) ierr=nfmpi_put_vara_double_all(ncid,ivns,ns_kji2,nc_kji2,drbf) endif call mtx2vec_f(wcavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid, idw, ns_kji2, nf_kji2, rbfw) call mtx2vec_f(vdcsavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid, ivdcs, ns_kji2, nf_kji2, rbfw) call mtx2vec_f(hvavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid, ihv, ns_kji2, nf_kji2, rbfw) call mtx2vec_f(evavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid, iev, ns_kji2, nf_kji2, rbfw) call mtx2vec_f(vdc_gmavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid,ivdcgm,ns_kji2,nf_kji2,rbfw) call mtx2vec_f(wisopavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid,iwisop,ns_kji2,nf_kji2,rbfw) if (ldiag_budgets) then call mtx2vec_f(hdifb_temp,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid,ihdifbT,ns_kji2,nf_kji2,rbfw) call mtx2vec_f(hdifb_salt,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid,ihdifbS,ns_kji2,nf_kji2,rbfw) endif if (ldiag_budgets2) then call mtx2vec_f(wtsavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid, iwts, ns_kji2, nf_kji2, rbfw) call mtx2vec_f(wttavg,iw,rbfw) ierr=nfmpi_put_vara_double_all(ncid, iwtt, ns_kji2, nf_kji2, rbfw) endif call mtx2rvec2(qavg,rmbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, iqavg, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(wavg,rmbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, iwavg, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(TAUXAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, ITX, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(TAUYAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, ITY, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(LATHAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, ILH, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(SENHAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, ISH, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(QDOT2AVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, ISW, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(QDOTAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, ILW, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(EVAPOAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, IEVP, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(PRECAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, IRA, ns_tji2, nc_tji2, rmbf) call mtx2vec_c(KPP_SRC_T,IN,drbf) ierr=nfmpi_put_vara_double_all(NCID, IDKPPT, ns_kji2, nc_kji2, drbf) call mtx2vec_c(KPP_SRC_S,IN,drbf) ierr=nfmpi_put_vara_double_all(NCID, IDKPPS, ns_kji2, nc_kji2, drbf) call mtx2rvec2(RAINAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Irain, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(ROFFAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Iroff, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(IOFFAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Iioff, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(MELTAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Imelt, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(SNOWAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Isnow, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(LWUPAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Ilwup, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(LWDNAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Ilwdn, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(MELTHAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Imelth, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(SNOWFAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Isnowf, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(IOFFFAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID, Iiofff, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(SALTAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID,Ivs, ns_tji2, nc_tji2, rmbf) call mtx2rvec2(QFLXAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID,Iqflx,ns_tji2, nc_tji2, rmbf) call mtx2rvec2(HBLTAVG,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(NCID,Ihblt,ns_ji2, nc_ji2, rmbf) if (ldiag_budgets) then call mtx2rvec2(advtisopavg,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(ncid,iadvtisop,ns_ji2, nc_ji2, rmbf) call mtx2rvec2(advsisopavg,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(ncid,iadvsisop,ns_ji2, nc_ji2, rmbf) endif if (ldiag_budgets2) then call mtx2rvec2(hdiftavg,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(ncid,ihdift,ns_ji2, nc_ji2, rmbf) call mtx2rvec2(hdifsavg,rmbf,I2,J2,I2,J2,1,0,0) ierr=nfmpi_put_vara_double_all(ncid,ihdifs,ns_ji2, nc_ji2, rmbf) endif ierr=nfmpi_put_vara_double_all(NCID,i_days, ns_1, nc_1, days) ierr=nfmpi_close(ncid) CALL SETRD(PAVG,I0*J0*K1,0.d0) CALL SETRD(UAVG,I0*J0*K1,0.d0) CALL SETRD(VAVG,I0*J0*K1,0.d0) CALL SETRD(TAVG,I0*J0*K1,0.d0) CALL SETRD(SAVG,I0*J0*K1,0.d0) CALL SETRD(CAVG,I0*J0*K1,0.d0) CALL SETRD(WCAVG,I0*J0*K0,0.d0) CALL SETRD(VDCSAVG,I0*J0*K0,0.d0) CALL SETRD(HVAVG,I0*J0*K0,0.d0) CALL SETRD(EVAVG,I0*J0*K0,0.d0) CALL SETRD(DMXAVG,I0*J0*K1,0.d0) CALL SETRD(DMYAVG,I0*J0*K1,0.d0) CALL SETRD(RHOAVG,I0*J0*K1,0.d0) CALL SETRD(TAUXAVG,I2*J2,0.d0) CALL SETRD(TAUYAVG,I2*J2,0.d0) CALL SETRD(LATHAVG,I2*J2,0.d0) CALL SETRD(SENHAVG,I2*J2,0.d0) CALL SETRD(QDOT2AVG,I2*J2,0.d0) CALL SETRD(QDOTAVG,I2*J2,0.d0) CALL SETRD(EVAPOAVG,I2*J2,0.d0) CALL SETRD(PRECAVG,I2*J2,0.d0) CALL SETRD(KPP_SRC_T,I0*J0*K1,0.d0) CALL SETRD(KPP_SRC_S,I0*J0*K1,0.d0) CALL SETRD(RAINAVG,I2*J2*1,0.d0) CALL SETRD(ROFFAVG,I2*J2*1,0.d0) CALL SETRD(IOFFAVG,I2*J2*1,0.d0) CALL SETRD(MELTAVG,I2*J2*1,0.d0) CALL SETRD(SNOWAVG,I2*J2*1,0.d0) CALL SETRD(LWUPAVG,I2*J2*1,0.d0) CALL SETRD(LWDNAVG,I2*J2*1,0.d0) CALL SETRD(MELTHAVG,I2*J2*1,0.d0) CALL SETRD(SNOWFAVG,I2*J2*1,0.d0) CALL SETRD(IOFFFAVG,I2*J2*1,0.d0) CALL SETRD(SALTAVG,I2*J2*1,0.d0) CALL SETRD(QFLXAVG,I2*J2*1,0.d0) CALL SETRD(HBLTAVG,I2*J2*1,0.d0) CALL SETRD(KAPPA_ISOPAVG,I0*J0*K1,0.d0) CALL SETRD(KAPPA_THICAVG,I0*J0*K1,0.d0) CALL SETRD(HOR_DIFFAVG,I0*J0*K1,0.d0) CALL SETRD(GTK0_TAVG,I0*J0*K1,0.d0) CALL SETRD(GTK0_SAVG,I0*J0*K1,0.d0) CALL SETRD(VDC_GMAVG,I0*J0*K0,0.d0) CALL SETRD(UISOPAVG,I0*J0*K1,0.d0) CALL SETRD(VISOPAVG,I0*J0*K1,0.d0) CALL SETRD(WISOPAVG,I0*J0*K0,0.d0) if (ldiag_budgets) then CALL SETRD(ADVTISOPAVG,I2*J2*1,0.d0) CALL SETRD(ADVSISOPAVG,I2*J2*1,0.d0) CALL SETRD(VNTISOPAVG,I0*J0*K1,0.d0) CALL SETRD(VNSISOPAVG,I0*J0*K1,0.d0) CALL SETRD(HDIFE_TEMP,I0*J0*K1,0.d0) CALL SETRD(HDIFE_SALT,I0*J0*K1,0.d0) CALL SETRD(HDIFN_TEMP,I0*J0*K1,0.d0) CALL SETRD(HDIFN_SALT,I0*J0*K1,0.d0) CALL SETRD(HDIFB_TEMP,I0*J0*K0,0.d0) CALL SETRD(HDIFB_SALT,I0*J0*K0,0.d0) endif if (ldiag_budgets2) then CALL SETRD(WTSAVG,I0*J0*K0,0.d0) CALL SETRD(WTTAVG,I0*J0*K0,0.d0) CALL SETRD(UESAVG,I0*J0*K1,0.d0) CALL SETRD(UETAVG,I0*J0*K1,0.d0) CALL SETRD(VNSAVG,I0*J0*K1,0.d0) CALL SETRD(VNTAVG,I0*J0*K1,0.d0) CALL SETRD(HDIFTAVG,I2*J2*1,0.d0) CALL SETRD(HDIFSAVG,I2*J2*1,0.d0) endif end subroutine ! ---------------------------------------------------------------------- subroutine write_topo parameter(i01=i0+1,j01=j0+1,nbg0=nb0*ngy0,nbg1=nbg0-1,ibir=i2t/ngy0) character fn*17 integer*2 nbf,cpuid common/windsglo/taux(i2,j2,12),tauy(i2,j2,12) dimension z_c(k1),z_f(k0),nda(3),ndb(3),ndc(3),ndd(4),ndw(3) integer(kind=mpi_offset_kind) st_z,ct_z,nss(4),nee(4),nws(3),nwe(3),nks(2),nke(2) dimension xlon(i2),ylat(j2) dimension wbf(i2*j2),sbf(i2*j2*k1),rbf(i2*j2*12),vbf(i2*j2*k1*12) dimension inf(i2*j2*k1),iwf(i2*j2*k0),kbf(i2*j2),cpuid(i0,j0) fn='output/TOPO.nc' cpuid = in(:,:,1)*myid do 999 j=1,j2 999 ylat(j)=ydeg(j+1) do 1000 i=1,i2 1000 xlon(i)=xdeg(i+1) do 1001 k=1,k1 1001 z_c(k)=z(2*k) do 1002 k=1,k0 1002 z_f(k)=z(1+2*(k-1)) ierr=nfmpi_create(m_cart,fn,nf_64bit_offset,mpi_info_null,ncid) ierr=nfmpi_def_dim(ncid, "level-center", nn(1), kcid) ierr=nfmpi_def_dim(ncid, "level-face", nn(5), kfid) ierr=nfmpi_def_dim(ncid, "latitude", nn(2), jid) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), iid) ierr=nfmpi_def_dim(ncid, "month", nn(4), mid) ierr=nfmpi_def_var(ncid, "lev_c", nf_double, 1, kcid, izc) ierr=nfmpi_def_var(ncid, "lev_f", nf_double, 1, kfid, izf) ierr=nfmpi_def_var(ncid, "lat", nf_double, 1, jid, iyd) ierr=nfmpi_def_var(ncid, "lon", nf_double, 1, iid, ixd) nda(1)=iid nda(2)=jid ierr=nfmpi_def_var(ncid, "s_nudge", nf_double, 2, nda, isn) ierr=nfmpi_def_var(ncid, "t_nudge", nf_double, 2, nda, itn) ndb(1)=iid ndb(2)=jid ndb(3)=kcid ierr=nfmpi_def_var(ncid, "hmean_nudge", nf_double, 3, ndb, ihn) ndd(1)=iid ndd(2)=jid ndd(3)=kcid ndd(4)=mid ierr=nfmpi_def_var(ncid, "sclis", nf_double, 4, ndd, isc) ierr=nfmpi_def_var(ncid, "tclis", nf_double, 4, ndd, itc) ierr=nfmpi_def_var(ncid, "kb", nf_int, 2, ndb, iik) ierr=nfmpi_def_var(ncid, "mask", nf_int,3, ndb, iin) ndw(1)=iid ndw(2)=jid ndw(3)=kfid ierr=nfmpi_def_var(ncid, "mask_w", nf_int,3, ndw, iiw) ndc(1)=iid ndc(2)=jid ndc(3)=mid ierr=nfmpi_def_var(ncid, "taux", nf_double, 3, ndc, itx) ierr=nfmpi_def_var(ncid, "tauy", nf_double, 3, ndc, ity) ierr=nfmpi_def_var(ncid, "cpuid", nf_int, 2, nda, icp) ierr=nfmpi_enddef(ncid) ! z! zf ydeg xdeg st_z=1 ct_z = k1 ierr=nfmpi_put_vara_double_all(ncid,izc,st_z,ct_z,z_c) ct_z = k0 ierr=nfmpi_put_vara_double_all(ncid,izf,st_z,ct_z,z_f) ierr=nfmpi_put_vara_double_all(ncid,iyd,ns_kji(2),nc_kji(2),ylat) ierr=nfmpi_put_vara_double_all(ncid,ixd,ns_kji(3),nc_kji(3),xlon) ! s_nudge t_nudge hmean_nudge call mtx2rvec2(s_nudge,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, isn, ns_ji2,nc_ji2,wbf) call mtx2rvec2(t_nudge,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, itn, ns_ji2, nc_ji2,wbf) call mtx2rvec2(hmean_nudge,sbf,i0,j0,i2,j2,k1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ihn, ns_kji2, nc_kji2,sbf) ! taux tauy call mtx2rvec2(taux,rbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, itx, ns_tji2, nc_tji2, rbf) call mtx2rvec2(tauy,rbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, ity, ns_tji2, nc_tji2, rbf) ! sclis tclis nss(4)=ns_tji(1) nss(3)=ns_kji(1) nss(2)=ns_tji(2) nss(1)=ns_tji(3) nee(4)=nc_tji(1) nee(3)=nc_kji(1) nee(2)=nc_tji(2) nee(1)=nc_tji(3) call mtx2rvec_m(sclis,vbf,i0,j0,k1,i2,j2,k1,12,1,1) ierr=nfmpi_put_vara_double_all(ncid,isc,nss,nee,vbf) call mtx2rvec_m(tclis,vbf,i0,j0,k1,i2,j2,k1,12,1,1) ierr=nfmpi_put_vara_double_all(ncid,itc,nss,nee,vbf) ! kb in iw nks(1)=ns_kji2(1) nks(2)=ns_kji2(2) nke(1)=nc_kji2(1) nke(2)=nc_kji2(2) call mtx2ivec(kb,kbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_int_all(ncid,iik,ns_kji2,nc_kji2,kbf) call mtx2ivec(in,inf,i0,j0,i2,j2,k1,1,1) ierr=nfmpi_put_vara_int_all(ncid,iin,ns_kji2,nc_kji2,inf) nws(3)=ns_kji(1) nws(2)=ns_kji(2) nws(1)=ns_kji(3) nwe(3)=nn(5) nwe(2)=nc_kji(2) nwe(1)=nc_kji(3) call mtx2ivec(iw,iwf,i0,j0,i2,j2,k0,1,1) ierr=nfmpi_put_vara_int_all(ncid,iiw,nws,nwe,iwf) call mtx2ivec(cpuid,kbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_int_all(ncid, icp, ns_ji2,nc_ji2,kbf) ierr=nfmpi_close(ncid) end subroutine ! ---------------------------------------------------------------------- subroutine write_rerun parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ibir=i2t/ngy0,j01=j0+1) character fn*17 integer*2 nbf real*8 dbf dimension dbf(i2*j2) dimension wbf(i2*j2*k0) dimension nd(4) ! write(*,'(a20,12i3)') 'kilmer:nsombo=', nsombo ierr=nfmpi_create(m_cart,'data/rerun.nc',nf_64bit_offset,mpi_info_null,ncid) call pnetcdferrck(ierr) ierr=nfmpi_def_dim(ncid, "latitude", nn(2), idj) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), idi) ierr=nfmpi_def_dim(ncid, "month", nn(4), idt) ierr=nfmpi_def_dim(ncid, "global" , nn(6), id1) call pnetcdferrck(ierr) nd(1)=id1 ierr=nfmpi_def_var(ncid, "itf", nf_int, 1, nd, i_itf) ierr=nfmpi_def_var(ncid, "days", nf_double, 1, nd, i_days) ierr=nfmpi_def_var(ncid, "evap", nf_double, 1, nd, i_evap) ierr=nfmpi_def_var(ncid, "qsum", nf_double, 1, nd, i_qsum) ierr=nfmpi_def_var(ncid, "olde", nf_double, 1, nd, i_olde) ierr=nfmpi_def_var(ncid, "oldq", nf_double, 1, nd, i_oldq) nd(1)=idt ierr=nfmpi_def_var(ncid, "nsombo", nf_int, 1, nd, i_nsombo) nd(1)=idj nd(2)=idi ierr=nfmpi_def_var(ncid, "x", nf_double, 2, nd, ix) ! ierr=nfmpi_def_var(ncid, "fsf", nf_double, 2, nd, ifsf) ierr=nfmpi_def_var(ncid, "p0", nf_double, 2, nd, ip0) nd(1)=idt nd(2)=idj nd(3)=idi ierr=nfmpi_def_var(ncid, "qvag", nf_double, 3, nd, iqavg) ierr=nfmpi_def_var(ncid, "wvag", nf_double, 3, nd, iwavg) ierr=nfmpi_def_var(ncid, "qtmp", nf_double, 3, nd, iqtmp) ierr=nfmpi_def_var(ncid, "wtmp", nf_double, 3, nd, iwtmp) nd(1)=idj nd(2)=idi ierr=nfmpi_def_var(ncid, "tnudge", nf_double, 2, nd, itnudge) ierr=nfmpi_def_var(ncid, "pbar", nf_double, 2, nd, ipbar) ierr=nfmpi_def_var(ncid, "pvar", nf_double, 2, nd, ipvar) ierr=nfmpi_def_var(ncid, "xbar", nf_double, 2, nd, ixbar) ierr=nfmpi_def_var(ncid, "ucli", nf_double, 2, nd, iucli) ierr=nfmpi_def_var(ncid, "vcli", nf_double, 2, nd, ivcli) ierr=nfmpi_def_var(ncid, "rmsv", nf_double, 2, nd, irmsv) ierr=nfmpi_def_var(ncid, "cgr", nf_double, 2, nd, icgr) ierr=nfmpi_def_var(ncid, "cgrh", nf_double, 2, nd, icgrh) ierr=nfmpi_def_var(ncid, "cgp", nf_double, 2, nd, icgp) ierr=nfmpi_def_var(ncid, "cgv", nf_double, 2, nd, icgv) ierr=nfmpi_def_var(ncid, "cgt", nf_double, 2, nd, icgt) ierr=nfmpi_def_var(ncid, "cgs", nf_double, 2, nd, icgs) ierr=nfmpi_enddef(ncid) ierr=nfmpi_put_vara_int_all(ncid, i_itf, ns_1, nc_1, itf) ierr=nfmpi_put_vara_double_all(ncid, i_days, ns_1, nc_1, days) ierr=nfmpi_put_vara_double_all(ncid, i_evap, ns_1, nc_1, evap) ierr=nfmpi_put_vara_double_all(ncid, i_qsum, ns_1, nc_1, qsum) ierr=nfmpi_put_vara_double_all(ncid, i_olde, ns_1, nc_1, olde) ierr=nfmpi_put_vara_double_all(ncid, i_oldq, ns_1, nc_1, oldq) ierr=nfmpi_put_vara_int_all(ncid, i_nsombo, ns_tji(1), nc_tji(1), nsombo) ! call mtx2dvec(x,dbf) ! ierr=nfmpi_put_vara_double_all(ncid,ix,ns_ji,nc_ji,dbf) call mtx2rvec(x,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ix, ns_ji, nc_ji, wbf) ! call mtx2rvec(fsf,wbf,i0,j0,i2,j2,1,1,1) ! ierr=nfmpi_put_vara_double_all(ncid, ifsf, ns_ji, nc_ji, wbf) call mtx2rvec(p0,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ip0, ns_ji, nc_ji, wbf) call mtx2rvec(qavg,wbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, iqavg, ns_tji, nc_tji, wbf) call mtx2rvec(wavg,wbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, iwavg, ns_tji, nc_tji, wbf) call mtx2rvec(qtmp,wbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, iqtmp, ns_tji, nc_tji, wbf) call mtx2rvec(wtmp,wbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_put_vara_double_all(ncid, iwtmp, ns_tji, nc_tji, wbf) call mtx2rvec(tnudge,wbf,i2,j2,i2,j2,1,0,0) ierr=nfmpi_put_vara_double_all(ncid, itnudge, ns_ji, nc_ji, wbf) call mtx2rvec(pbar,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ipbar, ns_ji, nc_ji, wbf) call mtx2rvec(pvar,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ipvar, ns_ji, nc_ji, wbf) call mtx2rvec(xbar,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ixbar, ns_ji, nc_ji, wbf) call mtx2rvec(ucli,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, iucli, ns_ji, nc_ji, wbf) call mtx2rvec(vcli,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ivcli, ns_ji, nc_ji, wbf) call mtx2rvec(rmsv,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, irmsv, ns_ji, nc_ji, wbf) call mtx2rvec(cgr,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, icgr, ns_ji, nc_ji, wbf) call mtx2rvec(cgrh,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, icgrh, ns_ji, nc_ji, wbf) call mtx2rvec(cgp,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, icgp, ns_ji, nc_ji, wbf) call mtx2rvec(cgv,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, icgv, ns_ji, nc_ji, wbf) call mtx2rvec(cgt,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, icgt, ns_ji, nc_ji, wbf) call mtx2rvec(cgs,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, icgs, ns_ji, nc_ji, wbf) ierr=nfmpi_close(ncid) call write2nc('u1','u1',u1,k1,1) call write2nc('u2','u2',u2,k1,1) call write2nc('ul','ulf',ulf,k1,1) call write2nc('v1','v1',v1,k1,1) call write2nc('v2','v2',v2,k1,1) call write2nc('vl','vlf',vlf,k1,1) call write2nc('t1','t1',t1,k1,1) call write2nc('t2','t2',t2,k1,1) call write2nc('tl','tlf',tlf,k1,1) call write2nc('s1','s1',s1,k1,1) call write2nc('s2','s2',s2,k1,1) call write2nc('sl','slf',slf,k1,1) call write2nc('pp','p',p,k1,1) call write2nc('uc','u',u,k1,1) call write2nc('wc','w',w,k0,5) call write2nc('vc','v',v,k1,1) !yc call write2nc('c1','c1',c1,k1,1) call write2nc('c2','c2',c2,k1,1) call write2nc('cl','clf',clf,k1,1) !yc call write2nc('rh','rho',rho,k1,1) call write2nc('bo','bolus_sp',bolus_sp,1,1) end subroutine ! ---------------------------------------------------------------------- subroutine read_gas(fice,xkw,patm) ! dimension fice(i2,j2,12),xkw(i2,j2,12),patm(i2,j2,12) parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ibir=i2t/ngy0,j01=j0+1) dimension rrbf(i2*j2*12) real*8 :: rrbf ! ierr=nfmpi_open(m_cart,'prepglo/data/timcom_gasx.nc',nf_nowrite,mpi_info_null,ncid) call pnetcdferrck(ierr) ! ierr=nfmpi_inq_varid(ncid, "fice", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_tji,nc_tji,rrbf) call pnetcdferrck(ierr) call rvec2mtx(fice,rrbf,i2,j2,i2,j2,12,0,0) ! ierr=nfmpi_inq_varid(ncid, "xkw", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_tji,nc_tji,rrbf) call pnetcdferrck(ierr) call rvec2mtx(xkw,rrbf,i2,j2,i2,j2,12,0,0) ! ierr=nfmpi_inq_varid(ncid, "patm", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_tji,nc_tji,rrbf) call pnetcdferrck(ierr) call rvec2mtx(patm,rrbf,i2,j2,i2,j2,12,0,0) ! end subroutine ! ---------------------------------------------------------------------- ! ---------------------------------------------------------------------- subroutine read_rerun parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ibir=i2t/ngy0,j01=j0+1) character fn*17 integer*2 nbf real*8 dbf dimension dbf(i2*j2) dimension rbf(i2*j2*k0),rrbf(i2*j2*12) dimension nd(4) ierr=nfmpi_open(m_cart,'data/rerun.nc',nf_nowrite,mpi_info_null,ncid) call pnetcdferrck(ierr) ierr=nfmpi_inq_varid(ncid, "itf", itmp) ierr=nfmpi_get_var_int_all(ncid, itmp, itf) call pnetcdferrck(ierr) ierr=nfmpi_inq_varid(ncid, "days", itmp) ierr=nfmpi_get_var_double_all(ncid, itmp, days) call pnetcdferrck(ierr) ierr=nfmpi_inq_varid(ncid, "evap", itmp) ierr=nfmpi_get_var_double_all(ncid, itmp, evap) call pnetcdferrck(ierr) ierr=nfmpi_inq_varid(ncid, "qsum", itmp) ierr=nfmpi_get_var_double_all(ncid, itmp, qsum) call pnetcdferrck(ierr) ierr=nfmpi_inq_varid(ncid, "olde", itmp) ierr=nfmpi_get_var_double_all(ncid, itmp, olde) call pnetcdferrck(ierr) ierr=nfmpi_inq_varid(ncid, "oldq", itmp) ierr=nfmpi_get_var_double_all(ncid, itmp, oldq) call pnetcdferrck(ierr) ierr=nfmpi_inq_varid(ncid, "nsombo", itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_tji(1),nc_tji(1),nsombo) call pnetcdferrck(ierr) !! ierr=nfmpi_inq_varid(ncid, "x", itmp) !! ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,dbf) !! call pnetcdferrck(ierr) !! call dvec2mtx(x,dbf) ierr=nfmpi_inq_varid(ncid, "x", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(x,rbf,i0,j0,i2,j2,1,1,1) ! ierr=nfmpi_inq_varid(ncid, "fsf", itmp) ! ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) ! call rvec2mtx(fsf,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "p0", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(p0,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "qvag", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_tji,nc_tji,rrbf) call pnetcdferrck(ierr) call rvec2mtx(qavg,rrbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_inq_varid(ncid, "wvag", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_tji,nc_tji,rrbf) call pnetcdferrck(ierr) call rvec2mtx(wavg,rrbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_inq_varid(ncid, "qtmp", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_tji,nc_tji,rrbf) call pnetcdferrck(ierr) call rvec2mtx(qtmp,rrbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_inq_varid(ncid, "wtmp", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_tji,nc_tji,rrbf) call pnetcdferrck(ierr) call rvec2mtx(wtmp,rrbf,i2,j2,i2,j2,12,0,0) ierr=nfmpi_inq_varid(ncid, "tnudge", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(tnudge,rbf,i2,j2,i2,j2,1,0,0) ierr=nfmpi_inq_varid(ncid, "pbar", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(pbar,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "pvar", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(pvar,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "xbar", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(xbar,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "ucli", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(ucli,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "vcli", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(vcli,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "rmsv", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(rmsv,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "cgr", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(cgr,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "cgrh", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(cgrh,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "cgp", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(cgp,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "cgv", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(cgv,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "cgt", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(cgt,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_inq_varid(ncid, "cgs", itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ji,nc_ji,rbf) call pnetcdferrck(ierr) call rvec2mtx(cgs,rbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_close(ncid) call pnetcdferrck(ierr) call readnc('u1','u1',u1,k1) call readnc('u2','u2',u2,k1) call readnc('ul','ulf',ulf,k1) call readnc('v1','v1',v1,k1) call readnc('v2','v2',v2,k1) call readnc('vl','vlf',vlf,k1) call readnc('t1','t1',t1,k1) call readnc('t2','t2',t2,k1) call readnc('tl','tlf',tlf,k1) call readnc('s1','s1',s1,k1) call readnc('s2','s2',s2,k1) call readnc('sl','slf',slf,k1) call readnc('pp','p',p,k1) call readnc('uc','u',u,k1) call readnc('wc','w',w,k0) call readnc('vc','v',v,k1) !yc call readnc('c1','c1',c1,k1) call readnc('c2','c2',c2,k1) call readnc('cl','clf',clf,k1) !yc call readnc('rh','rho',rho,k1) call readnc('bo','bolus_sp',bolus_sp,1) call mpi_sendrecv(u(i1,1,1),1,m_vlon,m_e,1,u(1,1,1),1,m_vlon,m_w,1,m_cart,istat,ierr) call mpi_sendrecv(v(1,j1,1),1,m_vlat,m_n,1,v(1,1,1),1,m_vlat,m_s,1,m_cart,istat,ierr) end subroutine ! ------------------------------------------------------------- subroutine write_init2nc(stm,ttm) dimension stm(i0,j0,k1),ttm(i0,j0,k1),wbf(i2*j2*k1),nd(3) ierr=nfmpi_create(m_cart,'data/initial.nc',nf_64bit_offset,mpi_info_null,ncid) call pnetcdferrck(ierr) ierr=nfmpi_def_dim(ncid, "level", nn(1), idk) ierr=nfmpi_def_dim(ncid, "latitude", nn(2), idj) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), idi) call pnetcdferrck(ierr) nd(1)=idk nd(2)=idj nd(3)=idi ierr=nfmpi_def_var(ncid, 'ti', nf_double, 3, nd, itmp) ierr=nfmpi_def_var(ncid, 'si', nf_double, 3, nd, ismp) ierr=nfmpi_enddef(ncid) ! for temperature l=1 do 100 i=2,i1 do 100 j=2,j1 do 100 k=1,k1 wbf(l)=ttm(i,j,k) 100 l=l+1 nc_kji(1)=k1 ierr=nfmpi_put_vara_double_all(ncid, itmp, ns_kji, nc_kji, wbf) call pnetcdferrck(ierr) ! for salinity l=1 do 101 i=2,i1 do 101 j=2,j1 do 101 k=1,k1 wbf(l)=stm(i,j,k) 101 l=l+1 ierr=nfmpi_put_vara_double_all(ncid, ismp, ns_kji, nc_kji, wbf) ierr=nfmpi_close(ncid) end subroutine ! ---------------------------------------------------------------------- subroutine initbred parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ibir=i2t/ngy0,j01=j0+1) character fn*17,filename*30 real*8 dbf dimension dbf(i2*j2) dimension rbf(i2*j2*k0),rrbf(i2*j2*12) dimension nd(4) dimension ub(i0,j0,k1),vb(i0,j0,k1) jt=mylat*j2 it=mylon*i2 do 50 j=1,j2 do 50 i=1,i2 ibred(i,j)=0 50 if (((it+i.ge.540).and.(it+i).le.720).and.((jt+j.ge.524).and.(jt+j).le.572))ibred(i,j)=1 do 100 k=1,30 do 100 j=2,j1 do 100 i=2,i1 ub(i,j,k)=u1(i,j,k) 100 vb(i,j,k)=v1(i,j,k) call readnc('u1','u1',u1,k1) call readnc('v1','v1',v1,k1) call readnc('t1','t1',t1,k1) call readnc('s1','s1',s1,k1) bf=0. eke=0. tmp=0. do 150 k=1,30 do 150 j=2,j1 do 150 i=2,i1 ub(i,j,k)=ibred(i-1,j-1)*(ub(i,j,k)-u1(i,j,k)) vb(i,j,k)=ibred(i-1,j-1)*(vb(i,j,k)-v1(i,j,k)) temp=in(i,j,k)*(ub(i,j,k)*ub(i,j,k)+vb(i,j,k)*vb(i,j,k)) 150 tmp=tmp+temp call mpi_allreduce(tmp,temp,1,mpi_real8,mpi_sum,m_cart,ierr) bf1=sqrt(temp) if (myid .eq. 0) print*,'bred ke1 factor =',bf1,'bred ke1 = ',temp do 200 k=1,30 do 200 j=2,j1 do 200 i=2,i1 ub(i,j,k)=u2(i,j,k) 200 vb(i,j,k)=v2(i,j,k) call readnc('u2','u2',u2,k1) call readnc('v2','v2',v2,k1) call readnc('t2','t2',t2,k1) call readnc('s2','s2',s2,k1) bf=0. eke=0. tmp=0. do 250 k=1,30 do 250 j=2,j1 do 250 i=2,i1 ub(i,j,k)=ibred(i-1,j-1)*(ub(i,j,k)-u2(i,j,k)) vb(i,j,k)=ibred(i-1,j-1)*(vb(i,j,k)-v2(i,j,k)) temp=in(i,j,k)*(ub(i,j,k)*ub(i,j,k)+vb(i,j,k)*vb(i,j,k)) 250 tmp=tmp+temp call mpi_allreduce(tmp,temp,1,mpi_real8,mpi_sum,m_cart,ierr) bf2=sqrt(temp) if (myid .eq. 0) print*,'bred ke2 factor =',bf2,'bred ke2 = ',temp do 300 k=1,30 do 300 j=2,j1 do 300 i=2,i1 ub(i,j,k)=ulf(i,j,k) 300 vb(i,j,k)=vlf(i,j,k) call readnc('ul','ulf',ulf,k1) call readnc('vl','vlf',vlf,k1) call readnc('tl','tlf',tlf,k1) call readnc('sl','slf',slf,k1) bf=0. eke=0. tmp=0. do 350 k=1,30 do 350 j=2,j1 do 350 i=2,i1 ub(i,j,k)=ibred(i-1,j-1)*(ub(i,j,k)-ulf(i,j,k)) vb(i,j,k)=ibred(i-1,j-1)*(vb(i,j,k)-vlf(i,j,k)) temp=in(i,j,k)*(ub(i,j,k)*ub(i,j,k)+vb(i,j,k)*vb(i,j,k)) 350 tmp=tmp+temp call mpi_allreduce(tmp,temp,1,mpi_real8,mpi_sum,m_cart,ierr) bflf=sqrt(temp) if (myid .eq. 0)print*,'bred kelf factor =',bflf,'bred kelf = ',temp end subroutine ! ---------------------------------------------------------------------- subroutine rescbred parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ibir=i2t/ngy0,j01=j0+1) character fn*17,filename*30 real*8 dbf dimension dbf(i2*j2) dimension rbf(i2*j2*k0),rrbf(i2*j2*12) dimension nd(4) dimension ub(i0,j0,k1),vb(i0,j0,k1),tb(i0,j0,k1),sb(i0,j0,k1) do 100 k=1,30 do 100 j=2,j1 do 100 i=2,i1 ub(i,j,k)=u1(i,j,k) vb(i,j,k)=v1(i,j,k) tb(i,j,k)=t1(i,j,k) 100 sb(i,j,k)=s1(i,j,k) call readnc('u1','u1',u1,k1) call readnc('v1','v1',v1,k1) call readnc('t1','t1',t1,k1) call readnc('s1','s1',s1,k1) tmp=0. do 130 k=1,30 do 130 j=2,j1 do 130 i=2,i1 ub(i,j,k)=ibred(i-1,j-1)*(ub(i,j,k)-u1(i,j,k)) vb(i,j,k)=ibred(i-1,j-1)*(vb(i,j,k)-v1(i,j,k)) tb(i,j,k)=ibred(i-1,j-1)*(tb(i,j,k)-t1(i,j,k)) sb(i,j,k)=ibred(i-1,j-1)*(sb(i,j,k)-s1(i,j,k)) temp=in(i,j,k)*(ub(i,j,k)*ub(i,j,k)+vb(i,j,k)*vb(i,j,k)) 130 tmp=tmp+temp call mpi_allreduce(tmp,temp,1,mpi_real8,mpi_sum,m_cart,ierr) tp=bf1/sqrt(temp) temp=0. do 160 k=1,30 do 160 j=2,j1 do 160 i=2,i1 temp=temp+in(i,j,k)*ibred(i-1,j-1)*ub(i,j,k)*ub(i,j,k) temp=temp+in(i,j,k)*ibred(i-1,j-1)*vb(i,j,k)*vb(i,j,k) u1(i,j,k)=u1(i,j,k)+in(i,j,k)*ub(i,j,k)*tp v1(i,j,k)=v1(i,j,k)+in(i,j,k)*vb(i,j,k)*tp t1(i,j,k)=t1(i,j,k)+in(i,j,k)*tb(i,j,k)*tp 160 s1(i,j,k)=s1(i,j,k)+in(i,j,k)*sb(i,j,k)*tp call mpi_allreduce(temp,tmp,1,mpi_real8,mpi_sum,m_cart,ierr) if (myid .eq. 0) print*,'bred ke1 factor =',tp,'bred ke1 = ',tmp do 200 k=1,30 do 200 j=2,j1 do 200 i=2,i1 ub(i,j,k)=u2(i,j,k) vb(i,j,k)=v2(i,j,k) tb(i,j,k)=t2(i,j,k) 200 sb(i,j,k)=s2(i,j,k) call readnc('u2','u2',u2,k1) call readnc('v2','v2',v2,k1) call readnc('t2','t2',t2,k1) call readnc('s2','s2',s2,k1) tmp=0. do 230 k=1,30 do 230 j=2,j1 do 230 i=2,i1 ub(i,j,k)=ibred(i-1,j-1)*(ub(i,j,k)-u2(i,j,k)) vb(i,j,k)=ibred(i-1,j-1)*(vb(i,j,k)-v2(i,j,k)) tb(i,j,k)=ibred(i-1,j-1)*(tb(i,j,k)-t2(i,j,k)) sb(i,j,k)=ibred(i-1,j-1)*(sb(i,j,k)-s2(i,j,k)) temp=in(i,j,k)*(ub(i,j,k)*ub(i,j,k)+vb(i,j,k)*vb(i,j,k)) 230 tmp=tmp+temp call mpi_allreduce(tmp,temp,1,mpi_real8,mpi_sum,m_cart,ierr) tp=bf2/sqrt(temp) temp=0. do 260 k=1,30 do 260 j=2,j1 do 260 i=2,i1 temp=temp+in(i,j,k)*ibred(i-1,j-1)*ub(i,j,k)*ub(i,j,k) temp=temp+in(i,j,k)*ibred(i-1,j-1)*vb(i,j,k)*vb(i,j,k) u2(i,j,k)=u2(i,j,k)+in(i,j,k)*ub(i,j,k)*tp v2(i,j,k)=v2(i,j,k)+in(i,j,k)*vb(i,j,k)*tp t2(i,j,k)=t2(i,j,k)+in(i,j,k)*tb(i,j,k)*tp 260 s2(i,j,k)=s2(i,j,k)+in(i,j,k)*sb(i,j,k)*tp call mpi_allreduce(temp,tmp,1,mpi_real8,mpi_sum,m_cart,ierr) if (myid .eq. 0) print*,'bred ke2 factor =',tp,'bred ke2 = ',tmp do 300 k=1,30 do 300 j=2,j1 do 300 i=2,i1 ub(i,j,k)=ulf(i,j,k) vb(i,j,k)=vlf(i,j,k) tb(i,j,k)=tlf(i,j,k) 300 sb(i,j,k)=slf(i,j,k) call readnc('ul','ulf',ulf,k1) call readnc('vl','vlf',vlf,k1) call readnc('tl','tlf',tlf,k1) call readnc('sl','slf',slf,k1) tmp=0. do 330 k=1,30 do 330 j=2,j1 do 330 i=2,i1 ub(i,j,k)=ibred(i-1,j-1)*(ub(i,j,k)-ulf(i,j,k)) vb(i,j,k)=ibred(i-1,j-1)*(vb(i,j,k)-vlf(i,j,k)) tb(i,j,k)=ibred(i-1,j-1)*(tb(i,j,k)-tlf(i,j,k)) sb(i,j,k)=ibred(i-1,j-1)*(sb(i,j,k)-slf(i,j,k)) temp=in(i,j,k)*(ub(i,j,k)*ub(i,j,k)+vb(i,j,k)*vb(i,j,k)) 330 tmp=tmp+temp call mpi_allreduce(tmp,temp,1,mpi_real8,mpi_sum,m_cart,ierr) tp=bflf/sqrt(temp) temp=0. do 360 k=1,30 do 360 j=2,j1 do 360 i=2,i1 temp=temp+in(i,j,k)*ibred(i-1,j-1)*ub(i,j,k)*ub(i,j,k) temp=temp+in(i,j,k)*ibred(i-1,j-1)*vb(i,j,k)*vb(i,j,k) ulf(i,j,k)=ulf(i,j,k)+in(i,j,k)*ub(i,j,k)*tp vlf(i,j,k)=vlf(i,j,k)+in(i,j,k)*vb(i,j,k)*tp tlf(i,j,k)=tlf(i,j,k)+in(i,j,k)*tb(i,j,k)*tp 360 slf(i,j,k)=slf(i,j,k)+in(i,j,k)*sb(i,j,k)*tp call mpi_allreduce(temp,tmp,1,mpi_real8,mpi_sum,m_cart,ierr) if (myid .eq. 0) print*,'bred kel factor =',tp,'bred kel = ',tmp end subroutine ! ---------------------------------------------------------------------- subroutine write2nc(fn,vn,fld,l0,nl) parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ibir=i2t/ngy0,j01=j0+1) character fn*(*),vn*(*),filename*10 dimension fld(i0,j0,l0),wbf(i2*j2*l0),nd(3) write(filename,'(a5,a2,a3)'),'data/',fn,'.nc' ierr=nfmpi_create(m_cart,filename,nf_64bit_offset,mpi_info_null,ncid) if (ierr .ne. 0) print*,fn,nfmpi_strerror(ierr) if (nl .eq. 1) then ierr=nfmpi_def_dim(ncid, "level", nn(1), idk) else ierr=nfmpi_def_dim(ncid, "level", nn(nl), idk) endif ierr=nfmpi_def_dim(ncid, "latitude", nn(2), idj) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), idi) nd(1)=idk nd(2)=idj nd(3)=idi ierr=nfmpi_def_var(ncid, vn, nf_double, 3, nd, itmp) if (ierr .ne. 0) print*,fn,nfmpi_strerror(ierr) ierr=nfmpi_enddef(ncid) if (ierr .ne. 0) print*,fn,nfmpi_strerror(ierr) l=1 do 100 i=2,i1 do 100 j=2,j1 do 100 k=1,l0 wbf(l)=fld(i,j,k) 100 l=l+1 nc_kji(1)=l0 ierr=nfmpi_put_vara_double_all(ncid, itmp, ns_kji, nc_kji, wbf) if (ierr .ne. 0) print*,fn,nfmpi_strerror(ierr) ierr=nfmpi_close(ncid) if (ierr .ne. 0) print*,fn,nfmpi_strerror(ierr) end subroutine ! ------------------------------------------------------------- subroutine read_initnc(stm,ttm) dimension stm(i0,j0,k1),ttm(i0,j0,k1),rbf(i2*j2*k1),nd(3) ierr=nfmpi_open(m_cart,'data/initial.nc',nf_nowrite,mpi_info_null,ncid) if(ierr.ne.0)then call pnetcdferrck(ierr) call mpi_finalize(ierr) stop endif ierr=nfmpi_inq_varid(ncid,'ti',itmp) nc_kji(1)=k1 ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_kji,nc_kji,rbf) call pnetcdferrck(ierr) l=1 do 11 i=2,i1 do 11 j=2,j1 do 11 k=1,k1 ttm(i,j,k)=rbf(l) 11 l=l+1 ierr=nfmpi_inq_varid(ncid,'si',ismp) ierr=nfmpi_get_vara_double_all(ncid,ismp,ns_kji,nc_kji,rbf) call pnetcdferrck(ierr) l=1 do 12 i=2,i1 do 12 j=2,j1 do 12 k=1,k1 stm(i,j,k)=rbf(l) 12 l=l+1 ierr=nfmpi_close(ncid) end subroutine ! ---------------------------------------------------------------------- subroutine readnc(fn,vn,fld,l0) parameter(nbg0=nb0*ngy0,nbg1=nbg0-1,i01=i0+1,ibir=i2t/ngy0,j01=j0+1) character fn*(*),vn*(*),filename*10 dimension fld(i0,j0,l0),rbf(i2*j2*l0),nd(3) write(filename,'(a5,a2,a3)'),'data/',fn,'.nc' ierr=nfmpi_open(m_cart,filename,nf_nowrite,mpi_info_null,ncid) if (ierr .ne. 0) print*,fn,nfmpi_strerror(ierr) ierr=nfmpi_inq_varid(ncid,vn,itmp) if (ierr .ne. 0) print*,'nfmpi_inq_var ',fn,nfmpi_strerror(ierr) nc_kji(1)=l0 ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_kji,nc_kji,rbf) if (ierr .ne. 0) print*,'nfmpi_get_vara',fn,nfmpi_strerror(ierr) ierr=nfmpi_close(ncid) if (ierr .ne. 0) print*,fn,nfmpi_strerror(ierr) l=1 do 11 i=2,i1 do 11 j=2,j1 do 11 k=1,l0 fld(i,j,k)=rbf(l) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine timeavg(fd,fld,kl,ct) real*8 fld,fd,ct dimension fld(i0,j0,k1),fd(i0,j0,kl) do 100 k=1,kl do 100 j=2,j1 do 100 i=2,i1 100 fld(i,j,k)=fld(i,j,k)+ct*fd(i,j,k) end subroutine ! ---------------------------------------------------------------------- subroutine timeavg_2d(fd,fld,ct) real*8 fd,fld,ct dimension fld(i2,j2,1),fd(i2,j2,1) do 100 j=1,j2 do 100 i=1,i2 100 fld(i,j,1)=fld(i,j,1)+ct*fd(i,j,1) end subroutine ! ---------------------------------------------------------------------- subroutine timeavg_2d_qflux(fd,fld,const) use ice, only: tavg_sum_qflux use time_management, only: nsteps_run real*8 fd,fld,const dimension fld(i2,j2,1),fd(i2,j2,1) do 100 j=1,j2 do 100 i=1,i2 100 fld(i,j,1)=fld(i,j,1)+const*max(0.d0,fd(i,j,1)) if (mod(syng_days,ttmon(nmon)) .eq. 0) then fld(:,:,1) = fld(:,:,1)*(1.0d0/tavg_sum_qflux) !WRITE(*,*)'timeavg_2d_qflux=',tavg_sum_qflux, nopt*itfday, itf, nsteps_run tavg_sum_qflux = 0.d0 endif end subroutine ! ---------------------------------------------------------------------- subroutine mtx2rvec(fd,rbf,in0,jn0,nx,ny,nl,ip,jp) dimension fd(in0,jn0,nl),rbf(nx*ny*nl) l=1 ibegin=1+ip iend=nx+ibegin-1 jb=1+jp je=ny+jb-1 do 11 i=ibegin,iend do 11 j=jb,je do 11 k=1,nl rbf(l)=fd(i,j,k) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine mtx2rvec2(fd,rbf,in0,jn0,nx,ny,nl,ip,jp) real*8 fd,rbf dimension fd(in0,jn0,nl),rbf(nx*ny*nl) l=1 ibegin=1+ip iend=nx+ibegin-1 jb=1+jp je=ny+jb-1 do 11 k=1,nl do 11 j=jb,je do 11 i=ibegin,iend rbf(l)=fd(i,j,k) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine mtx2rvec_m(fd,rbf,in0,jn0,kn1,nx,ny,nk,nl,ip,jp) dimension fd(in0,jn0,kn1,nl),rbf(nx*ny*nk*nl) l=1 ibegin=1+ip iend=nx+ibegin-1 jb=1+jp je=ny+jb-1 do 12 m=1,nl do 12 k=1,nk do 12 j=jb,je do 12 i=ibegin,iend rbf(l)=fd(i,j,k,m) 12 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine mtx2ivec(fd,rbf,in0,jn0,nx,ny,nl,ip,jp) integer*2 fd integer rbf dimension fd(in0,jn0,nl),rbf(nx*ny*nl) l=1 ibegin=1+ip iend=nx+ibegin-1 jb=1+jp je=ny+jb-1 do 11 k=1,nl do 11 j=jb,je do 11 i=ibegin,iend rbf(l)=int(fd(i,j,k)) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine mtx2dvec(fd,dbf) parameter(i2j2=i2*j2) real*8 fd,dbf dimension fd(i0,j0),dbf(i2j2) l=1 do 11 i=2,i1 do 11 j=2,j1 dbf(l)=fd(i,j) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine rvec2mtx(fd,rbf,in0,jn0,nx,ny,nl,ip,jp) dimension fd(in0,jn0,nl),rbf(nx*ny*nl) ibegin=1+ip iend=nx+ibegin-1 jb=1+jp je=ny+jb-1 l=1 do 11 i=ibegin,iend do 11 j=jb,je do 11 k=1,nl fd(i,j,k)=rbf(l) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine rvec2mtx2(fd,rbf,in0,jn0,nx,ny,nl,ip,jp) dimension fd(nx,ny,nl),rbf(nx*ny*nl) ibegin=1+ip iend=nx+ibegin-1 jb=1+jp je=ny+jb-1 l=1 do 11 i=ibegin,iend do 11 j=jb,je do 11 k=1,nl fd(i-1,j-1,k)=rbf(l) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine mtx2vec_c(fd,in,rbf) parameter(i2j2k1=i2*j2*k1) integer*2 in,nbf real*8 fd,rbf dimension fd(i0,j0,k1) dimension in(i0,j0,k1),rbf(i2j2k1) ! rm=rmin+1.e-5*rf ! rn=9999./rf l=1 do 11 k=1,k1 do 11 j=2,j1 do 11 i=2,i1 ! fd(i,j,k)=max(min(fd(i,j,k),rmin+rf),rmin) ! nbf(l)=-999*(1-in(i,j,k))+in(i,j,k)*rn*(fd(i,j,k)-rm) rbf(l)=fd(i,j,k)*in(i,j,k) ! nbf(l)=in(i,j,k)*rn*(fd(i,j,k)-rmin) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine mtx2vec_f(fd,iw,rbfw) parameter(i2j2k0=i2*j2*k0) integer*2 iw real*8 fd,rbfw dimension fd(i0,j0,k0) dimension iw(i0,j0,k0),rbfw(i2j2k0) ! rm=rmin+1.e-5*rf ! rn=9999./rf l=1 do 11 k=1,k0 do 11 j=2,j1 do 11 i=2,i1 ! fd(i,j,k)=max(min(fd(i,j,k),rmin+rf),rmin) ! nbf(l)=-999*(1-in(i,j,k))+in(i,j,k)*rn*(fd(i,j,k)-rm) rbfw(l)=fd(i,j,k)*iw(i,j,k) ! nbf(l)=in(i,j,k)*rn*(fd(i,j,k)-rmin) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine mtx2dec_c(fd,in,rbf) parameter(i2j2k1=i2*j2*k1) integer*2 in,nbf real*8 fd dimension fd(i0,j0,k1) dimension in(i0,j0,k1) real*8 rbf(i2j2k1) l=1 do 11 k=1,k1 do 11 j=2,j1 do 11 i=2,i1 rbf(l)=in(i,j,k)*fd(i,j,k) 11 l=l+1 end subroutine subroutine mtx2vec_int2_2d(fd,rbf) parameter(i2j2=i2*j2) integer*2 fd dimension fd(i0,j0) integer*2 rbf(i2j2) l=1 do 11 j=2,j1 do 11 i=2,i1 rbf(l)=fd(i,j) 11 l=l+1 end subroutine subroutine mtx2vec_dbl_2d(fd,rbf,bp) integer, intent(in) :: bp real*8, dimension(:,:), intent(in) :: fd real*8, dimension(:), intent(inout) :: rbf l=1 if (bp==1) then do 11 j=2,j1 do 11 i=2,i1 rbf(l)=fd(i,j) 11 l=l+1 else do 22 j=1,j2 do 22 i=1,i2 rbf(l)=fd(i,j) 22 l=l+1 end if end subroutine subroutine vec2mtx_dbl_2d(fd,dbf,bp) integer, intent(in) :: bp real*8, dimension(:,:), intent(inout) :: fd real*8, dimension(:), intent(in) :: dbf l=1 if (bp==1) then do 11 j=2,j1 do 11 i=2,i1 fd(i,j)=dbf(l) 11 l=l+1 else do 22 j=1,j2 do 22 i=1,i2 fd(i,j)=dbf(l) 22 l=l+1 end if end subroutine ! ---------------------------------------------------------------------- subroutine dvec2mtx(fd,dbf) parameter(i2j2=i2*j2) real*8 fd,dbf dimension fd(i2,j2),dbf(i2j2) l=1 do 11 i=1,i2 do 11 j=1,j2 fd(i,j)=dbf(l) 11 l=l+1 end subroutine ! ---------------------------------------------------------------------- subroutine pnetcdferrck(ierr) if(ierr.ne.nf_noerr)write(*,'(/2a)')'pnetcdf error: ',nfmpi_strerror(ierr) end subroutine subroutine restart if ( ((lrstrt.eq.0).and.(mod(syng_days,ttmon(nmon)).eq.0.or.(itf-it0+daodt).eq.mxit)).or.& ((lrstrt.eq.1).and.(mod(syng_days,ttmon(nmon)).eq.0.or.(itf-it0).eq.mxit)) ) then if (myid.eq.0) print*,'write rerun file' if (lbred .eq. 1) call rescbred if (lbred .eq. 0) call write_rerun endif ! ncopt: years of sving rerun files if(mod(itf,ncopt*365*itfday).eq.0) then ifl_sys=1 nys=itf/(365*itfday) if(myid.eq.0) then !write(sys1,'(a11,i3.3,a13,i3.3)'),'test -e opt',nys,' || mkdir opt',nys !write(sys2,'(a19,i3.3)'),'cp ./data/*.n! ./opt',nys !call system(sys1) !call system(sys2) !print*,'saving rerun files in opt',nys ifl_sys=0 endif call mpi_bcast(ifl_sys,1,mpi_integer,0,m_cart,ierr) endif if ( (lrstrt.eq.0.and.(itf-it0+daodt).ge.mxit).or.& (lrstrt.eq.1.and.(itf-it0).ge.mxit) ) then if(myid.eq.0) then mon = nld if(nld==12) mon=0 write(*,*) 'outmonth',nyr,mon write(sys3,'(a22,i4.4,i2.2,a27,i4.4,i2.2)'),& 'test -e rerun/rest_',nyr,mon,' || mkdir -p rerun/rest_',nyr,mon write(sys4,'(a26,i4.4,i2.2,a2)'),'cp data/* rerun/rest_',nyr,mon,'/.' call system(sys3) call system(sys4) write(sys3,'(a46,i4.4,i2.2,a2)'),'cp ./global_saltotal_tendency rerun/rest_',nyr,mon,'/.' write(sys4,'(a49,i4.4,i2.2,a2)'),'cp ./global_ssh_saltotal_initial rerun/rest_',nyr,mon,'/.' call system(sys3) call system(sys4) print*,'saving rerun files on',nyr,mon endif endif write(14,405) syng_days,nyr 405 format('save at day',f4.0,' ,year',i3) end subroutine subroutine rdnc_evp2 use comm, only: m_cart,myid,mylon,mylat use const, only: i2,j2,ngy0,ngx0 implicit none character :: fn*19 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_ij(2),nc_ij(2) fn = 'prepglo/data/evp.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ij(1) = mylon*i2+1 ns_ij(2) = mylat*j2+1 nc_ij(1) = i2 nc_ij(2) = j2 ierr=nfmpi_inq_varid(ncid,'al',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,al) ierr=nfmpi_inq_varid(ncid,'ar',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,ar) ierr=nfmpi_inq_varid(ncid,'ab',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,ab) ierr=nfmpi_inq_varid(ncid,'ac',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,ac) ierr=nfmpi_inq_varid(ncid,'cl',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,cl) ierr=nfmpi_inq_varid(ncid,'cb',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,cb) ierr=nfmpi_inq_varid(ncid,'cc',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,cc) ierr=nfmpi_inq_varid(ncid,'cr',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,cr) ierr=nfmpi_inq_varid(ncid,'ct',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,ct) ns_ij(1) = mylon*i2+1 ns_ij(2) = mylat*(j2+1)+1 nc_ij(1) = i2 nc_ij(2) = j2+1 ierr=nfmpi_inq_varid(ncid,'at',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,at) ierr=nfmpi_close(ncid) end subroutine rdnc_evp2 subroutine rdnc_evp1 use comm, only: m_cart,myid,mylon,mylat use const, only: i2,j2,ngy0,ngx0,ibir,i0,nb0,nbg0,nbg1 implicit none character :: fn*19 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_ijk(3),nc_ijk(3),ns_ij(2),nc_ij(2),ns_i(1),nc_i(1) fn = 'prepglo/data/evp.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ij(1) = mylon*i2+1 ns_ij(2) = mylat*j2+1 nc_ij(1) = i2 nc_ij(2) = j2 ierr=nfmpi_inq_varid(ncid,'al',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,al) ierr=nfmpi_inq_varid(ncid,'ar',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,ar) ierr=nfmpi_inq_varid(ncid,'ab',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,ab) ierr=nfmpi_inq_varid(ncid,'ac',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,ac) ns_ij(1) = mylon*i2+1 ns_ij(2) = mylat*(j2+1)+1 nc_ij(1) = i2 nc_ij(2) = j2+1 ierr=nfmpi_inq_varid(ncid,'at',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,at) ns_ijk(1) = mylat*ibir+1 ns_ijk(2) = mylon*i0+1 ns_ijk(3) = 1 nc_ijk(1) = ibir nc_ijk(2) = i0 nc_ijk(3) = nbg0 ierr=nfmpi_inq_varid(ncid,'rinv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,rinv) ns_ijk(1) = mylat*ibir+1 ns_ijk(2) = mylon*i0+1 ns_ijk(3) = 1 nc_ijk(1) = ibir nc_ijk(2) = i0 nc_ijk(3) = nbg1 ierr=nfmpi_inq_varid(ncid,'rinv1',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,rinv1) ns_i = 1 nc_i = nb0 ierr=nfmpi_inq_varid(ncid,'ie',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,ie) ierr=nfmpi_close(ncid) end subroutine rdnc_evp1 subroutine rdnc_windmix use comm, only: m_cart use const, only: k2 implicit none character :: fn*23 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_i,nc_i fn = 'prepglo/data/windmix.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_i = 1 nc_i = k2 ierr=nfmpi_inq_varid(ncid,'vbk',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,vbk) ierr=nfmpi_inq_varid(ncid,'hbk',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,hbk) ierr=nfmpi_close(ncid) end subroutine rdnc_windmix subroutine rdnc_winds use comm, only: m_cart,mylon,mylat use const, only: i2,j2,ngx0,ngy0 implicit none character :: fn*21 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_ijt(3),nc_ijt(3) fn = 'prepglo/data/winds.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ijt(1) = mylon*i2+1 ns_ijt(2) = mylat*j2+1 ns_ijt(3) = 1 nc_ijt(1) = i2 nc_ijt(2) = j2 nc_ijt(3) = 12 ! if (lscowf) then ierr=nfmpi_inq_varid(ncid,'tauxs',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijt,nc_ijt,taux) ierr=nfmpi_inq_varid(ncid,'tauys',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijt,nc_ijt,tauy) ! else ! ierr=nfmpi_inq_varid(ncid,'taux_data',itmp) ! ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijt,nc_ijt,taux) ! ierr=nfmpi_inq_varid(ncid,'tauy_data',itmp) ! ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijt,nc_ijt,tauy) ! endif ierr=nfmpi_close(ncid) end subroutine rdnc_winds subroutine rdnc_rad use comm, only: m_cart,mylon,mylat use const, only: i2,j2,ngx0,ngy0 implicit none character :: fn*25 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_ijt(3),nc_ijt(3) fn = 'prepglo/data/radiation.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ijt(1) = mylon*i2+1 ns_ijt(2) = mylat*j2+1 ns_ijt(3) = 1 nc_ijt(1) = i2 nc_ijt(2) = j2 nc_ijt(3) = 12 ierr=nfmpi_inq_varid(ncid,'swnet',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijt,nc_ijt,qsw) ierr=nfmpi_close(ncid) end subroutine rdnc_rad subroutine rdnc_levitus(nm) use comm, only: m_cart,mylon,mylat use const, only: i0,j0,ngx0,ngy0,k1 implicit none character :: fn*28 character :: s_mon(12)*5 = (/'s_jan','s_feb','s_mar','s_apr','s_may','s_jun', & 's_jul','s_aug','s_sep','s_oct','s_nov','s_dec'/) character :: t_mon(12)*5 = (/'t_jan','t_feb','t_mar','t_apr','t_may','t_jun', & 't_jul','t_aug','t_sep','t_oct','t_nov','t_dec'/) integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_ijk(3),nc_ijk(3) integer,intent(in) :: nm fn = 'prepglo/data/annualevitus.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ijk(1) = mylon*i0+1 ns_ijk(2) = mylat*j0+1 ns_ijk(3) = 1 nc_ijk(1) = i0 nc_ijk(2) = j0 nc_ijk(3) = k1 ierr=nfmpi_inq_varid(ncid,s_mon(nm),itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,sclim) ierr=nfmpi_inq_varid(ncid,t_mon(nm),itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,tclim) ierr=nfmpi_close(ncid) end subroutine rdnc_levitus subroutine rdnc_zkb use comm, only: m_cart,mylon,mylat use const, only: i0,j0,ngx0,ngy0,k1,k0,i01 implicit none character :: fn*19 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_i,nc_i,ns_ij(2),nc_ij(2) integer(kind=mpi_offset_kind) :: ns_ijk(3),nc_ijk(3) fn = 'prepglo/data/zkb.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_i = 1 nc_i = 1 ierr=nfmpi_inq_varid(ncid,'tlz',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,tlz) ns_i = 1 nc_i = k0+k1 ierr=nfmpi_inq_varid(ncid,'z',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,z) ns_i = 1 nc_i = k1 ierr=nfmpi_inq_varid(ncid,'odz',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,odz) ns_i = 1 nc_i = k0 ierr=nfmpi_inq_varid(ncid,'odzw',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,odzw) ns_ij(1) = mylon*i0+1 ns_ij(2) = mylat*j0+1 nc_ij(1) = i0 nc_ij(2) = j0 ierr=nfmpi_inq_varid(ncid,'kb',itmp) ierr=nfmpi_get_vara_int2_all(ncid,itmp,ns_ij,nc_ij,kb) ns_ij(1) = mylon*i0+1 ns_ij(2) = mylat*(j0+1)+1 nc_ij(1) = i0 nc_ij(2) = j0+1 ierr=nfmpi_inq_varid(ncid,'iv0',itmp) ierr=nfmpi_get_vara_int2_all(ncid,itmp,ns_ij,nc_ij,iv0) ns_ij(1) = mylon*(i01+1)+1 ns_ij(2) = mylat*j0+1 nc_ij(1) = i01+1 nc_ij(2) = j0 ierr=nfmpi_inq_varid(ncid,'iu0',itmp) ierr=nfmpi_get_vara_int2_all(ncid,itmp,ns_ij,nc_ij,iu0) ns_ijk(1) = mylon*i0+1 ns_ijk(2) = mylat*j0+1 ns_ijk(3) = 1 nc_ijk(1) = i0 nc_ijk(2) = j0 nc_ijk(3) = k0 ierr=nfmpi_inq_varid(ncid,'iw',itmp) ierr=nfmpi_get_vara_int2_all(ncid,itmp,ns_ijk,nc_ijk,iw) nc_ijk(3) = k1 ierr=nfmpi_inq_varid(ncid,'in',itmp) ierr=nfmpi_get_vara_int2_all(ncid,itmp,ns_ijk,nc_ijk,in) ns_ijk(2) = mylat*(j0+1)+1 nc_ijk(2) = j0+1 ierr=nfmpi_inq_varid(ncid,'iv',itmp) ierr=nfmpi_get_vara_int2_all(ncid,itmp,ns_ijk,nc_ijk,iv) ns_ijk(1) = mylon*(i01+1)+1 ns_ijk(2) = mylat*j0+1 nc_ijk(1) = i01+1 nc_ijk(2) = j0 ierr=nfmpi_inq_varid(ncid,'iu',itmp) ierr=nfmpi_get_vara_int2_all(ncid,itmp,ns_ijk,nc_ijk,iu) ierr=nfmpi_close(ncid) end subroutine rdnc_zkb subroutine rdnc_zkb2 use comm, only: m_cart,mylon,mylat use const, only: i0,j0 implicit none character :: fn*19 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_ij(2),nc_ij(2) fn = 'prepglo/data/zkb.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ij(1) = mylon*i0+1 ns_ij(2) = mylat*j0+1 nc_ij(1) = i0 nc_ij(2) = j0 ierr=nfmpi_inq_varid(ncid,'rmets',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,scr(:,:,1)) ierr=nfmpi_close(ncid) end subroutine rdnc_zkb2 subroutine rdnc_rundata use comm, only: m_cart,mylon,mylat use const, only: i0,j0,j1,j2,ngx0,ngy0 implicit none character :: fn*23 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_i,nc_i fn = 'prepglo/data/rundata.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_i = 1 nc_i = 5 ierr=nfmpi_inq_varid(ncid,'case',itmp) ierr=nfmpi_get_vara_text_all(ncid,itmp,ns_i,nc_i,case) nc_i = 63 ierr=nfmpi_inq_varid(ncid,'describ',itmp) ierr=nfmpi_get_vara_text_all(ncid,itmp,ns_i,nc_i,dscrib) nc_i = 1 ierr=nfmpi_inq_varid(ncid,'dt',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,dt) ierr=nfmpi_inq_varid(ncid,'tlz',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,tlz) ierr=nfmpi_inq_varid(ncid,'b',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,b) ierr=nfmpi_inq_varid(ncid,'g',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,g) ierr=nfmpi_inq_varid(ncid,'dm0',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,dm0) ierr=nfmpi_inq_varid(ncid,'de0',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,de0) ierr=nfmpi_inq_varid(ncid,'dmz0',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,dmz0) ierr=nfmpi_inq_varid(ncid,'rzmx',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,rzmx) ierr=nfmpi_inq_varid(ncid,'drag',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,drag) ierr=nfmpi_inq_varid(ncid,'fltw',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,fltw) ! ierr=nfmpi_inq_varid(ncid,'daodt',itmp) ! ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,daodt) ierr=nfmpi_inq_varid(ncid,'odt',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,odt) ierr=nfmpi_inq_varid(ncid,'prn',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,prn) ierr=nfmpi_inq_varid(ncid,'orzmx',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,orzmx) ierr=nfmpi_inq_varid(ncid,'ofltw',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,ofltw) ierr=nfmpi_inq_varid(ncid,'rawf',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,rawf) ierr=nfmpi_inq_varid(ncid,'ktrm',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,ktrm) ! ierr=nfmpi_inq_varid(ncid,'lrstrt',itmp) ! ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,lrstrt) ! ierr=nfmpi_inq_varid(ncid,'mxit',itmp) ! ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,mxit) ierr=nfmpi_inq_varid(ncid,'isav',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,isav) ierr=nfmpi_inq_varid(ncid,'mxsav',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,mxsav) ierr=nfmpi_inq_varid(ncid,'lopen',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,lopen) ierr=nfmpi_inq_varid(ncid,'lmovi',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,lmovi) ierr=nfmpi_inq_varid(ncid,'mvi',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,mvi) ierr=nfmpi_inq_varid(ncid,'lfsrf',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,lfsrf) ierr=nfmpi_inq_varid(ncid,'lsolver',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,lsolver) ierr=nfmpi_inq_varid(ncid,'lprecon',itmp) ierr=nfmpi_get_vara_int_all(ncid,itmp,ns_i,nc_i,lprecon) ns_i = mylat*j2+1 nc_i = j2 ierr=nfmpi_inq_varid(ncid,'f',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,f) ierr=nfmpi_inq_varid(ncid,'tanphi',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,tanphi) ns_i = mylat*j1+1 nc_i = j1 ierr=nfmpi_inq_varid(ncid,'csv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,csv) ierr=nfmpi_inq_varid(ncid,'ocsv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,ocsv) ierr=nfmpi_inq_varid(ncid,'dxv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,dxv) ierr=nfmpi_inq_varid(ncid,'odxv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,odxv) ierr=nfmpi_inq_varid(ncid,'dyv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,dyv) ierr=nfmpi_inq_varid(ncid,'odyv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,odyv) ns_i = mylat*j0+1 nc_i = j0 ierr=nfmpi_inq_varid(ncid,'y',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,y) ierr=nfmpi_inq_varid(ncid,'ydeg',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,ydeg) ierr=nfmpi_inq_varid(ncid,'yv',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,yv) ierr=nfmpi_inq_varid(ncid,'yvdeg',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,yvdeg) ierr=nfmpi_inq_varid(ncid,'cs',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,cs) ierr=nfmpi_inq_varid(ncid,'ocs',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,ocs) ierr=nfmpi_inq_varid(ncid,'dx',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,dx) ierr=nfmpi_inq_varid(ncid,'odx',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,odx) ierr=nfmpi_inq_varid(ncid,'dy',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,dy) ierr=nfmpi_inq_varid(ncid,'ody',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,ody) ns_i = mylon*i0+1 nc_i = i0 ierr=nfmpi_inq_varid(ncid,'xdeg',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_i,nc_i,xdeg) ierr=nfmpi_close(ncid) end subroutine rdnc_rundata subroutine rdnc_tidal use comm, only : mylat,mylon use const, only: i2,j2,i0,j0,ngx0,ngy0 implicit none character :: fn*27 integer :: ierr, tide_id, ncid real*8, dimension(i2,j2) :: tmp integer(kind=mpi_offset_kind) :: ns_ij(2),nc_ij(2) fn = 'prepglo/data/tidalenergy.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ij(1) = mylon*i2+1 ns_ij(2) = mylat*j2+1 nc_ij(1) = i2 nc_ij(2) = j2 ierr=nfmpi_inq_varid(ncid,"wave_dissipation",tide_id) call pnetcdferrck(ierr) ierr=nfmpi_get_vara_double_all(ncid,tide_id,ns_ij,nc_ij,tmp) call pnetcdferrck(ierr) ierr=nfmpi_close(ncid) tmp=merge(tmp,0.d0, tmp > -1.e+10) tidal_energy_flux(2:i1,2:j1)=tmp(:,:) call mpi_exch_2d_r8(tidal_energy_flux) end subroutine rdnc_tidal subroutine rdnc_STF use comm, only: m_cart,mylon,mylat use const, only: i2,j2,ngx0,ngy0 !implicit none character :: fn*26 integer :: ncid,ierr,itmp integer(kind=mpi_offset_kind) :: ns_ijk(3),nc_ijk(3) fn = 'prepglo/data/Surforcing.nc' ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ijk(1) = mylon*i2+1 ns_ijk(2) = mylat*j2+1 ns_ijk(3) = 1 nc_ijk(1) = i2 nc_ijk(2) = j2 nc_ijk(3) = 12 ierr=nfmpi_inq_varid(ncid,'qdot',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,qdottmp) ierr=nfmpi_inq_varid(ncid,'qdot2',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,qdot2tmp) ierr=nfmpi_inq_varid(ncid,'salt',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,salttmp) ierr=nfmpi_inq_varid(ncid,'prec',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,prectmp) ierr=nfmpi_inq_varid(ncid,'evap',itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijk,nc_ijk,evaptmp) ierr=nfmpi_close(ncid) end subroutine rdnc_STF subroutine rdnc_ij(fn,varname,outvar) use comm, only: m_cart,mylon,mylat use const, only: i2,j2,ngx0,ngy0 implicit none character, intent(in) :: fn*(*),varname*(*) integer :: ncid,ierr,itmp,nx,ny integer(kind=mpi_offset_kind) :: ns_ij(2),nc_ij(2) real*8, dimension(:,:) :: outvar nx=size(outvar,1) ny=size(outvar,2) ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) ns_ij(1) = mylon*nx+1 ns_ij(2) = mylat*ny+1 nc_ij(1) = nx nc_ij(2) = ny ierr=nfmpi_inq_varid(ncid,varname,itmp) ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ij,nc_ij,outvar) ierr=nfmpi_close(ncid) end subroutine rdnc_ij subroutine rdnc_ijm(fn,varname,nsth,ncth,outvar) use comm, only: m_cart,mylon,mylat use const, only: i2,j2,ngx0,ngy0 implicit none character, intent(in) :: fn*(*),varname*(*) integer, intent(in) :: nsth,ncth integer :: ncid,ierr,itmp,nx,ny integer(kind=mpi_offset_kind) :: ns_ijm(3),nc_ijm(3) real*8, dimension(:,:) :: outvar nx=size(outvar,1) ny=size(outvar,2) ierr=nfmpi_open(m_cart,fn,nf_nowrite,mpi_info_null,ncid) if(myid==0) write(*,*) varname,'openierr',ierr ns_ijm(1) = mylon*nx+1 ns_ijm(2) = mylat*ny+1 ns_ijm(3) = nsth nc_ijm(1) = nx nc_ijm(2) = ny nc_ijm(3) = ncth ierr=nfmpi_inq_varid(ncid,varname,itmp) if(myid==0) write(*,*) varname,'tagid',ierr ierr=nfmpi_get_vara_double_all(ncid,itmp,ns_ijm,nc_ijm,outvar) if(myid==0) write(*,*) varname,'readierr',ierr ierr=nfmpi_close(ncid) end subroutine rdnc_ijm ! ---------------------------------------------------------------------- subroutine setrd(a,n,r) ! ---------------------------------------------------------------------- DIMENSION a(*) REAL*8 a,r integer :: i,n do i=1,n a(i)=r end do end subroutine setrd ! ---------------------------------------------------------------------- subroutine check_val2d(dbl,fn) use const, only: ngy0,ngx0 use comm, only: m_cart,mylat,mylon implicit none character*(*), intent(in) :: fn integer :: ncid,ierr,ns(2) integer :: j0id,i0id integer :: ichek,nx,ny integer(kind=mpi_offset_kind) :: dim_nn(2) integer(kind=mpi_offset_kind) :: ns_ij(2),nc_ij(2) real*8, dimension(:,:), intent(in) :: dbl nx = size(dbl,1); ny = size(dbl,2) !output file name !fn = 'checkval.nc' !create ncfile and id ierr=nfmpi_create(m_cart,fn,nf_clobber,mpi_info_null,ncid) !define dimension and assign dimID dim_nn(2) = ny*ngy0 dim_nn(1) = nx*ngx0 ierr=nfmpi_def_dim(ncid,"j0_global",dim_nn(2),j0id) ierr=nfmpi_def_dim(ncid,"i0_global",dim_nn(1),i0id) ns(2) = j0id ns(1) = i0id ns_ij(2) = mylat*ny+1 ns_ij(1) = mylon*nx+1 nc_ij(2) = ny nc_ij(1) = nx !define variable ierr=nfmpi_def_var(ncid,"variable",nf_double,2,ns,ichek) ierr=nfmpi_enddef(ncid) !put variable ierr=nfmpi_put_vara_double_all(ncid,ichek,ns_ij,nc_ij,dbl) ierr=nfmpi_close(ncid) end subroutine check_val2d subroutine check_val3d(dbl,fn) use const, only: ngy0,ngx0 use comm, only: m_cart,mylat,mylon implicit none character*(*), intent(in) :: fn integer :: ncid,ierr,ns(3) integer :: j0id,i0id,k1id integer :: ichek,nx,ny,nz integer(kind=mpi_offset_kind) :: dim_nn(3) integer(kind=mpi_offset_kind) :: ns_ijk(3),nc_ijk(3) real*8, dimension(:,:,:), intent(in) :: dbl nx = size(dbl,1) ny = size(dbl,2) nz = size(dbl,3) !output file name !fn = 'checkval.nc' !create ncfile and id ierr=nfmpi_create(m_cart,fn,nf_clobber,mpi_info_null,ncid) !define dimension and assign dimID dim_nn(3) = nz dim_nn(2) = ny*ngy0 dim_nn(1) = nx*ngx0 ierr=nfmpi_def_dim(ncid,"k1",dim_nn(3),k1id) ierr=nfmpi_def_dim(ncid,"j0_global",dim_nn(2),j0id) ierr=nfmpi_def_dim(ncid,"i0_global",dim_nn(1),i0id) ns(3) = k1id ns(2) = j0id ns(1) = i0id ns_ijk(3) = 1 ns_ijk(2) = mylat*ny+1 ns_ijk(1) = mylon*nx+1 nc_ijk(3) = nz nc_ijk(2) = ny nc_ijk(1) = nx !define variable ierr=nfmpi_def_var(ncid,"variable",nf_double,3,ns,ichek) ierr=nfmpi_enddef(ncid) !put variable ierr=nfmpi_put_vara_double_all(ncid,ichek,ns_ijk,nc_ijk,dbl) ierr=nfmpi_close(ncid) end subroutine check_val3d subroutine timerout if(myid ==0) then open(88,file='data/timer'//grd,form='formatted') write(88,'(1x,A10,1x,I7,/)')'iteration:', itf-it0 write(88,'(1x,A10,10x,f8.4,1x,A3,1x,A9,/)') 'initialize',timer(1),'sec',',timer(1)' write(88,'(1x,A17,3x,f8.4,1x,A3,1x,A9,/)') 'run (single_loop)',timer(2),'sec',',timer(2)' write(88,'(1x,A11,9x,f8.4,1x,A3,1x,A9,/)') 'run(fsglo)',timer(4),'sec',',timer(4)' write(88,'(1x,A16,4x,f8.4,1x,A3,1x,A9,/)') 'run (write_hist)',timer(5),'sec',',timer(5)' write(88,'(1x,A16,4x,f8.4,1x,A3,1x,A9,/)') 'fsglo (var_exec)',timer(6),'sec',',timer(6)' write(88,'(1x,A17,3x,f8.4,1x,A3,1x,A9,/)') 'fsglo (interp_uv)',timer(7),'sec',',timer(7)' write(88,'(1x,A18,2x,f8.4,1x,A3,1x,A9,/)') 'fsglo (it_evp_sol)',timer(8),'sec',',timer(8)' write(88,'(1x,A18,2x,f8.4,1x,A3,1x,A9,/)') 'fsglo (evp_solver)',timer(9),'sec',',timer(9)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'fsglo (exec_aft_sol)',timer(10),'sec',',timer(10)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'fsglo (vertical-mix)',timer(11),'sec',',timer(11)' write(88,'(1x,A14,6x,f8.4,1x,A3,1x,A10,/)') 'fsglo (CFCmod)',timer(12),'sec',',timer(12)' write(88,'(1x,A16,4x,f8.4,1x,A3,1x,A10,/)') 'fsglo (ice_form)',timer(13),'sec',',timer(13)' write(88,'(1x,A20,4x,f8.4,1x,A3,//)') 'fsglo (air-sea flux)',timer(14),'sec' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'ice_flx_to coupler',timer(15),'sec',',timer(15)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'OCN/ICE PREP',timer(16),'sec',',timer(16)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'OCN SETUP',timer(17),'sec',',timer(17)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'ICE SETUP',timer(18),'sec',',timer(18)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'Run Ice Model',timer(19),'sec',',timer(19)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'OCN PREP',timer(20),'sec',',timer(20)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'ice to cpl',timer(21),'sec',',timer(21)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'Update fractions',timer(22),'sec',',timer(22)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'ATM/OCN FLUX CALC',timer(23),'sec',',timer(23)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'Run Ocn Model',timer(24),'sec',',timer(24)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'RUN atm model',timer(25),'sec',',timer(25)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'atm to cpl',timer(26),'sec',',timer(26)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'ocn to cpl',timer(27),'sec',',timer(27)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'ocn_import_mct',timer(28),'sec',',timer(28)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'pop_sum_buffer',timer(29),'sec',',timer(29)' write(88,'(1x,A20,f8.4,1x,A3,1x,A10,/)') 'ocn_export_mct',timer(30),'sec',',timer(30)' write(88,*) 'run (mxit_loop)',timer(3),'sec',',timer(3)' close(88) endif end subroutine subroutine write_GM_grid parameter(i01=i0+1,j01=j0+1,nbg0=nb0*ngy0,nbg1=nbg0-1,ibir=i2t/ngy0) character fn*20 dimension nd(2), wbf(i2*j2) integer :: nd fn='output/GM_gird.nc' ierr=nfmpi_create(m_cart,fn,nf_64bit_offset,mpi_info_null,ncid) ierr=nfmpi_def_dim(ncid, "latitude", nn(2), jid) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), iid) nd(1)=iid nd(2)=jid ierr=nfmpi_def_var(ncid, "DYT", nf_double, 2, nd, idyt) ierr=nfmpi_def_var(ncid, "DXT", nf_double, 2, nd, idxt) ierr=nfmpi_def_var(ncid, "HTE", nf_double, 2, nd, ihte) ierr=nfmpi_def_var(ncid, "HTN", nf_double, 2, nd, ihtn) ierr=nfmpi_enddef(ncid) call mtx2rvec2(DYT,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, idyt, ns_ji2,nc_ji2,wbf) call mtx2rvec2(DXT,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, idxt, ns_ji2,nc_ji2,wbf) call mtx2rvec2(HTE,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ihte, ns_ji2,nc_ji2,wbf) call mtx2rvec2(HTN,wbf,i0,j0,i2,j2,1,1,1) ierr=nfmpi_put_vara_double_all(ncid, ihtn, ns_ji2,nc_ji2,wbf) ierr=nfmpi_close(ncid) end subroutine subroutine write_first_forcing parameter(i01=i0+1,j01=j0+1,nbg0=nb0*ngy0,nbg1=nbg0-1,ibir=i2t/ngy0) character fn*26 dimension nd(2), wbf(i2*j2) integer :: nd fn='output/first_forcing.nc' ierr=nfmpi_create(m_cart,fn,nf_64bit_offset,mpi_info_null,ncid) ierr=nfmpi_def_dim(ncid, "latitude", nn(2), jid) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), iid) nd(1)=iid nd(2)=jid ierr=nfmpi_def_var(ncid, "lwup", nf_double, 2, nd, ilwup) ierr=nfmpi_enddef(ncid) call mtx2rvec2(lwup,wbf,i2,j2,i2,j2,1,0,0) ierr=nfmpi_put_vara_double_all(ncid, ilwup, ns_ji2,nc_ji2,wbf) ierr=nfmpi_close(ncid) end subroutine subroutine write_second_forcing parameter(i01=i0+1,j01=j0+1,nbg0=nb0*ngy0,nbg1=nbg0-1,ibir=i2t/ngy0) character fn*27 dimension nd(2), wbf(i2*j2) integer :: nd fn='output/second_forcing.nc' ierr=nfmpi_create(m_cart,fn,nf_64bit_offset,mpi_info_null,ncid) ierr=nfmpi_def_dim(ncid, "latitude", nn(2), jid) ierr=nfmpi_def_dim(ncid, "longitude", nn(3), iid) nd(1)=iid nd(2)=jid ierr=nfmpi_def_var(ncid, "lwup", nf_double, 2, nd, ilwup) ierr=nfmpi_enddef(ncid) call mtx2rvec2(lwup,wbf,i2,j2,i2,j2,1,0,0) ierr=nfmpi_put_vara_double_all(ncid, ilwup, ns_ji2,nc_ji2,wbf) ierr=nfmpi_close(ncid) end subroutine end module