ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
wrt_ini_mod Module Reference

Functions/Subroutines

subroutine, public wrt_ini (ng, tile, tindex, outrec)
 
subroutine, private wrt_ini_nf90 (ng, tile, tindex, lbi, ubi, lbj, ubj, outrec)
 
subroutine, private wrt_ini_pio (ng, tile, tindex, lbi, ubi, lbj, ubj, outrec)
 
subroutine, public wrt_frc (ng, tile, tindex, outrec)
 
subroutine, private wrt_frc_nf90 (ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
 
subroutine, private wrt_frc_pio (ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
 
subroutine, public wrt_frc_ad (ng, tile, tindex, outrec)
 
subroutine, private wrt_frc_ad_nf90 (ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
 
subroutine, private wrt_frc_ad_pio (ng, tile, tindex, outrec, lbij, ubij, lbi, ubi, lbj, ubj)
 

Function/Subroutine Documentation

◆ wrt_frc()

subroutine, public wrt_ini_mod::wrt_frc ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec )

Definition at line 1010 of file wrt_ini.F.

1011!=======================================================================
1012!
1013! Imported variable declarations.
1014!
1015 integer, intent(in) :: ng, tile, Tindex, OutRec
1016!
1017! Local variable declarations.
1018!
1019# ifdef ADJUST_BOUNDARY
1020 integer :: LBij, UBij
1021# endif
1022 integer :: LBi, UBi, LBj, UBj
1023!
1024 character (len=*), parameter :: MyFile = &
1025 & __FILE__//", wrt_frc"
1026!
1027!-----------------------------------------------------------------------
1028! Writes out surface forcing and or open boundary background state
1029! into nonlinear initial conditions NetCDF file.
1030!-----------------------------------------------------------------------
1031!
1032# ifdef ADJUST_BOUNDARY
1033 lbij=bounds(ng)%LBij
1034 ubij=bounds(ng)%UBij
1035# endif
1036 lbi=bounds(ng)%LBi(tile)
1037 ubi=bounds(ng)%UBi(tile)
1038 lbj=bounds(ng)%LBj(tile)
1039 ubj=bounds(ng)%UBj(tile)
1040!
1041 SELECT CASE (ini(ng)%IOtype)
1042 CASE (io_nf90)
1043 CALL wrt_frc_nf90 (ng, tile, tindex, outrec, &
1044# ifdef ADJUST_BOUNDARY
1045 & lbij, ubij, &
1046# endif
1047 & lbi, ubi, lbj, ubj)
1048
1049# if defined PIO_LIB && defined DISTRIBUTE
1050 CASE (io_pio)
1051 CALL wrt_frc_pio (ng, tile, tindex, outrec, &
1052# ifdef ADJUST_BOUNDARY
1053 & lbij, ubij, &
1054# endif
1055 & lbi, ubi, lbj, ubj)
1056# endif
1057 CASE DEFAULT
1058 IF (master) WRITE (stdout,10) ini(ng)%IOtype
1059 exit_flag=3
1060 END SELECT
1061 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1062!
1063 10 FORMAT (' WRT_FRC - Illegal output type, io_type = ',i0)
1064!
1065 RETURN

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ini, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, mod_iounits::stdout, wrt_frc_nf90(), and wrt_frc_pio().

Referenced by i4dvar_mod::background().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_frc_ad()

subroutine, public wrt_ini_mod::wrt_frc_ad ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec )

Definition at line 1719 of file wrt_ini.F.

1720!=======================================================================
1721!
1722! Imported variable declarations.
1723!
1724 integer, intent(in) :: ng, tile, Tindex, OutRec
1725!
1726! Local variable declarations.
1727!
1728# ifdef ADJUST_BOUNDARY
1729 integer :: LBij, UBij
1730# endif
1731 integer :: LBi, UBi, LBj, UBj
1732!
1733 character (len=*), parameter :: MyFile = &
1734 & __FILE__//", wrt_frc"
1735!
1736!-----------------------------------------------------------------------
1737! Writes out surface forcing and or open boundary background state
1738! into nonlinear initial conditions NetCDF file.
1739!-----------------------------------------------------------------------
1740!
1741# ifdef ADJUST_BOUNDARY
1742 lbij=bounds(ng)%LBij
1743 ubij=bounds(ng)%UBij
1744# endif
1745 lbi=bounds(ng)%LBi(tile)
1746 ubi=bounds(ng)%UBi(tile)
1747 lbj=bounds(ng)%LBj(tile)
1748 ubj=bounds(ng)%UBj(tile)
1749!
1750 SELECT CASE (ini(ng)%IOtype)
1751 CASE (io_nf90)
1752 CALL wrt_frc_ad_nf90 (ng, tile, tindex, outrec, &
1753# ifdef ADJUST_BOUNDARY
1754 & lbij, ubij, &
1755# endif
1756 & lbi, ubi, lbj, ubj)
1757
1758# if defined PIO_LIB && defined DISTRIBUTE
1759 CASE (io_pio)
1760 CALL wrt_frc_ad_pio (ng, tile, tindex, outrec, &
1761# ifdef ADJUST_BOUNDARY
1762 & lbij, ubij, &
1763# endif
1764 & lbi, ubi, lbj, ubj)
1765# endif
1766 CASE DEFAULT
1767 IF (master) WRITE (stdout,10) ini(ng)%IOtype
1768 exit_flag=3
1769 END SELECT
1770 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1771!
1772 10 FORMAT (' WRT_FRC_AD - Illegal output type, io_type = ',i0)
1773!
1774 RETURN

References mod_param::bounds, mod_scalars::exit_flag, strings_mod::founderror(), mod_iounits::ini, mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, mod_iounits::stdout, wrt_frc_ad_nf90(), and wrt_frc_ad_pio().

Referenced by convolve_mod::error_covariance(), and rbl4dvar_mod::increment().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_frc_ad_nf90()

subroutine, private wrt_ini_mod::wrt_frc_ad_nf90 ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 1778 of file wrt_ini.F.

1783!***********************************************************************
1784!
1785 USE mod_netcdf
1786!
1787! Imported variable declarations.
1788!
1789 integer, intent(in) :: ng, tile, Tindex, OutRec
1790# ifdef ADJUST_BOUNDARY
1791 integer, intent(in) :: LBij, UBij
1792# endif
1793 integer, intent(in) :: LBi, UBi, LBj, UBj
1794!
1795! Local variable declarations.
1796!
1797 integer :: gfactor, gtype, i, itrc, status
1798!
1799 real(dp) :: scale
1800!
1801 character (len=*), parameter :: MyFile = &
1802 & __FILE__//", wrt_frc_AD_nf90"
1803!
1804 sourcefile=myfile
1805!
1806!-----------------------------------------------------------------------
1807! Write out initial conditions.
1808!-----------------------------------------------------------------------
1809!
1810 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1811!
1812! Report.
1813!
1814 IF (master) THEN
1815# ifdef NESTING
1816 WRITE (stdout,10) outer, inner, tindex, outrec, ng
1817# else
1818 WRITE (stdout,10) outer, inner, tindex, outrec
1819# endif
1820 END IF
1821!
1822! Set grid type factor to write full (gfactor=1) fields or water
1823! points (gfactor=-1) fields only.
1824!
1825# if defined WRITE_WATER && defined MASKING
1826 gfactor=-1
1827# else
1828 gfactor=1
1829# endif
1830
1831# ifdef ADJUST_BOUNDARY
1832!
1833! Write out open boundary fields. Notice that these fields have their
1834! own fixed time-dimension (of size Nbrec) to allow 4DVAR adjustments
1835! at other times in addition to initialization time.
1836!
1837! Write out free-surface open boundaries.
1838!
1839 IF (any(lobc(:,isfsur,ng))) THEN
1840 scale=1.0_dp
1841 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1842 & vname(1,idsbry(isfsur)), &
1843 & ini(ng)%Vid(idsbry(isfsur)), &
1844 & outrec, r2dvar, &
1845 & lbij, ubij, nbrec(ng), scale, &
1846 & boundary(ng) % ad_zeta_obc(lbij:,:,:, &
1847 & tindex))
1848 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1849 IF (master) THEN
1850 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
1851 END IF
1852 exit_flag=3
1853 ioerror=status
1854 RETURN
1855 END IF
1856 END IF
1857!
1858! Write out 2D U-momentum component open boundaries.
1859!
1860 IF (any(lobc(:,isubar,ng))) THEN
1861 scale=1.0_dp
1862 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1863 & vname(1,idsbry(isubar)), &
1864 & ini(ng)%Vid(idsbry(isubar)), &
1865 & outrec, u2dvar, &
1866 & lbij, ubij, nbrec(ng), scale, &
1867 & boundary(ng) % ad_ubar_obc(lbij:,:,:, &
1868 & tindex))
1869 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1870 IF (master) THEN
1871 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
1872 END IF
1873 exit_flag=3
1874 ioerror=status
1875 RETURN
1876 END IF
1877 END IF
1878!
1879! Write out 2D V-momentum component open boundaries.
1880!
1881 IF (any(lobc(:,isvbar,ng))) THEN
1882 scale=1.0_dp
1883 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1884 & vname(1,idsbry(isvbar)), &
1885 & ini(ng)%Vid(idsbry(isvbar)), &
1886 & outrec, v2dvar, &
1887 & lbij, ubij, nbrec(ng), scale, &
1888 & boundary(ng) % ad_vbar_obc(lbij:,:,:, &
1889 & tindex))
1890 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1891 IF (master) THEN
1892 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
1893 END IF
1894 exit_flag=3
1895 ioerror=status
1896 RETURN
1897 END IF
1898 END IF
1899
1900# ifdef SOLVE3D
1901!
1902! Write out 3D U-momentum component open boundaries.
1903!
1904 IF (any(lobc(:,isuvel,ng))) THEN
1905 scale=1.0_dp
1906 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1907 & vname(1,idsbry(isuvel)), &
1908 & ini(ng)%Vid(idsbry(isuvel)), &
1909 & outrec, u3dvar, &
1910 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1911 & boundary(ng) % ad_u_obc(lbij:,:,:,:, &
1912 & tindex))
1913 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1914 IF (master) THEN
1915 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
1916 END IF
1917 exit_flag=3
1918 ioerror=status
1919 RETURN
1920 END IF
1921 END IF
1922!
1923! Write out 3D V-momentum component open boundaries.
1924!
1925 IF (any(lobc(:,isvvel,ng))) THEN
1926 scale=1.0_dp
1927 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1928 & vname(1,idsbry(isvvel)), &
1929 & ini(ng)%Vid(idsbry(isvvel)), &
1930 & outrec, v3dvar, &
1931 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1932 & boundary(ng) % ad_v_obc(lbij:,:,:,:, &
1933 & tindex))
1934 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1935 IF (master) THEN
1936 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
1937 END IF
1938 exit_flag=3
1939 ioerror=status
1940 RETURN
1941 END IF
1942 END IF
1943!
1944! Write out 3D tracers open boundaries.
1945!
1946 DO itrc=1,nt(ng)
1947 IF (any(lobc(:,istvar(itrc),ng))) THEN
1948 scale=1.0_dp
1949 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1950 & vname(1,idsbry(istvar(itrc))), &
1951 & ini(ng)%Vid(idsbry(istvar(itrc))), &
1952 & outrec, r3dvar, &
1953 & lbij, ubij, 1, n(ng), nbrec(ng), &
1954 & scale, &
1955 & boundary(ng) % ad_t_obc(lbij:,:,:,:, &
1956 & tindex,itrc))
1957 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1958 IF (master) THEN
1959 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
1960 & outrec
1961 END IF
1962 exit_flag=3
1963 ioerror=status
1964 RETURN
1965 END IF
1966 END IF
1967 END DO
1968# endif
1969# endif
1970
1971# ifdef ADJUST_WSTRESS
1972!
1973! Write out surface U-momentum stress. Notice that the stress has its
1974! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
1975! at other times in addition to initialization time.
1976!
1977 scale=1.0_dp
1978 gtype=gfactor*u3dvar
1979 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idusms, &
1980 & ini(ng)%Vid(idusms), &
1981 & outrec, gtype, &
1982 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1983# ifdef MASKING
1984 & grid(ng) % umask, &
1985# endif
1986 & forces(ng) % ad_ustr(:,:,:,tindex))
1987 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1988 IF (master) THEN
1989 WRITE (stdout,20) trim(vname(1,idusms)), outrec
1990 END IF
1991 exit_flag=3
1992 ioerror=status
1993 RETURN
1994 END IF
1995!
1996! Write out surface V-momentum stress.
1997!
1998 scale=1.0_dp
1999 gtype=gfactor*v3dvar
2000 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idvsms, &
2001 & ini(ng)%Vid(idvsms), &
2002 & outrec, gtype, &
2003 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
2004# ifdef MASKING
2005 & grid(ng) % vmask, &
2006# endif
2007 & forces(ng) % ad_vstr(:,:,:,tindex))
2008 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2009 IF (master) THEN
2010 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
2011 END IF
2012 exit_flag=3
2013 ioerror=status
2014 RETURN
2015 END IF
2016# endif
2017
2018# if defined ADJUST_STFLUX && defined SOLVE3D
2019!
2020! Write out surface net tracers fluxes. Notice that fluxes have their
2021! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
2022! at other times in addition to initialization time.
2023!
2024 DO itrc=1,nt(ng)
2025 IF (lstflux(itrc,ng)) THEN
2026 scale=1.0_dp
2027 gtype=gfactor*r3dvar
2028 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idtsur(itrc), &
2029 & ini(ng)%Vid(idtsur(itrc)), &
2030 & outrec, gtype, &
2031 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
2032# ifdef MASKING
2033 & grid(ng) % rmask, &
2034# endif
2035 & forces(ng) % ad_tflux(:,:,:,tindex,itrc))
2036 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2037 IF (master) THEN
2038 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
2039 & outrec
2040 END IF
2041 exit_flag=3
2042 ioerror=status
2043 RETURN
2044 END IF
2045 END IF
2046 END DO
2047# endif
2048!
2049!-----------------------------------------------------------------------
2050! Synchronize initial NetCDF file to disk to allow other processes
2051! to access data immediately after it is written.
2052!-----------------------------------------------------------------------
2053!
2054 CALL netcdf_sync (ng, inlm, ini(ng)%name, ini(ng)%ncid)
2055 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2056!
2057 10 FORMAT (2x,'WRT_FRC_AD_NF90 - writing forcing fields', &
2058 & ' (Outer=',i2.2, &
2059# ifdef NESTING
2060 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,', Grid ', &
2061 & i0,')')
2062# else
2063 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,')')
2064# endif
2065 20 FORMAT (/,' WRT_FRC_AD_NF90 - error while writing variable: ',a, &
2066 & /,19x,'into initial NetCDF file for time record: ',i0)
2067!
2068 RETURN
mod_netcdf
Definition mod_netcdf.F:2
mod_netcdf::netcdf_sync
subroutine, public netcdf_sync(ng, model, ncname, ncid)
Definition mod_netcdf.F:9505

