C Copyright 1981-2012 ECMWF.
C
C This software is licensed under the terms of the Apache Licence 
C Version 2.0 which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
C
C In applying this licence, ECMWF does not waive the privileges and immunities 
C granted to it by virtue of its status as an intergovernmental organisation 
C nor does it submit to any jurisdiction.
C

      INTEGER FUNCTION INIT_CM( KPARAM, KVAL )
C---->
C**** INIT_CM
C
C     Purpose
C     -------
C
C     Initialise common block values used by interpolation.
C
C
C     Interface
C     ---------
C
C     IRET = INIT_CM( KPARAM, KVAL )
C
C     Input
C     -----
C
C     KPARAM - Flag indicating common block element to update.
C     KVAL   - Value for element.
C
C
C     Output
C     ------
C
C     Common block entry updated.
C
C
C     Method
C     ------
C
C     1      NIFORM
C     2      NOFORM
C     3      NITABLE
C     4      NIPARAM
C     5      NIRESO
C     6      NORESO
C     7      NOACC
C     8      NIGRID(1)
C     9      NIGRID(2)
C     10     NOGRID(1)
C     11     NOGRID(2)
C     12     NIGAUSS, RIGAUSS, MILLEN, NINS, NIGAUSO, HIGAUST
C     13     NOGAUSS, ROGAUSS, NOLPTS, NONS, NOGAUSO, HOGAUST
C     14     NIAREA(1)
C     15     NIAREA(2)
C     16     NIAREA(3)
C     17     NIAREA(4)
C     18     NOAREA(1)
C     19     NOAREA(2)
C     20     NOAREA(3)
C     21     NOAREA(4)
C     22     NISCNM
C     23     NOSCNM
C     24     LSM
C     25     LWIND
C     26     LPREC
C     27     RIGAUSS, MILLEN, NINS, NIGAUSO, HIGAUST
C     28     ROGAUSS, NOLPTS, NONS, NOGAUSO, HOGAUST
C     29     LSMPAR
C
C     99     Display current values in common block.
C
C
C     Externals
C     ---------
C
C     None.
C
C
C     Author
C     ------
C
C     J.D.Chambers     ECMWF
C
C----<
C
      IMPLICIT NONE
C
C     Function arguments
C
      INTEGER KPARAM, KVAL
C
C     Local variables
C
      INTEGER IRET, LOOP
C
#include "parim.h"
#include "nifld.common"
#include "nofld.common"
#include "grfixed.h"
#include "current.h"
C
      INIT_CM = 0
C
      IF ( KPARAM .EQ.1 ) NIFORM = KVAL
C
      IF ( KPARAM .EQ.2 ) NOFORM = KVAL
C
      IF ( KPARAM .EQ.3 ) NITABLE = KVAL
C
      IF ( KPARAM .EQ.4 ) NIPARAM = KVAL
C
      IF ( KPARAM .EQ.5 ) NIRESO = KVAL
C
      IF ( KPARAM .EQ.6 ) NORESO = KVAL
C
      IF ( KPARAM .EQ.7 ) NOACC = KVAL
C
      IF ( KPARAM .EQ.8 ) NIGRID(1) = KVAL
C
      IF ( KPARAM .EQ.9 ) NIGRID(2) = KVAL
C
      IF ( KPARAM .EQ.10) NOGRID(1) = KVAL
C
      IF ( KPARAM .EQ.11) NOGRID(2) = KVAL
C
      IF ( KPARAM .EQ.12) THEN
        NIGAUSS = KVAL
        IF( (NIGAUSO.NE.NIGAUSS).OR.(HIGAUST.NE.'F') ) THEN
          CALL JGETGG( NIGAUSS, 'F', RIGAUSS, MILLEN, IRET)
          IF ( IRET .NE. 0 ) THEN
            WRITE(*,*) 'INIT_CM: JGETGG failed for NIGAUSS'
            INIT_CM = IRET
            GOTO 900
          ENDIF
          NINS = 2*NIGAUSS
          NIGAUSO = NIGAUSS
          HIGAUST = 'F'
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.13) THEN
        NOGAUSS = KVAL
        IF( (NOGAUSO.NE.NOGAUSS).OR.(HOGAUST.NE.'F') ) THEN
          CALL JGETGG( NOGAUSS, 'F', ROGAUSS, NOLPTS, IRET)
          IF ( IRET .NE. 0 ) THEN
            WRITE(*,*) 'INIT_CM: JGETGG failed for NOGAUSS'
            INIT_CM = IRET
            GOTO 900
          ENDIF
          NONS = 2*NOGAUSS
          NOGAUSO = NOGAUSS
          HOGAUST = 'F'
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.14) NIAREA(1) = KVAL
C
      IF ( KPARAM .EQ.15) NIAREA(2) = KVAL
C
      IF ( KPARAM .EQ.16) NIAREA(3) = KVAL
C
      IF ( KPARAM .EQ.17) NIAREA(4) = KVAL
C
      IF ( KPARAM .EQ.18) NOAREA(1) = KVAL
C
      IF ( KPARAM .EQ.19) NOAREA(2) = KVAL
C
      IF ( KPARAM .EQ.20) NOAREA(3) = KVAL
C
      IF ( KPARAM .EQ.21) NOAREA(4) = KVAL
C
      IF ( KPARAM .EQ.22) NISCNM    = KVAL
C
      IF ( KPARAM .EQ.23) NOSCNM    = KVAL
