famiso.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE famiso_fort             &
&                     (fa,  ldebug )
USE fa_mod, ONLY : fa_com, jpniil
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Ce sous-programme permet d'activer ou de desactiver le mode
!     "Mise au point du logiciel". ( par defaut, inactif )
!        A noter que le mode "mise au point" du logiciel LFI n'est pas
!     modifie.
!**
!        Argument : LDEBUG (Entree) ==> Vrai si on doit activer ce mode.
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) IREP, INUMER, INIMES
!
LOGICAL LDEBUG
CHARACTER(LEN=FA%JPXNOM) CLACTI 
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR

!
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAMISO_MT',0,zhook_handle)
clacti=''
IF (fa%FAMISO_LLPREA) THEN
  CALL farine_fort              &
&                 (fa, 2_jplikb )
  fa%FAMISO_LLPREA=.false.
ENDIF
!
fa%LFAMOP=ldebug
!
!  Prise en compte du niveau de messagerie dans GRIBEX
!
!IF (FA%LFAMOP) THEN
!  CALL GRSDBG(1)
!ELSE
!  CALL GRSDBG(0)
!ENDIF
!
!        MESSAGERIE EVENTUELLE .
!
IF (fa%NIMSGA.NE.2)  THEN 
  IF (lhook) CALL dr_hook('FAMISO_MT',1,zhook_handle)
  RETURN
ENDIF
inumer=jpniil
inimes=2
irep=0
clnspr='FAMISO'
WRITE (unit=clmess,fmt='(''LDEBUG= '',L1)') ldebug
CALL faipar_fort                                      &
&               (fa, inumer,inimes,irep,.false.,clmess, &
&                clnspr,clacti,.false.)
!
IF (lhook) CALL dr_hook('FAMISO_MT',1,zhook_handle)
END SUBROUTINE famiso_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE famiso64           &
&           (ldebug)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
LOGICAL                LDEBUG                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL famiso_fort           &
&           (fa, ldebug)

END SUBROUTINE famiso64

SUBROUTINE famiso             &
&           (ldebug)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
LOGICAL                LDEBUG                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL famiso_mt             &
&           (fa, ldebug)

END SUBROUTINE famiso

SUBROUTINE famiso_mt             &
&           (fa, ldebug)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
LOGICAL                LDEBUG                                 ! IN   
! Local integers
! Convert arguments


CALL famiso_fort           &
&           (fa, ldebug)


END SUBROUTINE famiso_mt

!INTF LDEBUG        IN