References mod_boundary::boundary, mod_scalars::exit_flag, mod_forces::forces, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idsbry, mod_ncparam::idtsur, mod_ncparam::idusms, mod_ncparam::idvsms, mod_iounits::ini, mod_param::inlm, mod_scalars::inner, mod_iounits::ioerror, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_scalars::nbrec, mod_netcdf::netcdf_sync(), mod_scalars::nfrec, mod_scalars::noerror, mod_param::nt, mod_scalars::outer, mod_param::r2dvar, mod_param::r3dvar, mod_iounits::sourcefile, mod_iounits::stdout, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, and mod_ncparam::vname.

Referenced by wrt_frc_ad().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_frc_ad_pio()

subroutine, private wrt_ini_mod::wrt_frc_ad_pio ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 2074 of file wrt_ini.F.

2079!***********************************************************************
2080!
2081 USE mod_pio_netcdf
2082!
2083! Imported variable declarations.
2084!
2085 integer, intent(in) :: ng, tile, Tindex, OutRec
2086# ifdef ADJUST_BOUNDARY
2087 integer, intent(in) :: LBij, UBij
2088# endif
2089 integer, intent(in) :: LBi, UBi, LBj, UBj
2090!
2091! Local variable declarations.
2092!
2093 integer :: i, ifield, itrc, status
2094!
2095 real(dp) :: scale
2096!
2097 character (len=*), parameter :: MyFile = &
2098 & __FILE__//", wrt_frc_AD_pio"
2099!
2100 TYPE (IO_desc_t), pointer :: ioDesc
2101!
2102 sourcefile=myfile
2103!
2104!-----------------------------------------------------------------------
2105! Write out initial conditions.
2106!-----------------------------------------------------------------------
2107!
2108 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2109!
2110! Report
2111!
2112 IF (master) THEN
2113# ifdef NESTING
2114 WRITE (stdout,10) outer, inner, tindex, outrec, ng
2115# else
2116 WRITE (stdout,10) outer, inner, tindex, outrec
2117# endif
2118 END IF
2119
2120# ifdef ADJUST_BOUNDARY
2121!
2122! Write out open boundary fields. Notice that these fields have their
2123! own fixed time-dimension (of size Nbrec) to allow 4DVAR adjustments
2124! at other times in addition to initialization time.
2125!
2126! Write out free-surface open boundaries.
2127!
2128 IF (any(lobc(:,isfsur,ng))) THEN
2129 scale=1.0_dp
2130 IF (ini(ng)%pioVar(idsbry(isfsur))%dkind.eq.pio_double) THEN
2131 iodesc => iodesc_dp_r2dobc(ng)
2132 ELSE
2133 iodesc => iodesc_sp_r2dobc(ng)
2134 END IF
2135!
2136 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, &
2137 & ini(ng)%pioFile, &
2138 & vname(1,idsbry(isfsur)), &
2139 & ini(ng)%pioVar(idsbry(isfsur)), &
2140 & outrec,iodesc, &
2141 & lbij, ubij, nbrec(ng), scale, &
2142 & boundary(ng) % ad_zeta_obc(lbij:,:,:, &
2143 & tindex))
2144 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2145 IF (master) THEN
2146 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
2147 END IF
2148 exit_flag=3
2149 ioerror=status
2150 RETURN
2151 END IF
2152 END IF
2153!
2154! Write out 2D U-momentum component open boundaries.
2155!
2156 IF (any(lobc(:,isubar,ng))) THEN
2157 scale=1.0_dp
2158 IF (ini(ng)%pioVar(idsbry(isubar))%dkind.eq.pio_double) THEN
2159 iodesc => iodesc_dp_u2dobc(ng)
2160 ELSE
2161 iodesc => iodesc_sp_u2dobc(ng)
2162 END IF
2163!
2164 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, &
2165 & ini(ng)%pioFile, &
2166 & vname(1,idsbry(isubar)), &
2167 & ini(ng)%pioVar(idsbry(isubar)), &
2168 & outrec, iodesc, &
2169 & lbij, ubij, nbrec(ng), scale, &
2170 & boundary(ng) % ad_ubar_obc(lbij:,:,:, &
2171 & tindex))
2172 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2173 IF (master) THEN
2174 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
2175 END IF
2176 exit_flag=3
2177 ioerror=status
2178 RETURN
2179 END IF
2180 END IF
2181!
2182! Write out 2D V-momentum component open boundaries.
2183!
2184 IF (any(lobc(:,isvbar,ng))) THEN
2185 scale=1.0_dp
2186 IF (ini(ng)%pioVar(idsbry(isvbar))%dkind.eq.pio_double) THEN
2187 iodesc => iodesc_dp_v2dobc(ng)
2188 ELSE
2189 iodesc => iodesc_sp_v2dobc(ng)
2190 END IF
2191!
2192 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, &
2193 & ini(ng)%pioFile, &
2194 & vname(1,idsbry(isvbar)), &
2195 & ini(ng)%pioVar(idsbry(isvbar)), &
2196 & outrec, iodesc, &
2197 & lbij, ubij, nbrec(ng), scale, &
2198 & boundary(ng) % ad_vbar_obc(lbij:,:,:, &
2199 & tindex))
2200 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2201 IF (master) THEN
2202 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
2203 END IF
2204 exit_flag=3
2205 ioerror=status
2206 RETURN
2207 END IF
2208 END IF
2209
2210# ifdef SOLVE3D
2211!
2212! Write out 3D U-momentum component open boundaries.
2213!
2214 IF (any(lobc(:,isuvel,ng))) THEN
2215 scale=1.0_dp
2216 IF (ini(ng)%pioVar(idsbry(isuvel))%dkind.eq.pio_double) THEN
2217 iodesc => iodesc_dp_u3dobc(ng)
2218 ELSE
2219 iodesc => iodesc_sp_u3dobc(ng)
2220 END IF
2221!
2222 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, &
2223 & ini(ng)%pioFile, &
2224 & vname(1,idsbry(isuvel)), &
2225 & ini(ng)%pioVar(idsbry(isuvel)), &
2226 & outrec, iodesc, &
2227 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
2228 & boundary(ng) % ad_u_obc(lbij:,:,:,:, &
2229 & tindex))
2230 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2231 IF (master) THEN
2232 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
2233 END IF
2234 exit_flag=3
2235 ioerror=status
2236 RETURN
2237 END IF
2238 END IF
2239!
2240! Write out 3D V-momentum component open boundaries.
2241!
2242 IF (any(lobc(:,isvvel,ng))) THEN
2243 scale=1.0_dp
2244 IF (ini(ng)%pioVar(idsbry(isvvel))%dkind.eq.pio_double) THEN
2245 iodesc => iodesc_dp_v3dobc(ng)
2246 ELSE
2247 iodesc => iodesc_sp_v3dobc(ng)
2248 END IF
2249!
2250 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, &
2251 & ini(ng)%pioFile, &
2252 & vname(1,idsbry(isvvel)), &
2253 & ini(ng)%pioVar(idsbry(isvvel)), &
2254 & outrec, iodesc, &
2255 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
2256 & boundary(ng) % ad_v_obc(lbij:,:,:,:, &
2257 & tindex))
2258 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2259 IF (master) THEN
2260 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
2261 END IF
2262 exit_flag=3
2263 ioerror=status
2264 RETURN
2265 END IF
2266 END IF
2267!
2268! Write out 3D tracers open boundaries.
2269!
2270 DO itrc=1,nt(ng)
2271 IF (any(lobc(:,istvar(itrc),ng))) THEN
2272 scale=1.0_dp
2273 ifield=idsbry(istvar(itrc))
2274 IF (ini(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
2275 iodesc => iodesc_dp_r3dobc(ng)
2276 ELSE
2277 iodesc => iodesc_sp_r3dobc(ng)
2278 END IF
2279!
2280 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, &
2281 & ini(ng)%pioFile, &
2282 & vname(1,idsbry(istvar(itrc))), &
2283 & ini(ng)%pioVar(idsbry(istvar(itrc))), &
2284 & outrec, iodesc, &
2285 & lbij, ubij, 1, n(ng), nbrec(ng), &
2286 & scale, &
2287 & boundary(ng) % ad_t_obc(lbij:,:,:,:, &
2288 & tindex,itrc))
2289 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2290 IF (master) THEN
2291 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
2292 & outrec
2293 END IF
2294 exit_flag=3
2295 ioerror=status
2296 RETURN
2297 END IF
2298 END IF
2299 END DO
2300# endif
2301# endif
2302
2303# ifdef ADJUST_WSTRESS
2304!
2305! Write out surface U-momentum stress. Notice that the stress has its
2306! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
2307! at other times in addition to initialization time.
2308!
2309 scale=1.0_dp
2310 IF (ini(ng)%pioVar(idusms)%dkind.eq.pio_double) THEN
2311 iodesc => iodesc_dp_u2dfrc(ng)
2312 ELSE
2313 iodesc => iodesc_sp_u2dfrc(ng)
2314 END IF
2315!
2316 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idusms, &
2317 & ini(ng)%pioVar(idusms), &
2318 & outrec, iodesc, &
2319 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
2320# ifdef MASKING
2321 & grid(ng) % umask, &
2322# endif
2323 & forces(ng) % ad_ustr(:,:,:,tindex))
2324 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2325 IF (master) THEN
2326 WRITE (stdout,20) trim(vname(1,idusms)), outrec
2327 END IF
2328 exit_flag=3
2329 ioerror=status
2330 RETURN
2331 END IF
2332!
2333! Write out surface V-momentum stress.
2334!
2335 scale=1.0_dp
2336 IF (ini(ng)%pioVar(idvsms)%dkind.eq.pio_double) THEN
2337 iodesc => iodesc_dp_v2dfrc(ng)
2338 ELSE
2339 iodesc => iodesc_sp_v2dfrc(ng)
2340 END IF
2341!
2342 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idvsms, &
2343 & ini(ng)%pioVar(idvsms), &
2344 & outrec, iodesc, &
2345 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
2346# ifdef MASKING
2347 & grid(ng) % vmask, &
2348# endif
2349 & forces(ng) % ad_vstr(:,:,:,tindex))
2350 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2351 IF (master) THEN
2352 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
2353 END IF
2354 exit_flag=3
2355 ioerror=status
2356 RETURN
2357 END IF
2358# endif
2359
2360# if defined ADJUST_STFLUX && defined SOLVE3D
2361!
2362! Write out surface net tracers fluxes. Notice that fluxes have their
2363! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
2364! at other times in addition to initialization time.
2365!
2366 DO itrc=1,nt(ng)
2367 IF (lstflux(itrc,ng)) THEN
2368 scale=1.0_dp
2369 IF (ini(ng)%pioVar(idtsur(itrc))%dkind.eq.pio_double) THEN
2370 iodesc => iodesc_dp_r2dfrc(ng)
2371 ELSE
2372 iodesc => iodesc_sp_r2dfrc(ng)
2373 END IF
2374!
2375 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idtsur(itrc), &
2376 & ini(ng)%pioVar(idtsur(itrc)), &
2377 & outrec, iodesc, &
2378 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
2379# ifdef MASKING
2380 & grid(ng) % rmask, &
2381# endif
2382 & forces(ng) % ad_tflux(:,:,:,tindex,itrc))
2383 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2384 IF (master) THEN
2385 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
2386 & outrec
2387 END IF
2388 exit_flag=3
2389 ioerror=status
2390 RETURN
2391 END IF
2392 END IF
2393 END DO
2394# endif
2395!
2396!-----------------------------------------------------------------------
2397! Synchronize initial NetCDF file to disk to allow other processes
2398! to access data immediately after it is written.
2399!-----------------------------------------------------------------------
2400!
2401 CALL pio_netcdf_sync (ng, inlm, ini(ng)%name, ini(ng)%pioFile)
2402 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2403!
2404 10 FORMAT (2x,'WRT_FRC_AD_PIO - writing forcing fields', &
2405 & ' (Outer=',i2.2, &
2406# ifdef NESTING
2407 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,', Grid ', &
2408 & i0,')')
2409# else
2410 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,')')
2411# endif
2412 20 FORMAT (/,' WRT_FRC_AD_PIO - error while writing variable: ',a, &
2413 & /,19x,'into initial NetCDF file for time record: ',i0)
2414!
2415 RETURN
mod_pio_netcdf
Definition mod_pio_netcdf.F:2
mod_pio_netcdf::iodesc_sp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dobc
Definition mod_pio_netcdf.F:217
mod_pio_netcdf::iodesc_dp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dobc
Definition mod_pio_netcdf.F:256
mod_pio_netcdf::iodesc_sp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dfrc
Definition mod_pio_netcdf.F:228
mod_pio_netcdf::iodesc_dp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dobc
Definition mod_pio_netcdf.F:260
mod_pio_netcdf::pio_netcdf_sync
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
Definition mod_pio_netcdf.F:9275
mod_pio_netcdf::iodesc_dp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dobc
Definition mod_pio_netcdf.F:259
mod_pio_netcdf::iodesc_sp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dobc
Definition mod_pio_netcdf.F:219
mod_pio_netcdf::iodesc_dp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dobc
Definition mod_pio_netcdf.F:255
mod_pio_netcdf::iodesc_sp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dobc
Definition mod_pio_netcdf.F:215
mod_pio_netcdf::iodesc_sp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dobc
Definition mod_pio_netcdf.F:220
mod_pio_netcdf::iodesc_dp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dfrc
Definition mod_pio_netcdf.F:267
mod_pio_netcdf::iodesc_dp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dobc
Definition mod_pio_netcdf.F:254
mod_pio_netcdf::iodesc_sp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dobc
Definition mod_pio_netcdf.F:216
mod_pio_netcdf::iodesc_dp_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dfrc
Definition mod_pio_netcdf.F:268
mod_pio_netcdf::iodesc_sp_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dfrc
Definition mod_pio_netcdf.F:229
mod_pio_netcdf::iodesc_dp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dfrc
Definition mod_pio_netcdf.F:264
mod_pio_netcdf::iodesc_dp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dobc
Definition mod_pio_netcdf.F:258
mod_pio_netcdf::iodesc_sp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dobc
Definition mod_pio_netcdf.F:221
mod_pio_netcdf::iodesc_sp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dfrc
Definition mod_pio_netcdf.F:225

