facodega.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE facodega                                            &
&          (pfdata, klenf, kbits, knbit, kb1par, kb2par,       &
&           pvert, klenv, kgrib, kleng, kword, kround, kcpack, &
&           kscalp, kerr, pmin, pmax, ldarpe)
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KLENF                                  ! IN   
REAL (KIND=JPDBLR)     PFDATA     (klenf)                     ! IN   
INTEGER (KIND=JPLIKB)  KBITS                                  ! IN   
INTEGER (KIND=JPLIKB)  KNBIT                                  ! IN   
INTEGER (KIND=JPLIKB)  KB1PAR     (19)                        ! INOUT
INTEGER (KIND=JPLIKB)  KB2PAR     (17)                        ! INOUT
INTEGER (KIND=JPLIKB)  KLENV                                  ! IN   
REAL (KIND=JPDBLR)     PVERT      (klenv)                     ! IN   
INTEGER (KIND=JPLIKB)  KLENG                                  ! IN   
INTEGER (KIND=JPLIKB)  KGRIB      (kleng)                     !   OUT
INTEGER (KIND=JPLIKB)  KWORD                                  !   OUT
INTEGER (KIND=JPLIKB)  KROUND                                 ! IN   
INTEGER (KIND=JPLIKB)  KCPACK                                 ! IN   
INTEGER (KIND=JPLIKB)  KSCALP                                 ! IN   
INTEGER (KIND=JPLIKB)  KERR                                   !   OUT
REAL (KIND=JPDBLD)     PMIN                                   !   OUT
REAL (KIND=JPDBLD)     PMAX                                   !   OUT
LOGICAL                LDARPE                                 ! IN   
! Local integers
INTEGER (KIND=JPLIKM)  ILENF                                  ! IN   
INTEGER (KIND=JPLIKM)  IBITS                                  ! IN   
INTEGER (KIND=JPLIKM)  INBIT                                  ! IN   
INTEGER (KIND=JPLIKM)  IB1PAR     (19)                        ! INOUT
INTEGER (KIND=JPLIKM)  IB2PAR     (17)                        ! INOUT
INTEGER (KIND=JPLIKM)  ILENV                                  ! IN   
INTEGER (KIND=JPLIKM)  ILENG                                  ! IN   
INTEGER (KIND=JPLIKM)  IWORD                                  !   OUT
INTEGER (KIND=JPLIKM)  IROUND                                 ! IN   
INTEGER (KIND=JPLIKM)  ICPACK                                 ! IN   
INTEGER (KIND=JPLIKM)  ISCALP                                 ! IN   
INTEGER (KIND=JPLIKM)  IERR                                   !   OUT
! Local reals
REAL (KIND=JPDBLD)     ZFDATA     (klenf)                     ! IN   
REAL (KIND=JPDBLD)     ZVERT      (klenv)                     ! IN   
! Convert arguments

ilenf      = int(     klenf, jplikm)
ibits      = int(     kbits, jplikm)
inbit      = int(     knbit, jplikm)
ib1par     = int(    kb1par, jplikm)
ib2par     = int(    kb2par, jplikm)
ilenv      = int(     klenv, jplikm)
ileng      = int(     kleng, jplikm)
iround     = int(    kround, jplikm)
icpack     = int(    kcpack, jplikm)
iscalp     = int(    kscalp, jplikm)

IF (jpdblr == jpdbld) THEN

  CALL codega                                                     &
  &           (pfdata, ilenf, ibits, inbit, ib1par, ib2par,       &
  &            pvert, ilenv, kgrib, ileng, iword, iround, icpack, &
  &            iscalp, ierr, pmin, pmax, ldarpe)

ELSE

  zfdata = real(pfdata, jpdbld)
  zvert  = real( pvert, jpdbld)

  CALL codega                                                     &
  &           (zfdata, ilenf, ibits, inbit, ib1par, ib2par,       &
  &            zvert, ilenv, kgrib, ileng, iword, iround, icpack, &
  &            iscalp, ierr, pmin, pmax, ldarpe)

ENDIF

kb1par     = int(    ib1par, jplikb)
kb2par     = int(    ib2par, jplikb)
kword      = int(     iword, jplikb)
kerr       = int(      ierr, jplikb)

END SUBROUTINE facodega