/***************************** LICENSE START ***********************************

 Copyright 2012 ECMWF and INPE. This software is distributed under the terms
 of the Apache License version 2.0. In applying this license, ECMWF does not
 waive the privileges and immunities granted to it by virtue of its status as
 an Intergovernmental Organization or submit itself to any jurisdiction.

 ***************************** LICENSE END *************************************/


#include <math.h>
#include "Divrot.h"

#if 0
      SUBROUTINE DIVROT
C
C          COMPUTE ROTATIONAL WIND IF VORTICITY SUPPLIED
C          COMPUTE DIVERGENT WIND IF DIVERGENCE SUPPLIED
C
C        Input:
C          Fieldset of vorticity or divergence (spherical harmonics)
C          Spectral truncation required
C          Indicator for whether spatial smoothing required
C          Smoothing constants
C
C        Output:
C          Fieldset of rotational or divergent wind u-v components
C           (spherical harmonics)
C
C        Author:
C          B. Norris,  October 1996
C
C
#include <grbsh.h>
#include <grbsec.h>

      integer cputenv

#ifdef __alpha
      INTEGER*8 IGRIB1,ICNT,IGRIB2,JMGRIBB,IWORD
#endif

C      PARAMETER (JMTRUNC=213)
C      PARAMETER (JMUAF=(JMTRUNC+1)*(JMTRUNC+2))
C      PARAMETER (JMGRIB=(JMUAF/2)+1000)
C      PARAMETER (JSEC0=2,JSEC1=255,JSEC2=1000,JSEC3=2,JSEC4=100)
C      PARAMETER (JPSEC2=96,JPSEC3=2)

      DIMENSION IGRIB(JMGRIB)
      DIMENSION ISEC0(JSEC0)
      DIMENSION ISEC1(JSEC1)
      DIMENSION ISEC2(JSEC2)
      DIMENSION ISEC3(JSEC3)
      DIMENSION ISEC4(JSEC4)
      DIMENSION ZSEC2(JPSEC2)
      DIMENSION ZSEC3(JPSEC3)
      DIMENSION DV1(JMUAF),DV2(JMUAF),DU(JMUAF),DV(JMUAF)
      LOGICAL NLSMTH
      CHARACTER*4 YSMTH
      DATA DV2/JMUAF*0.0/

c -------------------------------------------------------------------
c
C     GET FIRST ARGUMENT AS A FIELDSET OF VORTICITY OR DIVERGENCE
C               ICNT IS THE NUMBER OF FIELDS

      CALL MGETG(IGRIB1,ICNT)

C        GET USER OPTIONS
C
C           Spectral truncation
      CALL MGETN (RTOUT)
C           Smoothing indicator and constants
      CALL MGETS (YSMTH)
      NLSMTH=.FALSE.
      IF(YSMTH(1:2).EQ.'on') NLSMTH=.TRUE.
      CALL MGETN (FLTC)
      CALL MGETN (RFLTEXP)
      MFLTEXP = NINT (RFLTEXP)
      WRITE (*,*) ' RTOUT,NLSMTH,FLTC,MFLTEXP '
      WRITE (*,*)   RTOUT,NLSMTH,FLTC,MFLTEXP
      WRITE (*,'(A,A)') ' YSMTH ',YSMTH

C     CREATE A NEW FIELDSET

      CALL MNEWG(IGRIB2)
C
c -------------------------------------------------------------------
c
C     LOOP ON FIELDS

      DO 10 I=1,ICNT

C       GET NEXT FIELD FROM FIELDSET

        JMGRIBB = JMGRIB	!POINTERS BETWEEN C AND FORTRAN MUST BE 8 BYTES
        CALL MLOADG(IGRIB1,IGRIB,JMGRIBB)

C       EXPAND

        IPNTS = JMUAF
        IERR = 0
        CALL GRIBEX (ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,
     C             DV1,IPNTS,IGRIB,JMGRIB,IWORD,'D',IERR)