References mod_boundary::boundary, mod_scalars::exit_flag, mod_forces::forces, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idsbry, mod_ncparam::idtsur, mod_ncparam::idusms, mod_ncparam::idvsms, mod_iounits::ini, mod_param::inlm, mod_scalars::inner, mod_pio_netcdf::iodesc_dp_r2dfrc, mod_pio_netcdf::iodesc_dp_r2dobc, mod_pio_netcdf::iodesc_dp_r3dobc, mod_pio_netcdf::iodesc_dp_u2dfrc, mod_pio_netcdf::iodesc_dp_u2dobc, mod_pio_netcdf::iodesc_dp_u3dobc, mod_pio_netcdf::iodesc_dp_v2dfrc, mod_pio_netcdf::iodesc_dp_v2dobc, mod_pio_netcdf::iodesc_dp_v3dobc, mod_pio_netcdf::iodesc_sp_r2dfrc, mod_pio_netcdf::iodesc_sp_r2dobc, mod_pio_netcdf::iodesc_sp_r3dobc, mod_pio_netcdf::iodesc_sp_u2dfrc, mod_pio_netcdf::iodesc_sp_u2dobc, mod_pio_netcdf::iodesc_sp_u3dobc, mod_pio_netcdf::iodesc_sp_v2dfrc, mod_pio_netcdf::iodesc_sp_v2dobc, mod_pio_netcdf::iodesc_sp_v3dobc, mod_iounits::ioerror, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_scalars::nbrec, mod_scalars::nfrec, mod_scalars::noerror, mod_param::nt, mod_scalars::outer, mod_pio_netcdf::pio_netcdf_sync(), mod_iounits::sourcefile, mod_iounits::stdout, and mod_ncparam::vname.

Referenced by wrt_frc_ad().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_frc_nf90()

subroutine, private wrt_ini_mod::wrt_frc_nf90 ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 1069 of file wrt_ini.F.

