#include "cppdefs.h" SUBROUTINE wrt_quick (ng, tile) ! !svn $Id: wrt_quick.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 ROMS QUICKSAVE 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 SOLVE3D USE mod_coupling #endif USE mod_forces USE mod_grid 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 USE mod_stepping ! USE nf_fwrite2d_mod, ONLY : nf_fwrite2d #ifdef SOLVE3D USE nf_fwrite3d_mod, ONLY : nf_fwrite3d 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 ! implicit none ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile ! ! Local variable declarations. ! integer :: LBi, UBi, LBj, UBj 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 # 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) ! !----------------------------------------------------------------------- ! Write out quicksave 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. ! QCK(ng)%Rindex=QCK(ng)%Rindex+1 Fcount=QCK(ng)%Fcount QCK(ng)%Nrec(Fcount)=QCK(ng)%Nrec(Fcount)+1 ! ! Write out model time (s). ! CALL netcdf_put_fvar (ng, iNLM, QCK(ng)%name, & & TRIM(Vname(idtime,ng)), time(ng:), & & (/QCK(ng)%Rindex/), (/1/), & & ncid = QCK(ng)%ncid, & & varid = QCK(ng)%Vid(idtime)) IF (FoundError(exit_flag, NoError, __LINE__, & & __FILE__)) RETURN #if defined SEDIMENT && defined SED_MORPH ! ! Write out time-dependent bathymetry (m) ! IF (Qout(idBath,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idbath), & & QCK(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)), QCK(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, QCK(ng)%ncid, QCK(ng)%Vid(idPwet), & & QCK(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)), QCK(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, QCK(ng)%ncid, QCK(ng)%Vid(idRwet), & & QCK(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)), QCK(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, QCK(ng)%ncid, QCK(ng)%Vid(idUwet), & & QCK(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)), QCK(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, QCK(ng)%ncid, QCK(ng)%Vid(idVwet), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #endif #ifdef SOLVE3D ! ! Write time-varying depths of RHO-points. ! IF (Qout(idpthR,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idpthR), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write time-varying depths of U-points. ! IF (Qout(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, QCK(ng)%ncid, QCK(ng)%Vid(idpthU), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write time-varying depths of V-points. ! IF (Qout(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, QCK(ng)%ncid, QCK(ng)%Vid(idpthV), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write time-varying depths of W-points. ! IF (Qout(idpthW,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idpthW), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! ! Write out free-surface (m) ! IF (Qout(idFsur,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idFsur), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D U-momentum component (m/s). ! IF (Qout(idUbar,ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUbar), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D V-momentum component (m/s). ! IF (Qout(idVbar,ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVbar), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D Eastward and Northward momentum components (m/s) at ! RHO-points. ! IF (Qout(idu2dE,ng).and.Qout(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, QCK(ng)%ncid, QCK(ng)%Vid(idu2dE), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idv2dN), & & QCK(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)), QCK(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 (Qout(idUvel,ng)) THEN scale=1.0_r8 gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUvel), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D V-momentum component (m/s). ! IF (Qout(idVvel,ng)) THEN scale=1.0_r8 gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVvel), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out surface U-momentum component (m/s). ! IF (Qout(idUsur,ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUsur), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % u(:,:,N(ng),NOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUsur)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out surface V-momentum component (m/s). ! IF (Qout(idVsur,ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVsur), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % v(:,:,N(ng),NOUT)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVsur)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D Eastward and Northward momentum components (m/s) at ! RHO-points. ! IF ((Qout(idu3dE,ng).and.Qout(idv3dN,ng)).or. & & (Qout(idUsuE,ng).and.Qout(idVsuN,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) IF ((Qout(idu3dE,ng).and.Qout(idv3dN,ng))) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idu3dE), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idv3dN), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out surface Eastward and Northward momentum components (m/s) at ! RHO-points. ! IF ((Qout(idUsuE,ng).and.Qout(idVsuN,ng))) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idUsuE), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & Ur3d(:,:,N(ng))) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idUsuE)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idVsuN), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask_full, & # endif & Vr3d(:,:,N(ng))) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVsuN)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF deallocate (Ur3d) deallocate (Vr3d) END IF ! ! Write out S-coordinate omega vertical velocity (m/s). ! IF (Qout(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, QCK(ng)%ncid, QCK(ng)%Vid(idOvel), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF deallocate (Wr3d) END IF ! ! Write out vertical velocity (m/s). ! IF (Qout(idWvel,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWvel), & & QCK(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)), QCK(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 (Qout(idTvar(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Tid(itrc), & & QCK(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))), & & QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO ! ! Write out surface tracer type variables. ! DO itrc=1,NT(ng) IF (Qout(idsurT(itrc),ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idsurT(itrc)), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % t(:,:,N(ng),NOUT,itrc)) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idsurT(itrc))), & & QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO ! ! Write out density anomaly. ! IF (Qout(idDano,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idDano), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % rho) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idDano)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef LMD_SKPP ! ! Write out depth surface boundary layer. ! IF (Qout(idHsbl,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idHsbl), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % hsbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idHsbl)), QCK(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 (Qout(idHbbl,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idHbbl), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % hbbl) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idHbbl)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif ! ! Write out vertical viscosity coefficient. ! IF (Qout(idVvis,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVvis), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Akv, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, & & __FILE__)) THEN IF (Master) THEN WRITE (stdout,10) TRIM(Vname(1,idVvis)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out vertical diffusion coefficient for potential temperature. ! IF (Qout(idTdif,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idTdif), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # 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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef SALINITY ! ! Write out vertical diffusion coefficient for salinity. ! IF (Qout(idSdif,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idSdif), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # 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)), QCK(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 (Qout(idMtke,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idMtke), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # 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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out turbulent length scale field. ! IF (Qout(idMtls,ng)) THEN scale=1.0_r8 gtype=gfactor*w3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idMtls), & & QCK(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # 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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # if defined BULK_FLUXES || defined ECOSIM || defined ATM_PRESS ! ! Write out surface air pressure. ! IF (Qout(idPair,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idPair), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # if defined BULK_FLUXES || defined ECOSIM ! ! Write out surface winds. ! IF (Qout(idUair,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUair), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF IF (Qout(idVair,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVair), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif ! ! Write out surface active traces fluxes. ! DO itrc=1,NAT IF (Qout(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, QCK(ng)%ncid, & & QCK(ng)%Vid(idTsur(itrc)), & & QCK(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))), & & QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # ifdef BULK_FLUXES ! ! Write out latent heat flux. ! IF (Qout(idLhea,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idLhea), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out sensible heat flux. ! IF (Qout(idShea,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idShea), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out longwave radiation flux. ! IF (Qout(idLrad,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idLrad), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef EMINUSP ! ! Write out E-P (m/s). ! IF (Qout(idEmPf,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idEmPf), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out evaporation rate (kg/m2/s). ! IF (Qout(idevap,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idevap), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out precipitation rate (kg/m2/s). ! IF (Qout(idrain,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idrain), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif # endif # ifdef SHORTWAVE ! ! Write out shortwave radiation flux. ! IF (Qout(idSrad,ng)) THEN scale=rho0*Cp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idSrad), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif #endif ! ! Write out surface U-momentum stress. ! IF (Qout(idUsms,ng)) THEN scale=rho0 ! m2/s2 to Pa gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUsms), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out surface V-momentum stress. ! IF (Qout(idVsms,ng)) THEN scale=rho0 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVsms), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bottom U-momentum stress. ! IF (Qout(idUbms,ng)) THEN scale=-rho0 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUbms), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bottom V-momentum stress. ! IF (Qout(idVbms,ng)) THEN scale=-rho0 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVbms), & & QCK(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)), QCK(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 (Qout(idUbrs,ng)) THEN scale=-rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUbrs), & & QCK(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)), QCK(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 (Qout(idVbrs,ng)) THEN scale=-rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVbrs), & & QCK(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)), QCK(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 (Qout(idUbws,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUbws), & & QCK(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)), QCK(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 (Qout(idVbws,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVbws), & & QCK(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)), QCK(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 (Qout(idUbcs,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUbcs), & & QCK(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)), QCK(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 (Qout(idVbcs,ng)) THEN scale=rho0 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVbcs), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out wind-induced, bed wave orbital U-velocity at RHO-points. ! IF (Qout(idUbot,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUbot), & & QCK(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)), QCK(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 (Qout(idVbot,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVbot), & & QCK(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)), QCK(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 (Qout(idUbur,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idUbur), & & QCK(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)), QCK(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 (Qout(idVbvr,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idVbvr), & & QCK(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)), QCK(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 (Qout(idUbld(i),ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idUbld(i)), & & QCK(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))), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out bed load transport in V-direction. ! IF (Qout(idVbld(i),ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idVbld(i)), & & QCK(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))), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif ! ! Write out sediment fraction of each size class in each bed layer. ! DO i=1,NST IF (Qout(idfrac(i),ng)) THEN scale=1.0_r8 gtype=gfactor*b3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idfrac(i)), & & QCK(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))), QCK(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 (Qout(idBmas(i),ng)) THEN scale=1.0_r8 gtype=gfactor*b3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idBmas(i)), & & QCK(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))), QCK(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 (Qout(idSbed(i),ng)) THEN scale=1.0_r8 gtype=gfactor*b3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, & & QCK(ng)%Vid(idSbed(i)), & & QCK(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))), QCK(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 (Qout(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, QCK(ng)%ncid, & & QCK(ng)%Vid(idBott(i)), & & QCK(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))), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF END DO # endif #endif #ifdef NEARSHORE_MELLOR ! ! Write out 2D radiation stress, Sxx-component. ! IF (Qout(idW2xx,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW2xx), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D radiation stress, Sxy-component. ! IF (Qout(idW2xy,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW2xy), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D radiation stress, Syy-component. ! IF (Qout(idW2yy,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW2yy), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out total 2D U-radiation stress. ! IF (Qout(idU2rs,ng)) THEN scale=rho0 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idU2rs), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out total 2D V-radiation stress. ! IF (Qout(idV2rs,ng)) THEN scale=rho0 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idV2rs), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D U-momentum Stokes drift velocity. ! IF (Qout(idU2Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*u2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idU2sd), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 2D V-momentum Stokes drift velocity. ! IF (Qout(idV2Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*v2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idV2Sd), & & QCK(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)), QCK(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 (Qout(idW3xx,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW3xx), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D radiation stress, Sxy-horizontal component. ! IF (Qout(idW3xy,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW3xy), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D radiation stress, Syy-horizontal component. ! IF (Qout(idW3yy,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW3yy), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # ifdef NEARSHORE_MELLOR05 ! ! Write out 3D radiation stress, Szx-vertical component. ! IF (Qout(idW3zx,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW3zx), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D radiation stress, Szy-vertical component. ! IF (Qout(idW3zy,ng)) THEN scale=1.0_r8 gtype=gfactor*r3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idW3zy), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF # endif ! ! Write out 3D total U-radiation stress. ! IF (Qout(idU3rs,ng)) THEN scale=rho0 gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idU3rs), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D total V-radiation stress. ! IF (Qout(idV3rs,ng)) THEN scale=rho0 gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idV3rs), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D U-momentum Stokes drift velocity. ! IF (Qout(idU3Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*u3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idU3Sd), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF ! ! Write out 3D V-momentum stokes velocity. ! IF (Qout(idV3Sd,ng)) THEN scale=1.0_r8 gtype=gfactor*v3dvar status=nf_fwrite3d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idV3Sd), & & QCK(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)), QCK(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 (Qout(idWamp,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWamp), & & QCK(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)), QCK(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 (Qout(idWlen,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWlen), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_DIR ! ! Write out wind-induced wave direction. ! IF (Qout(idWdir,ng)) THEN scale=rad2deg gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWdir), & & QCK(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)), QCK(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 (Qout(idWdip,ng)) THEN scale=rad2deg gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWdip), & & QCK(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)), QCK(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 (Qout(idWptp,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWptp), & & QCK(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)), QCK(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 (Qout(idWpbt,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWpbt), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #ifdef WAVES_UB ! ! Write out wind-induced wave bottom orbital velocity. ! IF (Qout(idWorb,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWorb), & & QCK(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)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif #if defined TKE_WAVEDISS || defined WAVES_OCEAN ! ! Write out wave dissipation. ! IF (Qout(idWdis,ng)) THEN scale=1.0_r8 gtype=gfactor*r2dvar status=nf_fwrite2d(ng, iNLM, QCK(ng)%ncid, QCK(ng)%Vid(idWdis), & & QCK(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,idWdis)), QCK(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END IF #endif ! !----------------------------------------------------------------------- ! Synchronize quicksave NetCDF file to disk to allow other processes ! to access data immediately after it is written. !----------------------------------------------------------------------- ! CALL netcdf_sync (ng, iNLM, QCK(ng)%name, QCK(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, & & __FILE__)) RETURN #ifdef SOLVE3D # ifdef NESTING IF (Master) WRITE (stdout,20) KOUT, NOUT, QCK(ng)%Rindex, ng # else IF (Master) WRITE (stdout,20) KOUT, NOUT, QCK(ng)%Rindex # endif #else # ifdef NESTING IF (Master) WRITE (stdout,20) KOUT, QCK(ng)%Rindex, ng # else IF (Master) WRITE (stdout,20) KOUT, QCK(ng)%Rindex # endif #endif ! 10 FORMAT (/,' WRT_QUICK - error while writing variable: ',a,/,13x, & & 'into quicksave NetCDF file for time record: ',i4) #ifdef SOLVE3D 20 FORMAT (6x,'WRT_QUICK - wrote quicksave', 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_QUICK - wrote quicksave', 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_quick