C           VALIDATE

        CALL DVVALID (ISEC1,ISEC2,IERROR)
	IF(IERROR.NE.0) RETURN

C           COMPUTE DIVERGENT OR ROTATIONAL WIND

        ITIN = ISEC2(2)
        NTOUT = NINT (RTOUT)
        IF (NTOUT.GT.ITIN) THEN
	  JJ = cputenv
     X    ('VELSTR_ENV=OUTPUT TRUNCATION GREATER THAN INPUT TRUNCATION')
	 RETURN
	ENDIF
        IF (NTOUT.EQ.0) NTOUT=ITIN
        IF(ISEC1(6).EQ.138) THEN
C             IF(I.EQ.1) CALL MSETS ('rot')
             CALL VOD2UV (DV1,DV2,ITIN,DU,DV,NTOUT)
        ELSE
C             IF(I.EQ.1) CALL MSETS ('div')
             CALL VOD2UV (DV2,DV1,ITIN,DU,DV,NTOUT)
        ENDIF

C           SMOOTHING

        ITIN = NTOUT
        NPREL4 = ITIN+1
        I1 = JMUAF
        IF(NLSMTH) THEN
             CALL BPPSMTH (DU,I1,FLTC,MFLTEXP,NPREL4)
             CALL BPPSMTH (DV,I1,FLTC,MFLTEXP,NPREL4)
        ENDIF

C          REPACK U COMPONENT

        IPNTS = (NTOUT+1)*(NTOUT+2)
        ISEC1(6) = 131
        ISEC2(2) = NTOUT
        ISEC2(3) = NTOUT
        ISEC2(4) = NTOUT
C        IF(ISEC2(6).EQ.2) CALL GRSMKP (1)
C           FORCE SIMPLE PACKING
        ISEC2(6) = 1
        ISEC4(1) = IPNTS
        DO 201 K4=3,JSEC4
        ISEC4(K4) = 0
  201   CONTINUE

        IF(I.EQ.1) THEN
C             CALL GRPRS0 (ISEC0)
C             CALL GRPRS1 (ISEC0,ISEC1)
C             CALL GRPRS2 (ISEC0,ISEC2,ZSEC2)
C             CALL GRPRS3 (ISEC0,ISEC3,ZSEC3)
C             CALL GRPRS4 (ISEC0,ISEC4,DU)
C             WRITE (*,'(1H /(1H ,4(2X,E12.3)))')
C     X             (DU(KD),KD=1,IPNTS,100)
        ENDIF

        RMIN=1.0E10
        RMAX=-1.0E10
        DO 202 KD=1,IPNTS
        IF(DU(KD).LT.RMIN) RMIN=DU(KD)
        IF(DU(KD).GT.RMAX) RMAX=DU(KD)
  202   CONTINUE
        WRITE (*,*) ' RMIN ',RMIN,' RMAX ',RMAX

        IERR = 0
        CALL GRIBEX (ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,
     C             DU,IPNTS,IGRIB,JMGRIB,IWORD,'C',IERR)

C          ADD TO FIELDSET

        CALL MSAVEG(IGRIB2,IGRIB,IWORD)

C          REPACK V COMPONENT

        RMIN=1.0E10
        RMAX=-1.0E10
        DO 203 KD=1,IPNTS
        IF(DV(KD).LT.RMIN) RMIN=DV(KD)
        IF(DV(KD).GT.RMAX) RMAX=DV(KD)
  203   CONTINUE
        WRITE (*,*) ' RMIN ',RMIN,' RMAX ',RMAX

        ISEC1(6) = 132
        IERR = 0
        CALL GRIBEX (ISEC0,ISEC1,ISEC2,ZSEC2,ISEC3,ZSEC3,ISEC4,
     C             DV,IPNTS,IGRIB,JMGRIB,IWORD,'C',IERR)

