!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
subroutine wrgomobs,1
implicit none
*
* Author: Simon Pellerin *ARMA/SMC Nov. 2001
* Purpose: Write GOMOBS values in prof file for validation purposes
*
integer :: ihdlout,istat, prof_wrrec,jlev,jo
real, allocatable, dimension(:,:) :: z3d
real, allocatable, dimension(:) :: z2d
integer, allocatable, dimension(:) :: i2d
#include "comdim.cdk"
#include "comdimo.cdk"
#include "commvog.cdk"
include 'prof_f.h'
allocate(z3d(nflev,nobtot))
allocate(z2d(nobtot))
allocate(i2d(nobtot))
ihdlout = prof_open('gomobs.prof','WRITE','FILE')
do jo = 1, nobtot
do jlev = 1, nflev
z3d(jlev,jo) = gomug(jlev,jo)
enddo
enddo
istat = prof_pvar(ihdlout,z3d,v3d_utru)
do jo = 1, nobtot
do jlev = 1, nflev
z3d(jlev,jo) = gomvg(jlev,jo)
enddo
enddo
istat = prof_pvar(ihdlout,z3d,v3d_vtru)
do jo = 1, nobtot
do jlev = 1, nflev
z3d(jlev,jo) = gomtg(jlev,jo)
enddo
enddo
istat = prof_pvar(ihdlout,z3d,v3d_temp)
do jo = 1, nobtot
do jlev = 1, nflev
z3d(jlev,jo) = gomqg(jlev,jo)
enddo
enddo
istat = prof_pvar(ihdlout,z3d,v3d_sphu)
do jo = 1, nobtot
z2d(jo) = gompsg(1,jo)
enddo
istat = prof_pvar(ihdlout,z2d,v2d_psur)
do jo = 1, nobtot
i2d(jo) = jo
enddo
istat = prof_pvar(ihdlout,i2d,v2d_otag)
istat = prof_pvar(ihdlout,i2d,v2d_mtag)
istat = prof_wrrec(ihdlout)
istat = prof_close(ihdlout)
deallocate(z3d)
deallocate(z2d)
call abort3d
(0,'wrgomobs')
end subroutine wrgomobs