!-------------------------------------- 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 sugrdgauss 1,2
#if defined (DOC)
!
!**** sugrdgauss - Defines RPN positional parameters (>>,^^) of a Rotated Gaussian computational grid.
!
! Initialization of comgrd
!
! Modifications.
! --------------
*Author : L. Fillion ARMA/EC 19 Oct 2009
*Revision:
!
#endif
!
IMPLICIT NONE
#include "taglam4d.cdk"
#include "comdim.cdk"
#include "comlun.cdk"
#include "comlunla.cdk"
#include "comcst.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
#include "comgemla.cdk"
#include "comgembgh.cdk"
#include "comgdpar.cdk"
!
logical llF_stagger_L,llF_print_L,llF_gauss_L
integer Imargin,iNX,iF_nxla,IF_nimax
integer iNY,iF_nyla,iF_njmax
integer ierr,ji,jj,j1,j2
integer vstretch_axis2
integer igdid,iunsrc
!
integer fstfrm, fnom, fstouv, fstprm
integer gdgaxes,ezqkdef,ezgdef_fmem,gdxyfll
integer tictacig1, tictacig2, tictacig3
real zlat4,zlon4,zx,zy
real zxlon1_4,zxlat1_4,zxlon2_4,zxlat2_4
real ZF_x(ni),ZF_y(nj)
real ax(ni),ay(nj)
real zF_dxla,zF_xbeg,zF_xend,ZF_amp,zF_dxmax
real zF_dyla,zF_ybeg,zF_yend,zF_dymax
!
real*8 a_8,b_8,c_8,d_8,xyz1_8(3),xyz2_8(3)
real*8 zrot_t(3,3),zunit(3,3)
real*8 zlat,zdlon,zdlat
real*8 ZF_x_8(ni+1)
real*8 ZF_y_8(nj)
!
!!
WRITE(nulout,FMT='(/,'' sugrdgauss- RPN parameter setup for Minimization Grid '')')
!
cgrtypa = 'Z'
!
! 1. Build (lon,lat) of analysis grid (radians) and
! Build (lon,lat) of analysis grid (degrees) as in GEM
! ----------------------------------------------------
!
! X-Direction
!
write(nulout,*) 'sugrdgauss: X-DIRECTION **************'
zF_dxla = 360./real(ni) ! to avoid i/o in vstretch_axis2
zF_xbeg = 0.
zF_xend = 360.
iNX = ni+1
iF_nxla = ni+1
llF_stagger_L = .false.
llF_print_L = .true.
zF_dxmax = 360.
llF_gauss_L = .true.
!
write(nulout,*) 'sugrdgauss: zF_dxla=',zF_dxla
write(nulout,*) 'sugrdgauss: zF_xbeg=',zF_xbeg
write(nulout,*) 'sugrdgauss: zF_xend=',zF_xend
write(nulout,*) 'sugrdgauss: iNX=',iNX
write(nulout,*) 'sugrdgauss: iF_nxla=',iF_nxla
write(nulout,*) 'sugrdgauss: zF_dxmax=',zF_dxmax
write(nulout,*) 'sugrdgauss: llF_gauss_L=',llF_gauss_L
!
ierr=vstretch_axis2
(ZF_x_8, zF_dxla, zF_xbeg, zF_xend, Imargin, iNX,
& iF_nxla, ZF_amp, llF_stagger_L, llF_print_L, zF_dxmax,
& IF_nimax, llF_gauss_L)
!
do ji=1,ni
grd_x_8(ji)=ZF_x_8(ji) ! will be usefull when writing on RPN standard files.
enddo
do ji=1,ni-1
grd_u_x_8(ji)=(ZF_x_8(ji)+ZF_x_8(ji+1))*0.5 ! will be usefull when writing on RPN standard files.
write(nulout,*) 'sugrdgeom: ji,grd_u_x_8(ji)=',ji,grd_u_x_8(ji)
enddo
!
! Y-Direction
!
write(nulout,*) 'sugrdgauss: Y-DIRECTION **************'
zF_dyla = zF_dxla ! to avoid i/o in vstretch_axis2
zF_ybeg = -90.
zF_yend = 90.
iNY = nj
iF_nyla = nj
llF_stagger_L = .true.
llF_print_L = .true.
zF_dymax = 180.
llF_gauss_L = .true.
!
ierr=vstretch_axis2
(ZF_y_8, zF_dyla, zF_ybeg, zF_yend, Imargin, iNY,
& iF_nyla, ZF_amp, llF_stagger_L, llF_print_L, zF_dymax,
& IF_njmax, llF_gauss_L)
do jj=1,nj
grd_y_8(jj)=ZF_y_8(jj) ! will be usefull when writing on RPN standard files.
enddo
do jj=1,nj-1
grd_v_y_8(jj)=(ZF_y_8(jj)+ZF_y_8(jj+1))*0.5 ! will be usefull when writing on RPN standard files.
write(nulout,*) 'sugrdgeom: jj,grd_v_y_8(jj)=',jj,grd_v_y_8(jj)
enddo
!
return
end