C          ADD TO FIELDSET

        CALL MSAVEG(IGRIB2,IGRIB,IWORD)


10    CONTINUE

c --------------------------------------------------------------------

C     SET RESULT
      CALL MSETG(IGRIB2)

      WRITE (*,'(A)') '  END OF DIVROT '

      RETURN
      END
#endif



// from libMars/emos.c
extern "C" {
/*fortint int2_intout(const char* param,fortint iv[],fortfloat dv[],const char* cv);*/
fortint intout_(char*, fortint[], fortfloat[], const char*, fortint, fortint);
fortint intin_(char*, fortint[], fortfloat[], const char*, fortint, fortint);
}

/*
// --------------------------------------------------------------------------------
// repackGribValues
// does what it says... this is because if we want to change the bitsPerValue, then
// we also need to get grib_api to repack the data with the new resolution.
// --------------------------------------------------------------------------------

static void repackGribValues (grib_handle *gh, int bitsPerValue)
{
    size_t len = 0;                                        // data values count
    int ret = grib_get_size( gh, "values", &len );
//    badRetVal (ret, "grib_get_size", "repackGribValues");

    double* values = new double[len];                             // allocate array for values
    ret = grib_get_double_array( gh, "values", values, &len );  // get the values
//    badRetVal (ret, "grib_get_double_array", "repackGribValues");

    ret = grib_set_long (gh, "numberOfBitsContainingEachPackedValue", bitsPerValue);  // set bitsPerValue


    ret = grib_set_double_array(gh, "values", values, len );  // set the values
//    badRetVal (ret, "grib_set_double_array", "repackGribValues");
}
*/


