#include "cppdefs.h" MODULE wrt_rst_mod ! !git $Id$ !svn $Id: wrt_rst.F 1190 2023-08-18 19:51:09Z arango $ !================================================== Hernan G. Arango === ! Copyright (c) 2002-2023 The ROMS/TOMS Group ! ! Licensed under a MIT/X style license ! ! See License_ROMS.md ! !======================================================================= ! ! ! This module writes requested model fields into the RESTART output ! ! file using the standard NetCDF library or the Parallel-IO (PIO) ! ! library. ! ! ! ! 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 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 ! #ifdef ICE_MODEL USE ice_output_mod, ONLY : ice_wrt_nf90 # if defined PIO_LIB && defined DISTRIBUTE USE ice_output_mod, ONLY : ice_wrt_pio # endif #endif USE nf_fwrite2d_mod, ONLY : nf_fwrite2d #if defined PERFECT_RESTART || defined SOLVE3D USE nf_fwrite3d_mod, ONLY : nf_fwrite3d #endif #if defined PERFECT_RESTART && defined SOLVE3D USE nf_fwrite4d_mod, ONLY : nf_fwrite4d #endif USE strings_mod, ONLY : FoundError ! implicit none ! PUBLIC :: wrt_rst PRIVATE :: wrt_rst_nf90 #if defined PIO_LIB && defined DISTRIBUTE PRIVATE :: wrt_rst_pio #endif ! CONTAINS ! !*********************************************************************** SUBROUTINE wrt_rst (ng, tile) !*********************************************************************** ! ! Imported variable declarations. ! integer, intent(in) :: ng, tile ! ! Local variable declarations. ! integer :: LBi, UBi, LBj, UBj ! character (len=*), parameter :: MyFile = & & __FILE__ ! !----------------------------------------------------------------------- ! Write out history fields according to IO type. !----------------------------------------------------------------------- ! LBi=BOUNDS(ng)%LBi(tile) UBi=BOUNDS(ng)%UBi(tile) LBj=BOUNDS(ng)%LBj(tile) UBj=BOUNDS(ng)%UBj(tile) ! SELECT CASE (RST(ng)%IOtype) CASE (io_nf90) CALL wrt_rst_nf90 (ng, iNLM, tile, & & LBi, UBi, LBj, UBj) #if defined PIO_LIB && defined DISTRIBUTE CASE (io_pio) CALL wrt_rst_pio (ng, iNLM, tile, & & LBi, UBi, LBj, UBj) #endif CASE DEFAULT IF (Master) WRITE (stdout,10) RST(ng)%IOtype exit_flag=3 END SELECT IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! 10 FORMAT (' WRT_RST - Illegal output file type, io_type = ',i0, & & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.') ! RETURN END SUBROUTINE wrt_rst ! !*********************************************************************** SUBROUTINE wrt_rst_nf90 (ng, model, tile, & & LBi, UBi, LBj, UBj) !*********************************************************************** ! USE mod_netcdf ! ! Imported variable declarations. ! integer, intent(in) :: ng, model, tile integer, intent(in) :: LBi, UBi, LBj, UBj ! ! Local variable declarations. ! integer :: Fcount, gfactor, gtype, i, itrc, status # if defined PERFECT_RESTART || defined SOLVE3D integer :: ntmp(1) # endif ! real(dp) :: scale ! character (len=*), parameter :: MyFile = & & __FILE__//", wrt_rst_nf90" ! SourceFile=MyFile ! !----------------------------------------------------------------------- ! Write out restart fields. !----------------------------------------------------------------------- ! IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Set grid type factor to write full (gfactor=1) fields or water ! points (gfactor=-1) fields only. ! #if !defined PERFECT_RESTART && \ (defined WRITE_WATER && defined MASKING) gfactor=-1 #else gfactor=1 #endif ! ! Set time record index. ! RST(ng)%Rindex=RST(ng)%Rindex+1 Fcount=RST(ng)%Fcount RST(ng)%Nrec(Fcount)=RST(ng)%Nrec(Fcount)+1 ! ! Report. ! #ifdef SOLVE3D # ifdef NESTING IF (Master) WRITE (stdout,10) KOUT, NOUT, RST(ng)%Rindex, ng # else IF (Master) WRITE (stdout,10) KOUT, NOUT, RST(ng)%Rindex # endif #else # ifdef NESTING IF (Master) WRITE (stdout,10) KOUT, RST(ng)%Rindex, ng # else IF (Master) WRITE (stdout,10) KOUT, RST(ng)%Rindex # endif #endif ! ! If requested, set time index to recycle time records in restart ! file. ! IF (LcycleRST(ng)) THEN RST(ng)%Rindex=MOD(RST(ng)%Rindex-1,2)+1 END IF #ifdef PERFECT_RESTART ! ! Write out time-stepping indices. ! # ifdef SOLVE3D ntmp(1)=1+MOD((iic(ng)-1)-ntstart(ng),2) CALL netcdf_put_ivar (ng, model, RST(ng)%name, 'nstp', & & ntmp, (/RST(ng)%Rindex/), (/1/), & & ncid = RST(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN CALL netcdf_put_ivar (ng, model, RST(ng)%name, 'nrhs', & & ntmp, (/RST(ng)%Rindex/), (/1/), & & ncid = RST(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ntmp(1)=3-ntmp(1) CALL netcdf_put_ivar (ng, model, RST(ng)%name, 'nnew', & & ntmp, (/RST(ng)%Rindex/), (/1/), & & ncid = RST(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif CALL netcdf_put_ivar (ng, model, RST(ng)%name, 'kstp', & & kstp(ng:), (/RST(ng)%Rindex/), (/1/), & & ncid = RST(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN CALL netcdf_put_ivar (ng, model, RST(ng)%name, 'krhs', & & krhs(ng:), (/RST(ng)%Rindex/), (/1/), & & ncid = RST(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN CALL netcdf_put_ivar (ng, model, RST(ng)%name, 'knew', & & knew(ng:), (/RST(ng)%Rindex/), (/1/), & & ncid = RST(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #endif ! ! Write out model time (s). ! CALL netcdf_put_fvar (ng, model, RST(ng)%name, & & TRIM(Vname(1,idtime)), time(ng:), & & (/RST(ng)%Rindex/), (/1/), & & ncid = RST(ng)%ncid, & & varid = RST(ng)%Vid(idtime)) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #if defined SEDIMENT && defined SED_MORPH ! ! Write out time-dependent bathymetry (m) ! IF (Hout(idbath,ng)) THEN scale=1.0_dp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idbath, & & RST(ng)%Vid(idbath), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idbath)), RST(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_dp gtype=gfactor*p2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idPwet, & & RST(ng)%Vid(idPwet), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idPwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at RHO-points. ! scale=1.0_dp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idRwet, & & RST(ng)%Vid(idRwet), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at U-points. ! scale=1.0_dp gtype=gfactor*u2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idUwet, & & RST(ng)%Vid(idUwet), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at V-points. ! scale=1.0_dp gtype=gfactor*v2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idVwet, & & RST(ng)%Vid(idVwet), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #endif ! ! Write out free-surface (m). ! scale=1.0_dp #ifdef PERFECT_RESTART gtype=gfactor*r3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idFsur, & & RST(ng)%Vid(idFsur), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, 3, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif # ifdef WET_DRY & OCEAN(ng) % zeta, & & SetFillVal = .FALSE.) # else & OCEAN(ng) % zeta) # endif #else gtype=gfactor*r2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idFsur, & & RST(ng)%Vid(idFsur), & & RST(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 #endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idFsur)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #ifdef PERFECT_RESTART ! ! Write out RHS of free-surface equation. ! scale=1.0_dp gtype=gfactor*r3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idRzet, & & RST(ng)%Vid(idRzet), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % rzeta) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRzet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #endif ! ! Write out 2D momentum component (m/s) in the XI-direction. ! scale=1.0_dp #ifdef PERFECT_RESTART gtype=gfactor*u3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idUbar, & & RST(ng)%Vid(idUbar), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, 3, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % ubar, & & SetFillVal = .FALSE.) #else gtype=gfactor*u2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idUbar, & & RST(ng)%Vid(idUbar), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % ubar(:,:,KOUT)) #endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUbar)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #ifdef PERFECT_RESTART ! ! Write out RHS of 2D momentum equation in the XI-direction. ! scale=1.0_dp gtype=gfactor*u3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idRu2d, & & RST(ng)%Vid(idRu2d), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, 2, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % rubar, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRu2d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #endif ! ! Write out 2D momentum component (m/s) in the ETA-direction. ! scale=1.0_dp #ifdef PERFECT_RESTART gtype=gfactor*v3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idVbar, & & RST(ng)%Vid(idVbar), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, 3, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % vbar, & & SetFillVal = .FALSE.) #else gtype=gfactor*v2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idVbar, & & RST(ng)%Vid(idVbar), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % vbar(:,:,KOUT)) #endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVbar)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #ifdef PERFECT_RESTART ! ! Write out RHS of 2D momentum equation in the ETA-direction. ! scale=1.0_dp gtype=gfactor*v3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idRv2d, & & RST(ng)%Vid(idRv2d), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, 2, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % rvbar, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRv2d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF #endif #ifdef SOLVE3D ! ! Write out 3D momentum component (m/s) in the XI-direction. ! scale=1.0_dp gtype=gfactor*u3dvar # ifdef PERFECT_RESTART status=nf_fwrite4d(ng, model, RST(ng)%ncid, idUvel, & & RST(ng)%Vid(idUvel), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % u, & & SetFillVal = .FALSE.) # else status=nf_fwrite3d(ng, model, RST(ng)%ncid, idUvel, & & RST(ng)%Vid(idUvel), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % u(:,:,:,NOUT)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUvel)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef PERFECT_RESTART ! ! Write out RHS of 3D momentum equation in the XI-direction. ! scale=1.0_dp gtype=gfactor*u3dvar status=nf_fwrite4d(ng, model, RST(ng)%ncid, idRu3d, & & RST(ng)%Vid(idRu3d), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % ru, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRu3d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif ! ! Write out momentum component (m/s) in the ETA-direction. ! scale=1.0_dp gtype=gfactor*v3dvar # ifdef PERFECT_RESTART status=nf_fwrite4d(ng, model, RST(ng)%ncid, idVvel, & & RST(ng)%Vid(idVvel), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % v, & & SetFillVal = .FALSE.) # else status=nf_fwrite3d(ng, model, RST(ng)%ncid, idVvel, & & RST(ng)%Vid(idVvel), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % v(:,:,:,NOUT)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVvel)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef PERFECT_RESTART ! ! Write out RHS of 3D momentum equation in the ETA-direction. ! scale=1.0_dp gtype=gfactor*v3dvar status=nf_fwrite4d(ng, model, RST(ng)%ncid, idRv3d, & & RST(ng)%Vid(idRv3d), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % rv, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRv3d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif ! ! Write out tracer type variables. ! DO itrc=1,NT(ng) scale=1.0_dp gtype=gfactor*r3dvar # ifdef PERFECT_RESTART status=nf_fwrite4d(ng, model, RST(ng)%ncid, idTvar(itrc), & & RST(ng)%Tid(itrc), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % t(:,:,:,:,itrc)) # else status=nf_fwrite3d(ng, model, RST(ng)%ncid, idTvar(itrc), & & RST(ng)%Tid(itrc), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % t(:,:,:,NOUT,itrc)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idTvar(itrc))), & & RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out density anomaly. ! scale=1.0_dp gtype=gfactor*r3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idDano, & & RST(ng)%Vid(idDano), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idDano)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef LMD_SKPP ! ! Write out depth of surface boundary layer. ! scale=1.0_dp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idHsbl, & & RST(ng)%Vid(idHsbl), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % hsbl) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idHsbl)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # ifdef LMD_BKPP ! ! Write out depth of bottom boundary layer. ! scale=1.0_dp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idHbbl, & & RST(ng)%Vid(idHbbl), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % hbbl) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idHbbl)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # if defined PERFECT_RESTART && defined LMD_NONLOCAL ! ! Write out KPP nonlocal transport. ! DO i=1,NAT scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idGhat(i), & & RST(ng)%Vid(idGhat(i)), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % ghats(:,:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idGhat(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif # if defined BVF_MIXING || defined GLS_MIXING || \ defined MY25_MIXING || defined LMD_MIXING ! ! Write out vertical viscosity coefficient. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idVvis, & & RST(ng)%Vid(idVvis), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVvis)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out vertical diffusion coefficient for potential temperature. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idTdif, & & RST(ng)%Vid(idTdif), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idTdif)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef SALINITY ! ! Write out vertical diffusion coefficient for salinity. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idSdif, & & RST(ng)%Vid(idSdif), & & RST(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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idSdif)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # endif # if defined PERFECT_RESTART && \ (defined GLS_MIXING || defined MY25_MIXING) ! ! Write out turbulent kinetic energy. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite4d(ng, model, RST(ng)%ncid, idMtke, & & RST(ng)%Vid(idMtke), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % tke, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idMtke)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Define turbulent kinetic energy time length scale. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite4d(ng, model, RST(ng)%ncid, idMtls, & & RST(ng)%Vid(idMtls), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % gls, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idMtls)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Define vertical mixing turbulent length scale. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idVmLS, & & RST(ng)%Vid(idVmLS), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Lscale) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVmLS)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Define turbulent kinetic energy vertical diffusion coefficient. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idVmKK, & & RST(ng)%Vid(idVmKK), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Akk) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVmKK)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef GLS_MIXING ! ! Define turbulent length scale vertical diffusion coefficient. ! scale=1.0_dp gtype=gfactor*w3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idVmKP, & & RST(ng)%Vid(idVmKP), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Akp) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVmKP)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # endif # ifdef SEDIMENT # ifdef BEDLOAD ! ! Write out bed load transport in U-direction. ! DO i=1,NST scale=1.0_dp gtype=gfactor*u2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idUbld(i), & & RST(ng)%Vid(idUbld(i)), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & SEDBED(ng) % bedldu(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUbld(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out bed load transport in V-direction. ! DO i=1,NST scale=1.0_dp gtype=gfactor*v2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idVbld(i), & & RST(ng)%Vid(idVbld(i)), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & SEDBED(ng) % bedldv(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVbld(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif ! ! Write out sediment fraction of each size class in each bed layer. ! DO i=1,NST scale=1.0_dp gtype=gfactor*b3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idfrac(i), & & RST(ng)%Vid(idfrac(i)), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed_frac(:,:,:,i), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idfrac(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out sediment mass of each size class in each bed layer. ! DO i=1,NST scale=1.0_dp gtype=gfactor*b3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idBmas(i), & & RST(ng)%Vid(idBmas(i)), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed_mass(:,:,:,NOUT,i), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idBmas(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out sediment properties in each bed layer. ! DO i=1,MBEDP IF (i.eq.itauc) THEN scale=rho0 ELSE scale=1.0_dp END IF gtype=gfactor*b3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idSbed(i), & & RST(ng)%Vid(idSbed(i)), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed(:,:,:,i), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idSbed(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif # if defined SEDIMENT || defined BBL_MODEL ! ! Write out exposed sediment layer properties. Notice that only the ! first four properties (mean grain diameter, mean grain density, ! mean settling velocity, mean critical erosion stress, ! ripple length and ripple height) are written. ! DO i=1,6 scale=1.0_dp gtype=gfactor*r2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idBott(i), & & RST(ng)%Vid(idBott(i)), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bottom(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idBott(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif #endif #ifdef WEC ! ! Write out 2D Stokes U-velocity. ! scale=1.0_dp gtype=gfactor*u2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idU2Sd, & & RST(ng)%Vid(idU2Sd), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % ubar_stokes) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,20) TRIM(Vname(1,idU2Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF ! ! Write out 2D Stokes V-velocity. ! scale=1.0_dp gtype=gfactor*v2dvar status=nf_fwrite2d(ng, model, RST(ng)%ncid, idV2Sd, & & RST(ng)%Vid(idV2Sd), & & RST(ng)%Rindex, gtype, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % vbar_stokes) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,20) TRIM(Vname(1,idV2Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF # ifdef SOLVE3D ! ! Write out 3D Stokes U-velocity. ! scale=1.0_dp gtype=gfactor*u3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idU3Sd, & & RST(ng)%Vid(idU3Sd), & & RST(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__, MyFile)) THEN IF(Master) WRITE (stdout,20) TRIM(Vname(1,idU3Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF ! ! Write out 3D Stokes V-velocity. ! scale=1.0_dp gtype=gfactor*v3dvar status=nf_fwrite3d(ng, model, RST(ng)%ncid, idV3Sd, & & RST(ng)%Vid(idV3Sd), & & RST(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__, MyFile)) THEN IF (Master) WRITE (stdout,20) TRIM(Vname(1,idV3Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF # endif #endif #ifdef ICE_MODEL ! !----------------------------------------------------------------------- ! Write out seaice model state variables. !----------------------------------------------------------------------- ! CALL ice_wrt_nf90 (ng, model, tile, & & LBi, UBi, LBj, UBj, & & Hout, RST) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN #endif ! !----------------------------------------------------------------------- ! Synchronize restart NetCDF file to disk. !----------------------------------------------------------------------- ! CALL netcdf_sync (ng, model, RST(ng)%name, RST(ng)%ncid) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! 10 FORMAT (2x,'WRT_RST_NF90 - writing re-start', t42, & #ifdef SOLVE3D # ifdef NESTING & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2) # else & 'fields (Index=',i1,',',i1,') in record = ',i0) # endif #else # ifdef NESTING & 'fields (Index=',i1,') in record = ',i0,t92,i2.2) # else & 'fields (Index=',i1,') in record = ',i0) # endif #endif 20 FORMAT (/,' WRT_RST_NF90 - error while writing variable: ',a, & & /,16x,'into restart NetCDF file for time record: ',i0) ! RETURN END SUBROUTINE wrt_rst_nf90 #if defined PIO_LIB && defined DISTRIBUTE ! !*********************************************************************** SUBROUTINE wrt_rst_pio (ng, model, tile, & & LBi, UBi, LBj, UBj) !*********************************************************************** ! USE mod_pio_netcdf ! ! Imported variable declarations. ! integer, intent(in) :: ng, model, tile integer, intent(in) :: LBi, UBi, LBj, UBj ! ! Local variable declarations. ! integer :: Fcount, i, itrc, status # if defined PERFECT_RESTART || defined SOLVE3D integer :: ntmp(1) # endif ! real(dp) :: scale ! character (len=*), parameter :: MyFile = & & __FILE__//", wrt_rst_pio" ! TYPE (IO_desc_t), pointer :: ioDesc ! SourceFile=MyFile ! !----------------------------------------------------------------------- ! Write out restart fields. !----------------------------------------------------------------------- ! IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! ! Set time record index. ! RST(ng)%Rindex=RST(ng)%Rindex+1 Fcount=RST(ng)%Fcount RST(ng)%Nrec(Fcount)=RST(ng)%Nrec(Fcount)+1 ! ! Report. ! # ifdef SOLVE3D # ifdef NESTING IF (Master) WRITE (stdout,10) KOUT, NOUT, RST(ng)%Rindex, ng # else IF (Master) WRITE (stdout,10) KOUT, NOUT, RST(ng)%Rindex # endif # else # ifdef NESTING IF (Master) WRITE (stdout,10) KOUT, RST(ng)%Rindex, ng # else IF (Master) WRITE (stdout,10) KOUT, RST(ng)%Rindex # endif # endif ! ! If requested, set time index to recycle time records in restart ! file. ! IF (LcycleRST(ng)) THEN RST(ng)%Rindex=MOD(RST(ng)%Rindex-1,2)+1 END IF # ifdef PERFECT_RESTART ! ! Write out time-stepping indices. ! # ifdef SOLVE3D ntmp(1)=1+MOD((iic(ng)-1)-ntstart(ng),2) CALL pio_netcdf_put_ivar (ng, model, RST(ng)%name, 'nstp', & & ntmp, (/RST(ng)%Rindex/), (/1/), & & pioFile = RST(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN CALL pio_netcdf_put_ivar (ng, model, RST(ng)%name, 'nrhs', & & ntmp, (/RST(ng)%Rindex/), (/1/), & & pioFile = RST(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ntmp(1)=3-ntmp(1) CALL pio_netcdf_put_ivar (ng, model, RST(ng)%name, 'nnew', & & ntmp, (/RST(ng)%Rindex/), (/1/), & & pioFile = RST(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif CALL pio_netcdf_put_ivar (ng, model, RST(ng)%name, 'kstp', & & kstp(ng:), (/RST(ng)%Rindex/), (/1/), & & pioFile = RST(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN CALL pio_netcdf_put_ivar (ng, model, RST(ng)%name, 'krhs', & & krhs(ng:), (/RST(ng)%Rindex/), (/1/), & & pioFile = RST(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN CALL pio_netcdf_put_ivar (ng, model, RST(ng)%name, 'knew', & & knew(ng:), (/RST(ng)%Rindex/), (/1/), & & pioFile = RST(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif ! ! Write out model time (s). ! CALL pio_netcdf_put_fvar (ng, model, RST(ng)%name, & & TRIM(Vname(1,idtime)), time(ng:), & & (/RST(ng)%Rindex/), (/1/), & & pioFile = RST(ng)%pioFile, & & pioVar = RST(ng)%pioVar(idtime)%vd) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # if defined SEDIMENT && defined SED_MORPH ! ! Write out time-dependent bathymetry (m) ! IF (Hout(idbath,ng)) THEN scale=1.0_dp IF (RST(ng)%pioVar(idbath)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r2dvar(ng) ELSE ioDesc => ioDesc_sp_r2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idbath, & & RST(ng)%pioVar(idbath), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & GRID(ng) % h, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idbath)), RST(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_dp IF (RST(ng)%pioVar(idPwet)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_p2dvar(ng) ELSE ioDesc => ioDesc_sp_p2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idPwet, & & RST(ng)%pioVar(idPwet), & & RST(ng)%Rindex, & & ioDesc(ng), & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % pmask, & # endif & GRID(ng) % pmask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idPwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at RHO-points. ! scale=1.0_dp IF (RST(ng)%pioVar(idRwet)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r2dvar(ng) ELSE ioDesc => ioDesc_sp_r2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idRwet, & & RST(ng)%pioVar(idRwet), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & GRID(ng) % rmask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at U-points. ! scale=1.0_dp IF (RST(ng)%pioVar(idUwet)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_u2dvar(ng) ELSE ioDesc => ioDesc_sp_u2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idUwet, & & RST(ng)%pioVar(idUwet), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & GRID(ng) % umask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out wet/dry mask at V-points. ! scale=1.0_dp IF (RST(ng)%pioVar(idVwet)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_v2dvar(ng) ELSE ioDesc => ioDesc_sp_v2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idVwet, & & RST(ng)%pioVar(idVwet), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & GRID(ng) % vmask_wet, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVwet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif ! ! Write out free-surface (m). ! scale=1.0_dp # ifdef PERFECT_RESTART IF (RST(ng)%pioVar(idFsur)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_zeta(ng) ELSE ioDesc => ioDesc_sp_zeta(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idFsur, & & RST(ng)%pioVar(idFsur), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, 3, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif # ifdef WET_DRY & OCEAN(ng) % zeta, & & SetFillVal = .FALSE.) # else & OCEAN(ng) % zeta) # endif # else IF (RST(ng)%pioVar(idFsur)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r2dvar(ng) ELSE ioDesc => ioDesc_sp_r2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idFsur, & & RST(ng)%pioVar(idFsur), & & RST(ng)%Rindex, & & ioDesc, & & 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 # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idFsur)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef PERFECT_RESTART ! ! Write out RHS of free-surface equation. ! scale=1.0_dp IF (RST(ng)%pioVar(idRzet)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_rzeta(ng) ELSE ioDesc => ioDesc_sp_rzeta(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idRzet, & & RST(ng)%pioVar(idRzet), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % rzeta) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRzet)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif ! ! Write out 2D momentum component (m/s) in the XI-direction. ! scale=1.0_dp # ifdef PERFECT_RESTART IF (RST(ng)%pioVar(idUbar)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_ubar(ng) ELSE ioDesc => ioDesc_sp_ubar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idUbar, & & RST(ng)%pioVar(idUbar), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, 3, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % ubar, & & SetFillVal = .FALSE.) # else IF (RST(ng)%pioVar(idUbar)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_u2dvar(ng) ELSE ioDesc => ioDesc_sp_u2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idUbar, & & RST(ng)%pioVar(idUbar), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % ubar(:,:,KOUT)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUbar)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef PERFECT_RESTART ! ! Write out RHS of 2D momentum equation in the XI-direction. ! scale=1.0_dp IF (RST(ng)%pioVar(idRu2d)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_rubar(ng) ELSE ioDesc => ioDesc_sp_rubar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idRu2d, & & RST(ng)%pioVar(idRu2d), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, 2, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % rubar, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRu2d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif ! ! Write out 2D momentum component (m/s) in the ETA-direction. ! scale=1.0_dp # ifdef PERFECT_RESTART IF (RST(ng)%pioVar(idVbar)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_vbar(ng) ELSE ioDesc => ioDesc_sp_vbar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idVbar, & & RST(ng)%pioVar(idVbar), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, 3, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % vbar, & & SetFillVal = .FALSE.) # else IF (RST(ng)%pioVar(idVbar)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_v2dvar(ng) ELSE ioDesc => ioDesc_sp_v2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idVbar, & & RST(ng)%pioVar(idVbar), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % vbar(:,:,KOUT)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVbar)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef PERFECT_RESTART ! ! Write out RHS of 2D momentum equation in the ETA-direction. ! scale=1.0_dp IF (RST(ng)%pioVar(idRv2d)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_rvbar(ng) ELSE ioDesc => ioDesc_sp_rvbar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idRv2d, & & RST(ng)%pioVar(idRv2d), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, 2, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % rvbar, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRv2d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # ifdef SOLVE3D ! ! Write out 3D momentum component (m/s) in the XI-direction. ! scale=1.0_dp # ifdef PERFECT_RESTART IF (RST(ng)%pioVar(idUvel)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_uvel(ng) ELSE ioDesc => ioDesc_sp_uvel(ng) END IF status=nf_fwrite4d(ng, model, RST(ng)%pioFile, idUvel, & & RST(ng)%pioVar(idUvel), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % u, & & SetFillVal = .FALSE.) # else IF (RST(ng)%pioVar(idUvel)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_u3dvar(ng) ELSE ioDesc => ioDesc_sp_u3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idUvel, & & RST(ng)%pioVar(idUvel), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask_full, & # endif & OCEAN(ng) % u(:,:,:,NOUT)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUvel)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef PERFECT_RESTART ! ! Write out RHS of 3D momentum equation in the XI-direction. ! scale=1.0_dp IF (RST(ng)%pioVar(idRu3d)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_ruvel(ng) ELSE ioDesc => ioDesc_sp_ruvel(ng) END IF status=nf_fwrite4d(ng, model, RST(ng)%pioFile, idRu3d, & & RST(ng)%pioVar(idRu3d), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % ru, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRu3d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif ! ! Write out momentum component (m/s) in the ETA-direction. ! scale=1.0_dp # ifdef PERFECT_RESTART IF (RST(ng)%pioVar(idVvel)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_vvel(ng) ELSE ioDesc => ioDesc_sp_vvel(ng) END IF status=nf_fwrite4d(ng, model, RST(ng)%pioFile, idVvel, & & RST(ng)%pioVar(idVvel), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % v, & & SetFillVal = .FALSE.) # else IF (RST(ng)%pioVar(idVvel)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_v3dvar(ng) ELSE ioDesc => ioDesc_sp_v3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idVvel, & & RST(ng)%pioVar(idVvel), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask_full, & # endif & OCEAN(ng) % v(:,:,:,NOUT)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVvel)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef PERFECT_RESTART ! ! Write out RHS of 3D momentum equation in the ETA-direction. ! scale=1.0_dp IF (RST(ng)%pioVar(idRv3d)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_rvvel(ng) ELSE ioDesc => ioDesc_sp_rvvel(ng) END IF status=nf_fwrite4d(ng, model, RST(ng)%pioFile, idRv3d, & & RST(ng)%pioVar(idRv3d), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % rv, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idRv3d)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif ! ! Write out tracer type variables. ! DO itrc=1,NT(ng) scale=1.0_dp # ifdef PERFECT_RESTART IF (RST(ng)%pioTrc(itrc)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_trcvar(ng) ELSE ioDesc => ioDesc_sp_trcvar(ng) END IF status=nf_fwrite4d(ng, model, RST(ng)%pioFile, idTvar(itrc), & & RST(ng)%pioTrc(itrc), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % t(:,:,:,:,itrc)) # else IF (RST(ng)%pioTrc(itrc)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r3dvar(ng) ELSE ioDesc => ioDesc_sp_r3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idTvar(itrc), & & RST(ng)%pioTrc(itrc), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % t(:,:,:,NOUT,itrc)) # endif IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idTvar(itrc))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out density anomaly. ! scale=1.0_dp IF (RST(ng)%pioVar(idDano)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r3dvar(ng) ELSE ioDesc => ioDesc_sp_r3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idDano, & & RST(ng)%pioVar(idDano), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & OCEAN(ng) % rho) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idDano)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef LMD_SKPP ! ! Write out depth of surface boundary layer. ! scale=1.0_dp IF (RST(ng)%pioVar(idHsbl)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r2dvar(ng) ELSE ioDesc => ioDesc_sp_r2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idHsbl, & & RST(ng)%pioVar(idHsbl), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % hsbl) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idHsbl)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # ifdef LMD_BKPP ! ! Write out depth of bottom boundary layer. ! scale=1.0_dp IF (RST(ng)%pioVar(idHbbl)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r2dvar(ng) ELSE ioDesc => ioDesc_sp_r2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idHbbl, & & RST(ng)%pioVar(idHbbl), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % hbbl) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idHbbl)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # if defined PERFECT_RESTART && defined LMD_NONLOCAL ! ! Write out KPP nonlocal transport. ! DO i=1,NAT scale=1.0_dp IF (RST(ng)%pioVar(idGhat(i))%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_w3dvar(ng) ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idGhat(i), & & RST(ng)%pioVar(idGhat(i)), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % ghats(:,:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idGhat(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif # if defined BVF_MIXING || defined GLS_MIXING || \ defined MY25_MIXING || defined LMD_MIXING ! ! Write out vertical viscosity coefficient. ! scale=1.0_dp IF (RST(ng)%pioVar(idVvis)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_w3dvar(ng) ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idVvis, & & RST(ng)%pioVar(idVvis), & & RST(ng)%Rindex, & & ioDesc, & & 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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVvis)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Write out vertical diffusion coefficient for potential temperature. ! scale=1.0_dp IF (RST(ng)%pioVar(idTdif)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_w3dvar(ng) ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idTdif, & & RST(ng)%pioVar(idTdif), & & RST(ng)%Rindex, & & ioDesc, & & 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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idTdif)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef SALINITY ! ! Write out vertical diffusion coefficient for salinity. ! scale=1.0_dp IF (RST(ng)%pioVar(idSdif)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_w3dvar(ng) ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idSdif, & & RST(ng)%pioVar(idSdif), & & RST(ng)%Rindex, & & ioDesc, & & 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__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idSdif)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # endif # if defined PERFECT_RESTART && \ (defined GLS_MIXING || defined MY25_MIXING) ! ! Write out turbulent kinetic energy. ! scale=1.0_dp IF (RST(ng)%pioVar(idMtke)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_tkevar(ng) ELSE ioDesc => ioDesc_sp_tkevar(ng) END IF status=nf_fwrite4d(ng, model, RST(ng)%pioFile, idMtke, & & RST(ng)%pioVar(idMtke), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % tke, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idMtke)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Define turbulent kinetic energy time length scale. ! scale=1.0_dp IF (RST(ng)%pioVar(idMtls)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_tkevar(ng) ELSE ioDesc => ioDesc_sp_tkevar(ng) END IF status=nf_fwrite4d(ng, model, RST(ng)%pioFile, idMtls, & & RST(ng)%pioVar(idMtls), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), 1, 2, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % gls, & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idMtls)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Define vertical mixing turbulent length scale. ! scale=1.0_dp IF (RST(ng)%pioVar(idVmLS)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_w3dvar(ng) ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idVmLS, & & RST(ng)%pioVar(idVmLS), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Lscale) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVmLS)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF ! ! Define turbulent kinetic energy vertical diffusion coefficient. ! scale=1.0_dp IF (RST(ng)%pioVar(idVmKK)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_w3dvar(ng) ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idVmKK, & & RST(ng)%pioVar(idVmKK), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Akk) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVmKK)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # ifdef GLS_MIXING ! ! Define turbulent length scale vertical diffusion coefficient. ! scale=1.0_dp IF (RST(ng)%pioVar(idVmKP)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_w3dvar(ng) ELSE ioDesc => ioDesc_sp_w3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idVmKP, & & RST(ng)%pioVar(idVmKP), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 0, N(ng), scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & MIXING(ng) % Akp) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVmKP)), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF # endif # endif # ifdef SEDIMENT # ifdef BEDLOAD ! ! Write out bed load transport in U-direction. ! DO i=1,NST scale=1.0_dp IF (RST(ng)%pioVar(idUbld(i))%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_u2dvar(ng) ELSE ioDesc => ioDesc_sp_u2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idUbld(i), & & RST(ng)%pioVar(idUbld(i)), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & SEDBED(ng) % bedldu(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idUbld(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out bed load transport in V-direction. ! DO i=1,NST scale=1.0_dp IF (RST(ng)%pioVar(idVbld(i))%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_v2dvar(ng) ELSE ioDesc => ioDesc_sp_v2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idVbld(i), & & RST(ng)%pioVar(idVbld(i)), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & SEDBED(ng) % bedldv(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idVbld(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif ! ! Write out sediment fraction of each size class in each bed layer. ! DO i=1,NST scale=1.0_dp IF (RST(ng)%pioVar(idfrac(i))%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_b3dvar(ng) ELSE ioDesc => ioDesc_sp_b3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idfrac(i), & & RST(ng)%pioVar(idfrac(i)), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed_frac(:,:,:,i), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idfrac(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out sediment mass of each size class in each bed layer. ! DO i=1,NST scale=1.0_dp IF (RST(ng)%pioVar(idBmas(i))%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_b3dvar(ng) ELSE ioDesc => ioDesc_sp_b3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idBmas(i), & & RST(ng)%pioVar(idBmas(i)), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed_mass(:,:,:,NOUT,i), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idBmas(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO ! ! Write out sediment properties in each bed layer. ! DO i=1,MBEDP IF (i.eq.itauc) THEN scale=rho0 ELSE scale=1.0_dp END IF IF (RST(ng)%pioVar(idSbed(i))%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_b3dvar(ng) ELSE ioDesc => ioDesc_sp_b3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idSbed(i), & & RST(ng)%pioVar(idSbed(i)), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, Nbed, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bed(:,:,:,i), & & SetFillVal = .FALSE.) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idSbed(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif # if defined SEDIMENT || defined BBL_MODEL ! ! Write out exposed sediment layer properties. Notice that only the ! first six properties (mean grain diameter, mean grain density, ! mean settling velocity, mean critical erosion stress, ! ripple length and ripple height) are written. ! DO i=1,6 scale=1.0_dp IF (RST(ng)%pioVar(idBott(i))%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_r2dvar(ng) ELSE ioDesc => ioDesc_sp_r2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idBott(i), & & RST(ng)%pioVar(idBott(i)), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % rmask, & # endif & SEDBED(ng) % bottom(:,:,i)) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) THEN WRITE (stdout,20) TRIM(Vname(1,idBott(i))), RST(ng)%Rindex END IF exit_flag=3 ioerror=status RETURN END IF END DO # endif # endif # ifdef WEC ! ! Write out 2D Stokes U-velocity. ! scale=1.0_dp IF (RST(ng)%pioVar(idU2Sd)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_u2dvar(ng) ELSE ioDesc => ioDesc_sp_u2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idU2Sd, & & RST(ng)%pioVar(idU2Sd), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % ubar_stokes) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,20) TRIM(Vname(1,idU2Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF ! ! Write out 2D Stokes V-velocity. ! scale=1.0_dp IF (RST(ng)%pioVar(idV2Sd)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_v2dvar(ng) ELSE ioDesc => ioDesc_sp_v2dvar(ng) END IF status=nf_fwrite2d(ng, model, RST(ng)%pioFile, idV2Sd, & & RST(ng)%pioVar(idV2Sd), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % vbar_stokes) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,20) TRIM(Vname(1,idV2Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF # ifdef SOLVE3D ! ! Write out 3D Stokes U-velocity. ! scale=1.0_dp IF (RST(ng)%pioVar(idU3Sd)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_u3dvar(ng) ELSE ioDesc => ioDesc_sp_u3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idU3Sd, & & RST(ng)%pioVar(idU3Sd), & & RST(ng)%Rindex, & & ioDesc, & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % umask, & # endif & OCEAN(ng) % u_stokes) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF(Master) WRITE (stdout,20) TRIM(Vname(1,idU3Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF ! ! Write out 3D Stokes V-velocity. ! scale=1.0_dp IF (RST(ng)%pioVar(idV3Sd)%dkind.eq.PIO_double) THEN ioDesc => ioDesc_dp_v3dvar(ng) ELSE ioDesc => ioDesc_sp_v3dvar(ng) END IF status=nf_fwrite3d(ng, model, RST(ng)%pioFile, idV3Sd, & & RST(ng)%pioVar(idV3Sd), & & RST(ng)%Rindex, & & ioDesc, & & & LBi, UBi, LBj, UBj, 1, N(ng), scale, & # ifdef MASKING & GRID(ng) % vmask, & # endif & OCEAN(ng) % v_stokes) IF (FoundError(status, nf90_noerr, __LINE__, MyFile)) THEN IF (Master) WRITE (stdout,20) TRIM(Vname(1,idV3Sd)), & & RST(ng)%Rindex exit_flag=3 ioerror=status RETURN END IF # endif # endif # ifdef ICE_MODEL ! !----------------------------------------------------------------------- ! Write out seaice model state variables. !----------------------------------------------------------------------- ! CALL ice_wrt_pio (ng, model, tile, & & LBi, UBi, LBj, UBj, & & Hout, RST) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN # endif ! !----------------------------------------------------------------------- ! Synchronize restart NetCDF file to disk. !----------------------------------------------------------------------- ! CALL pio_netcdf_sync (ng, model, RST(ng)%name, RST(ng)%pioFile) IF (FoundError(exit_flag, NoError, __LINE__, MyFile)) RETURN ! 10 FORMAT (2x,'WRT_RST_PIO - writing re-start', t42, & # ifdef SOLVE3D # ifdef NESTING & 'fields (Index=',i1,',',i1,') in record = ',i0,t92,i2.2) # else & 'fields (Index=',i1,',',i1,') in record = ',i0) # endif # else # ifdef NESTING & 'fields (Index=',i1,') in record = ',i0,t92,i2.2) # else & 'fields (Index=',i1,') in record = ',i0) # endif # endif 20 FORMAT (/,' WRT_RST_PIO - error while writing variable: ',a, & & /,16x,'into restart NetCDF file for time record: ',i0) ! RETURN END SUBROUTINE wrt_rst_pio #endif END MODULE wrt_rst_mod