!-------------------------------------- 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 sucoriol 1,2
#if defined (DOC) 
!
!**** sucoriol -  Prepares Coriolis factor on the analysis computational grid. The former then 
!                 depends on both latitude and longitude in general (see working notes).
!
!     Modifications.
!     --------------
*Author : L. Fillion ARMA/MSC 24 Sep 05.
*Revision:
!
#endif
!
      IMPLICIT NONE
      integer kulout
#include "taglam4d.cdk"
#include "comcst.cdk"
#include "comdim.cdk"
#include "comdimo.cdk"
#include "comlun.cdk"
#include "comgemla.cdk"
#include "comgrd_param.cdk"
#include "comgrd.cdk"
!
      integer ji,jj,j1,j2,jobs,inip1,injp1
      real zlat4rot_deg,zlon4rot_deg,zlat4_deg,zlon4_deg
      real*8 zlatr,zlonr,zcon
      real*8 zri(3,3)
      real*8 z2d(nila,njla)
!
!!
      WRITE(nulout,FMT='(/,'' sucoriol- Precomputations of Coriolis parameter on the analysis grid'')')
!
      zcon = 2.*romega
!
      do j1=1,3
        do j2=1,3
          zri(j1,j2)=Grd_rot_8(j2,j1)
        enddo
      enddo
!
      do ji = 1, nila
        zlon4_deg = grd_x_8(ji)   ! degrees double precision to single precision
        do jj = 1, njla
          zlat4_deg = grd_y_8(jj)
          call ll2ll(zlat4rot_deg,zlon4rot_deg,zlat4_deg,zlon4_deg,zri,1,1)
          zlatr = rdeg2rad*zlat4rot_deg
          z2d(ji,jj)= zcon*sin(zlatr)
        enddo
      enddo
!
      inip1 = nila+1
      injp1 = njla+1
      call mach2(z2d,nila,njla,inip1,injp1)
      do ji=1,nila
        do jj=1,njla
           coriol(ji,jj)=z2d(ji,jj)
        enddo
      enddo
!
      return
      end