bool
Divrot::convert_DIVROT( MvRequest& out )
{
   DfileOut = marstmp();                     //-- file for computed fields

   for( int f = 0; f < Dnfield; ++f )        //-- loop over input fields
   {
/*
      MvField myField = Dfieldset[ f ];      //-- get grib handle for this field
      grib_handle* gh = myField.getGribHandle();


      if( ! isValidData_DVVALID( gh ) )      //-- must be vorticity or divergence
      {
         marslog(LOG_EROR,"Divrot: invalid data");
         return false;
      }

      checkOutputTruncation( gh );           //-- ensure output truncation

      size_t len = 0;                        //-- data values count
      int ret = grib_get_size( gh, "values", &len );
      badRetVal( ret, "grib_get_size", "Divrot::convert_DIVROT" );

                                             //-- input array for div/vor
      double* divOrVor = new double[len];
                                             //-- empty array (only zeroes)
      double* zero = new double[len];
      memset( zero, 0, sizeof(double)*len );

                                             //-- create output arrays for U and V
      DoutputValsLen = (DtruncOut+1)*(DtruncOut+2);
      double* U = new double[DoutputValsLen];
      double* V = new double[DoutputValsLen];

      fortint inwords  = (len            * sizeof(double)) / sizeof(fortint);
      fortint outwords = (DoutputValsLen * sizeof(double)) / sizeof(fortint);


      ret = grib_get_double_array( gh, "values", divOrVor, &len );
      badRetVal( ret, "grib_get_double_array", "Divrot::convert_DIVROT" );
*/

      char* bufferVorticity   = NULL;
      char* bufferDivergence  = NULL;
      size_t sizeVorticity = 0, sizeDivergence = 0;
      int ret;
      err marsRet;

      MvField myField = Dfieldset[ f ];      //-- get grib handle for this field
      grib_handle *ghVorticity;
      grib_handle *ghDivergence;
      grib_handle *ghZero = NULL;
      size_t voValuesLength = 0, divValuesLength = 0;   //-- data values count
      double* zero = NULL;

      // note: vorticity->rotwind, divergence->divwind, both->uvwind

      switch (DresultParam)
      {
        case eRotational:
        {
            ghVorticity  = myField.getGribHandle();
            ghDivergence = grib_handle_clone (ghVorticity);  // create an all-zero valued GRIB for divergence
            ghZero       = ghDivergence;                     // this is the one we will zero
            break;
        }

        case eDivergent:
        {
            ghDivergence = myField.getGribHandle();
            ghVorticity  = grib_handle_clone (ghDivergence);   // create an all-zero valued GRIB for vorticity
            ghZero       = ghVorticity;                        // this is the one we will zero
            break;
        }

        case eUV:
        {
            MvField myField2 = Dfieldset2[ f ];     //-- get grib handle for 'the other' field
            ghVorticity  = myField.getGribHandle();
            ghDivergence = myField2.getGribHandle();
            break;
        }
        
        default:
        {
            marslog(LOG_EROR,"Divrot: params should be vorticity or divergence");
            return false;
        }
      }
      



      if( ! isValidData_DVVALID( ghVorticity ) )      //-- must be vorticity or divergence
      {
         marslog(LOG_EROR,"Divrot: invalid vorticity data");
         return false;
      }

      if( ! isValidData_DVVALID( ghDivergence ) )      //-- must be vorticity or divergence
      {
         marslog(LOG_EROR,"Divrot: invalid divergence data");
         return false;
      }



      checkOutputTruncation( ghVorticity );           //-- ensure output truncation
      checkOutputTruncation( ghDivergence );          //-- ensure output truncation



      // get the data array lengths and ensure they are the same

      ret = grib_get_size( ghVorticity, "values", &voValuesLength );  //-- get the data array size
      badRetVal( ret, "grib_get_size vorticity values", "Divrot::convert_DIVROT" );

      ret = grib_get_size( ghDivergence, "values", &divValuesLength );  //-- get the data array size
      badRetVal( ret, "grib_get_size divergence values", "Divrot::convert_DIVROT" );


     if (voValuesLength != divValuesLength)
     {
        marslog(LOG_EROR,"Divrot: vorticity and divergence fields should have the same number of points (%d, %d)",
                voValuesLength, divValuesLength);
        return false;
     }



      // set the 'zero' GRIB values to zero
      
      if (ghZero != NULL)
      {
          zero = new double[voValuesLength];
          memset( zero, 0, sizeof(double)*voValuesLength );

          ret = grib_set_double_array (ghZero, "values", zero, voValuesLength);	 
          badRetVal( ret, "grib_set_double_array", "Divrot::convert_DIVROT" );
      }



      // get the input GRIB message into a char buffer, because this is
      // what makeuv() wants

      ret = grib_get_message(ghVorticity,  (const void **)&bufferVorticity,  &sizeVorticity);
      ret = grib_get_message(ghDivergence, (const void **)&bufferDivergence, &sizeDivergence);


      // compute the size of the output buffers

      DoutputValsLen = voValuesLength*3 + 4096;//(DtruncOut+1)*(DtruncOut+2) + 4096;
      char *u = new char[DoutputValsLen * sizeof(double)];
      char *v = new char[DoutputValsLen * sizeof(double)];


      // set the output truncation in emoslib

      fortfloat realv[4];
      fortint truncout = DtruncOut;
      fortint e;
      char *int_parameter = "truncation";
      //char *text = "";
      //fortint   intv[4];
      //XXXXintv[0] = DtruncOut;
      //XXXX COMMENTED OUT WITH NEW MARS CLIENT, 21/10/2010 int2_intout("truncation",intv,realv,text);


      //int2_intout("truncation",intv,realv,text);
      e  = intout_(C2FORT(int_parameter),&truncout,realv,C2FORT(0),strlen(int_parameter),0);
      e += intin_ (C2FORT(int_parameter),&truncout,realv,C2FORT(0),strlen(int_parameter),0);

      if (e != 0)
      {
          marslog(LOG_EROR,"Divrot: error when setting output truncation");
          return false;
      }


      // derive u/v using the libMars function

      // err makeuv(char *vo, char *d, long inlen, char *u, char *v, long *outlen);
      marsRet = makeuv(bufferVorticity, bufferDivergence, sizeVorticity, u, v, &DoutputValsLen);

      if (marsRet != 0)
      {
          marslog(LOG_EROR,"Divrot: error converting from VO/D");
          return false;
      }



      grib_handle *ghU = grib_handle_new_from_message(0, u, DoutputValsLen);
      grib_handle *ghV = grib_handle_new_from_message(0, v, DoutputValsLen);

//      repackGribValues (ghU, 24);
//      repackGribValues (ghV, 24);

      appendWindComponent( ghU );     //-- (normal) wind U comp
      appendWindComponent( ghV );     //-- (normal) wind V comp


/*
      if( Dparam == eVorticity )
      {                                      //-- vod2uv_ is in Emoslib
//         vod2uv_( divOrVor, zero, &DtruncIn, U, V, &DtruncOut );
         int2_intuvu( divOrVor, zero, inwords, U, V, &outwords );

//       appendWindComponent( gh, U, 13 );   //-- rotational wind U comp
//       appendWindComponent( gh, V, 14 );   //-- rotational wind V comp
      }
      else // eDivergence
      {                                      //-- vod2uv_ is in Emoslib
//         vod2uv_( zero, divOrVor, &DtruncIn, U, V, &DtruncOut );
         int2_intuvu( zero, divOrVor, inwords, U, V, &outwords );

//       appendWindComponent( gh, U, 11 );   //-- divergent wind U comp
//       appendWindComponent( gh, V, 12 );   //-- divergent wind V comp
      }


      appendWindComponent( gh, U, 131 );     //-- (normal) wind U comp
      appendWindComponent( gh, V, 132 );     //-- (normal) wind V comp
*/

//      delete [] divOrVor;                    //-- delete dynamic arrays
      if (zero) delete [] zero;
      if (u)    delete [] u;
      if (v)    delete [] v;

      grib_handle_delete (ghU);
      grib_handle_delete (ghV);

   }
                                             //-- file to FieldSet and to Request
   MvFieldSet fs( DfileOut.c_str() );
   out = fs.getRequest();

  return true;
}