C
      IF ( KPARAM .EQ.24) THEN
        IF ( KVAL .EQ. 1) THEN
          LSM       = .TRUE.
        ELSE
          LSM       = .FALSE.
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.25) THEN
        IF ( KVAL .EQ. 1) THEN
          LWIND     = .TRUE.
        ELSE
          LWIND     = .FALSE.
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.26) THEN
        IF ( KVAL .EQ. 1) THEN
          LPREC     = .TRUE.
        ELSE
          LPREC     = .FALSE.
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.27) THEN
        IF ( KVAL .EQ. 1) THEN
          IF( (NIGAUSO.NE.NIGAUSS).OR.(HIGAUST.NE.'R') ) THEN
            CALL JGETGG( NIGAUSS, 'R', RIGAUSS, MILLEN, IRET)
            IF ( IRET .NE. 0 ) THEN
              WRITE(*,*) 'INIT_CM: JGETGG failed for NIGAUSS'
              INIT_CM = IRET
              GOTO 900
            ENDIF
            NINS = 2*NIGAUSS
            NIGAUSO = NIGAUSS
            HIGAUST = 'R'
          ENDIF
        ELSE
          WRITE(*,*) 'No user input supported for reduced gaussian grid'
          INIT_CM = 999
          GOTO 900
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.28) THEN
        IF ( KVAL .EQ. 1) THEN
          IF( (NOGAUSO.NE.NOGAUSS).OR.(HOGAUST.NE.'R') ) THEN
            CALL JGETGG( NOGAUSS, 'R', ROGAUSS, NOLPTS, IRET)
            IF ( IRET .NE. 0 ) THEN
              WRITE(*,*) 'INIT_CM: JGETGG failed for NIGAUSS'
              INIT_CM = IRET
              GOTO 900
            ENDIF
            NONS = 2*NOGAUSS
            NOGAUSO = NOGAUSS
            HOGAUST = 'R'
          ENDIF
        ELSE
          WRITE(*,*) 'No user input supported for reduced gaussian grid'
          INIT_CM = 999
          GOTO 900
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.29) THEN
        IF ( KVAL .EQ. 1) THEN
          LSMPAR    = .TRUE.
        ELSE
          LSMPAR    = .FALSE.
        ENDIF
      ENDIF
C
      IF ( KPARAM .EQ.99) THEN
        WRITE(*,*) ' LCHANGE   = ', LCHANGE
        WRITE(*,*) ' LSMCHNG   = ', LSMCHNG
        WRITE(*,*) ' LSMSET    = ', LSMSET
        WRITE(*,*) ' LSMPARSET = ', LSMPARSET
        WRITE(*,*) ' LPRECSET  = ', LPRECSET
        WRITE(*,*) ' LWINDSET  = ', LWINDSET
        WRITE(*,*) ' NINS      = ', NINS
        WRITE(*,*) ' NIWE      = ', NIWE
        WRITE(*,*) ' NO1NS     = ', NO1NS
        WRITE(*,*) ' NO1WE     = ', NO1WE
        WRITE(*,*) ' NONS      = ', NONS
        WRITE(*,*) ' NOWE      = ', NOWE
C
        WRITE(*,*) ' NIFORM    = ', NIFORM
        WRITE(*,*) ' NOFORM    = ', NOFORM
        WRITE(*,*) ' NITABLE   = ', NITABLE
        WRITE(*,*) ' NIPARAM   = ', NIPARAM
        WRITE(*,*) ' NIRESO    = ', NIRESO
        WRITE(*,*) ' NORESO    = ', NORESO
        WRITE(*,*) ' LNORESO   = ', LNORESO
        WRITE(*,*) ' NOACC     = ', NOACC 
        WRITE(*,*) ' LNOACC    = ', LNOACC 
        WRITE(*,*) ' NIGRID(1) = ', NIGRID(1)
        WRITE(*,*) ' NIGRID(2) = ', NIGRID(2)
        WRITE(*,*) ' NOGRID(1) = ', NOGRID(1)
        WRITE(*,*) ' NOGRID(2) = ', NOGRID(2)
        WRITE(*,*) ' NIGAUSS   = ', NIGAUSS
        WRITE(*,*) ' NOGAUSS   = ', NOGAUSS
        WRITE(*,*) ' LNOGAUS   = ', LNOGAUS
        WRITE(*,*) ' NIAREA(1) = ', NIAREA(1)
        WRITE(*,*) ' NIAREA(2) = ', NIAREA(2)
        WRITE(*,*) ' NIAREA(3) = ', NIAREA(3)
        WRITE(*,*) ' NIAREA(4) = ', NIAREA(4)
        WRITE(*,*) ' NOAREA(1) = ', NOAREA(1)
        WRITE(*,*) ' NOAREA(2) = ', NOAREA(2)
        WRITE(*,*) ' NOAREA(3) = ', NOAREA(3)
        WRITE(*,*) ' NOAREA(4) = ', NOAREA(4)
        WRITE(*,*) ' NISCNM    = ', NISCNM   
        WRITE(*,*) ' NOSCNM    = ', NOSCNM   
        WRITE(*,*) ' LSM       = ', LSM      
        WRITE(*,*) ' LWIND     = ', LWIND    
        WRITE(*,*) ' LPREC     = ', LPREC    
        WRITE(*,*) ' LSMPAR    = ', LSMPAR   
      ENDIF
C
      IF ( KPARAM .GT.99) THEN
        DO 110 LOOP = 1, NINS
          WRITE(*,*) ' RIGAUSS(',LOOP,'), MILLEN(',LOOP,')=',
     X                 RIGAUSS(LOOP), MILLEN(LOOP)
  110   CONTINUE
        DO 120 LOOP = 1, NONS
          WRITE(*,*) ' ROGAUSS(',LOOP,'), NOLPTS(',LOOP,')=',
     X                 ROGAUSS(LOOP), NOLPTS(LOOP)
  120   CONTINUE
      ENDIF
C
 900  CONTINUE
      RETURN
      END
