fagrtw.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE fagrtw_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 :: IOST

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

krep=0

IF (.NOT. ASSOCIATED (fa%YGR1TAB)) THEN
  CALL faicor_fort (fa)
ENDIF

iost = 0

WRITE (kunit, '("VERSION = ",I10)', err=999, iostat=iost) 1                
WRITE (kunit, '(I10)', err=999, iostat=iost) SIZE (fa%YGR1TAB) 

DO jj = 1, SIZE (fa%YGR1TAB)
  WRITE (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

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

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

END SUBROUTINE fagrtw_fort

! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE fagrtw64                    &
&           (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 fagrtw_fort                           &
&           (fa, krep, kunit)

END SUBROUTINE fagrtw64

SUBROUTINE fagrtw                      &
&           (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 fagrtw_mt                             &
&           (fa, krep, kunit)

END SUBROUTINE fagrtw

SUBROUTINE fagrtw_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 fagrtw_fort                           &
&           (fa, irep, iunit)

krep       = int(      irep, jplikm)

END SUBROUTINE fagrtw_mt

!INTF KREP            OUT
!INTF KUNIT         IN