//_____________________________________________________________________________
//--
//-- This is a copy of Velstr::isValidData_DVVALID.
//-- The original Fortran code is still left in file
//-- ../Velstr/velstr-exFortran.cc
//--
bool
Divrot::isValidData_DVVALID( grib_handle* gh )
{
  const int cBUFLEN = 50;
  char charBuf[ cBUFLEN+1 ];

  size_t len = cBUFLEN;                      //-- is spectral or not?
  int ret = grib_get_string( gh, "gridType", charBuf, &len );
  badRetVal( ret, "grib_get_string/gridType"
           , "Divrot::isValidData_DVVALID" );

  if( string(charBuf) != cSPECTRAL )
  {
     marslog(LOG_EROR,"Divrot: data is '%s', must be spectral ('%s')"
            ,charBuf
            ,cSPECTRAL.c_str() );
     return false;
  }

  long param;
  ret = grib_get_long( gh, "mars.param", &param );
  badRetVal( ret, "grib_get_string/mars.param", "Divrot::isValidData_DVVALID" );

  if ( param == atol(cVORTICITY.c_str()) )
  {
     Dparam = eVorticity;
     return true;
  }

  if ( param == atol(cDIVERGENCE.c_str()) )
  {
     Dparam = eDivergence;
     return true;
  }

  marslog(LOG_EROR
         ,"Divrot: param is '%s', must be vorticity (%s) or divergence (%s)"
         ,charBuf
         ,cVORTICITY.c_str()
         ,cDIVERGENCE.c_str() );
  return false;
}
//_____________________________________________________________________________
//--
//-- This is a copy of Velstr::smooth_BPPSMTH.
//-- The original Fortran code is still left in file
//-- ../Velstr/velstr-exFortran.cc
//--
bool
Divrot::smooth_BPPSMTH( grib_handle* gh )
{
  size_t len = 0;                              //-- data values count
  int ret = grib_get_size( gh, "values", &len );
  badRetVal( ret, "grib_get_size", "Divrot::smooth_BPPSMTH" );

  double* data = new double[len];            //-- get data values
  ret = grib_get_double_array( gh, "values", data, &len );
  badRetVal( ret, "grib_get_double_array", "Divrot::smooth_BPPSMTH" );
#if 0
  long DtruncIn = 0;                          //-- get truncation
  ret = grib_get_long( gh, "pentagonalResolutionParameterJ", &DtruncIn );
  badRetVal( ret, "pentagonalResolutionParameterJ", "Divrot::smooth_BPPSMTH" );
#endif
                                             //-- prepare smoothing stuff
  double fltcons = -1./pow( Dfltc*(Dfltc+1), Dmfltexp );
  sendProgress( "Spatial smoothing, Fltc = %g, Mfltexp = %g"
              , Dfltc, Dmfltexp );
  cout << "Spatial smoothing, Fltc = " << Dfltc
       << ",  Mfltexp = " << Dmfltexp << endl;

  long itinp1 = DtruncOut;  //-- NPREL4
  double* dummy = new double[ itinp1 ];      //-- compute final smoothing coefficients
  dummy[0] = 1.0;
  for( int n=1; n<itinp1; ++n )
  {
     dummy[ n ] = exp( fltcons * pow( (double)(n*(n+1)), Dmfltexp ) );
  }

  int i  = 0;                                //-- do the smoothing
  int ii = 0;
  for( int m=0; m<itinp1; ++m )
  for( int n=m; n<itinp1; ++n )
  {
     data[ ii   ] = dummy[ n ] * data[ i   ];
     data[ ii+1 ] = dummy[ n ] * data[ i+1 ];
     i  += 2;
     ii += 2;
  }
                                             //-- put back the smoothed data
  ret = grib_set_double_array( gh, "values", data, len );
  badRetVal( ret, "grib_set_double_array", "Divrot::smooth_BPPSMTH" );

  delete [] dummy;
  delete [] data;

  return true;
}

