!-------------------------------------- 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 sugrdlam 1,7
#if defined (DOC)
!
!**** sugrdlam - Defines the computational grid of the Minimization part of the
! variational analysis:
! First letter is G or L "GU" for Global or Lam
! Second letter is U or V for Uniform or Variable mesh
!
! Initialization of comgrd
!
! Modifications.
! --------------
*Author : L. Fillion ARMA/MSC 21 March 2005
*Revision:
* L. Fillion ARMA/MSC May 2006: Mesovar upgrade to v10_0_0.
* L. Fillion ARMA/EC 2 Nov 2009 - Correct documentation on reference to cxgaig.ftn
!
#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(nila),ZF_y(njla)
real ax(nila),ay(njla)
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(nila)
real*8 ZF_y_8(njla)
real*8 zdx(nila,njla), zdy(nila,njla)
!
!!
WRITE(nulout,FMT='(/,'' sugrdlam- Minimization Grid definition'')')
!
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,*) 'sugrdlam: X-DIRECTION **************'
zF_dxla = grd_dx ! to avoid i/o in vstretch_axis2
zF_xbeg = grd_x0
zF_xend = grd_xl
iNX = nila
iF_nxla = nila
llF_stagger_L = .false.
llF_print_L = .true.
zF_dxmax = grd_dx
llF_gauss_L = .false.
!
write(nulout,*) 'sugrdlam: zF_dxla=',zF_dxla
write(nulout,*) 'sugrdlam: zF_xbeg=',zF_xbeg
write(nulout,*) 'sugrdlam: zF_xend=',zF_xend
write(nulout,*) 'sugrdlam: iNX=',iNX
write(nulout,*) 'sugrdlam: iF_nxla=',iF_nxla
write(nulout,*) 'sugrdlam: zF_dxmax=',zF_dxmax
!
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,nila
! write(nulout,*) 'sugrdlam: ji,ZF_x_8(ji)=',ji,ZF_x_8(ji)
grd_x_8(ji)=ZF_x_8(ji) ! will be usefull when writing on RPN standard files.
enddo
do jj=1,njla
do ji=1,nila
rlon_an(ji,jj)=ZF_x_8(ji)*rdeg2rad
enddo
enddo
!
! Y-Direction
!
write(nulout,*) 'sugrdlam: Y-DIRECTION **************'
zF_dyla = grd_dy ! to avoid i/o in vstretch_axis2
zF_ybeg = grd_y0
zF_yend = grd_yl
iNY = njla
iF_nyla = njla
llF_stagger_L = .false.
llF_print_L = .true.
zF_dymax = grd_dy
llF_gauss_L = .false.
!
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,njla
grd_y_8(jj)=ZF_y_8(jj) ! will be usefull when writing on RPN standard files.
enddo
do jj=1,njla
do ji=1,nila
rlat_an(ji,jj)=ZF_y_8(jj)*rdeg2rad
enddo
enddo
!
! 1.1 Set resolution arrays ( >> & ^^ RPN file positional records)
! -------------------------------------------------------------
!
do ji=1,nila
! write(nulout,*) 'sugrdlam: ji,grd_x_8(ji)=',ji,grd_x_8(ji)
enddo
!
do jj=1,njla
! write(nulout,*) 'sugrdlam: jj,grd_y_8(jj)=',jj,grd_y_8(jj)
enddo
!
zdlon= grd_dx*rdeg2rad
zdlat= grd_dy*rdeg2rad
!
do jj= -4,njla+4
do ji= -4,nila+4
rdlon_an(ji,jj) = zdlon
rdlat_an(ji,jj) = zdlat
if(rdlon_an(ji,jj).le.0.) then
write(nulout,*) 'sugrdlam: ji,jj = ',ji,jj
call abort3d(nulout,'sugrdlam: rdlon_an(ji,jj).le.0.')
endif
if(rdlat_an(ji,jj).le.0.) then
write(nulout,*) 'sugrdlam: ji,jj = ',ji,jj
call abort3d(nulout,'sugrdlam: rdlat_an(ji,jj).le.0.')
endif
enddo
enddo
!
! West
!
do jj= -4, njla+4
zlat = rlat_an(1,jj)+(jj-1)*grd_dy*rdeg2rad
do ji= -4, 0
rlat_an(ji,jj)=zlat
rlon_an(ji,jj)=rlon_an(1,1)+(ji-1)*grd_dx*rdeg2rad
enddo
enddo
!
! East
!
do jj= -4, njla+4
zlat = rlat_an(1,jj)+(jj-1)*grd_dy*rdeg2rad
do ji= 1,4
rlat_an(nila+ji,jj)=zlat
rlon_an(nila+ji,jj)=rlon_an(nila,1)+ji*grd_dx*rdeg2rad
enddo
enddo
!
! North on (1,..nila) interval
!
do jj= 1,4
zlat = rlat_an(1,njla)+jj*grd_dy*rdeg2rad
do ji= 1,nila
rlat_an(ji,njla+jj)=zlat
rlon_an(ji,njla+jj)=rlon_an(ji,njla)
enddo
enddo
!
! South on (1,..nila) interval
!
do jj= -4,0
zlat = rlat_an(1,1)+(jj-1)*grd_dy*rdeg2rad
do ji= 1,nila
rlat_an(ji,jj)=zlat
rlon_an(ji,jj)=rlon_an(ji,1)
enddo
enddo
!
do ji=1,nila
ax(ji)=ZF_x_8(ji)
enddo
do jj=1,njla
ay(jj)=ZF_y_8(jj)
enddo
!
! 2. Set analysis file parameters
! ----------------------------
!
zxlon1_4 = grd_xlon1
zxlat1_4 = grd_xlat1
zxlon2_4 = grd_xlon2
zxlat2_4 = grd_xlat2
!
call cxgaig('E',mig1tic,mig2tic,mig3tic,mig4tic,
& zxlat1_4,zxlon1_4,zxlat2_4,zxlon2_4)
!
write(nulout,*) 'sugrdlam: '
write(nulout,*) 'sugrdlam: mig1tic = ',mig1tic
write(nulout,*) 'sugrdlam: mig2tic = ',mig2tic
write(nulout,*) 'sugrdlam: mig3tic = ',mig3tic
write(nulout,*) 'sugrdlam: mig4tic = ',mig4tic
write(nulout,*) 'sugrdlam: '
!
ngid_an= ezgdef_fmem(nila,njla,'Z','E',mig1tic, mig2tic,mig3tic,mig4tic, ! mig2tic etc already built by cxgaig...
& ax,ay)
!
! Set ip1,ip2,ip3 of positional parameters (= ig1,ig2,ig3 of analysis fields)
!
write(nulout,*) 'sugrdlam: grd_ni,grd_nj = ',grd_ni,grd_nj
!
call ipig(mig1flda,mig2flda,mig3flda,
& grd_dx,grd_dy,grd_nila,grd_njla,grd_ni,grd_nj,
& grd_rot_8, grd_roule)
!
write(nulout,*) 'sugrdlam: mig1flda,mig2flda,mig3flda',
& mig1flda,mig2flda,mig3flda
!
! 3. Set non-extended inner analysis file parameters
! (i.e. the LAM forecast grid extension but with current spatial resolution)
! --------------------------------------------------------------------------
!
! Scalar Grid:
!
ngid_in= ezgdef_fmem(mni_in,mnj_in,'Z','E',mig1tic, mig2tic,mig3tic,mig4tic,
& ax,ay) ! tic tac same as extended grid
!
! Set ip1,ip2,ip3 of positional parameters (= ig1,ig2,ig3 of scalar fields)
!
call ipig(mig1in,mig2in,mig3in,
& grd_dx,grd_dy,mni_in,mnj_in,mni_in,mnj_in,
& grd_rot_8, grd_roule)
!
write(nulout,*) 'sugrdlam: mni_in,mnj_in=',mni_in,mnj_in
write(nulout,*) 'sugrdlam: mig1in,mig2in,mig3in = ',mig1in,mig2in,mig3in
!
! U Grid:
! ------
ngidu_in= ezgdef_fmem(mni_in-1,mnj_in,'Z','E',mig1tic, mig2tic,mig3tic,mig4tic,
& ax,ay) ! tic tac same as extended grid
!
! Set ip1,ip2,ip3 of positional parameters (= ig1,ig2,ig3 of scalar fields)
!
! call ipig(mig1in_u,mig2in_u,mig3in_u,
! & grd_dx,grd_dy,mni_in-1,mnj_in,mni_in-1,mnj_in,
! & grd_rot_8, grd_roule)
!
mig1in_u = mig1in
mig2in_u = mig2in+1
mig3in_u = mig3in
write(nulout,*) 'sugrdlam: mig1in_u,mig2in_u,mig3in_u = ',mig1in_u,mig2in_u,mig3in_u
!
! V Grid:
! ------
ngidv_in= ezgdef_fmem(mni_in,mnj_in-1,'Z','E',mig1tic, mig2tic,mig3tic,mig4tic,
& ax,ay) ! tic tac same as extended grid
!
! Set ip1,ip2,ip3 of positional parameters (= ig1,ig2,ig3 of scalar fields)
!
! call ipig(mig1in_v,mig2in_v,mig3in_v,
! & grd_dx,grd_dy,mni_in,mnj_in-1,mni_in,mnj_in-1,
! & grd_rot_8, grd_roule)
!
mig1in_v = mig1in
mig2in_v = mig2in+2
mig3in_v = mig3in
write(nulout,*) 'sugrdlam: mig1in_v,mig2in_v,mig3in_v = ',mig1in_v,mig2in_v,mig3in_v
!
! 4. Set grid spacing dxlam,dylam
! ----------------------------
!
call sudxdy_lu(ngid_an)
!
! 5. Ensure namelist parameters mextendx, mextendy are not zero
! since in that case no bi-periodicization is done which means
! the Mesovar cant operate since it relies on Bi-periodic assumptions
! which is basically required for the basic-state fields prepared
! on the analysis grid by subasic_gd.ftn. The latter fields are necessary
! for TL operators used in the definition of the control variables and
! possibly also for observation operators.
! ----------------------------------------------------------
!
if(mextendx.eq.0.) then
write(nulout,*)'sugrdlam: WARNING !!!!!!!!!!! mextendx = 0'
!cluc call abort3d(nulout,'sugrdlam: mextendx = 0')
else if(mextendy.eq.0.) then
write(nulout,*)'sugrdlam: WARNING !!!!!!!!!!! mextendy = 0'
!cluc call abort3d(nulout,'sugrdlam: mextendy = 0')
endif
!
! 6. Specify file units and names for lam4d minimization needs
!
nulmin=992
nusdevin=991
nutemp=700
write(nulout,*) 'sugrdlam: Open file NULMIN = ',NULMIN
write(nulout,*) 'sugrdlam: NUSDEVIN = ',nusdevin
write(nulout,*) 'sugrdlam: NUTEMP = ',nutemp
open (unit=nulmin,file='mindiag.od')
!
!---------------------------------------------------------------------------
1001 format (/1x,'COMPUTE MODEL GRID (S/R E_GRIDGEF)',
$ /1x,34('='))
1005 format (/1x,'AJUSTED RPN/FST grid descriptors Grd_xlat1,',
$ 'Grd_xlon1,Grd_xlat2,Grd_xlon2:'
$ /4f12.6/1x,73('='))
1020 FORMAT (/1X,'FINAL HORIZONTAL GRID CONFIGURATION:'
$ /1X,' NIla=',I4,' FROM Grd_x0=',F9.3,' TO Grd_xl=',F9.3,' DEGREES'
$ /1X,' NJla=',I4,' FROM Grd_y0=',F9.3,' TO Grd_yl=',F9.3,' DEGREES'
$ /1X,' CENTRAL POINT OF THE GRID Grd_xlon1,Grd_xlat1=',
$ 2F9.3,' DEGREES'/1x,74('='))
1025 FORMAT(/1X,'THE CONSTANT RESOLUTION AREA HAS:'
$ /1X,' NILA=',I4,' OF GRID-LENGTH=',F9.4,' DEGREES'
$ 1x,'(',i4,',',i4,' )',
$ /1X,' NJLA=',I4,' OF GRID-LENGTH=',F9.4,' DEGREES'
$ 1x,'(',i4,',',i4,' )',
$ /1x,56('='))
1030 FORMAT(/1X,'THE VARIABLE RESOLUTION AREA HAS:'
$ /1X,i3,' POINTS TO THE WEST AND ',i3,' POINTS TO THE EAST'
$ /2x,'WITH STRETCHING FACTOR=',F8.4,
$ ' AND MINIMUM RESOLUTION=',F8.4,
$ /1X,i3,' POINTS ON THE SOUTH AND ',i3,' POINTS ON THE NORTH'
$ /2x,'WITH STRETCHING FACTOR=',F8.4,
$ ' AND MINIMUM RESOLUTION=',F8.4)
1031 FORMAT(1x,64('='))
1035 FORMAT(2x,'RESOLUTION IS LIMITED TO ',F9.4,1x,
$ 'DEGREES OVER LAST',I4,' DELTA-',a1,' AT ',
$ 'EACH ENDS OF THE ',a1,' AXIS.')
*
*----------------------------------------------------------------------
*
return
end