#define c_str(s) ('s\0') c---------------------------------------------------------------------- subroutine init_data_out (tfile,dfile,nx,ny,npt,nz,xx,yy,en) c---------------------------------------------------------------------- common/grid/nxp,nyp,nxyc,nzl,nbx,nby,ncs,land,nlo,npbc include 'comm_new.h' include 'comm_data.h' include 'comm_pbl.h' include 'comm_tracer.h' include 'comm_para.h' include 'comm_bio.h' include 'comm_diff.h' include 'biology.h' character*(*) tfile, dfile real en(1), xx(1), yy(1) real zz(100),zzm(100),zzw(100) integer tios_idvar common /tios_id/ iddq, ifoh ,idtm, idep , idct common /vert/ zin(MAXNZ+1), hin(MAXNZ), t_in(MAXNZ+1), s_in(MAXNZ+1), * bint(MAXNZ), cint(MAXNZ), dzin(MAXNZ+1), sigma(MAXNZ), * facz(MAXNZ), ttr_fac(MAXNZ) save zz, zzm, zzw call tios_init (tfile, dfile) do i = 1, nz+1 zz(i) = zin(i) enddo zzm(1) = 0.0 do i = 2, nz zzm(i) = hin(i-1) + zzm(i-1) zzw(i-1) = zzm(i) enddo zzm(nz+1) = zin(nz+1) zzm(nz+2) = zin(nz+1) + 10. call tios_grid (id_g0, nxp, nyp, 1, xx, yy, 0.) ! xy surface grid call tios_grid (id_g1, nxp, nyp, nz, xx, yy, zin) ! xyz (TEMP) grid call tios_grid (id_g2, npten, 1, nz+1, zz, zz, zin) call tios_grid (id_g3, nxp, nyp, nz-1, xx, yy, zin) call tios_grid (id_g4, 1, nyp, nz+2, xx, yy, zzm) ! yz (MOSF) grid call tios_grid (id_g5, nxp, nyp, nz-1, xx, yy, zzw) ! xyz(W_VEL) grid call tios_grid (id_g6, 1, nyp, 1, xx, yy, zin) ! y (heat transport) grid call tios_grid (id_g7, nxp, nyp, nz+1, xx, yy, zin) ! xyz (Tracers) call tios_map (imap, nxp*nyp, nxyc, iox) call tios_var (extra, c_str(EXTRA), id_g1, imap) call tios_var (extraw, c_str(EXTRAW), id_g5, imap) call tios_var (extram, c_str(EXTRA_MEAN), id_g1, imap) call tios_var (t, c_str(TEMP), id_g1, imap) call tios_var (ft_ha, c_str(TEMP_HA), id_g1, imap) call tios_var (ft_va, c_str(TEMP_VA), id_g1, imap) call tios_var (ft_hd, c_str(TEMP_HD), id_g1, imap) call tios_var (ft_vd, c_str(TEMP_VD), id_g1, imap) call tios_var (ft_ca, c_str(TEMP_CA), id_g1, imap) call tios_var (ft_sp, c_str(TEMP_SP), id_g1, imap) call tios_var (u, c_str(U_VEL), id_g1, imap) call tios_var (v, c_str(V_VEL), id_g1, imap) call tios_var (fhd,c_str(DIV), id_g1, imap) call tios_var (w, c_str(W_VEL), id_g5, imap) call tios_var (w((nz-1)*npt+1), c_str(W_BOT), id_g0, imap) call tios_var (ucs, c_str(US_C), id_g1, imap) call tios_var (vcs, c_str(VS_C), id_g1, imap) call tios_var (ws, c_str(WS_VEL), id_g5, imap) call tios_var (sal, c_str(SALT), id_g1, imap) call tios_var (dens, c_str(DENS), id_g1, imap) call tios_var (pdens,c_str(PDENS), id_g1, imap) call tios_var (fsal_ha, c_str(SALT_HA), id_g1, imap) call tios_var (fsal_va, c_str(SALT_VA), id_g1, imap) call tios_var (fsal_hd, c_str(SALT_HD), id_g1, imap) call tios_var (fsal_vd, c_str(SALT_VD), id_g1, imap) call tios_var (fsal_ca, c_str(SALT_CA), id_g1, imap) call tios_var (fsal_sp, c_str(SALT_SP), id_g1, imap) call tios_var (fsal_ri, c_str(SALT_RI), id_g1, imap) call tios_var (tm, c_str(T_MEAN), id_g1, imap) call tios_var (um, c_str(U_MEAN), id_g1, imap) call tios_var (vm, c_str(V_MEAN), id_g1, imap) call tios_var (wm, c_str(W_MEAN), id_g5, imap) call tios_var (salm, c_str(S_MEAN), id_g1, imap) call tios_var (densm, c_str(DENS_MEAN), id_g1, imap) call tios_var (vvc, c_str(KPP_vvc), id_g5, imap) call tios_var (vdc, c_str(KPP_vtc), id_g5, imap) call tios_var (vdc(nxyc*nz+1), c_str(KPP_vsc), id_g5, imap) call tios_var (hblt,c_str(KPP_hblt), id_g0, imap) iddq = tios_idvar(c_str(HFLX), id_g0, imap) c here I use tios_idvar only for cosmetic purposes, c (since HFLX will be stored in tp, not q) call tios_var(solr(npt3), c_str(SOLAR_qisw), id_g0, imap) call tios_var(qb, c_str(SOLAR_qsw), id_g0, imap) call tios_var(qb(npt2), c_str(LATENT_rlh), id_g0, imap) call tios_var(qb(npt3), c_str(SENSIBLE_sh), id_g0, imap) call tios_var(qb(npt4), c_str(LONGWAVE_qlw),id_g0, imap) call tios_var(qb(npt4+nxyc), c_str(DEFICIT), id_g0, imap) call tios_var(cld(npt3), c_str(CLDFR), id_g0, imap) call tios_var(wnd, c_str(WNSP_wspd), id_g0, imap) call tios_var(wnd(npt2), c_str(UWND_u) , id_g0, imap) call tios_var(wnd(npt3), c_str(VWND_v) , id_g0, imap) call tios_var(sst(npt3), c_str(SST), id_g0, imap) idep = tios_idvar(c_str(SFLX), id_g0, imap) call tios_var(sss(npt3), c_str(SSS), id_g0, imap) if (initq .eq. 8.or.use_ice) then call tios_var(amhum, c_str(PBLHUM_qa), id_g0, 0) call tios_var(amth, c_str(PBLTEM_th), id_g0, 0) call tios_var(amhum_mean,c_str(PBLHUM_MEAN), id_g0, 0) call tios_var(amth_mean, c_str(PBLTEM_MEAN), id_g0, 0) call tios_var(ahum(1,3), c_str(AIRHUM_q), id_g0, 0) call tios_var(atem(1,3), c_str(AIRTEM_t), id_g0, 0) endif if (use_ice) then do i=1,ntrac_sur it = npt*(i-1) + 1 nlen = name_trs(i) name_temporary = ftrsnm(i) call tios_var(trs(it),name_temporary(1:nlen)//'\0',id_g0,imap) call tios_var(trsm(it),name_temporary(1:nlen)//c_str(_MEAN), * id_g0,imap) enddo call tios_var(qios, c_str(QIOS), id_g0, imap) call tios_var(brne, c_str(BRNE), id_g0, imap) call tios_var(qb(npt1), c_str(QSW), id_g0, imap) call tios_var(prcp(npt3), c_str(PPI), id_g0, imap) call tios_var(pp, c_str(PP), id_g0, imap) call tios_var(tsnw, c_str(TSNW), id_g0, 0) call tios_var(rh, c_str(RH), id_g0, 0) call tios_var(rlhi, c_str(RLHI), id_g0, 0) call tios_var(shi, c_str(SHI), id_g0, 0) call tios_var(qlwi, c_str(QLWI), id_g0, 0) call tios_var(qswi, c_str(QSWI), id_g0, 0) endif call tios_var (hflx_mean,c_str(HFLX_MEAN), id_g0, imap) call tios_var (plat_mean,c_str(LATENT_MEAN) ,id_g0, imap) call tios_var (sens_mean,c_str(SENSIBLE_MEAN),id_g0, imap) call tios_var (plon_mean,c_str(LONGWAVE_MEAN),id_g0, imap) call tios_var (defi_mean,c_str(DEFICIT_MEAN) ,id_g0, imap) call tios_var (sflx_mean,c_str(SFLX_MEAN), id_g0, imap) call tios_var (zmld,c_str(MLD), id_g0, imap) call tios_var (xmld,c_str(IMLD),id_g0, imap) call tios_var (hc_top,c_str(HC_TOP), id_g5, imap) call tios_var (sc_top,c_str(SC_TOP), id_g5, imap) call tios_var (uc_top,c_str(UC_TOP), id_g5, imap) call tios_var (vc_top,c_str(VC_TOP), id_g5, imap) call tios_var (dh_top,c_str(DH_TOP), id_g5, imap) call tios_var (convnm, c_str(CONVN), id_g1, imap) call tios_var (en, c_str(ENRG), id_g2, 0) ifoh = tios_idvar (c_str(FOH), id_g0, imap) call tios_var (dept, c_str(TOTAL_DEPTH), id_g0, imap) call tios_var (relax, c_str(RELAX), id_g0, imap) call tios_var (sponge,c_str(SPONGE), id_g0, imap) call tios_var (kmap ,c_str(KMAP), id_g0, imap) if (ibaro .ne. 0) then call tios_var (psi, c_str(PSI), id_g0, imap) call tios_var (psim, c_str(PSI_MEAN), id_g0, imap) call tios_var (ubar, c_str(U_BAR), id_g0, imap) call tios_var (vbar, c_str(V_BAR), id_g0, imap) call tios_var (dfhd, c_str(DDIV), id_g0, imap) endif idct = idvar_tios(c_str(CURLTAU), id_g0, imap) call tios_var(taux, c_str(TAUX), id_g0, imap) call tios_var(tauy, c_str(TAUY), id_g0, imap) call tios_var(cor, c_str(CORX_BAR), id_g0, imap) call tios_var(cor(npt+1), c_str(CORY_BAR), id_g0, imap) call tios_var(pgf, c_str(PGFX_BAR), id_g0, imap) call tios_var(pgf(npt+1), c_str(PGFY_BAR), id_g0, imap) call tios_var(uforc, c_str(TAUX_BAR), id_g0, imap) call tios_var(vforc, c_str(TAUY_BAR), id_g0, imap) call tios_var(gradE, c_str(GRADEX), id_g0, imap) call tios_var(gradE(npt+1), c_str(GRADEY), id_g0, imap) call tios_var (h, c_str(H_VALUES), id_g1, imap) idtm = idvar_tios (c_str(DELX), id_g0, imap) call tios_var (tp(npt+1), c_str(DELY), id_g0, imap) call tios_var (gradH, c_str(GRADHX), id_g0, imap) call tios_var (gradH(npt+1), c_str(GRADHY), id_g0, imap) call tios_var (psiv, c_str(MOSF), id_g4, 0) call tios_var (q_hd, c_str(Q_HD), id_g6, 0) call tios_var (q_ha, c_str(Q_HA), id_g6, 0) call tios_var (q_sp, c_str(Q_SP), id_g6, 0) call tios_var (hflx_y, c_str(HFLX_Y), id_g6, 0) call tios_var (ep_hd, c_str(EP_HD), id_g6, 0) call tios_var (ep_ha, c_str(EP_HA), id_g6, 0) call tios_var (ep_sp, c_str(EP_SP), id_g6, 0) call tios_var (ep_ri, c_str(EP_RI), id_g6, 0) call tios_var (sflx_y, c_str(SFLX_Y), id_g6, 0) nptz = npt*nz nptzp = npt*(nz+1) if (use_trac) then do i=1,ntrac it = nptz*(i-1) + 1 it1 = nptzp*(i-1) + 1 nlen = name_tr(i) name_temporary = ftrnm(i) call tios_var(tr(it),name_temporary(1:nlen)//'\0',id_g1,imap) call tios_var(ftr_ha(it1),name_temporary(1:nlen)//c_str(_HA), * id_g7,imap) call tios_var(ftr_va(it1),name_temporary(1:nlen)//c_str(_VA), * id_g7,imap) call tios_var(ftr_hd(it1),name_temporary(1:nlen)//c_str(_HD), * id_g7,imap) call tios_var(ftr_vd(it1),name_temporary(1:nlen)//c_str(_VD), * id_g7,imap) call tios_var(ftr_ca(it1),name_temporary(1:nlen)//c_str(_CA), * id_g7,imap) call tios_var(ftr_sp(it1),name_temporary(1:nlen)//c_str(_SP), * id_g7,imap) call tios_var(trm(it1),name_temporary(1:nlen)//c_str(_MEAN), * id_g7,imap) enddo if (iforc_tr.ge.61 .and. iforc_tr.le.63) then call tios_var(trtflx, c_str(TRTFLX),id_g0, imap) call tios_var(trtflx1,c_str(FLX1), id_g0, imap) call tios_var(trtflx2,c_str(FLX2), id_g0, imap) call tios_var(trtflx3,c_str(FLX3), id_g0, imap) call tios_var(cp, c_str(CP) , id_g0, imap) call tios_var(evap, c_str(EVP), id_g0, imap) call tios_var(precip, c_str(PRC), id_g0, imap) call tios_var(relhum, c_str(RLH), id_g0, imap) endif endif if (use_bio) then nptz = npt*nz nptzp= npt*(nz+1) ibio = ntrac*nptz ibiop = ibio + 1 do i=ntrac+1, ntrac+ntrac_bio it = nptz*(i-1) + 1 it1 = nptzp*(i-1) + 1 it0 = npt*(i-ntrac - 1) + 1 nlen = name_tr(i) name_temporary = ftrnm(i) call tios_var(tr(it),name_temporary(1:nlen)//'\0',id_g1,imap) call tios_var(ftr_ha(it1),name_temporary(1:nlen)//c_str(_HA), * id_g7,imap) call tios_var(ftr_va(it1),name_temporary(1:nlen)//c_str(_VA), * id_g7,imap) call tios_var(ftr_hd(it1),name_temporary(1:nlen)//c_str(_HD), * id_g7,imap) call tios_var(ftr_vd(it1),name_temporary(1:nlen)//c_str(_VD), * id_g7,imap) call tios_var(ftr_ca(it1),name_temporary(1:nlen)//c_str(_CA), * id_g7,imap) call tios_var(ftr_sp(it1),name_temporary(1:nlen)//c_str(_SP), * id_g7,imap) call tios_var(trm(it1),name_temporary(1:nlen)//c_str(_MEAN), * id_g7,imap) enddo in = 1 in0= 1 call tios_var(flxbio(in), c_str(FNUTPHY), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(FPHYZOO), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(FPHYDET), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(FDETZOO), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(FZOODET), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(FZOONUT), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(FDETNUT), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(SEDIMENT), id_g7, imap) in = in + nptzp call tios_var(flxbio(in), c_str(REMINERAL), id_g7, imap) call tios_var(xln, c_str(LN), id_g1, imap) call tios_var(xpar, c_str(PAR), id_g1, imap) call tios_var(xle, c_str(LE), id_g1, imap) call tios_var(xlt, c_str(LT), id_g1, imap) if (use_bio_old) then call tios_var(xlm, c_str(LM), id_g1, imap) call tios_var(xlmm, c_str(LM_MEAN), id_g1, imap) endif call tios_var(xlnm, c_str(LN_MEAN), id_g1, imap) call tios_var(xparm, c_str(PAR_MEAN), id_g1, imap) call tios_var(xlem, c_str(LE_MEAN), id_g1, imap) call tios_var(xltm, c_str(LT_MEAN), id_g1, imap) call tios_var(xzm, c_str(ZM), id_g0, imap) call tios_var(xze, c_str(ZE), id_g0, imap) call tios_var(xzmm, c_str(ZM_MEAN), id_g0, imap) call tios_var(xzem, c_str(ZE_MEAN), id_g0, imap) endif call tios_read return end c-------------------------------------------------- subroutine data_out (tenso, nx, ny, npt, nz, en) c-------------------------------------------------- common/grid/nxp,nyp,nxyc,nzl,nbx,nby,ncs,land,nlo,npbc include 'comm_new.h' include 'comm_data.h' include 'comm_pbl.h' include 'comm_diff.h' include 'comm_tracer.h' include 'comm_bio.h' real en(1) common /tios_id/ iddq, ifoh ,idtm, idep, idct external h_to_z, out_mean, out_mosf, dept_to_foh, comp_q * ,comp_ep, out_mean_bio, out_conv, curl_of_tau, out_mean_force integer tios_putvar, tios_putidvar common /mean_comm/ nmcount, nmcount_bio, nmcount_mosf, nmcount_conv common /flux_comm/ largestep_count,mix_count c stream bases variables are: c EXTRA any instantaneous field on A-Grid, see code c EXTRA_MEAN any mean field, see code c EXTRAW any instantaneous field on W-Grid, see code c TEMP instantaneous temperature c DENS instantaneous density c W_VEL instantaneous vertical velocity c T_MEAN mean temperature \ c W_MEAN mean vertical velocity |any of these will trigger c DENS_MEAN mean density / a calculation of means c MOSF mean meridional stream function c CONVN mean convection measure c WNSP_wspd instantaneous surface windspeed c HFLX instantaneous surface heat flux c SFLX instantaneous surface freshwater flux c PBLHUM_qa instantaneous AML humidity c CICE instantaneous ice concentration c HICE instantaneous ice thickness c THICE instantaneous ice heat content c TSNW instantaneous 'snow' temperature c CICE_MEAN mean ice concentration c HICE_MEAN mean ice thickness c THICE_MEAN mean ice heat content c HFLX_MEAN mean surface heat flux c SFLX_MEAN mean surface freshwater flux c PBLHUM_MEAN mean AML humidity c PBLTEM_MEAN mean AML temperature c HC_TOP mean heat content of upper k layers c SC_TOP mean salt content of upper k layers c UC_TOP mean zonal transport of upper k layers c VC_TOP mean merid transport of upper k layers c DH_TOP mean dynamic height of upper k layers (meters) c MLD mean mixed layer depth c IMLD instantaneous number of layers in mixed layer if (n_debug.ne.0) CALL TIOS_CNTRL (1, 1) ! to dump every time step iret = tios_putvar (extra, tenso, 0) iret = tios_putvar (extraw, tenso, 0) iret = tios_putvar (t, tenso, 0) iret = tios_putvar (dens, tenso, 0) iret = tios_putvar (w, tenso, 0) iret = tios_putvar (xmld, tenso, 0) c.....output mean MODEL variables: isetmean = 0 if (tios_putvar (tm, tenso, out_mean).eq.0) then if (tios_putvar (densm, tenso, out_mean).eq.0) then iret = tios_putvar (wm, tenso, out_mean) if (iret.ne.0) isetmean = 1 else isetmean = 1 iret = tios_putvar (wm, tenso, 0) endif else isetmean = 1 iret = tios_putvar (densm, tenso, 0) iret = tios_putvar (wm, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(extram, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(extram, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(hflx_mean, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(hflx_mean, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(sflx_mean, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(sflx_mean, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(zmld, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(zmld, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(hc_top, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(hc_top, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(sc_top, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(sc_top, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(uc_top, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(uc_top, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(vc_top, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(vc_top, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(dh_top, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(dh_top, tenso, 0) endif if (ibaro.ne.0) then if (isetmean.eq.0) then iret = tios_putvar(psim, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(psim, tenso, 0) endif endif iret = tios_putvar (psiv, tenso, out_mosf) iret = tios_putvar (convnm, tenso, out_conv) iret = tios_putvar (w((nz-1)*npt+1), tenso, 0) c..... iret = tios_putvar (vvc,tenso,0) iret = tios_putvar (hblt,tenso,0) iret = tios_putvar (wnd, tenso, 0) iret = tios_putidvar (iddq, tp, tenso, comp_q) iret = tios_putidvar (idep, tp, tenso, comp_ep) if (initq .eq. 8.or.use_ice) then iret = tios_putvar (amhum, tenso, 0) if (isetmean.eq.0) then iret = tios_putvar(amhum_mean, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(amhum_mean, tenso, 0) endif if (isetmean.eq.0) then iret = tios_putvar(amth_mean, tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(amth_mean, tenso, 0) endif endif do i=1,ntrac_sur it=npt*(i-1) + 1 iret = tios_putvar(trs(it) , tenso, 0) if (isetmean.eq.0) then iret = tios_putvar(trsm(it), tenso, out_mean) if (iret.ne.0) isetmean = 1 else iret = tios_putvar(trsm(it), tenso, 0) endif enddo if (use_ice) iret = tios_putvar (tsnw, tenso, 0) iret = tios_putvar (en, tenso, 0) iret = tios_putidvar (ifoh, tp, tenso, dept_to_foh) if (ibaro.ne.0) iret = tios_putvar (psi, tenso, 0) iret = tios_putvar (h, tenso, 0) iret = tios_putidvar (idtm, tp, tenso, h_to_z) iret = tios_putidvar (idct, tp, tenso, curl_of_tau) nptz = npt*nz nptzp = npt*(nz+1) if (use_trac) then do i=1,ntrac it=nptz*(i-1) + 1 it1=nptzp*(i-1) + 1 iret = tios_putvar(tr(it) , tenso, 0) if (isetmean.eq.1) then iret = tios_putvar(trm(it1), tenso, 0) else iret = tios_putvar(trm(it1), tenso, out_mean) if (iret.ne.0) isetmean = 1 endif enddo if (iforc_tr.ge.61 .and. iforc_tr.le.63 ) then iret = tios_putvar(trtflx, tenso, 0) iret = tios_putvar(cp, tenso, 0) iret = tios_putvar(trtflx1, tenso, 0) iret = tios_putvar(trtflx2, tenso, 0) iret = tios_putvar(trtflx3, tenso, 0) iret = tios_putvar(evap, tenso, 0) iret = tios_putvar(precip, tenso, 0) iret = tios_putvar(relhum, tenso, 0) endif endif if (use_bio) then iret = tios_putvar (xln, tenso, 0) iret = tios_putvar (xzm, tenso, 0) iret = tios_putvar (xze, tenso, 0) isetmean = 0 do i=ntrac+1, ntrac + ntrac_bio it=nptz*(i-1) + 1 it1=nptzp*(i-1) + 1 iret = tios_putvar(tr(it) , tenso, 0) if (isetmean.eq.1) then iret = tios_putvar(trm(it1), tenso, 0) else iret = tios_putvar(trm(it1), tenso, out_mean_bio) if (iret.ne.0) isetmean = 1 endif enddo if (isetmean.eq.1) then iret = tios_putvar (xlnm, tenso, 0) else iret = tios_putvar(xlnm, tenso, out_mean_bio) if (iret.ne.0) isetmean = 1 endif if (isetmean.eq.1) then iret = tios_putvar (xzmm, tenso, 0) else iret = tios_putvar(xzmm, tenso, out_mean_bio) if (iret.ne.0) isetmean = 1 endif endif isetmean = 0 if (isetmean.eq.1) then iret = tios_putvar (q_ha, tenso, 0) else iret = tios_putvar (q_ha, tenso, out_mean_force) if (iret.ne.0) isetmean = 1 endif if (isetmean.eq.1) then iret = tios_putvar (ep_ha, tenso, 0) else iret = tios_putvar (ep_ha, tenso, out_mean_force) if (iret.ne.0) isetmean = 1 endif if (isetmean.eq.1) then iret = tios_putvar (ft_ha, tenso, 0) else iret = tios_putvar (ft_ha, tenso, out_mean_force) if (iret.ne.0) isetmean = 1 endif if (isetmean.eq.1) then iret = tios_putvar (fsal_ha, tenso, 0) else iret = tios_putvar (fsal_ha, tenso, out_mean_force) if (iret.ne.0) isetmean = 1 endif if (isetmean.eq.1) then iret = tios_putvar (ft_ha, tenso, 0) else iret = tios_putvar (ft_ha, tenso, out_mean_force) if (iret.ne.0) isetmean = 1 endif if (use_trac.or.use_bio) then do i=1,ntrac_tot it=nptz*(i-1) + 1 if (isetmean.eq.1) then iret = tios_putvar(ftr_ha(it), tenso, 0) else iret = tios_putvar(ftr_ha(it), tenso, out_mean_force) if (iret.ne.0) isetmean = 1 endif enddo endif if (use_bio) then do i= 1, nflbio it=nptzp*(i-1) + 1 if (isetmean.eq.1) then iret = tios_putvar (flxbio(it), tenso, 0) else iret = tios_putvar (flxbio(it), tenso, out_mean_force) if (iret.ne.0) isetmean = 1 endif enddo endif call tios_save if (largestep_count.eq.0) then do i = 1, nz*npt ft_ha(i) = 0. ft_hd(i) = 0. ft_va(i) = 0. ft_vd(i) = 0. ft_ca(i) = 0. ft_sp(i) = 0. fsal_ha(i) = 0. fsal_hd(i) = 0. fsal_va(i) = 0. fsal_vd(i) = 0. fsal_ca(i) = 0. fsal_sp(i) = 0. fsal_ri(i) = 0. enddo do i = 1, ntrac_tot*(nz+1)*npt ftr_ha(i) = 0. ftr_hd(i) = 0. ftr_va(i) = 0. ftr_vd(i) = 0. ftr_ca(i) = 0. ftr_sp(i) = 0. enddo if (use_bio) then do i = 1, (nz+1)*npt*nflbio flxbio(i) = 0. enddo endif endif return end c------------------------------------------------------------ subroutine h_to_z c------------------------------------------------------------ include 'comm_data.h' include 'comm_para.h' common/grid/nxp,nyp,nxyc,nz,nbx,nby,ncs,land,nlo,npbc c do i = 1, nxyc tp(i) = 1./saxpk(i) tp(i+nxyc) = 1./saypk(i) enddo return end c------------------------------------------------------------ subroutine curl_of_tau c------------------------------------------------------------ include 'comm_data.h' common/grid/nxp,nyp,nxyc,nz,nbx,nby,ncs,land,nlo,npbc c curl of the wind stress call curlz (nxp,nyp,nxyc,nxyc,taux,tauy,dx2i,dy2i,ycos, * isk,inx,iny,tp,nbx,nby,lxxk,lyyk) return end c------------------------------------------------------------ subroutine dept_to_foh c------------------------------------------------------------ include 'comm_data.h' include 'comm_para.h' common/grid/nxp,nyp,nxyc,nz,nbx,nby,ncs,land,nlo,npbc c c compute f/H do i = 1, nxyc tp(i) = f(i)/dept(i) enddo return end c subroutine out_mean is now in dyn_trouble.f subroutine out_mean_force c-------------------------- include 'comm_para.h' include 'comm_data.h' include 'comm_new.h' include 'comm_bio.h' logical NEWRUN common /grid/ nxp, nyp, nxyc, nz, nbx,nby,ncs,land,nlo,npbc common /main/npt, NEWRUN common /flux_comm/ largestep_count,mix_count coef = 1./real(max(1,largestep_count)) coef_mix = 1./real(max(1,mix_count)) largestep_count = 0 mix_count = 0 do i = 1, nz*nxyc ft_ha(i) = coef*ft_ha(i) ft_hd(i) = coef*ft_hd(i) ft_va(i) = coef*ft_va(i) ft_vd(i) = coef*ft_vd(i) ft_sp(i) = coef*ft_sp(i) ft_ca(i) = coef_mix*ft_ca(i) fsal_ha(i) = coef*fsal_ha(i) fsal_hd(i) = coef*fsal_hd(i) fsal_va(i) = coef*fsal_va(i) fsal_vd(i) = coef*fsal_vd(i) fsal_sp(i) = coef*fsal_sp(i) fsal_ri(i) = coef*fsal_ri(i) fsal_ca(i) = coef_mix*fsal_ca(i) enddo do in = 1, (nz+1)*nxyc do k = 1, ntrac_tot i = (k-1)*(nz+1)*nxyc + in ftr_ha(i) = coef*ftr_ha(i) ftr_hd(i) = coef*ftr_hd(i) ftr_va(i) = coef*ftr_va(i) ftr_vd(i) = coef*ftr_vd(i) ftr_sp(i) = coef*ftr_sp(i) ftr_ca(i) = coef_mix*ftr_ca(i) enddo enddo do n= 1, ntrac_bio ideb = (ntrac+n-1)*nxyc*(nz+1) +1 call depth_int2(h, nz, npt, ftr_ha(ideb) ) call depth_int2(h, nz, npt, ftr_hd(ideb) ) call depth_int2(h, nz, npt, ftr_va(ideb) ) call depth_int2(h, nz, npt, ftr_vd(ideb) ) call depth_int2(h, nz, npt, ftr_sp(ideb) ) call depth_int2(h, nz, npt, ftr_ca(ideb) ) enddo call comp_qf(nxp,nyp,nz,npt,mask,ft_ha,q_ha,sxm,vcint) call comp_qf(nxp,nyp,nz,npt,mask,ft_hd,q_hd,sxm,vcint) call comp_qf(nxp,nyp,nz,npt,mask,ft_sp,q_sp,sxm,vcint) call comp_qf(nxp,nyp,nz,npt,mask,fsal_ha,ep_ha,sxm,vcint) call comp_qf(nxp,nyp,nz,npt,mask,fsal_hd,ep_hd,sxm,vcint) call comp_qf(nxp,nyp,nz,npt,mask,fsal_sp,ep_sp,sxm,vcint) call comp_qf(nxp,nyp,nz,npt,mask,fsal_ri,ep_ri,sxm,vcint) if (use_bio) then do i = 1, (nz+1)*nxyc*nflbio flxbio(i) = coef*flxbio(i) enddo do n= 1, nflbio ideb = (n-1)*nxyc*(nz+1) +1 call depth_int(h, nz, npt, flxbio(ideb) ) enddo endif return end subroutine out_conv c-------------------------- include 'comm_data.h' include 'comm_new.h' common /grid/ nxp, nyp, nxyc, nz, nbx,nby,ncs,land,nlo,npbc common /mean_comm/ nmcount, nmcount_bio, nmcount_mosf, nmcount_conv coef = 1./real(max(1,nmcount_conv)) nmcount_conv = 0 do i = 1, nz*nxyc convnm(i) = coef*convnm(i) enddo return end subroutine out_mean_bio c-------------------------- include 'comm_data.h' include 'comm_new.h' include 'comm_bio.h' common /grid/ nxp, nyp, nxyc, nz, nbx,nby,ncs,land,nlo,npbc common /mean_comm/ nmcount, nmcount_bio, nmcount_mosf, nmcount_conv coef = 1./real(max(1,nmcount_bio)) nmcount_bio = 0 ibio = ntrac*nxyc*(nz+1) do i = ibio+1, ibio + (nz+1)*nxyc*ntrac_bio trm(i) = coef*trm(i) enddo do n= 1, ntrac_bio ideb = (ntrac+n-1)*nxyc*(nz+1) +1 call depth_int(h, nz, nxyc, trm(ideb) ) enddo do i = 1, nz*nxyc xlem(i) = coef*xlem(i) xparm(i) = coef*xparm(i) xltm(i) = coef*xltm(i) xlnm(i) = coef*xlnm(i) enddo do i = 1, nxyc xzmm(i) = coef*xzmm(i) xzem(i) = coef*xzem(i) enddo if (use_bio_old) then do i = 1, nz*nxyc xlmm(i) = coef*xlmm(i) enddo endif return end c------------------------------------------------------------ subroutine out_mosf c------------------------------------------------------------ include 'comm_para.h' include 'comm_new.h' include 'comm_data.h' c# include 'comm_tios.h' common /grid/nxp,nyp,nxyc,nz,nbx,nby,ncs,land,nlo,npbc common /main/npt, NEWRUN common /mean_comm/ nmcount, nmcount_bio, nmcount_mosf, nmcount_conv c# common /param0/iyear,iday,isec,delt,ncyc,mbc,nonlin,label(20), c# * itherm,mlc,limp c for mean field meridional overturning streamfunction: coef = 1./real(nmcount_mosf) nmcount_mosf = 0 do i = 1, nz*nxyc vcm(i)= coef*vcm(i) enddo call comp_mosf(nxp,nyp,nz,npt,mask,vcm,psiv,sxm,vcint,tp) return end c------------------------------------------------------------ subroutine comp_mosf(nx,ny,nz,npt,mask,v,psi,sxm,vint,tmp) c------------------------------------------------------------ c find the meridional overturning streamfunction include 'comm_para.h' include 'comm_new.h' dimension mask(nx*ny,nz),v(npt,nz) dimension sxm(npt,nz),vint(ny,nz) dimension tmp(ny),psi(ny,nz+2) jmax=0 jmin=ny do j = 1, ny do i = 1, nx ij = (j-1)*nx + i ii = mask(ij,1) if (ii.gt.0) then jmax = max(jmax,j) jmin = min(jmin,j) endif enddo enddo do j = 1, ny tmp(j) = 0 enddo do j = 1, ny do i = 1, nx ij = (j-1)*nx + i do k = 1, nz ii = mask(ij,k) if (ii.gt.0) then tmp(j) = max(k,tmp(j)) endif enddo enddo enddo c compute vint = zonal integral of v call zonal_int(nx,ny,nz,npt,mask,v,vint,sxm) rnan = sqrt(-1.) do j = 1, ny do k = 1, nz+1 psi(j,k) = rnan enddo enddo do j = jmin, jmax psi(j,1) = 0. enddo do k = 1, tmp(jmin)+1 psi(jmin,k) = 0. enddo do k = 1, tmp(jmax)+1 psi(jmax,k) = 0. enddo c compute psi from integrating vint in z do j = jmin + 1, jmax - 1 psi(j,tmp(j)+1) = 0. do k = 2, tmp(j)+1 c psi(j,k)=psi(j,k-1) + vint(j,k-1) ik = tmp(j)+2-k psi(j,ik)=psi(j,ik+1) - vint(j,ik) enddo enddo c to prevent ugly ingrid picts: do j = 1, ny psi(j,nz+2) = rnan enddo return end c------------------------------------------------------------ subroutine comp_qf(nx,ny,nz,npt,mask,v,psi,sxm,vint) c------------------------------------------------------------ c find the meridional overturning streamfunction include 'comm_para.h' include 'comm_new.h' dimension mask(nx*ny,nz),v(npt,nz) dimension sxm(npt,nz),vint(ny,nz) dimension psi(ny) c compute vint = zonal integral of v call zonal_int(nx,ny,nz,npt,mask,v,vint,sxm) do j = 1, ny psi(j) = vint(j,1) enddo c compute psi from integrating vint in z do j = 1, ny do k = 2, nz psi(j) = psi(j) + vint(j,k) enddo enddo return end c------------------------------------------------------------ subroutine zonal_int(nx,ny,nz,npt,mask,f,fint,sxm) c------------------------------------------------------------ dimension mask(nx*ny,nz),f(npt,nz),fint(ny,nz),sxm(npt,nz) do j = 1, ny do k = 1, nz fint(j,k) = 0. enddo enddo do j = 1, ny do i = 1, nx ij = (j-1)*nx + i do k = 1, nz ii = mask(ij,1) if (mask(ij,k).gt.0) then fint(j,k) = fint(j,k) + f(ii,k)*sxm(ii,k) endif enddo enddo enddo return end c------------------------------------------------------------ subroutine depth_int(h, nz, npt, f) c------------------------------------------------------------ c integrates vertically over the first jpbio layers c and puts it in the last vertical layer (nz+1) include 'biology.h' dimension h(npt, nz), f(npt,nz+1) do i=1, npt fint =0. do k=1, jpbio fint=fint + f(i,k)*h(i,k) enddo f(i,nz+1)= fint enddo return end c------------------------------------------------------------ subroutine depth_int2(h, nz, npt, f) c------------------------------------------------------------ c integrates vertically over the first jpbio layers c and puts it in the last vertical layer (nz+1) include 'biology.h' dimension h(npt, nz), f(npt,nz+1) do i=1, npt fint =0. do k=1, jpbio fint=fint + f(i,k) enddo f(i,nz+1)= fint enddo return end subroutine add_mean(nstep, npt, nx, ny) c----------------------------- include 'comm_data.h' include 'comm_new.h' include 'comm_bio.h' include 'comm_pbl.h' common /grid/ nxp, nyp, nxyc, nz, nbx,nby,ncs,land,nlo,npbc common /mean_comm/ nmcount, nmcount_bio, nmcount_mosf, nmcount_conv common /flux_comm/ largestep_count,mix_count nmcount = nmcount + 1 nmcount_mosf = nmcount_mosf + 1 nmcount_bio = nmcount_bio + 1 nmcount_conv = nmcount_conv + 1 largestep_count = largestep_count + 1 nptz = nz*nxyc nptrz = ntrac*nz*nxyc nptrzp = ntrac*(nz+1)*nxyc nptzp = (nz+1)*nxyc budget = budget_eb + budget_pr + budget_ri + v_sponge bud = budget + budget_sp + budget_re - v_sponge coef_bud= coef_bud + tscl_bud*((budget_pr- budget)/budget_pr- coef_bud) if (nmcount .eq. 1) then do i = 1, nptz um(i) = 0. vm(i) = 0. wm(i) = 0. hm(i) = 0. tm(i) = 0. salm(i) = 0. densm(i) = 0. enddo do i = 1, nxyc hflx_mean(i) = 0. sflx_mean(i) = 0. plat_mean(i) = 0. defi_mean(i) = 0. plon_mean(i) = 0. sens_mean(i) = 0. psim(i) = 0. zmld(i) = h(i) enddo if (initq .eq. 8) then do i = 1, nx*ny amhum_mean(i)= 0. amth_mean(i) = 0. enddo endif do i = 1, nxyc*ntrac_sur trsm(i) = 0. enddo do i = 1, nptrzp trm(i) = 0. enddo endif if (nmcount_mosf .eq. 1) then do i = 1, nptz vcm(i) = 0. enddo endif if (nmcount_conv .eq. 1) then do i = 1, nptz convnm(i) = 0. enddo endif do i = 1, nptz um(i) = um(i) + u(i) vm(i) = vm(i) + v(i) vcm(i)= vcm(i)+ vc(i) hm(i) = hm(i) + h(i) wm(i) = wm(i) + w(i) tm(i) = tm(i) + t(i) salm(i) = salm(i) + sal(i) densm(i) = densm(i) + dens(i) convnm(i) = convnm(i) + convn(i) enddo rnan = sqrt(-1.) do i = 1, nxyc hflx_mean(i) = hflx_mean(i) + QCON*(qr(i) + q(i)) sflx_mean(i) = sflx_mean(i) + ep(i)/sal(i) plat_mean(i) = plat_mean(i) + qb(nxyc+i) defi_mean(i) = defi_mean(i) + qb(4*nxyc+i) plon_mean(i) = plon_mean(i) + qb(3*nxyc+i) sens_mean(i) = sens_mean(i) + qb(2*nxyc+i) psim(i) = psim(i) + psi(i) enddo if (initq .eq. 8) then do i = 1, nx*ny amhum_mean(i)= amhum_mean(i) + amhum(i) amth_mean(i) = amth_mean(i) + amth(i) enddo endif if (use_ice) then do i = 1, nxyc*ntrac_sur trsm(i) = trsm(i) + trs(i) enddo endif do i = 1, nxyc do k=1, nz do n=1, ntrac ind0= (n-1)*nz*nxyc + (k-1)*nxyc + i ind1= (n-1)*(nz+1)*nxyc + (k-1)*nxyc + i trm(ind1) = trm(ind1) + tr(ind0) enddo enddo enddo if (use_bio) then ibio = nptrzp if (nmcount_bio .eq. 1) then do i = 1, nptzp*ntrac_bio trm(ibio+i) = 0. enddo do i = 1, nptz xlem(i) = 0. xparm(i) = 0. xltm(i) = 0. xlnm(i) = 0. enddo do i = 1, nxyc xzmm(i) = 0. xzem(i) = 0. enddo if (use_bio_old) then do i = 1, nptz xlmm(i) = 0. enddo endif endif do n=1, ntrac_bio ib0 = (ntrac+n-1)*nz*nxyc ib1 = (ntrac+n-1)*(nz+1)*nxyc do k=1, nz ibk = (k-1)*nxyc do i = 1, nxyc ind0= ib0 + ibk + i ind1= ib1 + ibk + i trm(ind1) = trm(ind1) + tr(ind0) enddo enddo enddo do i = 1, nptz xparm(i) = xparm(i) + xpar(i) xlem(i) = xlem(i) + xle(i) xltm(i) = xltm(i) + xlt(i) xlnm(i) = xlnm(i) + xln(i) enddo if (use_bio_old) then do i = 1, nptz xlmm(i) = xlmm(i) + xlm(i) enddo endif do i = 1, nxyc xzmm(i) = xzmm(i) + xzm(i) xzem(i) = xzem(i) + xze(i) enddo endif return end c------------------------------------------------------------ subroutine comp_q c------------------------------------------------------------ include 'comm_new.h' include 'comm_data.h' common /grid/ nxp, nyp, nxyc, nz, nbx,nby,ncs,land,nlo,npbc do i = 1, nxyc tp(i) = QCON * (q(i) + qr(i)) enddo return end c------------------------------------------------------------ subroutine comp_ep c------------------------------------------------------------ include 'comm_new.h' include 'comm_data.h' common /grid/ nxp, nyp, nxyc, nz, nbx,nby,ncs,land,nlo,npbc do i = 1, nxyc tp(i) = ep(i)/sal(i) enddo return end