fagrtr.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE fagrtr_fort           &
&                     (fa, krep, kunit)
USE fa_mod, ONLY : fa_com, fagr1tab
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KREP, KUNIT
!
INTEGER (KIND=JPLIKB) JJ
INTEGER (KIND=JPLIKB) IVERS

INTEGER :: IOST

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

krep=0

IF (ASSOCIATED (fa%YGR1TAB)) THEN
  DEALLOCATE (fa%YGR1TAB)
  NULLIFY (fa%YGR1TAB)
ENDIF

iost = 0

READ (kunit, '("VERSION = ",I10)', err=999, iostat=iost) ivers

SELECT CASE (ivers)
  CASE (1)
    CALL fagrtr_fort_v1
  CASE DEFAULT
    WRITE (fa%NULOUT, *) "UNKNOWN VERSION :", ivers
    CALL sdl_srlabort
END SELECT

999 CONTINUE

IF (iost /= 0) THEN
  krep = iost
ENDIF

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

CONTAINS

SUBROUTINE fagrtr_fort_v1

READ (kunit, '(I10)', err=999, iostat=iost) fa%NBPARC
ALLOCATE (fa%YGR1TAB (fa%NBPARC))

DO jj = 1, fa%NBPARC
  READ (kunit, '(" | ",A8," | ",A24," | ",7I10," | ",L1," | ",E23.16," | ",L1," | ")', &
&       err=999, iostat=iost)                                                          &
&       fa%YGR1TAB (jj)%CIPREF, fa%YGR1TAB (jj)%CISUFF, fa%YGR1TAB (jj)%NCODPA(1:7),   &
&       fa%YGR1TAB (jj)%LFNIVA, fa%YGR1TAB (jj)%FMULTI, fa%YGR1TAB (jj)%LMULTI
ENDDO

999 CONTINUE

END SUBROUTINE fagrtr_fort_v1

END SUBROUTINE fagrtr_fort

! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE fagrtr64                    &
&           (krep, kunit)
USE fa_mod, ONLY : fa => fa_com_default, &
&                  fa_com_default_init,  &
&                  new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KREP                                   !   OUT
INTEGER (KIND=JPLIKB)  KUNIT                                  ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fagrtr_fort                           &
&           (fa, krep, kunit)

END SUBROUTINE fagrtr64

SUBROUTINE fagrtr                      &
&           (krep, kunit)
USE fa_mod, ONLY : fa => fa_com_default, &
&                  fa_com_default_init,  &
&                  new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KUNIT                                  ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fagrtr_mt                             &
&           (fa, krep, kunit)

END SUBROUTINE fagrtr

SUBROUTINE fagrtr_mt                       &
&           (fa, krep, kunit)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KUNIT                                  !   OUT
! Local integers
INTEGER (KIND=JPLIKB)  IREP                                   !   OUT
INTEGER (KIND=JPLIKB)  IUNIT                                  ! IN   
! Convert arguments

iunit      = int(     kunit, jplikb)

CALL fagrtr_fort                           &
&           (fa, irep, iunit)

krep       = int(      irep, jplikm)

END SUBROUTINE fagrtr_mt

!INTF KREP            OUT
!INTF KUNIT         IN