faiopt.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE faiopt_fort                                             &
&                     (fa,  krep, knumer, ldnomm, cdnomf, cdsttu,  &
&                      lderfa, ldimst, knimes, cdnomc)
USE fa_mod, ONLY : fa_com
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Sous-programme de recuperation des options d'OUVERTURE d'une unite 
!     logique "Fichier ARPEGE".
!     Il s'agit d'un fichier indexe, traite par le logiciel LFI.
!
!**
!     ARGUMENTS : Ce sont les memes que pour "FAITOU", sauf KNBARP
!                 et KNBARI qui ont ete retires
!
!                 KREP   (Sortie) ==> Code-reponse du sous-programme;
!                 KNUMER (Entree) ==> Numero de l'unite logique;
!                 LDNOMM (Sortie) ==> Vrai si l'unite logique doit etre
!                                     associee a un NOM de Fichier EXP-
!                                     LICITE lors de l'"OPEN" FORTRAN;
!                 CDNOMF (Sortie) ==> Nom de fichier explicite, si
!                                     *LDNOMM* est VRAI - Meme si ce
!                                     n'est pas le cas, ce *DOIT* ETRE
!                                     UN OBJET DE TYPE "CHARACTER" .
!                 CDSTTU (Sortie) ==> "STATUS" pour l'"OPEN" FORTRAN
!                                     ('OLD','NEW','UNKNOWN','SCRATCH')
!                                     par defaut, mettre 'UNKNOWN';
!                 LDERFA (Sortie) ==> Option d'erreur fatale;
!                 LDIMST (Sortie) ==> Option impression de Statistiques
!                                     au moment de la fermeture;
!                 KNIMES (Sortie) ==> Niveau de la Messagerie (0,1 ou 2)
!                                     ( 0==>Rien, 2==>Tout )
!                 CDNOMC (Sortie) ==> Nom du CADRE associe au fichier.
!*
!     N.B. :  Pour un fichier en mode creation, ce cadre doit avoir ete
!          defini au prealable (via le sous-programme FACADE, ou par
!          l'ouverture d'un fichier preexistant).
!             Pour un fichier ARPEGE preexistant, le cadre est lu sur le
!          fichier; s'il etait deja defini auparavant, il y a controle
!          de coherence entre les deux versions du cadre.
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KREP, KNUMER, KNIMES
!
CHARACTER CPNOMD*(*)
parameter( cpnomd='%%%%% FICHIER SANS NOM %%%%%' )
!
INTEGER (KIND=JPLIKB) IRANG, IRANGC
LOGICAL LDNOMM, LDERFA, LDIMST
INTEGER (KIND=JPLIKB) IREP
!
CHARACTER CDNOMF*(*), CDSTTU*(*), CDNOMC*(*)
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

irep=0
irang=0
CALL fanumu_fort                  &
&               (fa, knumer, irang)

IF (irang .EQ. 0) THEN
  irep=-1
  GOTO 1001
ENDIF

irangc=fa%FICHIER(irang)%NUCADR
cdnomc=fa%CADRE(irangc)%CNOMCA
ldnomm=fa%FICHIER(irang)%LNOMME
knimes=fa%FICHIER(irang)%NIVOMS
lderfa=fa%FICHIER(irang)%LERRFA
cdnomf=cpnomd
cdsttu=''
ldimst=.false.

IF (ldnomm) THEN
  CALL lfiopt_fort                                        &
&                 (fa%LFI, irep, knumer, ldnomm, cdnomf,  &
&                  cdsttu, lderfa, ldimst, knimes)

  IF (irep .NE. 0) GOTO 1001
ENDIF

1001 CONTINUE
krep=irep
IF (lhook) CALL dr_hook('FAIOPT_MT',1,zhook_handle)
END SUBROUTINE faiopt_fort




! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE faiopt64                                      &
&           (krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, cdnomc)
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)  KNUMER                                 ! IN   
LOGICAL                LDNOMM                                 !   OUT
CHARACTER (LEN=*)      CDNOMF                                 !   OUT
CHARACTER (LEN=*)      CDSTTU                                 !   OUT
LOGICAL                LDERFA                                 !   OUT
LOGICAL                LDIMST                                 !   OUT
INTEGER (KIND=JPLIKB)  KNIMES                                 !   OUT
CHARACTER (LEN=*)      CDNOMC                                 !   OUT

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faiopt_fort                                             &
&           (fa, krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, cdnomc)

END SUBROUTINE faiopt64

SUBROUTINE faiopt                                        &
&           (krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, cdnomc)
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)  KNUMER                                 ! IN   
LOGICAL                LDNOMM                                 !   OUT
CHARACTER (LEN=*)      CDNOMF                                 !   OUT
CHARACTER (LEN=*)      CDSTTU                                 !   OUT
LOGICAL                LDERFA                                 !   OUT
LOGICAL                LDIMST                                 !   OUT
INTEGER (KIND=JPLIKM)  KNIMES                                 !   OUT
CHARACTER (LEN=*)      CDNOMC                                 !   OUT

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faiopt_mt                                               &
&           (fa, krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, cdnomc)

END SUBROUTINE faiopt

SUBROUTINE faiopt_mt                                         &
&           (fa, krep, knumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, knimes, cdnomc)
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)  KNUMER                                 ! IN   
LOGICAL                LDNOMM                                 !   OUT
CHARACTER (LEN=*)      CDNOMF                                 !   OUT
CHARACTER (LEN=*)      CDSTTU                                 !   OUT
LOGICAL                LDERFA                                 !   OUT
LOGICAL                LDIMST                                 !   OUT
INTEGER (KIND=JPLIKM)  KNIMES                                 !   OUT
CHARACTER (LEN=*)      CDNOMC                                 !   OUT
! Local integers
INTEGER (KIND=JPLIKB)  IREP                                   !   OUT
INTEGER (KIND=JPLIKB)  INUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  INIMES                                 !   OUT
! Convert arguments

inumer     = int(    knumer, jplikb)

CALL faiopt_fort                                             &
&           (fa, irep, inumer, ldnomm, cdnomf, cdsttu, lderfa, &
&           ldimst, inimes, cdnomc)

krep       = int(      irep, jplikm)
knimes     = int(    inimes, jplikm)

END SUBROUTINE faiopt_mt

!INTF KREP            OUT 
!INTF KNUMER        IN    
!INTF LDNOMM          OUT 
!INTF CDNOMF          OUT 
!INTF CDSTTU          OUT 
!INTF LDERFA          OUT 
!INTF LDIMST          OUT 
!INTF KNIMES          OUT 
!INTF CDNOMC          OUT