1074!***********************************************************************
1075!
1076 USE mod_netcdf
1077!
1078! Imported variable declarations.
1079!
1080 integer, intent(in) :: ng, tile, Tindex, OutRec
1081# ifdef ADJUST_BOUNDARY
1082 integer, intent(in) :: LBij, UBij
1083# endif
1084 integer, intent(in) :: LBi, UBi, LBj, UBj
1085!
1086! Local variable declarations.
1087!
1088 integer :: gfactor, gtype, i, itrc, status
1089!
1090 real(dp) :: scale
1091!
1092 character (len=*), parameter :: MyFile = &
1093 & __FILE__//", wrt_frc_nf90"
1094!
1095 sourcefile=myfile
1096!
1097!-----------------------------------------------------------------------
1098! Write out initial conditions.
1099!-----------------------------------------------------------------------
1100!
1101 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1102!
1103! Report.
1104!
1105 IF (master) THEN
1106# ifdef NESTING
1107 WRITE (stdout,10) outer, inner, tindex, outrec, ng
1108# else
1109 WRITE (stdout,10) outer, inner, tindex, outrec
1110# endif
1111 END IF
1112!
1113! Set grid type factor to write full (gfactor=1) fields or water
1114! points (gfactor=-1) fields only.
1115!
1116# if defined WRITE_WATER && defined MASKING
1117 gfactor=-1
1118# else
1119 gfactor=1
1120# endif
1121
1122# ifdef ADJUST_BOUNDARY
1123!
1124! Write out open boundary fields. Notice that these fields have their
1125! own fixed time-dimension (of size Nbrec) to allow 4DVAR adjustments
1126! at other times in addition to initialization time.
1127!
1128! Write out free-surface open boundaries.
1129!
1130 IF (any(lobc(:,isfsur,ng))) THEN
1131 scale=1.0_dp
1132 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1133 & vname(1,idsbry(isfsur)), &
1134 & ini(ng)%Vid(idsbry(isfsur)), &
1135 & outrec, r2dvar, &
1136 & lbij, ubij, nbrec(ng), scale, &
1137 & boundary(ng) % zeta_obc(lbij:,:,:, &
1138 & tindex))
1139 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1140 IF (master) THEN
1141 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
1142 END IF
1143 exit_flag=3
1144 ioerror=status
1145 RETURN
1146 END IF
1147 END IF
1148!
1149! Write out 2D U-momentum component open boundaries.
1150!
1151 IF (any(lobc(:,isubar,ng))) THEN
1152 scale=1.0_dp
1153 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1154 & vname(1,idsbry(isubar)), &
1155 & ini(ng)%Vid(idsbry(isubar)), &
1156 & outrec, u2dvar, &
1157 & lbij, ubij, nbrec(ng), scale, &
1158 & boundary(ng) % ubar_obc(lbij:,:,:, &
1159 & tindex))
1160 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1161 IF (master) THEN
1162 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
1163 END IF
1164 exit_flag=3
1165 ioerror=status
1166 RETURN
1167 END IF
1168 END IF
1169!
1170! Write out 2D V-momentum component open boundaries.
1171!
1172 IF (any(lobc(:,isvbar,ng))) THEN
1173 scale=1.0_dp
1174 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1175 & vname(1,idsbry(isvbar)), &
1176 & ini(ng)%Vid(idsbry(isvbar)), &
1177 & outrec, v2dvar, &
1178 & lbij, ubij, nbrec(ng), scale, &
1179 & boundary(ng) % vbar_obc(lbij:,:,:, &
1180 & tindex))
1181 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1182 IF (master) THEN
1183 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
1184 END IF
1185 exit_flag=3
1186 ioerror=status
1187 RETURN
1188 END IF
1189 END IF
1190
1191# ifdef SOLVE3D
1192!
1193! Write out 3D U-momentum component open boundaries.
1194!
1195 IF (any(lobc(:,isuvel,ng))) THEN
1196 scale=1.0_dp
1197 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1198 & vname(1,idsbry(isuvel)), &
1199 & ini(ng)%Vid(idsbry(isuvel)), &
1200 & outrec, u3dvar, &
1201 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1202 & boundary(ng) % u_obc(lbij:,:,:,:, &
1203 & tindex))
1204 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1205 IF (master) THEN
1206 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
1207 END IF
1208 exit_flag=3
1209 ioerror=status
1210 RETURN
1211 END IF
1212 END IF
1213!
1214! Write out 3D V-momentum component open boundaries.
1215!
1216 IF (any(lobc(:,isvvel,ng))) THEN
1217 scale=1.0_dp
1218 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1219 & vname(1,idsbry(isvvel)), &
1220 & ini(ng)%Vid(idsbry(isvvel)), &
1221 & outrec, v3dvar, &
1222 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1223 & boundary(ng) % v_obc(lbij:,:,:,:, &
1224 & tindex))
1225 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1226 IF (master) THEN
1227 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
1228 END IF
1229 exit_flag=3
1230 ioerror=status
1231 RETURN
1232 END IF
1233 END IF
1234!
1235! Write out 3D tracers open boundaries.
1236!
1237 DO itrc=1,nt(ng)
1238 IF (any(lobc(:,istvar(itrc),ng))) THEN
1239 scale=1.0_dp
1240 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, ini(ng)%ncid, &
1241 & vname(1,idsbry(istvar(itrc))), &
1242 & ini(ng)%Vid(idsbry(istvar(itrc))), &
1243 & outrec, r3dvar, &
1244 & lbij, ubij, 1, n(ng), nbrec(ng), &
1245 & scale, &
1246 & boundary(ng) % t_obc(lbij:,:,:,:, &
1247 & tindex,itrc))
1248 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1249 IF (master) THEN
1250 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
1251 & outrec
1252 END IF
1253 exit_flag=3
1254 ioerror=status
1255 RETURN
1256 END IF
1257 END IF
1258 END DO
1259# endif
1260# endif
1261
1262# ifdef ADJUST_WSTRESS
1263!
1264! Write out surface U-momentum stress. Notice that the stress has its
1265! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
1266! at other times in addition to initialization time.
1267!
1268 scale=rho0 ! m2/s2 to N/m2 (Pa)
1269 gtype=gfactor*u3dvar
1270 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idusms, &
1271 & ini(ng)%Vid(idusms), &
1272 & outrec, gtype, &
1273 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1274# ifdef MASKING
1275 & grid(ng) % umask, &
1276# endif
1277 & forces(ng) % ustr(:,:,:,tindex))
1278 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1279 IF (master) THEN
1280 WRITE (stdout,20) trim(vname(1,idusms)), outrec
1281 END IF
1282 exit_flag=3
1283 ioerror=status
1284 RETURN
1285 END IF
1286!
1287! Write out surface V-momentum stress.
1288!
1289 scale=rho0 ! m2/s2 to N/m2 (Pa)
1290 gtype=gfactor*v3dvar
1291 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idvsms, &
1292 & ini(ng)%Vid(idvsms), &
1293 & outrec, gtype, &
1294 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1295# ifdef MASKING
1296 & grid(ng) % vmask, &
1297# endif
1298 & forces(ng) % vstr(:,:,:,tindex))
1299 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1300 IF (master) THEN
1301 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
1302 END IF
1303 exit_flag=3
1304 ioerror=status
1305 RETURN
1306 END IF
1307# endif
1308
1309# if defined ADJUST_STFLUX && defined SOLVE3D
1310!
1311! Write out surface net tracers fluxes. Notice that fluxes have their
1312! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
1313! at other times in addition to initialization time.
1314!
1315 DO itrc=1,nt(ng)
1316 IF (lstflux(itrc,ng)) THEN
1317 IF (itrc.eq.itemp) THEN
1318 scale=rho0*cp ! Celsius m/s to W/m2
1319 ELSE
1320 scale=1.0_dp
1321 END IF
1322 gtype=gfactor*r3dvar
1323 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idtsur(itrc), &
1324 & ini(ng)%Vid(idtsur(itrc)), &
1325 & outrec, gtype, &
1326 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1327# ifdef MASKING
1328 & grid(ng) % rmask, &
1329# endif
1330 & forces(ng) % tflux(:,:,:,tindex,itrc))
1331 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
1332 IF (master) THEN
1333 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1334 & outrec
1335 END IF
1336 exit_flag=3
1337 ioerror=status
1338 RETURN
1339 END IF
1340 END IF
1341 END DO
1342# endif
1343!
1344!-----------------------------------------------------------------------
1345! Synchronize initial NetCDF file to disk to allow other processes
1346! to access data immediately after it is written.
1347!-----------------------------------------------------------------------
1348!
1349 CALL netcdf_sync (ng, inlm, ini(ng)%name, ini(ng)%ncid)
1350 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1351!
1352 10 FORMAT (2x,'WRT_FRC_NF90 - writing forcing fields', &
1353 & ' (Outer=',i2.2, &
1354# ifdef NESTING
1355 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,', Grid ', &
1356 & i0,')')
1357# else
1358 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,')')
1359# endif
1360 20 FORMAT (/,' WRT_FRC_NF90 - error while writing variable: ',a, &
1361 & /,16x,'into initial NetCDF file for time record: ',i0)
1362!
1363 RETURN

References mod_boundary::boundary, mod_scalars::cp, mod_scalars::exit_flag, mod_forces::forces, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idsbry, mod_ncparam::idtsur, mod_ncparam::idusms, mod_ncparam::idvsms, mod_iounits::ini, mod_param::inlm, mod_scalars::inner, mod_iounits::ioerror, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_scalars::nbrec, mod_netcdf::netcdf_sync(), mod_scalars::nfrec, mod_scalars::noerror, mod_param::nt, mod_scalars::outer, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::rho0, mod_iounits::sourcefile, mod_iounits::stdout, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, and mod_ncparam::vname.

Referenced by wrt_frc().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_frc_pio()

subroutine, private wrt_ini_mod::wrt_frc_pio ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) outrec,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj )
private

Definition at line 1369 of file wrt_ini.F.

