program generate_orest ! Purpose ! ------- ! Generates a restart file to be used to initialise the CSIRO OGCM. The restart ! file is generated with the ocean at rest, and with the temperature and ! salinity equal to values that are read from external netCDF file(s). ! ! Usage ! ----- ! generate_orest ! ! Notes ! ----- ! An exisiting restart file is required. The temperatures provided should be in ! degC, and the salinity should be in psu. ! ! History ! ------- ! 2003 Sep 6 Steve Phipps Original version ! 2003 Sep 7 Steve Phipps Modified to use missing values of 0.0 for ! temperature, and 0.01 for salinity ! 2004 Sep 15 Steve Phipps Modified to allow temperatures and salinities ! to come from different files, and to allow ! them to be on a 64x56 grid only ! 2004 Nov 3 Steve Phipps Modified to correctly deal with indices ! controlling Fourier filtering at high latitudes implicit none include 'netcdf.inc' ! Define constants integer, parameter :: imt=66, jmt=58, km=21, lseg=5, lsegf=5, nisle=3, & njtbft=12, njtbfu=12, nslab=5676, nt=2, & inunit=10, outunit=11, jfrst=2, jmtm1=jmt-1 ! Declare variables character(len=10) :: tvar, svar character(len=80) :: infile, outfile, tfile, sfile integer :: i, j, k, itt, status, ncid, varid, jft1, jft2, jfu1, jfu2, & njtbft2, njtbfu2, nst, nsu, nnt, nnu integer, dimension(nisle) :: isis, ieis, jsis, jeis integer, dimension(jmt, lseg) :: isz, iez integer, dimension(imt, jmt) :: kmt, kmu integer, dimension(njtbfu, lsegf) :: iszf, iezf integer, dimension(njtbft, lsegf, km) :: istf, ietf integer, dimension(njtbfu, lsegf, km) :: isuf, ieuf integer, allocatable, dimension(:, :) :: iszf2, iezf2 integer, allocatable, dimension(:, :, :) :: istf2, ietf2, isuf2, ieuf2 real :: ttsec, area, volume real, dimension(imt, jmt) :: hr, p, pb real, dimension(imt, jmt, 2) :: ptd2 real(kind=4), dimension(imt-2, jmt-2, km) :: temp4, sal4 real, dimension(imt, jmt, km) :: temp, sal real, dimension(imt, jmt, km, nt, 2) :: odam_t real, dimension(imt, jmt, km, 2) :: odam_u, odam_v ! Get names of input and output restart files call getarg(1, infile) call getarg(2, outfile) ! Get file and variable names for the temperature and salinities write (*, *) write (*, '(a)', advance='no') "File containing temperature data : " read (*, *) tfile write (*, '(a)', advance='no') "File containing salinity data : " read (*, *) sfile write (*, *) write (*, '(a)', advance='no') "Variable containing temperature data : " read (*, *) tvar write (*, '(a)', advance='no') "Variable containing salinity data : " read (*, *) svar write (*, *) ! Get new values for JFT1, JFT2, JFU1 and JFU2 write (*, '(a)', advance='no') "New value for JFT1 : " read (*, *) jft1 write (*, '(a)', advance='no') "New value for JFT2 : " read (*, *) jft2 write (*, '(a)', advance='no') "New value for JFU1 : " read (*, *) jfu1 write (*, '(a)', advance='no') "New value for JFU2 : " read (*, *) jfu2 write (*, *) ! Calculate values for NJTBFT2 and NJTBFU2 njtbft2 = jft1 - jfrst + 1 + jmtm1 - jft2 + 1 njtbfu2 = jfu1 - jfrst + 1 + jmtm1 - jfu2 + 1 ! Allocate output index arrays allocate (iszf2(njtbfu2, lsegf), iezf2(njtbfu2, lsegf), & istf2(njtbft2, lsegf, km), ietf2(njtbft2, lsegf, km), & isuf2(njtbfu2, lsegf, km), ieuf2(njtbfu2, lsegf, km)) ! Get temperatures and salinities status = nf_open(trim(tfile), nf_nowrite, ncid) if (status /= nf_noerr) stop "netCDF error" status = nf_inq_varid(ncid, trim(tvar), varid) if (status /= nf_noerr) stop "netCDF error" status = nf_get_var_real(ncid, varid, temp4) if (status /= nf_noerr) stop "netCDF error" status = nf_close(ncid) if (status /= nf_noerr) stop "netCDF error" status = nf_open(trim(sfile), nf_nowrite, ncid) if (status /= nf_noerr) stop "netCDF error" status = nf_inq_varid(ncid, trim(svar), varid) if (status /= nf_noerr) stop "netCDF error" status = nf_get_var_real(ncid, varid, sal4) if (status /= nf_noerr) stop "netCDF error" status = nf_close(ncid) if (status /= nf_noerr) stop "netCDF error" ! Open input and output restart files open(unit=inunit, file=infile, status='old', form='unformatted', & action='read') open(unit=outunit, file=outfile, status='new', form='unformatted', & action='write') ! Read old restart file read (inunit) itt read (inunit) ttsec read (inunit) area read (inunit) volume read (inunit) pb read (inunit) p read (inunit) hr read (inunit) ptd2 read (inunit) isz read (inunit) iez read (inunit) isis read (inunit) ieis read (inunit) jsis read (inunit) jeis read (inunit) istf read (inunit) ietf read (inunit) isuf read (inunit) ieuf read (inunit) iszf read (inunit) iezf read (inunit) odam_t read (inunit) odam_u read (inunit) odam_v read (inunit) kmt read (inunit) kmu ! Reset various values to zero itt = 0 ttsec = 0.0 pb = 0.0 p = 0.0 ptd2 = 0.0 odam_u = 0.0 odam_v = 0.0 ! Derive output index arrays nst = jft1 - jfrst + 1 nsu = jfu1 - jfrst + 1 nnt = jmtm1 - jft2 + 1 nnu = jmtm1 - jfu2 + 1 iszf2(1:nsu, :) = iszf(1:nsu, :) iszf2(nsu+1:njtbfu2, :) = iszf(12-nnu+1:12, :) iezf2(1:nsu, :) = iezf(1:nsu, :) iezf2(nsu+1:njtbfu2, :) = iezf(12-nnu+1:12, :) istf2(1:nst, :, :) = istf(1:nst, :, :) istf2(nst+1:njtbft2, :, :) = istf(12-nnt+1:12, :, :) ietf2(1:nst, :, :) = ietf(1:nst, :, :) ietf2(nst+1:njtbft2, :, :) = ietf(12-nnt+1:12, :, :) isuf2(1:nsu, :, :) = isuf(1:nsu, :, :) isuf2(nsu+1:njtbfu2, :, :) = isuf(12-nnu+1:12, :, :) ieuf2(1:nsu, :, :) = ieuf(1:nsu, :, :) ieuf2(nsu+1:njtbfu2, :, :) = ieuf(12-nnu+1:12, :, :) ! Derive 64-bit temperatures and salinities, and fix missing values temp(2:imt-1, 2:jmt-1, :) = real(temp4, 8) sal(2:imt-1, 2:jmt-1, :) = 0.001 * (real(sal4, 8) - 35.0) do k = 1, km do j = 2, jmt-1 do i = 2, imt-1 if (temp(i, j, k) < -1.0e30) temp(i, j, k) = 0.0 if (sal(i, j, k) < -1.0e30) sal(i, j, k) = 0.01 end do end do end do ! Wrap temperatures and salinities, and pad at the poles temp(1, :, :) = temp(imt-1, :, :) sal(1, :, :) = sal(imt-1, :, :) temp(imt, :, :) = temp(2, :, :) sal(imt, :, :) = sal(2, :, :) temp(:, 1, :) = 0.0 sal(:, 1, :) = 0.01 temp(:, jmt, :) = 0.0 sal(:, jmt, :) = 0.0 ! Set temperatures and salinities odam_t(:, :, :, 1, 1) = temp odam_t(:, :, :, 1, 2) = temp odam_t(:, :, :, 2, 1) = sal odam_t(:, :, :, 2, 2) = sal ! Write new restart file write (outunit) itt write (outunit) ttsec write (outunit) area write (outunit) volume write (outunit) pb write (outunit) p write (outunit) hr write (outunit) ptd2 write (outunit) isz write (outunit) iez write (outunit) isis write (outunit) ieis write (outunit) jsis write (outunit) jeis write (outunit) istf2 write (outunit) ietf2 write (outunit) isuf2 write (outunit) ieuf2 write (outunit) iszf2 write (outunit) iezf2 write (outunit) odam_t write (outunit) odam_u write (outunit) odam_v write (outunit) kmt write (outunit) kmu ! Close input and output restart files close (unit=inunit) close (unit=outunit) stop end program generate_orest