bool
Divrot::checkOutputTruncation( grib_handle* gh )
{
  long myTtruncIn = 0;                          //-- get truncation
  int ret = grib_get_long( gh, "pentagonalResolutionParameterJ", &myTtruncIn );
  badRetVal( ret, "pentagonalResolutionParameterJ", "Divrot::checkOutputTruncation" );

  DtruncIn = myTtruncIn;

  if( DtruncOut > DtruncIn )
  {
     marslog( LOG_EROR, "Oops, requested output truncation %d greater than input %d..."
            , DtruncOut, (int)DtruncIn );
     marslog( LOG_EROR, "... setting output truncation to %d", (int)DtruncIn );
     cerr << "Oops, requested output truncation " << DtruncOut
          << " greater than input " << DtruncIn << endl
          << "... setting output truncation to " << DtruncIn << endl;

     DtruncOut = DtruncIn;                       //-- fall back to input truncation

     return false;
  }
  else
     return true;





/*

 useful code?

in MARS:

ACTUALLY

int2_intout("truncation",intv,realv,text))

 only 1st element of intv1 is used.


NOT:
fortint int2_intin(const char* param,fortint iv[],fortfloat dv[],const char* cv)
 {
         if(!cv) cv = "";
         return intin_(param,iv,dv,cv,strlen(param),strlen(cv));
 }
 
 
 Called by MARS:intuvs2, where intv is 1279, realv is unset, text is ""
                 if(err = int2_intin("truncation",intv,realv,text))
                 {
                         fprintf(stderr,"INTUVS2: Truncation  setup INTIN failed %d\n",err);
                         goto cleanup;
                 }

 
*/








}