1374!***********************************************************************
1375!
1376 USE mod_pio_netcdf
1377!
1378! Imported variable declarations.
1379!
1380 integer, intent(in) :: ng, tile, Tindex, OutRec
1381# ifdef ADJUST_BOUNDARY
1382 integer, intent(in) :: LBij, UBij
1383# endif
1384 integer, intent(in) :: LBi, UBi, LBj, UBj
1385!
1386! Local variable declarations.
1387!
1388 integer :: i, ifield, itrc, status
1389!
1390 real(dp) :: scale
1391!
1392 character (len=*), parameter :: MyFile = &
1393 & __FILE__//", wrt_frc_pio"
1394!
1395 TYPE (IO_desc_t), pointer :: ioDesc
1396!
1397 sourcefile=myfile
1398!
1399!-----------------------------------------------------------------------
1400! Write out initial conditions.
1401!-----------------------------------------------------------------------
1402!
1403 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1404!
1405! Report.
1406!
1407 IF (master) THEN
1408# ifdef NESTING
1409 WRITE (stdout,10) outer, inner, tindex, outrec, ng
1410# else
1411 WRITE (stdout,10) outer, inner, tindex, outrec
1412# endif
1413 END IF
1414
1415# ifdef ADJUST_BOUNDARY
1416!
1417! Write out open boundary fields. Notice that these fields have their
1418! own fixed time-dimension (of size Nbrec) to allow 4DVAR adjustments
1419! at other times in addition to initialization time.
1420!
1421! Write out free-surface open boundaries.
1422!
1423 IF (any(lobc(:,isfsur,ng))) THEN
1424 scale=1.0_dp
1425 IF (ini(ng)%pioVar(idsbry(isfsur))%dkind.eq.pio_double) THEN
1426 iodesc => iodesc_dp_r2dobc(ng)
1427 ELSE
1428 iodesc => iodesc_sp_r2dobc(ng)
1429 END IF
1430!
1431 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, &
1432 & ini(ng)%pioFile, &
1433 & vname(1,idsbry(isfsur)), &
1434 & ini(ng)%pioVar(idsbry(isfsur)), &
1435 & outrec, iodesc, &
1436 & lbij, ubij, nbrec(ng), scale, &
1437 & boundary(ng) % zeta_obc(lbij:,:,:, &
1438 & tindex))
1439 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1440 IF (master) THEN
1441 WRITE (stdout,20) trim(vname(1,idsbry(isfsur))), outrec
1442 END IF
1443 exit_flag=3
1444 ioerror=status
1445 RETURN
1446 END IF
1447 END IF
1448!
1449! Write out 2D U-momentum component open boundaries.
1450!
1451 IF (any(lobc(:,isubar,ng))) THEN
1452 scale=1.0_dp
1453 IF (ini(ng)%pioVar(idsbry(isubar))%dkind.eq.pio_double) THEN
1454 iodesc => iodesc_dp_u2dobc(ng)
1455 ELSE
1456 iodesc => iodesc_sp_u2dobc(ng)
1457 END IF
1458!
1459 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, &
1460 & ini(ng)%pioFile, &
1461 & vname(1,idsbry(isubar)), &
1462 & ini(ng)%pioVar(idsbry(isubar)), &
1463 & outrec, iodesc, &
1464 & lbij, ubij, nbrec(ng), scale, &
1465 & boundary(ng) % ubar_obc(lbij:,:,:, &
1466 & tindex))
1467 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1468 IF (master) THEN
1469 WRITE (stdout,20) trim(vname(1,idsbry(isubar))), outrec
1470 END IF
1471 exit_flag=3
1472 ioerror=status
1473 RETURN
1474 END IF
1475 END IF
1476!
1477! Write out 2D V-momentum component open boundaries.
1478!
1479 IF (any(lobc(:,isvbar,ng))) THEN
1480 scale=1.0_dp
1481 IF (ini(ng)%pioVar(idsbry(isvbar))%dkind.eq.pio_double) THEN
1482 iodesc => iodesc_dp_v2dobc(ng)
1483 ELSE
1484 iodesc => iodesc_sp_v2dobc(ng)
1485 END IF
1486!
1487 status=nf_fwrite2d_bry(ng, inlm, ini(ng)%name, &
1488 & ini(ng)%pioFile, &
1489 & vname(1,idsbry(isvbar)), &
1490 & ini(ng)%pioVar(idsbry(isvbar)), &
1491 & outrec, iodesc, &
1492 & lbij, ubij, nbrec(ng), scale, &
1493 & boundary(ng) % vbar_obc(lbij:,:,:, &
1494 & tindex))
1495 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1496 IF (master) THEN
1497 WRITE (stdout,20) trim(vname(1,idsbry(isvbar))), outrec
1498 END IF
1499 exit_flag=3
1500 ioerror=status
1501 RETURN
1502 END IF
1503 END IF
1504
1505# ifdef SOLVE3D
1506!
1507! Write out 3D U-momentum component open boundaries.
1508!
1509 IF (any(lobc(:,isuvel,ng))) THEN
1510 scale=1.0_dp
1511 IF (ini(ng)%pioVar(idsbry(isuvel))%dkind.eq.pio_double) THEN
1512 iodesc => iodesc_dp_u3dobc(ng)
1513 ELSE
1514 iodesc => iodesc_sp_u3dobc(ng)
1515 END IF
1516!
1517 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, &
1518 & ini(ng)%pioFile, &
1519 & vname(1,idsbry(isuvel)), &
1520 & ini(ng)%pioVar(idsbry(isuvel)), &
1521 & outrec, iodesc, &
1522 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1523 & boundary(ng) % u_obc(lbij:,:,:,:, &
1524 & tindex))
1525 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1526 IF (master) THEN
1527 WRITE (stdout,20) trim(vname(1,idsbry(isuvel))), outrec
1528 END IF
1529 exit_flag=3
1530 ioerror=status
1531 RETURN
1532 END IF
1533 END IF
1534!
1535! Write out 3D V-momentum component open boundaries.
1536!
1537 IF (any(lobc(:,isvvel,ng))) THEN
1538 scale=1.0_dp
1539 IF (ini(ng)%pioVar(idsbry(isvvel))%dkind.eq.pio_double) THEN
1540 iodesc => iodesc_dp_v3dobc(ng)
1541 ELSE
1542 iodesc => iodesc_sp_v3dobc(ng)
1543 END IF
1544!
1545 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, &
1546 & ini(ng)%pioFile, &
1547 & vname(1,idsbry(isvvel)), &
1548 & ini(ng)%pioVar(idsbry(isvvel)), &
1549 & outrec, iodesc, &
1550 & lbij, ubij, 1, n(ng), nbrec(ng), scale, &
1551 & boundary(ng) % v_obc(lbij:,:,:,:, &
1552 & tindex))
1553 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1554 IF (master) THEN
1555 WRITE (stdout,20) trim(vname(1,idsbry(isvvel))), outrec
1556 END IF
1557 exit_flag=3
1558 ioerror=status
1559 RETURN
1560 END IF
1561 END IF
1562!
1563! Write out 3D tracers open boundaries.
1564!
1565 DO itrc=1,nt(ng)
1566 IF (any(lobc(:,istvar(itrc),ng))) THEN
1567 scale=1.0_dp
1568 ifield=idsbry(istvar(itrc))
1569 IF (ini(ng)%pioVar(ifield)%dkind.eq.pio_double) THEN
1570 iodesc => iodesc_dp_r3dobc(ng)
1571 ELSE
1572 iodesc => iodesc_sp_r3dobc(ng)
1573 END IF
1574!
1575 status=nf_fwrite3d_bry(ng, inlm, ini(ng)%name, &
1576 & ini(ng)%pioFile, &
1577 & vname(1,ifield), &
1578 & ini(ng)%pioVar(ifield), &
1579 & outrec, iodesc, &
1580 & lbij, ubij, 1, n(ng), nbrec(ng), &
1581 & scale, &
1582 & boundary(ng) % t_obc(lbij:,:,:,:, &
1583 & tindex,itrc))
1584 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1585 IF (master) THEN
1586 WRITE (stdout,20) trim(vname(1,idsbry(istvar(itrc)))), &
1587 & outrec
1588 END IF
1589 exit_flag=3
1590 ioerror=status
1591 RETURN
1592 END IF
1593 END IF
1594 END DO
1595# endif
1596# endif
1597
1598# ifdef ADJUST_WSTRESS
1599!
1600! Write out surface U-momentum stress. Notice that the stress has its
1601! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
1602! at other times in addition to initialization time.
1603!
1604 scale=rho0 ! m2/s2 to N/m2 (Pa)
1605 IF (ini(ng)%pioVar(idusms)%dkind.eq.pio_double) THEN
1606 iodesc => iodesc_dp_u2dfrc(ng)
1607 ELSE
1608 iodesc => iodesc_sp_u2dfrc(ng)
1609 END IF
1610!
1611 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idusms, &
1612 & ini(ng)%pioVar(idusms), outrec, &
1613 & iodesc, &
1614 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1615# ifdef MASKING
1616 & grid(ng) % umask, &
1617# endif
1618 & forces(ng) % ustr(:,:,:,tindex))
1619 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1620 IF (master) THEN
1621 WRITE (stdout,20) trim(vname(1,idusms)), outrec
1622 END IF
1623 exit_flag=3
1624 ioerror=status
1625 RETURN
1626 END IF
1627!
1628! Write out surface V-momentum stress.
1629!
1630 scale=rho0 ! m2/s2 to N/m2 (Pa)
1631 IF (ini(ng)%pioVar(idvsms)%dkind.eq.pio_double) THEN
1632 iodesc => iodesc_dp_v2dfrc(ng)
1633 ELSE
1634 iodesc => iodesc_sp_v2dfrc(ng)
1635 END IF
1636!
1637 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idvsms, &
1638 & ini(ng)%pioVar(idvsms), outrec, &
1639 & iodesc, &
1640 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1641# ifdef MASKING
1642 & grid(ng) % vmask, &
1643# endif
1644 & forces(ng) % vstr(:,:,:,tindex))
1645 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1646 IF (master) THEN
1647 WRITE (stdout,20) trim(vname(1,idvsms)), outrec
1648 END IF
1649 exit_flag=3
1650 ioerror=status
1651 RETURN
1652 END IF
1653# endif
1654
1655# if defined ADJUST_STFLUX && defined SOLVE3D
1656!
1657! Write out surface net tracers fluxes. Notice that fluxes have their
1658! own fixed time-dimension (of size Nfrec) to allow 4DVAR adjustments
1659! at other times in addition to initialization time.
1660!
1661 DO itrc=1,nt(ng)
1662 IF (lstflux(itrc,ng)) THEN
1663 IF (itrc.eq.itemp) THEN
1664 scale=rho0*cp ! Celsius m/s to W/m2
1665 ELSE
1666 scale=1.0_dp
1667 END IF
1668 IF (ini(ng)%pioVar(idtsur(itrc))%dkind.eq.pio_double) THEN
1669 iodesc => iodesc_dp_r2dfrc(ng)
1670 ELSE
1671 iodesc => iodesc_sp_r2dfrc(ng)
1672 END IF
1673!
1674 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idtsur(itrc), &
1675 & ini(ng)%pioVar(idtsur(itrc)), outrec, &
1676 & iodesc, &
1677 & lbi, ubi, lbj, ubj, 1, nfrec(ng), scale, &
1678# ifdef MASKING
1679 & grid(ng) % rmask, &
1680# endif
1681 & forces(ng) % tflux(:,:,:,tindex,itrc))
1682 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1683 IF (master) THEN
1684 WRITE (stdout,20) trim(vname(1,idtsur(itrc))), &
1685 & outrec
1686 END IF
1687 exit_flag=3
1688 ioerror=status
1689 RETURN
1690 END IF
1691 END IF
1692 END DO
1693# endif
1694!
1695!-----------------------------------------------------------------------
1696! Synchronize initial NetCDF file to disk to allow other processes
1697! to access data immediately after it is written.
1698!-----------------------------------------------------------------------
1699!
1700 CALL pio_netcdf_sync (ng, inlm, ini(ng)%name, ini(ng)%pioFile)
1701 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1702!
1703 10 FORMAT (2x,'WRT_FRC_PIO - writing forcing fields', &
1704 & ' (Outer=',i2.2, &
1705# ifdef NESTING
1706 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,', Grid ', &
1707 & i0,')')
1708# else
1709 & ', Inner=',i3.3,', Index=',i0,', Rec=',i0,')')
1710# endif
1711 20 FORMAT (/,' WRT_FRC_pio - error while writing variable: ',a, &
1712 & /,15x,'into initial NetCDF file for time record: ',i0)
1713!
1714 RETURN

References mod_boundary::boundary, mod_scalars::cp, mod_scalars::exit_flag, mod_forces::forces, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idsbry, mod_ncparam::idtsur, mod_ncparam::idusms, mod_ncparam::idvsms, mod_iounits::ini, mod_param::inlm, mod_scalars::inner, mod_pio_netcdf::iodesc_dp_r2dfrc, mod_pio_netcdf::iodesc_dp_r2dobc, mod_pio_netcdf::iodesc_dp_r3dobc, mod_pio_netcdf::iodesc_dp_u2dfrc, mod_pio_netcdf::iodesc_dp_u2dobc, mod_pio_netcdf::iodesc_dp_u3dobc, mod_pio_netcdf::iodesc_dp_v2dfrc, mod_pio_netcdf::iodesc_dp_v2dobc, mod_pio_netcdf::iodesc_dp_v3dobc, mod_pio_netcdf::iodesc_sp_r2dfrc, mod_pio_netcdf::iodesc_sp_r2dobc, mod_pio_netcdf::iodesc_sp_r3dobc, mod_pio_netcdf::iodesc_sp_u2dfrc, mod_pio_netcdf::iodesc_sp_u2dobc, mod_pio_netcdf::iodesc_sp_u3dobc, mod_pio_netcdf::iodesc_sp_v2dfrc, mod_pio_netcdf::iodesc_sp_v2dobc, mod_pio_netcdf::iodesc_sp_v3dobc, mod_iounits::ioerror, mod_ncparam::isfsur, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_scalars::itemp, mod_scalars::lobc, mod_scalars::lstflux, mod_parallel::master, mod_param::n, mod_scalars::nbrec, mod_scalars::nfrec, mod_scalars::noerror, mod_param::nt, mod_scalars::outer, mod_pio_netcdf::pio_netcdf_sync(), mod_scalars::rho0, mod_iounits::sourcefile, mod_iounits::stdout, and mod_ncparam::vname.

Referenced by wrt_frc().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_ini()

subroutine, public wrt_ini_mod::wrt_ini ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in), optional outrec )

Definition at line 88 of file wrt_ini.F.

89!***********************************************************************
90!
91! Imported variable declarations.
92!
93 integer, intent(in) :: ng, tile, Tindex
94 integer, intent(in), optional :: OutRec
95!
96! Local variable declarations.
97!
98 integer :: LBi, UBi, LBj, UBj
99!
100 character (len=*), parameter :: MyFile = &
101 & __FILE__
102!
103!-----------------------------------------------------------------------
104! Write out nonlinear initial conditions.
105!-----------------------------------------------------------------------
106!
107 lbi=bounds(ng)%LBi(tile)
108 ubi=bounds(ng)%UBi(tile)
109 lbj=bounds(ng)%LBj(tile)
110 ubj=bounds(ng)%UBj(tile)
111!
112 SELECT CASE (dia(ng)%IOtype)
113 CASE (io_nf90)
114 CALL wrt_ini_nf90 (ng, tile, tindex, &
115 & lbi, ubi, lbj, ubj, &
116 & outrec)
117
118# if defined PIO_LIB && defined DISTRIBUTE
119 CASE (io_pio)
120 CALL wrt_ini_pio (ng, tile, tindex, &
121 & lbi, ubi, lbj, ubj, &
122 & outrec)
123# endif
124 CASE DEFAULT
125 IF (master) WRITE (stdout,10) dai(ng)%IOtype
126 exit_flag=3
127 END SELECT
128 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
129!
130 10 FORMAT (' WRT_INI - Illegal output file type, io_type = ',i0, &
131 & /,11x,'Check KeyWord ''OUT_LIB'' in ''roms.in''.')
132!
133 RETURN

References mod_param::bounds, mod_iounits::dai, mod_iounits::dia, mod_scalars::exit_flag, strings_mod::founderror(), mod_ncparam::io_nf90, mod_ncparam::io_pio, mod_parallel::master, mod_scalars::noerror, mod_iounits::stdout, wrt_ini_nf90(), and wrt_ini_pio().

Referenced by i4dvar_mod::analysis(), r4dvar_mod::background(), i4dvar_mod::background_initialize(), rbl4dvar_mod::background_initialize(), convolve_mod::error_covariance(), rbl4dvar_mod::increment(), and roms_kernel_mod::roms_run().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_ini_nf90()

subroutine, private wrt_ini_mod::wrt_ini_nf90 ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in), optional outrec )
private

Definition at line 137 of file wrt_ini.F.

