PlaSim/lsg/etc/outpost.f

!     ==================================================================
!     ------------------------------------------------------------------
!
      subroutine outpost
      use lsgvar
      implicit none
!
!     ------------------------------------------------------------------
!
!**** *outpost*
!
!     by U. Mikolajewicz 12/87.
!
!     Purpose.
!     --------
!     *outpost writes output data on tapeunit *nopost*.
!     This file is further processed in the postprocessor.
!     The file is defined during the run.
!     The time for the next output is read from file and the
!     name of the next output file is generated.
!
!     Input.
!     ------
!     common blocks /lsgfie/ and /lsgsur/
!     filpnew   file for output to be written on.
!
!     Output.
!     -------
!     File with output data.
!     filpnew   new name for the next file with output data.
!     ntnout    number of time step to write next output file.
!
!     Interface.
!     ----------
!     *call* *outpost*
!
!     Calls subroutines *datfrnt*.
!     ------------------------------------------------------------------
!
!
!     Dimension of local variables.
!     -----------------------------
      integer :: ji,jr,k,iyy,idd,jlev,jl,i,j
      real (kind=8) :: zero,zdum,zlen,zprel,zcode,zlev
      integer :: iddr(512)
      real (kind=8) :: zddr(512)
!
!*    1.        Actualize *iddr*.
!     -----------------
      zero=0.
      zdum=zero
!
!     *iddr* and *zddr* are header fields for output file.
!
      do ji=1,512
        iddr(ji)=nddr(ji)
        zddr(ji)=oddr(ji)
      end do
      iddr(404)=0
      iddr(22)=6*ken+8
      iddr(16)=6*ken+8
      call datfrnt(nt,iddr(12),iddr(11))
!
!     Pot. temperature in Kelvin.
!
      do jr=1,ken
        iddr(22+2*jr-1)=-2
      end do
      do jr=1,ken
!
!       Salinity.
!
        iddr(22+2*ken+2*jr-1)=-5
        iddr(22+2*ken+2*jr)=nint(du(jr))
!
!       Velocities.
!
        iddr(22+4*ken+2*jr-1)=-3
        iddr(22+4*ken+2*jr)=nint(du(jr))
        iddr(22+6*ken+2*jr-1)=-4
        iddr(22+6*ken+2*jr)=nint(du(jr))
        iddr(22+8*ken+2*jr-1)=-7
        iddr(22+8*ken+2*jr)=nint(dw(jr))
      end do
!
!     Barotropic velocities.
!
      iddr(22+10*ken+1)=-37
      iddr(22+10*ken+2)=-100
      iddr(22+10*ken+3)=-38
      iddr(22+10*ken+4)=-100
!
!     Surface elevation.
!
      iddr(22+10*ken+5)=-1
      iddr(22+10*ken+6)=-100
!
!     Ice thickness.
!
      iddr(22+10*ken+7)=-13
      iddr(22+10*ken+8)=-100
!
!     Topography in vector-points.
!
      iddr(22+10*ken+9)=-99
      iddr(22+10*ken+10)=-100
!
!     Topography in scalar-points.
!
      iddr(22+10*ken+11)=-98
      iddr(22+10*ken+12)=-100
!
!     Fresh water fluxes due to Newtonian coupling.
!
      iddr(22+10*ken+13)=-67
      iddr(22+10*ken+14)=-100
!
!     Heat fluxes due to Newtonian coupling.
!
      iddr(22+10*ken+15)=-68
      iddr(22+10*ken+16)=-100
!
!     Convective adjustment.
!
      iddr(22+10*ken+17)=-69
      iddr(22+10*ken+18)=-100
!
!     Horizontal stream function
!
      iddr(22+10*ken+19)=-27
      iddr(22+10*ken+20)=-100
!
!     Freshwater flux
!
      iddr(22+10*ken+21)=-65
      iddr(22+10*ken+22)=-100
!
      do k=2,ken
        if (iddr(22+10*ken+22+(k-1)*2)>=300) cycle
        iddr(22+10*ken+21+(k-1)*2)=-69
        iddr(22+10*ken+22+(k-1)*2)=nint(dw(k-1))
      end do
!
!
!*    2.        Write output on file *filpnew*.
!     -------------------------------
!
!     Write *iddr* and *zddr* on file.
!
      iyy=iddr(12)
      idd=iddr(11)

