#include "cppdefs.h" SUBROUTINE wrt_his (ng, tile) ! !svn $Id: wrt_his.F 889 2018-02-10 03:32:52Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2019 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.txt ! !======================================================================= ! ! ! This routine writes requested model fields at requested levels ! ! into history NetCDF file. ! ! ! ! Notice that only momentum is affected by the full time-averaged ! ! masks. If applicable, these mask contains information about ! ! river runoff and time-dependent wetting and drying variations. ! ! ! !======================================================================= ! USE mod_param USE mod_parallel #ifdef BBL_MODEL USE mod_bbl #endif #ifdef ADJUST_BOUNDARY USE mod_boundary #endif #ifdef SOLVE3D USE mod_coupling #endif USE mod_forces USE mod_grid #ifdef ICE_MODEL USE mod_ice #endif USE mod_iounits USE mod_mixing USE mod_ncparam USE mod_netcdf USE mod_ocean USE mod_scalars #if defined SEDIMENT || defined BBL_MODEL USE mod_sedbed USE mod_sediment #endif #if defined VEGETATION USE mod_vegetation USE mod_vegarr #endif #if defined BIOLOGY USE mod_biology #endif USE mod_stepping ! USE nf_fwrite2d_mod, ONLY : nf_fwrite2d #ifdef ADJUST_BOUNDARY USE nf_fwrite2d_bry_mod, ONLY : nf_fwrite2d_bry #endif #ifdef SOLVE3D USE nf_fwrite3d_mod, ONLY : nf_fwrite3d # ifdef ADJUST_BOUNDARY USE nf_fwrite3d_bry_mod, ONLY : nf_fwrite3d_bry # endif USE omega_mod, ONLY : scale_omega #endif USE uv_rotate_mod, ONLY : uv_rotate2d #ifdef SOLVE3D USE uv_rotate_mod, ONLY : uv_rotate3d #endif USE strings_mod, ONLY : FoundError #ifdef INWAVE_MODEL USE mod_inwave_params USE mod_inwave_vars #endif ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile ! ! Local variable declarations. ! integer :: LBi, UBi, LBj, UBj #ifdef ADJUST_BOUNDARY integer :: LBij, UBij #endif integer :: Fcount, gfactor, gtype, status #ifdef SOLVE3D integer :: i, itrc, j, k #endif real(r8) :: scale real(r8), allocatable :: Ur2d(:,:) real(r8), allocatable :: Vr2d(:,:) #ifdef SOLVE3D real(r8), allocatable :: Ur3d(:,:,:) real(r8), allocatable :: Vr3d(:,:,:) real(r8), allocatable :: Wr3d(:,:,:) #endif #ifdef BBL_MODEL real(r8), allocatable :: wrk2(:,:) #endif # include "set_bounds.h" ! SourceFile=__FILE__ ! LBi=LBOUND(GRID(ng)%h,DIM=1) UBi=UBOUND(GRID(ng)%h,DIM=1) LBj=LBOUND(GRID(ng)%h,DIM=2) UBj=UBOUND(GRID(ng)%h,DIM=2) #ifdef ADJUST_BOUNDARY LBij=BOUNDS(ng)%LBij UBij=BOUNDS(ng)%UBij #endif ! !----------------------------------------------------------------------- ! Write out history fields. !----------------------------------------------------------------------- ! IF (FoundError(exit_flag, NoError, __LINE__, & & __FILE__)) RETURN ! ! Set grid type factor to write full (gfactor=1) fields or water ! points (gfactor=-1) fields only. ! #if defined WRITE_WATER && defined MASKING gfactor=-1 #else gfactor=1 #endif ! ! Set time record index. ! HIS(ng)%Rindex=HIS(ng)%Rindex+1 Fcount=HIS(ng)%Fcount HIS(ng)%Nrec(Fcount)=HIS(ng)%Nrec(Fcount)+1 ! ! Write out model time (s). ! CALL netcdf_put_fvar (ng, iNLM, HIS(ng)%name, & & TRIM(Vname(idtime,ng)), time(ng:), & & (/HIS(ng)%Rindex/), (/1/), & & ncid = HIS(ng)%ncid, & & varid = HIS(ng)%Vid(idtime)) IF (FoundError(exit_flag, NoError, __LINE__, & & __FILE__)) RETURN #if defined SEDIMENT && defined SED_MORPH ! ! Write out time-dependent bathymetry (m) ! IF (Hout(idBath,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idbath), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & GRID(ng) % h, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idbath)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WET_DRY ! ! Write out wet/dry mask at PSI-points. ! scale=1.0_r8 gtype=gfactor*p2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idPwet), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % pmask, & # endif & GRID(ng) % pmask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPwet)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at RHO-points. ! scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRwet), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & GRID(ng) % rmask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRwet)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at U-points. ! scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUwet), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & GRID(ng) % umask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUwet)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at V-points. ! scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVwet), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & GRID(ng) % vmask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVwet)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #endif #ifdef SOLVE3D ! ! Write time-varying depths of RHO-points. ! IF (Hout(idpthR,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idpthR), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & GRID(ng) % z_r) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idpthR)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write time-varying depths of U-points. ! IF (Hout(idpthU,ng)) THEN scale=1.0_r8 gtype=gfactor*u3dvar DO k=1,N(ng) DO j=Jstr-1,Jend+1 DO i=IstrU-1,Iend+1 GRID(ng)%z_v(i,j,k)=0.5_r8*(GRID(ng)%z_r(i-1,j,k)+ & & GRID(ng)%z_r(i ,j,k)) END DO END DO END DO status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idpthU), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & GRID(ng) % z_v) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idpthU)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write time-varying depths of V-points. ! IF (Hout(idpthV,ng)) THEN scale=1.0_r8 gtype=gfactor*v3dvar DO k=1,N(ng) DO j=JstrV-1,Jend+1 DO i=Istr-1,Iend+1 GRID(ng)%z_v(i,j,k)=0.5_r8*(GRID(ng)%z_r(i,j-1,k)+ & & GRID(ng)%z_r(i,j ,k)) END DO END DO END DO status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idpthV), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & GRID(ng) % z_v) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idpthV)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write time-varying depths of W-points. ! IF (Hout(idpthW,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idpthW), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & GRID(ng) % z_w) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idpthW)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! ! Write out free-surface (m) ! IF (Hout(idFsur,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idFsur), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % rmask, & #endif #ifdef WET_DRY & OCEAN(ng) % zeta(:,:,KOUT), & & SetFillVal = .FALSE.) #else & OCEAN(ng) % zeta(:,:,KOUT)) #endif IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idFsur)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #if defined FORWARD_WRITE && defined FORWARD_RHS status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRzet), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % rzeta(:,:,KOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRzet)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #endif END IF #ifdef ADJUST_BOUNDARY ! ! Write out free-surface open boundaries. ! IF (ANY(Lobc(:,isFsur,ng))) THEN scale=1.0_r8 status=nf_fwrite2d_bry (ng, iNLM, HIS(ng)%name, HIS(ng)%ncid, & & Vname(1,idSbry(isFsur)), & & HIS(ng)%Vid(idSbry(isFsur)), & & HIS(ng)%Rindex, r2dvar, & & LBij, UBij, Nbrec(ng), scale, & & BOUNDARY(ng) % zeta_obc(LBij:,:,:, & & Lbout(ng))) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSbry(isFsur))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! ! Write out 2D U-momentum component (m/s). ! IF (Hout(idUbar,ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUbar), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % umask_full, & #endif & OCEAN(ng) % ubar(:,:,KOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbar)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #ifdef FORWARD_WRITE # ifdef FORWARD_RHS status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRu2d), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % rubar(:,:,KOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRu2d)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # ifdef SOLVE3D # ifdef FORWARD_RHS status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRuct), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & COUPLING(ng) % rufrc) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRuct)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUfx1), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & COUPLING(ng) % DU_avg1) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUfx1)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUfx2), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & COUPLING(ng) % DU_avg2) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUfx2)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif #endif END IF #ifdef ADJUST_BOUNDARY ! ! Write out 2D U-momentum component open boundaries. ! IF (ANY(Lobc(:,isUbar,ng))) THEN scale=1.0_r8 status=nf_fwrite2d_bry (ng, iNLM, HIS(ng)%name, HIS(ng)%ncid, & & Vname(1,idSbry(isUbar)), & & HIS(ng)%Vid(idSbry(isUbar)), & & HIS(ng)%Rindex, u2dvar, & & LBij, UBij, Nbrec(ng), scale, & & BOUNDARY(ng) % ubar_obc(LBij:,:,:, & & Lbout(ng))) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSbry(isUbar))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! ! Write out 2D V-momentum component (m/s). ! IF (Hout(idVbar,ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVbar), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % vmask_full, & #endif & OCEAN(ng) % vbar(:,:,KOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbar)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #ifdef FORWARD_WRITE # ifdef FORWARD_RHS status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRv2d), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % rvbar(:,:,KOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRv2d)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # ifdef SOLVE3D # ifdef FORWARD_RHS status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRvct), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & COUPLING(ng) % rvfrc) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRvct)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVfx1), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & COUPLING(ng) % DV_avg1) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVfx1)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVfx2), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & COUPLING(ng) % DV_avg2) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVfx2)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif #endif END IF #ifdef ADJUST_BOUNDARY ! ! Write out 2D V-momentum component open boundaries. ! IF (ANY(Lobc(:,isVbar,ng))) THEN scale=1.0_r8 status=nf_fwrite2d_bry (ng, iNLM, HIS(ng)%name, HIS(ng)%ncid, & & Vname(1,idSbry(isVbar)), & & HIS(ng)%Vid(idSbry(isVbar)), & & HIS(ng)%Rindex, v2dvar, & & LBij, UBij, Nbrec(ng), scale, & & BOUNDARY(ng) % vbar_obc(LBij:,:,:, & & Lbout(ng))) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSbry(isVbar))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! ! Write out 2D Eastward and Northward momentum components (m/s) at ! RHO-points. ! IF (Hout(idu2dE,ng).and.Hout(idv2dN,ng)) THEN IF (.not.allocated(Ur2d)) THEN allocate (Ur2d(LBi:UBi,LBj:UBj)) Ur2d(LBi:UBi,LBj:UBj)=0.0_r8 END IF IF (.not.allocated(Vr2d)) THEN allocate (Vr2d(LBi:UBi,LBj:UBj)) Vr2d(LBi:UBi,LBj:UBj)=0.0_r8 END IF CALL uv_rotate2d (ng, tile, .FALSE., .TRUE., & & LBi, UBi, LBj, UBj, & & GRID(ng) % CosAngler, & & GRID(ng) % SinAngler, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & OCEAN(ng) % ubar(:,:,KOUT), & & OCEAN(ng) % vbar(:,:,KOUT), & & Ur2d, Vr2d) scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idu2dE), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & Ur2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idu2dE)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idv2dN), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & Vr2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idv2dN)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (Ur2d) deallocate (Vr2d) END IF #ifdef SOLVE3D ! ! Write out 3D U-momentum component (m/s). ! IF (Hout(idUvel,ng)) THEN scale=1.0_r8 gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUvel), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % u(:,:,:,NOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUvel)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # if defined FORWARD_WRITE && defined FORWARD_RHS status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRu3d), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % ru(:,:,:,NOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRu3d)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif END IF # ifdef ADJUST_BOUNDARY ! ! Write out 3D U-momentum component open boundaries. ! IF (ANY(Lobc(:,isUvel,ng))) THEN scale=1.0_r8 status=nf_fwrite3d_bry (ng, iNLM, HIS(ng)%name, HIS(ng)%ncid, & & Vname(1,idSbry(isUvel)), & & HIS(ng)%Vid(idSbry(isUvel)), & & HIS(ng)%Rindex, u3dvar, & & LBij, UBij, 1, N(ng), Nbrec(ng), scale, & & BOUNDARY(ng) % u_obc(LBij:,:,:,:, & & Lbout(ng))) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSbry(isUvel))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif ! ! Write out 3D V-momentum component (m/s). ! IF (Hout(idVvel,ng)) THEN scale=1.0_r8 gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVvel), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % v(:,:,:,NOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVvel)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # if defined FORWARD_WRITE && defined FORWARD_RHS status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idRv3d), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % rv(:,:,:,NOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRv3d)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif END IF # ifdef ADJUST_BOUNDARY ! ! Write out 3D V-momentum component open boundaries. ! IF (ANY(Lobc(:,isVvel,ng))) THEN scale=1.0_r8 status=nf_fwrite3d_bry (ng, iNLM, HIS(ng)%name, HIS(ng)%ncid, & & Vname(1,idSbry(isVvel)), & & HIS(ng)%Vid(idSbry(isVvel)), & & HIS(ng)%Rindex, v3dvar, & & LBij, UBij, 1, N(ng), Nbrec(ng), scale, & & BOUNDARY(ng) % v_obc(LBij:,:,:,:, & & Lbout(ng))) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSbry(isVvel))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif ! ! Write out 3D Eastward and Northward momentum components (m/s) at ! RHO-points. ! IF (Hout(idu3dE,ng).and.Hout(idv3dN,ng)) THEN IF (.not.allocated(Ur3d)) THEN allocate (Ur3d(LBi:UBi,LBj:UBj,N(ng))) Ur3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 END IF IF (.not.allocated(Vr3d)) THEN allocate (Vr3d(LBi:UBi,LBj:UBj,N(ng))) Vr3d(LBi:UBi,LBj:UBj,1:N(ng))=0.0_r8 END IF CALL uv_rotate3d (ng, tile, .FALSE., .TRUE., & & LBi, UBi, LBj, UBj, 1, N(ng), & & GRID(ng) % CosAngler, & & GRID(ng) % SinAngler, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % u(:,:,:,NOUT), & & OCEAN(ng) % v(:,:,:,NOUT), & & Ur3d, Vr3d) scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idu3dE), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & Ur3d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idu3dE)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idv3dN), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & Vr3d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idv3dN)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (Ur3d) deallocate (Vr3d) END IF ! ! Write out S-coordinate omega vertical velocity (m/s). ! IF (Hout(idOvel,ng)) THEN IF (.not.allocated(Wr3d)) THEN allocate (Wr3d(LBi:UBi,LBj:UBj,0:N(ng))) Wr3d(LBi:UBi,LBj:UBj,0:N(ng))=0.0_r8 END IF scale=1.0_r8 gtype=gfactor*w3dvar CALL scale_omega (ng, tile, LBi, UBi, LBj, UBj, 0, N(ng), & & GRID(ng) % pm, & & GRID(ng) % pn, & & OCEAN(ng) % W, & & Wr3d) status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idOvel), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & Wr3d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idOvel)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (Wr3d) END IF ! ! Write out vertical velocity (m/s). ! IF (Hout(idWvel,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWvel), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % wvel) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWvel)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out tracer type variables. ! DO itrc=1,NT(ng) IF (Hout(idTvar(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Tid(itrc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % t(:,:,:,NOUT,itrc)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTvar(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # ifdef ADJUST_BOUNDARY ! ! Write out 3D tracers open boundaries. ! DO itrc=1,NT(ng) IF (ANY(Lobc(:,isTvar(itrc),ng))) THEN scale=1.0_r8 status=nf_fwrite3d_bry (ng, iNLM, HIS(ng)%name, HIS(ng)%ncid, & & Vname(1,idSbry(isTvar(itrc))), & & HIS(ng)%Vid(idSbry(isTvar(itrc))), & & HIS(ng)%Rindex, r3dvar, & & LBij, UBij, 1, N(ng), Nbrec(ng), & & scale, & & BOUNDARY(ng) % t_obc(LBij:,:,:,:, & & Lbout(ng),itrc)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSbry(isTvar(itrc)))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif # ifdef BEST_NPZ # ifdef STATIONARY !-------------------------------------- ! Write out 3D stationary variable array !-------------------------------------- DO itrc=1,NTS(ng) IF (Hout(idTSvar(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar ! print *,'st=',OCEAN(ng) % st(:,:,:,NOUT,itrc) ! if (hisTSid(itrc,ng) .lt. 0) hisTSid(itrc,ng) = 0 status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%TSid(itrc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % st(:,:,:,NOUT,itrc)) !--------------------- !Zero the output array !--------------------- ! print *,'st=',OCEAN(ng) % st(:,:,:,1,1) ! print *,'NOUT=',NOUT ! print *,'itrc=',itrc OCEAN(ng) % st(:,:,:,NOUT,itrc) = 0.0_r8 IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTSvar(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif # ifdef STATIONARY2 !-------------------------------------- ! Write out 2D stationary variable array !-------------------------------------- DO itrc=1,NTS2(ng) IF (Hout(idTS2var(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar if (hisTS2id(itrc,ng) .lt. 0) hisTS2id(itrc,ng) = 0 status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%TS2id(itrc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % st2(:,:,NOUT,itrc)) !--------------------- !Zero the output array !--------------------- OCEAN(ng) % st2(:,:,NOUT,itrc) = 0.0_r8 IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTS2var(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif !-------------------------------------- ! Write out 2D production array !-------------------------------------- # ifdef PROD2 DO itrc=1,NPT2(ng) IF (Hout(idPT2var(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar if (hisPT2id(itrc,ng) .lt. 0) hisPT2id(itrc,ng) = 0 status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%PT2id(itrc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % pt2(:,:,NOUT,itrc)) !--------------------- !Zero the output array !--------------------- OCEAN(ng) % pt2(:,:,NOUT,itrc) = 0.0_r8 IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPT2var(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif !-------------------------------------- ! Write out 3D production array !-------------------------------------- # ifdef PROD3 DO itrc=1,NPT3(ng) IF (Hout(idPT3var(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar if (hisPT3id(itrc,ng) .lt. 0) hisPT3id(itrc,ng) = 0 status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%PT3id(itrc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % pt3(:,:,:,NOUT,itrc)) !--------------------- !Zero the output array !--------------------- OCEAN(ng) % pt3(:,:,:,NOUT,itrc) = 0.0_r8 IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPT3var(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif !------------------------------ !Write out benthic variables !----------------------------- # if defined BENTHIC DO itrc=1,NBeT(ng) IF (Hout(idBeTvar(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Bid(itrc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & !Will need to switch this if have more than one depth level for benthos ! status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Bid(itrc), & ! & HIS(ng)%Rindex, gtype, & ! & LBi, UBi, LBj, UBj, 1, NBL(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % bt(:,:,1,NOUT,itrc)) ! print *,OCEAN(ng) % bt(LBi,LBj,1,NOUT,itrc) ! print *, 'LBi=',LBi,'LBj=',LBj,'NOUT=',NOUT,'itrc=',itrc IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10)TRIM(Vname(1,idBeTvar(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif !------------------------------ !Write out ice bio variables !----------------------------- # if defined ICE_BIO # ifdef CLIM_ICE_1D DO itrc=1,NIceT(ng) IF (Hout(idIceBvar(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%IceBid(itrc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & !Will need to switch this if have more than one depth level for benthos ! status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%IceBid(itrc), & ! & HIS(ng)%Rindex, gtype, & ! & LBi, UBi, LBj, UBj, 1, NBL(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % it(:,:,NOUT,itrc)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10)TRIM(Vname(1,idIceBvar(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # else ! ! Write out Ice Algae ! IF (Hout(idIcePhL,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idIcePhL), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % IcePhL(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idIcePhL)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out Ice Nitrate ! IF (Hout(idIceNO3,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idIceNO3), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % IceNO3(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idIceNO3)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! Write out Ice Ammonium ! IF (Hout(idIceNH4,ng)) THEN ! IF (Hout(idIceBvar,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idIceNH4), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % IceNH4(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idIceNH4)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! Write out IceLog (doesn't work with IceLog being int) ! # ifdef FOO IF (Hout(idIceLog,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idIceLog), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % IceLog(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idIceLog)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # endif # endif # endif ! ! Write out density anomaly. ! IF (Hout(idDano,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idDano), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % rho) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idDano)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef NEMURO_SED1 ! ! Write out PON in sediment. ! IF (Hout(idPONsed,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idPONsed), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % PONsed) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPONsed)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out OPAL in sediment. ! IF (Hout(idOPALsed,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idOPALsed), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % OPALsed) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idOPALsed)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out DENIT in sediment. ! IF (Hout(idDENITsed,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idDENITsed), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % DENITsed) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idDENITsed)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out buried PON in sediment. ! IF (Hout(idPONbur,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idPONbur), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % PON_burial) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPONbur)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out buried OPAL in sediment. ! IF (Hout(idOPALbur,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idOPALbur), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % OPAL_burial) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idOPALbur)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # ifdef PRIMARY_PROD ! ! Write out Net primary production. ! IF (Hout(idNPP,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idNPP), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & OCEAN(ng) % Bio_NPP) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idNPP)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # ifdef LMD_SKPP ! ! Write out depth surface boundary layer. ! IF (Hout(idHsbl,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idHsbl), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % hsbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idHsbl)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # ifdef LMD_BKPP ! ! Write out depth surface boundary layer. ! IF (Hout(idHbbl,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idHbbl), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % hbbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idHbbl)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # ifdef SSSFLX ! ! Write out sea surface salinity correction salt flux ! IF (Hout(idSSSf,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idSSSf), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & FORCES(ng) % sssflx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSSSf)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # if defined FORWARD_WRITE && defined LMD_NONLOCAL ! ! Write out KPP nonlocal transport. ! DO i=1,NAT IF (Hout(idGhat(i),ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idGhat(i)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % ghats(:,:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idGhat(i))), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif ! ! Write out vertical viscosity coefficient. ! IF (Hout(idVvis,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVvis), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % Akv, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVvis)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out vertical diffusion coefficient for potential temperature. ! IF (Hout(idTdif,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idTdif), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % Akt(:,:,:,itemp), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTdif)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef SALINITY ! ! Write out vertical diffusion coefficient for salinity. ! IF (Hout(idSdif,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idSdif), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % Akt(:,:,:,isalt), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSdif)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # if defined GLS_MIXING || defined MY25_MIXING ! ! Write out turbulent kinetic energy. ! IF (Hout(idMtke,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idMtke), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % tke(:,:,:,NOUT), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idMtke)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef FORWARD_WRITE scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVmKK), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % Akk) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVmKK)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif END IF ! ! Write out turbulent length scale field. ! IF (Hout(idMtls,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idMtls), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % gls(:,:,:,NOUT), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idMtls)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef FORWARD_WRITE scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVmLS), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % Lscale) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVmLS)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # if defined FORWARD_WRITE && defined GLS_MIXING scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVmKP), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & MIXING(ng) % Akp) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVmKP)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif END IF # endif # ifdef ICE_MODEL ! ! Write out ice 2D momentum component (m/s) in the XI-direction. ! IF (Hout(idUice,ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idUice), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & ICE(ng) % ui(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUice)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice 2D momentum component (m/s) in the ETA-direction. ! IF (Hout(idVice,ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idVice), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & ICE(ng) % vi(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVice)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D Eastward and Northward ice momentum components (m/s) at ! RHO-points. ! IF (Hout(idUiceE,ng).and.Hout(idViceN,ng)) THEN IF (.not.allocated(Ur2d)) THEN allocate (Ur2d(LBi:UBi,LBj:UBj)) Ur2d(LBi:UBi,LBj:UBj)=0.0_r8 END IF IF (.not.allocated(Vr2d)) THEN allocate (Vr2d(LBi:UBi,LBj:UBj)) Vr2d(LBi:UBi,LBj:UBj)=0.0_r8 END IF CALL uv_rotate2d (ng, tile, .FALSE., .TRUE., & & LBi, UBi, LBj, UBj, & & GRID(ng) % CosAngler, & & GRID(ng) % SinAngler, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & ICE(ng) % ui(:,:,IUOUT), & & ICE(ng) % vi(:,:,IUOUT), & & Ur2d, Vr2d) scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUiceE),& & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & Ur2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUiceE)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idViceN),& & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & Vr2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idViceN)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (Ur2d) deallocate (Vr2d) END IF ! ! Write out ice concentration ! IF (Hout(idAice,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idAice), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % ai(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idAice)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice average thickness ! IF (Hout(idHice,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idHice), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % hi(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idHice)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out snow average thickness ! IF (Hout(idHsno,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idHsno), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % hsn(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idHsno)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #ifdef MELT_PONDS ! ! Write out surface water fraction (on ice) ! IF (Hout(idApond,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idApond), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % apond(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idApond)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out surface water thickness (on ice) ! IF (Hout(idHpond,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idHpond), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % hpond(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idHpond)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! ! Write out ice age. ! IF (Hout(idAgeice,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idAgeice), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % ageice(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idAgeice)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice-ocean mass flux ! IF (Hout(idIomflx,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idIomflx), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % io_mflux) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idIomflx)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice/snow surface temperature ! IF (Hout(idTice,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idTice), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % tis) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTice)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice interior temperature ! IF (Hout(idTimid,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idTimid), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % ti(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTimid)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out internal ice stress component 11 ! IF (Hout(idSig11,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idSig11), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % sig11(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSig11)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out internal ice stress component 12 ! IF (Hout(idSig12,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idSig12), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % sig12(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSig12)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out internal ice stress component 22 ! IF (Hout(idSig22,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idSig22), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % sig22(:,:,IUOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSig22)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice-ocean friction velocity ! IF (Hout(idTauiw,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idTauiw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % utau_iw) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTauiw)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice-ocean momentum transfer coefficient ! IF (Hout(idChuiw,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idChuiw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & ICE(ng) % chu_iw) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idChuiw)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out temperature of molecular sublayer under ice ! IF (Hout(idT0mk,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idT0mk), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % t0mk) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idT0mk)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out salinity of molecular sublayer under ice ! IF (Hout(idS0mk,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idS0mk), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % s0mk) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idS0mk)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice freeze Wfr ! IF (Hout(idWfr,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idWfr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % wfr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWfr)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice melt/freeze wai ! IF (Hout(idWai,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idWai), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % wai) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWai)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice melt/freeze Wao ! IF (Hout(idWao,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idWao), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % wao) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWao)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice melt/freeze wio ! IF (Hout(idWio,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idWio), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % wio) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWio)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice melt/freeze wro ! IF (Hout(idWro,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idWro), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % wro) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWro)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out ice divergence rate ! IF (Hout(idWdiv,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idWdiv), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & ICE(ng) % wdiv) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWdiv)), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # if defined RUNOFF ! ! Write out runoff. ! IF (Hout(idRunoff,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idRunoff), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & FORCES(ng) % Runoff) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idRunoff)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS || \ defined ATM2OCN_FLUXES || defined CCSM_FLUXES2D ! ! Write out surface air pressure. ! IF (Hout(idPair,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idPair), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Pair) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPair)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # if defined BULK_FLUXES || defined AIR_OCEAN || defined ECOSIM ! ! Write out surface winds. ! IF (Hout(idUair,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUair), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Uwind) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUair)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF IF (Hout(idVair,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVair), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Vwind) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVair)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D Eastward and Northward surface winds (m/s) at ! RHO-points. ! IF (Hout(idUairE,ng).and.Hout(idVairN,ng)) THEN IF (.not.allocated(Ur2d)) THEN allocate (Ur2d(LBi:UBi,LBj:UBj)) Ur2d(LBi:UBi,LBj:UBj)=0.0_r8 END IF IF (.not.allocated(Vr2d)) THEN allocate (Vr2d(LBi:UBi,LBj:UBj)) Vr2d(LBi:UBi,LBj:UBj)=0.0_r8 END IF CALL uv_rotate2d (ng, tile, .FALSE., .TRUE., & & LBi, UBi, LBj, UBj, & & GRID(ng) % CosAngler, & & GRID(ng) % SinAngler, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & FORCES(ng) % Uwind, & & FORCES(ng) % Vwind, & & Ur2d, Vr2d) scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUairE),& & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & Ur2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUairE)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVairN),& & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % rmask_full, & #endif & Vr2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVairN)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (Ur2d) deallocate (Vr2d) END IF # endif ! ! Write out surface active traces fluxes. ! DO itrc=1,NAT IF (Hout(idTsur(itrc),ng)) THEN IF (itrc.eq.itemp) THEN # ifdef SO_SEMI scale=1.0_r8 # else scale=rho0*Cp ! Celsius m/s to W/m2 # endif ELSE IF (itrc.eq.isalt) THEN scale=1.0_r8 END IF gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idTsur(itrc)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % stflx(:,:,itrc)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idTsur(itrc))), & & HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # if defined BULK_FLUXES || defined AIR_OCEAN ! ! Write out latent heat flux. ! IF (Hout(idLhea,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idLhea), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % lhflx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idLhea)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out sensible heat flux. ! IF (Hout(idShea,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idShea), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % shflx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idShea)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out longwave radiation flux. ! IF (Hout(idLrad,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idLrad), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % lrflx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idLrad)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef EMINUSP ! ! Write out E-P (m/s). ! IF (Hout(idEmPf,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idEmPf), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % EminusP) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idEmPf)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out evaporation rate (kg/m2/s). ! IF (Hout(idevap,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idevap), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % evap) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idevap)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out precipitation rate (kg/m2/s). ! IF (Hout(idrain,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idrain), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % rain) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idrain)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # endif # ifdef SHORTWAVE ! ! Write out shortwave radiation flux. ! IF (Hout(idSrad,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idSrad), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % srflx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSrad)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif #endif ! #if defined ESTUARYBGC && defined SPECTRAL_LIGHT ! Write out Photosynthetically Available Radiation (PAR) ! IF (Hout(idPARo,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idPARo), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % PARout) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPARo)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! Write out Spectral Photosynthetically Available Radiation (PARs) ! IF (Hout(idPARs,ng)) THEN scale=1.0_r8 gtype=gfactor*s3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idPARs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, NBAND, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % PARs) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idPARs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! Write out Spectral Attenuation Kd ! IF (Hout(idSpKd,ng)) THEN scale=1.0_r8 gtype=gfactor*s3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idSpKd), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, NBAND, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % SpKd) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSpKd)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! #if defined ESTUARYBGC && defined SAV_BIOMASS ! ! Write out Dissolved Inorganic Nitrogen in water column ! IF (Hout(iddinw,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(iddinw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % DINwcr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,iddinw)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out Dissolved Inorganic Nitrogen in sediment column ! IF (Hout(iddins,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(iddins), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % DINsed) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,iddins)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out Dissolved Oxygen in water column ! IF (Hout(iddowc,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(iddowc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % DOwcr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,iddowc)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out Dissolved Inorganic Nitrogen in water column due to SAV ! IF (Hout(idwsvl,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idwsvl), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % DINwcr_sav) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idwsvl)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out above ground biomass. ! IF (Hout(idsagb,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsagb), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % AGB) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsagb)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out below ground biomass. ! IF (Hout(idsbgb,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsbgb), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % BGB) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsbgb)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! PP. ! IF (Hout(idsvpp,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsvpp), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % PP) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsvpp)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! AGM. ! IF (Hout(idsvam,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsvam), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % AGM) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsvam)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! . ! IF (Hout(idsgar,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsgar), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % AGAR) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsgar)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! . ! IF (Hout(idsvbr,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsvbr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % AGBR) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsvbr)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! . ! IF (Hout(idsvrs,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsvrs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % SEARS) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsvrs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! . ! IF (Hout(idsvbg,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsvbg), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % AGBG) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsvbg)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! . ! IF (Hout(idsvag,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsvag), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % BGAG) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsvag)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! IF (Hout(idsbgr,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsbgr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % BGR) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsbgr)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! . ! IF (Hout(idsbgm,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsbgm), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & OCEAN(ng) % BGM) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsbgm)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! ! Write out surface U-momentum stress. ! IF (Hout(idUsms,ng)) THEN #ifdef SO_SEMI scale=1.0_r8 #else scale=rho0 ! m2/s2 to Pa #endif gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUsms), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % umask, & #endif & FORCES(ng) % sustr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUsms)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out surface V-momentum stress. ! IF (Hout(idVsms,ng)) THEN #ifdef SO_SEMI scale=1.0_r8 #else scale=rho0 #endif gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVsms), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % vmask, & #endif & FORCES(ng) % svstr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVsms)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bottom U-momentum stress. ! IF (Hout(idUbms,ng)) THEN scale=-rho0 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUbms), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % umask, & #endif & FORCES(ng) % bustr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbms)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bottom V-momentum stress. ! IF (Hout(idVbms,ng)) THEN scale=-rho0 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVbms), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & #ifdef MASKING & GRID(ng) % vmask, & #endif & FORCES(ng) % bvstr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbms)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #ifdef SOLVE3D # ifdef BBL_MODEL ! ! Write out current-induced, bottom U-stress at RHO-points. ! IF (Hout(idUbrs,ng)) THEN scale=-rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUbrs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % bustrc) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbrs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out current-induced, bottom V-stress at RHO-points. ! IF (Hout(idVbrs,ng)) THEN scale=-rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVbrs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % bvstrc) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbrs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out wind-induced, bottom U-stress at RHO-points. ! IF (Hout(idUbws,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUbws), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % bustrw) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbws)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out wind-induced, bottom V-stress at RHO-points. ! IF (Hout(idVbws,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVbws), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % bvstrw) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbws)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out maximum wind and current, bottom U-stress at RHO-points. ! IF (Hout(idUbcs,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUbcs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % bustrcwmax) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbcs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out maximum wind and current, bottom V-stress at RHO-points. ! IF (Hout(idVbcs,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVbcs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % bvstrcwmax) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbcs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out maximum wave and current bottom stress magnitude. ! IF (Hout(idUVwc,ng)) THEN allocate (wrk2(LBi:UBi,LBj:UBj)) wrk2(LBi:UBi,LBj:UBj)=0.0_r8 scale=rho0 gtype=gfactor*r2dvar wrk2=sqrt(BBL(ng)%bustrcwmax*BBL(ng)%bustrcwmax+ & & BBL(ng)%bvstrcwmax*BBL(ng)%bvstrcwmax+1.0E-10_r8) status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUVwc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & wrk2(LBi:UBi,LBj:UBj)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUVwc)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (wrk2) END IF ! ! Write out wind-induced, bed wave orbital U-velocity at RHO-points. ! IF (Hout(idUbot,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUbot), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % Ubot) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbot)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out wind-induced, bed wave orbital V-velocity at RHO-points ! IF (Hout(idVbot,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVbot), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % Vbot) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbot)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bottom U-velocity above bed at RHO-points. ! IF (Hout(idUbur,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUbur), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % Ur) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbur)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bottom V-velocity above bed at RHO-points. ! IF (Hout(idVbvr,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVbvr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & BBL(ng) % Vr) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbvr)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # ifdef SEDIMENT # ifdef BEDLOAD ! ! Write out bed load transport in U-direction. ! DO i=1,NST IF (Hout(idUbld(i),ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idUbld(i)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & SEDBED(ng) % bedldu(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUbld(i))), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bed load transport in V-direction. ! IF (Hout(idVbld(i),ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idVbld(i)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & SEDBED(ng) % bedldv(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVbld(i))), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO ! # ifdef BEDLOAD_VANDERA ! ! Write out Ursell number of the asymmetric wave form. ! IF (Hout(idsurs,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsurs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % ursell_no) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsurs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out velocity skewness parameter of the asymmetric wave form. ! IF (Hout(idsrrw,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsrrw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % RR_asymwave) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsrrw)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out acceleration asymmetry parameter of the asymmetric wave form. ! IF (Hout(idsbtw,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsbtw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % beta_asymwave) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsbtw)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out reference height to get near bottom current velocity. ! IF (Hout(idszrw,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idszrw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % Zr_wbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idszrw)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bed roughness to get the current vel. at wave boundary layer. ! IF (Hout(idsksd,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsksd), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % ksd_wbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsksd)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out friction current velocity at the wave boundary layer. ! IF (Hout(idsusc,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsusc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % ustrc_wbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsusc)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out thickness of the wave boundary layer. ! IF (Hout(idstbl,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idstbl), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % thck_wbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idstbl)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out current velocity at the wave boundary layer. ! IF (Hout(idsubl,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsubl), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % udelta_wbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsubl)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out the angle between waves and currents. ! IF (Hout(idspwc,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idspwc), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % phi_wc) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idspwc)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out friction factor for currents. ! IF (Hout(idsfdw,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsfdw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % fd_wbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsfdw)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out crest velocity of the asymmetric wave form. ! IF (Hout(idsucr,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsucr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % ucrest_r) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsucr)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out trough velocity of the asymmetric wave form. ! IF (Hout(idsutr,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsutr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % utrough_r) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsutr)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out crest time period of the asymmetric wave form. ! IF (Hout(idstcr,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idstcr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % T_crest) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idstcr)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out trough time period of the asymmetric wave form. ! IF (Hout(idsttr,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idsttr), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % T_trough) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsttr)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! # endif # endif ! ! Write out sediment fraction of each size class in each bed layer. ! DO i=1,NST IF (Hout(idfrac(i),ng)) THEN scale=1.0_r8 gtype=gfactor*b3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idfrac(i)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed_frac(:,:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idfrac(i))), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO ! ! Write out sediment mass of each size class in each bed layer. ! DO i=1,NST IF (Hout(idBmas(i),ng)) THEN scale=1.0_r8 gtype=gfactor*b3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idBmas(i)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed_mass(:,:,:,NOUT,i)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idBmas(i))), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO ! ! Write out sediment properties in each bed layer. ! DO i=1,MBEDP IF (Hout(idSbed(i),ng)) THEN scale=1.0_r8 gtype=gfactor*b3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idSbed(i)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed(:,:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idSbed(i))), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif # if defined SEDIMENT || defined BBL_MODEL ! ! Write out exposed sediment layer properties. ! DO i=1,MBOTP IF (Hout(idBott(i),ng)) THEN IF (i.eq.itauc) THEN scale=rho0 ELSE scale=1.0_r8 END IF gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, & & HIS(ng)%Vid(idBott(i)), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bottom(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idBott(i))), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif #endif #ifdef INWAVE_MODEL ! ! Write out AC wave energy density. ! IF (Hout(idACen,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idACen), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, ND, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & WAVEP(ng) % AC(:,:,:,NOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idACen)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out energy celerity xi-direction. ! IF (Hout(idACcx,ng)) THEN scale=1.0_r8 gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idACcx), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, ND, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % umask_full, & # else & GRID(ng) % umask, & # endif # endif & WAVEP(ng) % cx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idACcx)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out energy celerity eta-direction. ! IF (Hout(idACcy,ng)) THEN scale=1.0_r8 gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idACcy), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, ND, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % vmask_full, & # else & GRID(ng) % vmask, & # endif # endif & WAVEP(ng) % cy) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idACcy)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out energy celerity xi-direction. ! IF (Hout(idACct,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idACct), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, ND, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & WAVEP(ng) % ct) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idACct)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out energy peak period. ! IF (Hout(idACtp,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idACtp), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, ND, scale, & # ifdef MASKING # ifdef WET_DRY & GRID(ng) % rmask_full, & # else & GRID(ng) % rmask, & # endif # endif & WAVEP(ng) % Ta) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idACtp)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef VEGETATION #include "vegetation_wrt_his.h" #endif #ifdef WEC_MELLOR ! ! Write out 2D radiation stress, Sxx-component. ! IF (Hout(idW2xx,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW2xx), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Sxx_bar) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW2xx)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D radiation stress, Sxy-component. ! IF (Hout(idW2xy,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW2xy), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Sxy_bar) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW2xy)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D radiation stress, Syy-component. ! IF (Hout(idW2yy,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW2yy), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Syy_bar) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW2yy)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef SOLVE3D ! ! Write out 3D radiation stress, Sxx-horizontal component. ! IF (Hout(idW3xx,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW3xx), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Sxx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW3xx)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D radiation stress, Sxy-horizontal component. ! IF (Hout(idW3xy,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW3xy), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Sxy) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW3xy)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D radiation stress, Syy-horizontal component. ! IF (Hout(idW3yy,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW3yy), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Syy) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW3yy)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D radiation stress, Szx-vertical component. ! IF (Hout(idW3zx,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW3zx), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Szx) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW3zx)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D radiation stress, Szy-vertical component. ! IF (Hout(idW3zy,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW3zy), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Szy) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW3zy)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif #endif #ifdef WEC ! ! Write out total 2D WEC u-stress. ! IF (Hout(idU2rs,ng)) THEN scale=rho0 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idU2rs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & MIXING(ng) % rustr2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idU2rs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out total 2D WEC v-stress. ! IF (Hout(idV2rs,ng)) THEN scale=rho0 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idV2rs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & MIXING(ng) % rvstr2d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idV2rs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D U-momentum Stokes drift velocity. ! IF (Hout(idU2Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idU2sd), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % ubar_stokes) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idU2Sd)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D V-momentum Stokes drift velocity. ! IF (Hout(idV2Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idV2sd), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % vbar_stokes) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idV2Sd)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef SOLVE3D ! ! Write out 3D total WEC u-stress. ! IF (Hout(idU3rs,ng)) THEN scale=rho0 gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idU3rs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & MIXING(ng) % rustr3d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idU3rs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D total V-radiation stress. ! IF (Hout(idV3rs,ng)) THEN scale=rho0 gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idV3rs), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & MIXING(ng) % rvstr3d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idV3rs)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D U-momentum Stokes drift velocity. ! IF (Hout(idU3Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idU3Sd), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % u_stokes) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idU3Sd)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D V-momentum stokes velocity. ! IF (Hout(idV3Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idV3Sd), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % v_stokes) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idV3Sd)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D Omega-momentum stokes velocity. ! IF (Hout(idW3Sd,ng)) THEN IF (.not.allocated(Wr3d)) THEN allocate (Wr3d(LBi:UBi,LBj:UBj,0:N(ng))) Wr3d(LBi:UBi,LBj:UBj,0:N(ng))=0.0_r8 END IF scale=1.0_r8 gtype=gfactor*w3dvar CALL scale_omega (ng, tile, LBi, UBi, LBj, UBj, 0, N(ng), & & GRID(ng) % pm, & & GRID(ng) % pn, & & OCEAN(ng) % W_stokes, & & Wr3d) status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW3Sd), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING GRID(ng) % rmask, & # endif & Wr3d) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW3Sd)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (Wr3d) END IF ! ! Write out 3D W-momentum stokes velocity. ! IF (Hout(idW3St,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idW3St), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % wstvel) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idW3St)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif #endif #ifdef WAVES_HEIGHT ! ! Write out wind-induced wave height. ! IF (Hout(idWamp,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWamp), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Hwave) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWamp)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_LENGTH ! ! Write out wind-induced wave length. ! IF (Hout(idWlen,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWlen), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Lwave) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWlen)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_LENGTHP ! ! Write out wind-induced peak wave length. ! IF (Hout(idWlep,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWlep), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Lwavep) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWlen)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_DIR ! ! Write out wind-induced mean wave direction. ! IF (Hout(idWdir,ng)) THEN scale=rad2deg gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdir), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Dwave) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWdir)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_DIRP ! ! Write out wind-induced peak wave direction. ! IF (Hout(idWdip,ng)) THEN scale=rad2deg gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdip), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Dwavep) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWdip)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_TOP_PERIOD ! ! Write out wind-induced surface wave period. ! IF (Hout(idWptp,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWptp), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Pwave_top) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWptp)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_BOT_PERIOD ! ! Write out wind-induced bottom wave period. ! IF (Hout(idWpbt,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWpbt), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Pwave_bot) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWpbt)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined BBL_MODEL || defined WAVES_OCEAN || \ defined SED_BEDLOAD_VANDERA ! ! Write out wind-induced wave bottom orbital velocity. ! IF (Hout(idWorb,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWorb), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Uwave_rms) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWorb)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined WAVES_OCEAN || (defined WEC_VF && defined BOTTOM_STREAMING) ! ! Write out wave dissipation due to bottom friction. ! IF (Hout(idWdif,ng)) THEN scale=rho0 ! W m /kg to W/m2 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdif), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Dissip_fric) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWdif)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined WAVES_OCEAN || defined TKE_WAVEDISS || \ defined WDISS_THORGUZA || defined WDISS_CHURTHOR || \ defined WDISS_INWAVE ! ! Write out wave dissipation due to breaking. ! IF (Hout(idWdib,ng)) THEN scale=rho0 ! W m /kg to W/m2 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdib), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Dissip_break) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWdib)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out wave dissipation due to white capping. ! IF (Hout(idWdiw,ng)) THEN scale=rho0 ! W m /kg to W/m2 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdiw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Dissip_wcap) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWdiw)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined ROLLER_SVENDSEN ! ! Write out percent wave breaking. ! IF (Hout(idWbrk,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWbrk), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Wave_break) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWbrk)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined WEC_ROLLER ! ! Write out roller dissipation. ! IF (Hout(idWdis,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWdis), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Dissip_roller) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWdis)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined WEC_ROLLER ! ! Write out roller wave action density. ! IF (Hout(idWrol,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWrol), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % rollA) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWrol)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined WAVES_DSPR ! ! Write out waves directional spreading. ! IF (Hout(idWvds,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWvds), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Wave_ds) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWvds)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out wave spectrum peakedness. ! IF (Hout(idWvqp,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWvqp), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & FORCES(ng) % Wave_qp) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWvqp)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined WEC_VF ! ! Write out WEC quasi-static sea level adjustment. ! IF (Hout(idWztw,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWztw), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % zetaw) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWztw)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out WEC quasi-static pressure. ! IF (Hout(idWqsp,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWqsp), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % qsp) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWqsp)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out WEC Bernoulli head. ! IF (Hout(idWbeh,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idWbeh), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % bh) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idWbeh)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef SOLVE3D # ifdef UV_KIRBY ! ! Write out coupling current velocity (x component). ! IF (Hout(idUwav,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idUwav), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % uwave) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUwav)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out coupling current velocity (y component). ! IF (Hout(idVwav,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, HIS(ng)%ncid, HIS(ng)%Vid(idVwav), & & HIS(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % vwave) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVwav)), HIS(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif #endif ! !----------------------------------------------------------------------- ! Synchronize history NetCDF file to disk to allow other processes ! to access data immediately after it is written. !----------------------------------------------------------------------- ! CALL netcdf_sync (ng, iNLM, HIS(ng)%name, HIS(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, & & __FILE__)) RETURN #ifdef SOLVE3D # ifdef NESTING IF (Master) WRITE (stdout,20) KOUT, NOUT, HIS(ng)%Rindex, ng # else IF (Master) WRITE (stdout,20) KOUT, NOUT, HIS(ng)%Rindex #ifdef OFFLINE_FLOATS IF (Master) print *, ' WRT_HIS model time (days), t=', tdays #endif # endif #else # ifdef NESTING IF (Master) WRITE (stdout,20) KOUT, HIS(ng)%Rindex, ng # else IF (Master) WRITE (stdout,20) KOUT, HIS(ng)%Rindex # endif #endif ! 10 FORMAT (/,' WRT_HIS - error while writing variable: ',a,/,11x, & & 'into history NetCDF file for time record: ',i4) #ifdef SOLVE3D 20 FORMAT (6x,'WRT_HIS - wrote history', t39, & # ifdef NESTING & 'fields (Index=',i1,',',i1,') in record = ',i7.7,t92,i2.2) # else & 'fields (Index=',i1,',',i1,') in record = ',i7.7) # endif #else 20 FORMAT (6x,'WRT_HIS - wrote history', t39, & # ifdef NESTING & 'fields (Index=',i1,') in record = ',i7.7,t92,i2.2) # else & 'fields (Index=',i1,') in record = ',i7.7) # endif #endif RETURN END SUBROUTINE wrt_his