140!***********************************************************************
141!
142 USE mod_netcdf
143!
144! Imported variable declarations.
145!
146 integer, intent(in) :: ng, tile, Tindex
147 integer, intent(in) :: LBi, UBi, LBj, UBj
148!
149 integer, intent(in), optional :: OutRec
150!
151! Local variable declarations.
152!
153 logical :: SetFillVal
154!
155 integer :: Fcount, gfactor, gtype, i, itrc, status, varid
156!
157 real(r8) :: Fmin, Fmax
158 real(dp) :: my_time, scale
159!
160 character (len=15) :: Tstring
161 character (len=22) :: t_code
162
163 character (len=*), parameter :: MyFile = &
164 & __FILE__//", wrt_ini_nf90"
165!
166 sourcefile=myfile
167!
168!-----------------------------------------------------------------------
169! Set SetFillVal to FALSE. This is essential to ensure identical
170! outer-loop solutions when increments are zero. NOT SURE WHY THIS
171! IS NECESSARY - PERHAPS SOMETHING WRONG WITH THE LOGIC OF
172! nf_fwrite routines.
173!-----------------------------------------------------------------------
174!
175 setfillval=.false.
176!
177!-----------------------------------------------------------------------
178! Write out initial conditions.
179!-----------------------------------------------------------------------
180!
181 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
182!
183! Set grid type factor to write full (gfactor=1) fields or water
184! points (gfactor=-1) fields only.
185!
186# if defined WRITE_WATER && defined MASKING
187 gfactor=-1
188# else
189 gfactor=1
190# endif
191!
192! Set time record index.
193!
194 IF (PRESENT(outrec)) THEN
195 ini(ng)%Rindex=outrec
196 ELSE
197 ini(ng)%Rindex=ini(ng)%Rindex+1
198 END IF
199 fcount=ini(ng)%Fcount
200 ini(ng)%Nrec(fcount)=ini(ng)%Nrec(fcount)+1
201!
202! Write out model time (s). Use the "tdays" variable here because of
203! the management of the "time" variable due to nesting.
204!
205 my_time=tdays(ng)*day2sec
206
207 CALL netcdf_put_fvar (ng, inlm, ini(ng)%name, &
208 & trim(vname(1,idtime)), my_time, &
209 & (/ini(ng)%Rindex/), (/1/), &
210 & ncid = ini(ng)%ncid, &
211 & varid = ini(ng)%Vid(idtime))
212 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
213 IF (master) THEN
214 WRITE (stdout,10) trim(vname(1,idfsur)), trim(ini(ng)%name), &
215 & ini(ng)%Rindex
216 END IF
217 RETURN
218 ELSE
219 IF (master) THEN
220 CALL time_string (my_time, t_code)
221 WRITE (tstring,'(f15.4)') my_time*sec2day
222 WRITE (stdout,20) t_code, ng, trim(adjustl(tstring)), &
223 & trim(ini(ng)%name), ini(ng)%Rindex, tindex
224 END IF
225 END IF
226!
227! Write out free-surface (m)
228!
229 scale=1.0_dp
230 gtype=gfactor*r2dvar
231 status=nf_fwrite2d(ng, inlm, ini(ng)%ncid, idfsur, &
232 & ini(ng)%Vid(idfsur), &
233 & ini(ng)%Rindex, gtype, &
234 & lbi, ubi, lbj, ubj, scale, &
235# ifdef MASKING
236 & grid(ng) % rmask, &
237# endif
238 & ocean(ng) % zeta(:,:,tindex), &
239# ifdef WET_DRY
240 & setfillval = .false., &
241# else
242 & setfillval = setfillval, &
243# endif
244 & minvalue = fmin, &
245 & maxvalue = fmax)
246 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
247 IF (master) THEN
248 WRITE (stdout,10) trim(vname(1,idfsur)), trim(ini(ng)%name), &
249 & ini(ng)%Rindex
250 END IF
251 exit_flag=3
252 ioerror=status
253 RETURN
254 ELSE
255 IF (master) THEN
256 WRITE (stdout,30) trim(vname(2,idfsur)), fmin, fmax
257 END IF
258 END IF
259!
260! Write out 2D momentum component (m/s) in the XI-direction.
261!
262 scale=1.0_dp
263 gtype=gfactor*u2dvar
264 status=nf_fwrite2d(ng, inlm, ini(ng)%ncid, idubar, &
265 & ini(ng)%Vid(idubar), &
266 & ini(ng)%Rindex, gtype, &
267 & lbi, ubi, lbj, ubj, scale, &
268# ifdef MASKING
269 & grid(ng) % umask_full, &
270# endif
271 & ocean(ng) % ubar(:,:,tindex), &
272 & setfillval = setfillval, &
273 & minvalue = fmin, &
274 & maxvalue = fmax)
275 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
276 IF (master) THEN
277 WRITE (stdout,10) trim(vname(1,idubar)), trim(ini(ng)%name), &
278 & ini(ng)%Rindex
279 END IF
280 exit_flag=3
281 ioerror=status
282 RETURN
283 ELSE
284 IF (master) THEN
285 WRITE (stdout,30) trim(vname(2,idubar)), fmin, fmax
286 END IF
287 END IF
288!
289! Write out 2D momentum component (m/s) in the ETA-direction.
290!
291 scale=1.0_dp
292 gtype=gfactor*v2dvar
293 status=nf_fwrite2d(ng, inlm, ini(ng)%ncid, idvbar, &
294 & ini(ng)%Vid(idvbar), &
295 & ini(ng)%Rindex, gtype, &
296 & lbi, ubi, lbj, ubj, scale, &
297# ifdef MASKING
298 & grid(ng) % vmask_full, &
299# endif
300 & ocean(ng) % vbar(:,:,tindex), &
301 & setfillval = setfillval, &
302 & minvalue = fmin, &
303 & maxvalue = fmax)
304 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
305 IF (master) THEN
306 WRITE (stdout,10) trim(vname(1,idvbar)), trim(ini(ng)%name), &
307 & ini(ng)%Rindex
308 END IF
309 exit_flag=3
310 ioerror=status
311 RETURN
312 ELSE
313 IF (master) THEN
314 WRITE (stdout,30) trim(vname(2,idvbar)), fmin, fmax
315 END IF
316 END IF
317
318# ifdef SOLVE3D
319!
320! Write out 3D momentum component (m/s) in the XI-direction.
321!
322 scale=1.0_dp
323 gtype=gfactor*u3dvar
324 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, iduvel, &
325 & ini(ng)%Vid(iduvel), &
326 & ini(ng)%Rindex, gtype, &
327 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
328# ifdef MASKING
329 & grid(ng) % umask_full, &
330# endif
331 & ocean(ng) % u(:,:,:,tindex), &
332 & setfillval = setfillval, &
333 & minvalue = fmin, &
334 & maxvalue = fmax)
335 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
336 IF (master) THEN
337 WRITE (stdout,10) trim(vname(1,iduvel)), trim(ini(ng)%name), &
338 & ini(ng)%Rindex
339 END IF
340 exit_flag=3
341 ioerror=status
342 RETURN
343 ELSE
344 IF (master) THEN
345 WRITE (stdout,30) trim(vname(2,iduvel)), fmin, fmax
346 END IF
347 END IF
348!
349! Write out 3D momentum component (m/s) in the ETA-direction.
350!
351 scale=1.0_dp
352 gtype=gfactor*v3dvar
353 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idvvel, &
354 & ini(ng)%Vid(idvvel), &
355 & ini(ng)%Rindex, gtype, &
356 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
357# ifdef MASKING
358 & grid(ng) % vmask_full, &
359# endif
360 & ocean(ng) % v(:,:,:,tindex), &
361 & setfillval = setfillval, &
362 & minvalue = fmin, &
363 & maxvalue = fmax)
364 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
365 IF (master) THEN
366 WRITE (stdout,10) trim(vname(1,idvvel)), trim(ini(ng)%name), &
367 & ini(ng)%Rindex
368 END IF
369 exit_flag=3
370 ioerror=status
371 RETURN
372 ELSE
373 IF (master) THEN
374 WRITE (stdout,30) trim(vname(2,idvvel)), fmin, fmax
375 END IF
376 END IF
377!
378! Write out tracer type variables.
379!
380 DO itrc=1,nt(ng)
381 scale=1.0_dp
382 gtype=gfactor*r3dvar
383 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idtvar(itrc), &
384 & ini(ng)%Tid(itrc), &
385 & ini(ng)%Rindex, gtype, &
386 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
387# ifdef MASKING
388 & grid(ng) % rmask, &
389# endif
390 & ocean(ng) % t(:,:,:,tindex,itrc), &
391 & setfillval = setfillval, &
392 & minvalue = fmin, &
393 & maxvalue = fmax)
394 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
395 IF (master) THEN
396 WRITE (stdout,10) trim(vname(1,idtvar(itrc))), &
397 & trim(ini(ng)%name), ini(ng)%Rindex
398 END IF
399 exit_flag=3
400 ioerror=status
401 RETURN
402 ELSE
403 IF (master) THEN
404 WRITE (stdout,30) trim(vname(2,idtvar(itrc))), fmin, fmax
405 END IF
406 END IF
407 END DO
408
409# if defined BVF_MIXING || defined GLS_MIXING || \
410 defined my25_mixing || defined lmd_mixing
411!
412! If defined, write out vertical viscosity coefficient.
413!
414 IF (ini(ng)%Vid(idvvis).le.0) THEN
415 CALL netcdf_inq_varid (ng, inlm, ini(ng)%name, vname(1,idvvis), &
416 & ini(ng)%ncid, ini(ng)%Vid(idvvis))
417 IF (founderror(status, nf90_noerr, __line__, myfile)) RETURN
418 END IF
419 scale=1.0_dp
420 gtype=gfactor*w3dvar
421 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idvvis, &
422 & ini(ng)%Vid(idvvis), &
423 & ini(ng)%Rindex, gtype, &
424 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
425# ifdef MASKING
426 & grid(ng) % rmask, &
427# endif
428 & mixing(ng) % Akv, &
429 & setfillval = .false., &
430 & minvalue = fmin, &
431 & maxvalue = fmax)
432 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
433 IF (master) THEN
434 WRITE (stdout,10) trim(vname(1,idvvis)), &
435 & trim(ini(ng)%name), ini(ng)%Rindex
436 END IF
437 exit_flag=3
438 ioerror=status
439 RETURN
440 ELSE
441 IF (master) THEN
442 WRITE (stdout,30) trim(vname(2,idvvis)), fmin, fmax
443 END IF
444 END IF
445!
446! If defined, write out vertical diffusion coefficient for potential
447! temperature.
448!
449 IF (ini(ng)%Vid(idtdif).le.0) THEN
450 CALL netcdf_inq_varid (ng, inlm, ini(ng)%name, vname(1,idtdif), &
451 & ini(ng)%ncid, ini(ng)%Vid(idtdif))
452 IF (founderror(status, nf90_noerr, __line__, myfile)) RETURN
453 END IF
454 scale=1.0_dp
455 gtype=gfactor*w3dvar
456 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idtdif, &
457 & ini(ng)%Vid(idtdif), &
458 & ini(ng)%Rindex, gtype, &
459 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
460# ifdef MASKING
461 & grid(ng) % rmask, &
462# endif
463 & mixing(ng) % Akt(:,:,:,itemp), &
464 & setfillval = .false., &
465 & minvalue = fmin, &
466 & maxvalue = fmax)
467 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
468 IF (master) THEN
469 WRITE (stdout,10) trim(vname(1,idtdif)), &
470 & trim(ini(ng)%name), ini(ng)%Rindex
471 END IF
472 exit_flag=3
473 ioerror=status
474 RETURN
475 ELSE
476 IF (master) THEN
477 WRITE (stdout,30) trim(vname(2,idtdif)), fmin, fmax
478 END IF
479 END IF
480
481# ifdef SALINITY
482!
483! If defined, write out vertical diffusion coefficient for salinity.
484!
485 IF (ini(ng)%Vid(idsdif).le.0) THEN
486 CALL netcdf_inq_varid (ng, inlm, ini(ng)%name, vname(1,idsdif), &
487 & ini(ng)%ncid, ini(ng)%Vid(idsdif))
488 IF (founderror(status, nf90_noerr, __line__, myfile)) RETURN
489 END IF
490 scale=1.0_dp
491 gtype=gfactor*w3dvar
492 status=nf_fwrite3d(ng, inlm, ini(ng)%ncid, idsdif, &
493 & ini(ng)%Vid(idsdif), &
494 & ini(ng)%Rindex, gtype, &
495 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
496# ifdef MASKING
497 & grid(ng) % rmask, &
498# endif
499 & mixing(ng) % Akt(:,:,:,isalt), &
500 & setfillval = .false., &
501 & minvalue = fmin, &
502 & maxvalue = fmax)
503 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
504 IF (master) THEN
505 WRITE (stdout,10) trim(vname(1,idsdif)), &
506 & trim(ini(ng)%name), ini(ng)%Rindex
507 END IF
508 exit_flag=3
509 ioerror=status
510 RETURN
511 ELSE
512 IF (master) THEN
513 WRITE (stdout,30) trim(vname(2,idsdif)), fmin, fmax
514 END IF
515 END IF
516# endif
517# endif
518# endif
519!
520!-----------------------------------------------------------------------
521! Synchronize initial NetCDF file to disk to allow other processes
522! to access data immediately after it is written.
523!-----------------------------------------------------------------------
524!
525 CALL netcdf_sync (ng, inlm, ini(ng)%name, ini(ng)%ncid)
526 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
527!
528 10 FORMAT (/,' WRT_INI_NF90 - error while writing variable: ',a, &
529 & /,16x,'into initial NetCDF file for time record: ',i0)
530 20 FORMAT (2x,'WRT_INI_NF90 - NLM: Writing initial state', &
531 & ' fields,',t75,a, &
532 & /,22x,'(Grid ',i2.2,', t = ',a,', File: ',a, &
533 & ', Rec=',i4.4,', Index=',i1,')')
534 30 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
535 & ' Max = ',1p,e15.8,')')
536!
537 RETURN
mod_netcdf::netcdf_put_fvar
Definition mod_netcdf.F:82
mod_netcdf::netcdf_inq_varid
subroutine, public netcdf_inq_varid(ng, model, ncname, myvarname, ncid, varid)
Definition mod_netcdf.F:1897