!
!  Coupled with PlaSim: name without year to be edited by coupled script
      write (filpnew,'(a)') 'LSG_outpost'
 9885 format (' OUTPOST: standard output ',a,' on file ',a,             &
     &        ' YYYYY -MMDD :',i5.2,i6.4,'  +')
!#ifdef 1
!      write (no6,9885) '(real*4)',filpnew,iyy,idd,ksum
!#else
      write (no6,9885) ' ',filpnew,iyy,idd
!#endif

      open (nopost,file=filpnew,form="unformatted",position="append")




      write (nopost) iddr
      write (nopost) zddr
      zlen=ien*jen
      zprel=6.
!
!     Write temperature.
!
      zcode=-2
      do jlev=1,ken
        write (nopost) zprel,zlen,zcode,zddr(10+jlev-1),zdum,zdum
        write (nopost) (((t(jl,jr,jlev)+tkelvin),jl=1,ien),jr=1,jen)
      end do
!
!     Salinity.
!
      zcode=-5
      do jlev=1,ken
        write (nopost) zprel,zlen,zcode,zddr(10+jlev-1),zdum,zdum
        write (nopost) ((s(jl,jr,jlev),jl=1,ien),jr=1,jen)
      end do
!
!     Velocities.
!
      zcode=-3
      do jlev=1,ken
        write (nopost) zprel,zlen,zcode,zddr(10+jlev-1),zdum,zdum
        write (nopost) ((utot(jl,jr,jlev),jl=1,ien),jr=1,jen)
      end do
!
      zcode=-4
      do jlev=1,ken
        write (nopost) zprel,zlen,zcode,zddr(10+jlev-1),zdum,zdum
        write (nopost) ((vtot(jl,jr,jlev),jl=1,ien),jr=1,jen)
      end do
!
      zcode=-7
      do jlev=1,ken
        write (nopost) zprel,zlen,zcode,dw(jlev),zdum,zdum
        write (nopost) ((w(jl,jr,jlev),jl=1,ien),jr=1,jen)
      end do
!
!     Barotropic velocities.
!
      zlev=-100.
      zcode=-37.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((ub(jl,jr),jl=1,ien),jr=1,jen)
!
      zcode=-38.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((vb(jl,jr),jl=1,ien),jr=1,jen)
!
!     Surface elevation and ice thickness.
!
      zcode=-1.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((zeta(jl,jr),jl=1,ien),jr=1,jen)
!
      zcode=-13.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((sice(jl,jr),jl=1,ien),jr=1,jen)
!
!     Horizontal barotropic stream function
      zcode=-27.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((psi(jl,jr),jl=1,ien),jr=1,jen)
!
!     Store topography in vector-points.
!
      zcode=-99.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((depth(jl,jr),jl=1,ien),jr=1,jen)
!
!     Store topography in scalar-points.
!
      zcode=-98.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((depp(jl,jr),jl=1,ien),jr=1,jen)
!
!     Store *fluwat*
!
      zcode=-65.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) fluwat
!
!     Store *flukwat*.
!
      zcode=-67.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) flukwat
!
!     Store *flukhea*.
!
      zcode=-68.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) flukhea
!
!     Store convect ice adjustments.
!
      zcode=-66.
      zlev=-100.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((convad(jl,jr,1),jl=1,ien),jr=1,jen)
      zcode=-69.
      do k=2,ken
        zlev=dw(k-1)
        write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
        write (nopost) ((convad(jl,jr,k),jl=1,ien),jr=1,jen)
      end do
!
!     Store *taux*.
!
      zcode=52.
      zlev=-100.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((taux(i,j)*rhonul,i=1,ien),j=1,jen)
!
!     Store *tauy*.
!
      zcode=53.
      zlev=-100.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((tauy(i,j)*rhonul,i=1,ien),j=1,jen)
!
!     Store *tbound*.
!
      zcode=-92.
      zlev=-100.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) ((tbound(i,j)+tkelvin,i=1,ien),j=1,jen)
!
!     Store *fluhea*.
!
      zcode=-18.
      write (nopost) zprel,zlen,zcode,zlev,zdum,zdum
      write (nopost) fluhea
!
!*    3.        Store output on file *filpnew*.
!     -------------------------------
      close (nopost)
      return
      end subroutine outpost