faigra.F90

Go to the documentation of this file.

SUBROUTINE faigra_fort (FA)

USE fa_mod, ONLY : ngrib2_glo_sh, ngrib2_glo_gp, ngrib2_lam_gp, &
                 & ngrib2_lam_bf, ngrib2_latlon, ngrib1_latlon, &
                 & lgrib2_lam_ex, lgrib2_lam_bf, lgrib2_init,   &
                 & fa_com
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
USE grib_api_interface
USE grib_api

IMPLICIT NONE

!****
!      Sous-programme de lecture des templates GRIB2.
!**
!

type(fa_com) :: fa

INTEGER :: IGRIB2_LAM_BF, IRET, IGRIBH

REAL (KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('FAIGRA_MT',0,zhook_handle)

!#define FAGRIB2
#ifdef FAGRIB2
!$OMP CRITICAL
IF (.NOT. lgrib2_init) THEN
  CALL igrib_new_from_samples (ngrib1_latlon,  'regular_ll_pl_grib1')
  CALL igrib_new_from_samples (ngrib2_latlon,  'regular_ll_pl_grib2')
  CALL igrib_new_from_samples (ngrib2_glo_sh,  'sh_ml_grib2')
  CALL igrib_new_from_samples (ngrib2_glo_gp,  'reduced_gg_ml_grib2')
  CALL igrib_new_from_samples (ngrib2_lam_gp,  'reduced_gg_ml_grib2')
  CALL igrib_new_from_samples (igrib2_lam_bf,  'lambert_bf_grib2', kret=iret)
  IF (iret == 0) THEN
    ngrib2_lam_bf = igrib2_lam_bf
    lgrib2_lam_bf = .true.
  ELSE
    WRITE (fa%NULOUT, '(A)') "FAIGRA: grib_api template `lambert_bf_grib2' was not found; &
                            &it will not be possible to encode spectral LAM fields with grib_api"
  ENDIF

! See if lambert_lam is available
  CALL igrib_clone (ngrib2_lam_gp, igribh)
  CALL igrib_set_value (igribh, 'gridType', 'lambert_lam', kret=iret)
  lgrib2_lam_ex = iret == 0
  CALL igrib_release (igribh)

  lgrib2_init = .true.
ENDIF
!$OMP END CRITICAL
#endif

IF (lhook) CALL dr_hook('FAIGRA_MT',1,zhook_handle)

END SUBROUTINE

SUBROUTINE faigra
USE fa_mod, ONLY : fa => fa_com_default, &
&                  fa_com_default_init,  &
&                  new_fa_default
IF (.NOT. fa_com_default_init) CALL new_fa_default ()
CALL faigra_fort (fa)
END SUBROUTINE

SUBROUTINE faigra64
USE fa_mod, ONLY : fa => fa_com_default, &
&                  fa_com_default_init,  &
&                  new_fa_default
IF (.NOT. fa_com_default_init) CALL new_fa_default ()
CALL faigra_fort (fa)
END SUBROUTINE

SUBROUTINE faigra_mt (FA)
USE fa_mod, ONLY : fa_com
type(fa_com) :: fa
CALL faigra_fort (fa)
END SUBROUTINE