References mod_scalars::day2sec, mod_scalars::exit_flag, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idfsur, mod_ncparam::idsdif, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_iounits::ini, mod_param::inlm, mod_iounits::ioerror, mod_scalars::isalt, mod_scalars::itemp, mod_parallel::master, mod_mixing::mixing, mod_param::n, mod_netcdf::netcdf_inq_varid(), mod_netcdf::netcdf_sync(), mod_scalars::noerror, mod_param::nt, mod_ocean::ocean, mod_param::r2dvar, mod_param::r3dvar, mod_scalars::sec2day, mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::tdays, dateclock_mod::time_string(), mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, mod_ncparam::vname, and mod_param::w3dvar.

Referenced by wrt_ini().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ wrt_ini_pio()

subroutine, private wrt_ini_mod::wrt_ini_pio ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) tindex,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in), optional outrec )
private

Definition at line 543 of file wrt_ini.F.

546!***********************************************************************
547!
548 USE mod_pio_netcdf
549!
550! Imported variable declarations.
551!
552 integer, intent(in) :: ng, tile, Tindex
553 integer, intent(in) :: LBi, UBi, LBj, UBj
554!
555 integer, intent(in), optional :: OutRec
556!
557! Local variable declarations.
558!
559 logical :: SetFillVal
560!
561 integer :: Fcount, i, itrc, status
562!
563 real(r8) :: Fmin, Fmax
564 real(dp) :: my_time, scale
565!
566 character (len=15) :: Tstring
567 character (len=22) :: t_code
568
569 character (len=*), parameter :: MyFile = &
570 & __FILE__//", wrt_ini_pio"
571!
572 TYPE (IO_desc_t), pointer :: ioDesc
573!
574 sourcefile=myfile
575!
576!-----------------------------------------------------------------------
577! Set SetFillVal to FALSE. This is essential to ensure identical
578! outer-loop solutions when increments are zero. NOT SURE WHY THIS
579! IS NECESSARY - PERHAPS SOMETHING WRONG WITH THE LOGIC OF
580! nf_fwrite routines.
581!-----------------------------------------------------------------------
582!
583 setfillval=.false.
584!
585!-----------------------------------------------------------------------
586! Write out initial conditions.
587!-----------------------------------------------------------------------
588!
589 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
590!
591! Set time record index.
592!
593 IF (PRESENT(outrec)) THEN
594 ini(ng)%Rindex=outrec
595 ELSE
596 ini(ng)%Rindex=ini(ng)%Rindex+1
597 END IF
598 fcount=ini(ng)%Fcount
599 ini(ng)%Nrec(fcount)=ini(ng)%Nrec(fcount)+1
600!
601! Write out model time (s). Use the "tdays" variable here because of
602! the management of the "time" variable due to nesting.
603!
604 my_time=tdays(ng)*day2sec
605
606 CALL pio_netcdf_put_fvar (ng, inlm, ini(ng)%name, &
607 & trim(vname(1,idtime)), my_time, &
608 & (/ini(ng)%Rindex/), (/1/), &
609 & piofile = ini(ng)%pioFile, &
610 & piovar = ini(ng)%pioVar(idtime)%vd)
611 IF (founderror(exit_flag, noerror, __line__, myfile)) THEN
612 IF (master) THEN
613 WRITE (stdout,10) trim(vname(1,idfsur)), trim(ini(ng)%name), &
614 & ini(ng)%Rindex
615 END IF
616 RETURN
617 ELSE
618 IF (master) THEN
619 CALL time_string (my_time, t_code)
620 WRITE (tstring,'(f15.4)') my_time*sec2day
621 WRITE (stdout,20) t_code, ng, trim(adjustl(tstring)), &
622 & trim(ini(ng)%name), ini(ng)%Rindex, tindex
623 END IF
624 END IF
625!
626! Write out free-surface (m)
627!
628 scale=1.0_dp
629 IF (ini(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
630 iodesc => iodesc_dp_r2dvar(ng)
631 ELSE
632 iodesc => iodesc_sp_r2dvar(ng)
633 END IF
634!
635 status=nf_fwrite2d(ng, inlm, ini(ng)%pioFile, idfsur, &
636 & ini(ng)%pioVar(idfsur), &
637 & ini(ng)%Rindex, &
638 & iodesc, &
639 & lbi, ubi, lbj, ubj, scale, &
640# ifdef MASKING
641 & grid(ng) % rmask, &
642# endif
643 & ocean(ng) % zeta(:,:,tindex), &
644# ifdef WET_DRY
645 & setfillval = .false., &
646# else
647 & setfillval = setfillval, &
648# endif
649 & minvalue = fmin, &
650 & maxvalue = fmax)
651 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
652 IF (master) THEN
653 WRITE (stdout,10) trim(vname(1,idfsur)), trim(ini(ng)%name), &
654 & ini(ng)%Rindex
655 END IF
656 exit_flag=3
657 ioerror=status
658 RETURN
659 ELSE
660 IF (master) THEN
661 WRITE (stdout,30) trim(vname(2,idfsur)), fmin, fmax
662 END IF
663 END IF
664!
665! Write out 2D momentum component (m/s) in the XI-direction.
666!
667 scale=1.0_dp
668 IF (ini(ng)%pioVar(idubar)%dkind.eq.pio_double) THEN
669 iodesc => iodesc_dp_u2dvar(ng)
670 ELSE
671 iodesc => iodesc_sp_u2dvar(ng)
672 END IF
673!
674 status=nf_fwrite2d(ng, inlm, ini(ng)%pioFile, idubar, &
675 & ini(ng)%pioVar(idubar), &
676 & ini(ng)%Rindex, &
677 & iodesc, &
678 & lbi, ubi, lbj, ubj, scale, &
679# ifdef MASKING
680 & grid(ng) % umask_full, &
681# endif
682 & ocean(ng) % ubar(:,:,tindex), &
683 & setfillval = setfillval, &
684 & minvalue = fmin, &
685 & maxvalue = fmax)
686 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
687 IF (master) THEN
688 WRITE (stdout,10) trim(vname(1,idubar)), trim(ini(ng)%name), &
689 & ini(ng)%Rindex
690 END IF
691 exit_flag=3
692 ioerror=status
693 RETURN
694 ELSE
695 IF (master) THEN
696 WRITE (stdout,30) trim(vname(2,idubar)), fmin, fmax
697 END IF
698 END IF
699!
700! Write out 2D momentum component (m/s) in the ETA-direction.
701!
702 scale=1.0_dp
703 IF (ini(ng)%pioVar(idvbar)%dkind.eq.pio_double) THEN
704 iodesc => iodesc_dp_v2dvar(ng)
705 ELSE
706 iodesc => iodesc_sp_v2dvar(ng)
707 END IF
708!
709 status=nf_fwrite2d(ng, inlm, ini(ng)%pioFile, idvbar, &
710 & ini(ng)%pioVar(idvbar), &
711 & ini(ng)%Rindex, &
712 & iodesc, &
713 & lbi, ubi, lbj, ubj, scale, &
714# ifdef MASKING
715 & grid(ng) % vmask_full, &
716# endif
717 & ocean(ng) % vbar(:,:,tindex), &
718 & setfillval = setfillval, &
719 & minvalue = fmin, &
720 & maxvalue = fmax)
721 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
722 IF (master) THEN
723 WRITE (stdout,10) trim(vname(1,idvbar)), trim(ini(ng)%name), &
724 & ini(ng)%Rindex
725 END IF
726 exit_flag=3
727 ioerror=status
728 RETURN
729 ELSE
730 IF (master) THEN
731 WRITE (stdout,30) trim(vname(2,idvbar)), fmin, fmax
732 END IF
733 END IF
734
735# ifdef SOLVE3D
736!
737! Write out 3D momentum component (m/s) in the XI-direction.
738!
739 scale=1.0_dp
740 IF (ini(ng)%pioVar(iduvel)%dkind.eq.pio_double) THEN
741 iodesc => iodesc_dp_u3dvar(ng)
742 ELSE
743 iodesc => iodesc_sp_u3dvar(ng)
744 END IF
745!
746 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, iduvel, &
747 & ini(ng)%pioVar(iduvel), &
748 & ini(ng)%Rindex, &
749 & iodesc, &
750 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
751# ifdef MASKING
752 & grid(ng) % umask_full, &
753# endif
754 & ocean(ng) % u(:,:,:,tindex), &
755 & setfillval = setfillval, &
756 & minvalue = fmin, &
757 & maxvalue = fmax)
758 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
759 IF (master) THEN
760 WRITE (stdout,10) trim(vname(1,iduvel)), trim(ini(ng)%name), &
761 & ini(ng)%Rindex
762 END IF
763 exit_flag=3
764 ioerror=status
765 RETURN
766 ELSE
767 IF (master) THEN
768 WRITE (stdout,30) trim(vname(2,iduvel)), fmin, fmax
769 END IF
770 END IF
771!
772! Write out 3D momentum component (m/s) in the ETA-direction.
773!
774 scale=1.0_dp
775 IF (ini(ng)%pioVar(idfsur)%dkind.eq.pio_double) THEN
776 iodesc => iodesc_dp_v3dvar(ng)
777 ELSE
778 iodesc => iodesc_sp_v3dvar(ng)
779 END IF
780!
781 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idvvel, &
782 & ini(ng)%pioVar(idvvel), &
783 & ini(ng)%Rindex, &
784 & iodesc, &
785 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
786# ifdef MASKING
787 & grid(ng) % vmask_full, &
788# endif
789 & ocean(ng) % v(:,:,:,tindex), &
790 & setfillval = setfillval, &
791 & minvalue = fmin, &
792 & maxvalue = fmax)
793 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
794 IF (master) THEN
795 WRITE (stdout,10) trim(vname(1,idvvel)), trim(ini(ng)%name), &
796 & ini(ng)%Rindex
797 END IF
798 exit_flag=3
799 ioerror=status
800 RETURN
801 ELSE
802 IF (master) THEN
803 WRITE (stdout,30) trim(vname(2,idvvel)), fmin, fmax
804 END IF
805 END IF
806!
807! Write out tracer type variables.
808!
809 DO itrc=1,nt(ng)
810 scale=1.0_dp
811 IF (ini(ng)%pioTrc(itrc)%dkind.eq.pio_double) THEN
812 iodesc => iodesc_dp_r3dvar(ng)
813 ELSE
814 iodesc => iodesc_sp_r3dvar(ng)
815 END IF
816!
817 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idtvar(itrc), &
818 & ini(ng)%pioTrc(itrc), &
819 & ini(ng)%Rindex, &
820 & iodesc, &
821 & lbi, ubi, lbj, ubj, 1, n(ng), scale, &
822# ifdef MASKING
823 & grid(ng) % rmask, &
824# endif
825 & ocean(ng) % t(:,:,:,tindex,itrc), &
826 & setfillval = setfillval, &
827 & minvalue = fmin, &
828 & maxvalue = fmax)
829 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
830 IF (master) THEN
831 WRITE (stdout,10) trim(vname(1,idtvar(itrc))), &
832 & trim(ini(ng)%name), ini(ng)%Rindex
833 END IF
834 exit_flag=3
835 ioerror=status
836 RETURN
837 ELSE
838 IF (master) THEN
839 WRITE (stdout,30) trim(vname(2,idtvar(itrc))), fmin, fmax
840 END IF
841 END IF
842 END DO
843
844# if defined BVF_MIXING || defined GLS_MIXING || \
845 defined my25_mixing || defined lmd_mixing
846!
847! If defined, write out vertical viscosity coefficient.
848!
849 IF (ini(ng)%pioVar(idvvis)%vd%varID.le.0) THEN
850 CALL pio_netcdf_inq_varid (ng, inlm, ini(ng)%name, &
851 & vname(1,idvvis), &
852 & ini(ng)%pioFile, &
853 & ini(ng)%pioVar(idvvis)%vd)
854 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
855 ini(ng)%pioVar(idvvis)%gtype=w3dvar
856 END IF
857
858 scale=1.0_dp
859 IF (ini(ng)%pioVar(idvvis)%dkind.eq.pio_double) THEN
860 iodesc => iodesc_dp_w3dvar(ng)
861 ELSE
862 iodesc => iodesc_sp_w3dvar(ng)
863 END IF
864!
865 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idvvis, &
866 & ini(ng)%pioVar(idvvis), &
867 & ini(ng)%Rindex, &
868 & iodesc, &
869 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
870# ifdef MASKING
871 & grid(ng) % rmask, &
872# endif
873 & mixing(ng) % Akv, &
874 & setfillval = .false., &
875 & minvalue = fmin, &
876 & maxvalue = fmax)
877 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
878 IF (master) THEN
879 WRITE (stdout,10) trim(vname(1,idvvis)), &
880 & trim(ini(ng)%name), ini(ng)%Rindex
881 END IF
882 exit_flag=3
883 ioerror=status
884 RETURN
885 ELSE
886 IF (master) THEN
887 WRITE (stdout,30) trim(vname(2,idvvis)), fmin, fmax
888 END IF
889 END IF
890!
891! If defined, write out vertical diffusion coefficient for potential
892! temperature.
893!
894 IF (ini(ng)%pioVar(idtdif)%vd%varID.le.0) THEN
895 CALL pio_netcdf_inq_varid (ng, inlm, ini(ng)%name, &
896 & vname(1,idtdif), &
897 & ini(ng)%pioFile, &
898 & ini(ng)%pioVar(idtdif)%vd)
899 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
900 ini(ng)%pioVar(idtdif)%gtype=w3dvar
901 END IF
902
903 scale=1.0_dp
904 IF (ini(ng)%pioVar(idtdif)%dkind.eq.pio_double) THEN
905 iodesc => iodesc_dp_w3dvar(ng)
906 ELSE
907 iodesc => iodesc_sp_w3dvar(ng)
908 END IF
909!
910 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idtdif, &
911 & ini(ng)%pioVar(idtdif), &
912 & ini(ng)%Rindex, &
913 & iodesc, &
914 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
915# ifdef MASKING
916 & grid(ng) % rmask, &
917# endif
918 & mixing(ng) % Akt(:,:,:,itemp), &
919 & setfillval = .false., &
920 & minvalue = fmin, &
921 & maxvalue = fmax)
922 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
923 IF (master) THEN
924 WRITE (stdout,10) trim(vname(1,idtdif)), &
925 & trim(ini(ng)%name), ini(ng)%Rindex
926 END IF
927 exit_flag=3
928 ioerror=status
929 RETURN
930 ELSE
931 IF (master) THEN
932 WRITE (stdout,30) trim(vname(2,idtdif)), fmin, fmax
933 END IF
934 END IF
935
936# ifdef SALINITY
937!
938! If defined, write out vertical diffusion coefficient for salinity.
939!
940 IF (ini(ng)%pioVar(idsdif)%vd%varID.le.0) THEN
941 CALL pio_netcdf_inq_varid (ng, inlm, ini(ng)%name, &
942 & vname(1,idsdif), &
943 & ini(ng)%pioFile, &
944 & ini(ng)%pioVar(idsdif)%vd)
945 IF (founderror(status, pio_noerr, __line__, myfile)) RETURN
946 ini(ng)%pioVar(idsdif)%gtype=w3dvar
947 END IF
948
949 scale=1.0_dp
950 IF (ini(ng)%pioVar(idsdif)%dkind.eq.pio_double) THEN
951 iodesc => iodesc_dp_w3dvar(ng)
952 ELSE
953 iodesc => iodesc_sp_w3dvar(ng)
954 END IF
955!
956 status=nf_fwrite3d(ng, inlm, ini(ng)%pioFile, idsdif, &
957 & ini(ng)%pioVar(idsdif), &
958 & ini(ng)%Rindex, &
959 & iodesc, &
960 & lbi, ubi, lbj, ubj, 0, n(ng), scale, &
961# ifdef MASKING
962 & grid(ng) % rmask, &
963# endif
964 & mixing(ng) % Akt(:,:,:,isalt), &
965 & setfillval = .false., &
966 & minvalue = fmin, &
967 & maxvalue = fmax)
968 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
969 IF (master) THEN
970 WRITE (stdout,10) trim(vname(1,idsdif)), &
971 & trim(ini(ng)%name), ini(ng)%Rindex
972 END IF
973 exit_flag=3
974 ioerror=status
975 RETURN
976 ELSE
977 IF (master) THEN
978 WRITE (stdout,30) trim(vname(2,idsdif)), fmin, fmax
979 END IF
980 END IF
981# endif
982# endif
983# endif
984!
985!-----------------------------------------------------------------------
986! Synchronize initial NetCDF file to disk to allow other processes
987! to access data immediately after it is written.
988!-----------------------------------------------------------------------
989!
990 CALL pio_netcdf_sync (ng, inlm, ini(ng)%name, ini(ng)%pioFile)
991 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
992!
993 10 FORMAT (/,' WRT_INI_PIO - error while writing variable: ',a, &
994 & /,15x,'into initial NetCDF file for time record: ',i0)
995 20 FORMAT (2x,'WRT_INI_PIO - NLM: Writing initial state', &
996 & ' fields,',t75,a, &
997 & /,22x,'(Grid ',i2.2,', t = ',a,', File: ',a, &
998 & ', Rec=',i4.4,', Index=',i1,')')
999 30 FORMAT (19x,'- ',a,/,22x,'(Min = ',1p,e15.8, &
1000 & ' Max = ',1p,e15.8,')')
1001!
1002 RETURN
mod_pio_netcdf::pio_netcdf_put_fvar
Definition mod_pio_netcdf.F:94
mod_pio_netcdf::iodesc_sp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_w3dvar
Definition mod_pio_netcdf.F:212
mod_pio_netcdf::iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
Definition mod_pio_netcdf.F:248
mod_pio_netcdf::iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
Definition mod_pio_netcdf.F:210
mod_pio_netcdf::iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
Definition mod_pio_netcdf.F:195
mod_pio_netcdf::iodesc_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
Definition mod_pio_netcdf.F:249
mod_pio_netcdf::iodesc_sp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
Definition mod_pio_netcdf.F:194
mod_pio_netcdf::iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
Definition mod_pio_netcdf.F:234
mod_pio_netcdf::iodesc_dp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
Definition mod_pio_netcdf.F:250
mod_pio_netcdf::pio_netcdf_inq_varid
subroutine, public pio_netcdf_inq_varid(ng, model, ncname, myvarname, piofile, piovar)
Definition mod_pio_netcdf.F:2378
mod_pio_netcdf::iodesc_dp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_w3dvar
Definition mod_pio_netcdf.F:251
mod_pio_netcdf::iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
Definition mod_pio_netcdf.F:235
mod_pio_netcdf::iodesc_sp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
Definition mod_pio_netcdf.F:211
mod_pio_netcdf::iodesc_sp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
Definition mod_pio_netcdf.F:209
mod_pio_netcdf::iodesc_dp_r2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
Definition mod_pio_netcdf.F:233
mod_pio_netcdf::iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
Definition mod_pio_netcdf.F:196

References mod_scalars::day2sec, mod_scalars::exit_flag, strings_mod::founderror(), mod_grid::grid, mod_ncparam::idfsur, mod_ncparam::idsdif, mod_ncparam::idtdif, mod_ncparam::idtime, mod_ncparam::idtvar, mod_ncparam::idubar, mod_ncparam::iduvel, mod_ncparam::idvbar, mod_ncparam::idvvel, mod_ncparam::idvvis, mod_iounits::ini, mod_param::inlm, mod_pio_netcdf::iodesc_dp_r2dvar, mod_pio_netcdf::iodesc_dp_r3dvar, mod_pio_netcdf::iodesc_dp_u2dvar, mod_pio_netcdf::iodesc_dp_u3dvar, mod_pio_netcdf::iodesc_dp_v2dvar, mod_pio_netcdf::iodesc_dp_v3dvar, mod_pio_netcdf::iodesc_dp_w3dvar, mod_pio_netcdf::iodesc_sp_r2dvar, mod_pio_netcdf::iodesc_sp_r3dvar, mod_pio_netcdf::iodesc_sp_u2dvar, mod_pio_netcdf::iodesc_sp_u3dvar, mod_pio_netcdf::iodesc_sp_v2dvar, mod_pio_netcdf::iodesc_sp_v3dvar, mod_pio_netcdf::iodesc_sp_w3dvar, mod_iounits::ioerror, mod_scalars::isalt, mod_scalars::itemp, mod_parallel::master, mod_mixing::mixing, mod_param::n, mod_scalars::noerror, mod_param::nt, mod_ocean::ocean, mod_pio_netcdf::pio_netcdf_inq_varid(), mod_pio_netcdf::pio_netcdf_sync(), mod_scalars::sec2day, mod_iounits::sourcefile, mod_iounits::stdout, mod_scalars::tdays, dateclock_mod::time_string(), mod_ncparam::vname, and mod_param::w3dvar.

Referenced by wrt_ini().

Here is the call graph for this function:
Here is the caller graph for this function: