fagiot.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE fagiot_fort                                              &
&                     (fa,  kngrib, knarg1, knarg2, knarg3, knarg4, &
&                      knarg5)
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 de modifier les options implicites
!     liees au codage GRIB des champs.
!     CES OPTIONS NE SONT UTILISEES QUE POUR (RE)ECRIRE DES CHAMPS
!     codes en GRIB, et les nouvelles valeurs implicites ne serviront
!     que LORS d'une OUVERTURE de FICHIER ULTERIEURE.
!       ( Grib, Implicites Options Techniques )
!**
!     Arguments : KNGRIB (Entree) ==> Niveau de codage GRIB (-1,0,1,2,3);
!                 KNARG1 (Entree) ==> Nombre de bits par valeur point-
!                                     de-grille;
!                 KNARG2 (Entree) ==> Nombre de bits par partie reelle/
!                                     imaginaire de coeff. spectral;
!                 KNARG3 (Entree) ==> Sous-troncature non compactee;
!                 KNARG4 (Entree) ==> Puissance de laplacien;
!                 KNARG5 (Entree) ==> Degre de modulation de KNARG4.
!
!     N.B.: Il doit y avoir coherence vis-a-vis des cadres deja definis
!           et vis-a-vis des limites usagers.
!           ( ce qui en pratique, ne concerne que KNARG3 )
!
!     Remarque:  KNARG3 egal a -1 est accepte, et dans ce cas
!                on indexera (a chaque ouverture de fichier) la sous-
!                troncature effective sur la troncature.
!
!      MODIF 30/03/2007 JM AUDOIN FA%LFAMOP pour limiter IMPRESSION
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KNGRIB, KNARG1, KNARG2
INTEGER (KIND=JPLIKB) KNARG3, KNARG4, KNARG5
!
INTEGER (KIND=JPLIKB) IMINIM, IREP, INIMES
INTEGER (KIND=JPLIKB) INUMER, J, IRANGC
!
LOGICAL LLVERG
!
!
!
CHARACTER(LEN=FA%JPXNOM) CLACTI 
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR
LOGICAL                  LLFATA

!**
!     1.  -  CONTROLES ET INITIALISATIONS.
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAGIOT_MT',0,zhook_handle)
clacti=''
IF (fa%FAGIOT_LLPREA) THEN
!
!          A la premiere utilisation, appel au sous-programme "FARINE".
!
  CALL farine_fort             &
&                (fa, 2_jplikb )
  fa%FAGIOT_LLPREA=.false.
ENDIF
!
llverg=.false.
iminim=min(2+kngrib,2+knarg1,2+knarg2,2+knarg3,1+knarg5)
!
IF (iminim.LE.0) THEN
  irep=-64
  GOTO 1001
ELSEIF (knarg1*knarg2.EQ.0) THEN
  irep=-64
  GOTO 1001
ELSEIF (kngrib.GT.3 .AND. .NOT. falgra(kngrib)) THEN
  irep=-96
  GOTO 1001
ELSEIF (max(knarg1,knarg2).GT.fa%NBIMAX) THEN
  irep=-97
  GOTO 1001
ELSEIF (abs(knarg4).GT.2**15-1) THEN
  irep=-98
  GOTO 1001
ENDIF
!
!         Verrouillage global eventuel.
!
IF (fa%LFAMUL) CALL lfiver_fort                        &
&                              (fa%LFI, fa%VRGLAS,'ON')
llverg=fa%LFAMUL
!
IF (knarg3.GE.fa%NXTRON) THEN
  irep=-113
  GOTO 1001
ENDIF
!
!        Coherence de "KNARG3" vis-a-vis de la troncature des cadres
!     deja definis.
!
DO j=1,fa%NCADEF
irangc=fa%NCAIND(j)
!
IF (knarg3.GE.fa%CADRE(irangc)%MTRONC) THEN
  irep=-99
  GOTO 1001
ENDIF
!
ENDDO
!**
!     2.  -  STOCKAGE DES NOUVEAUX PARAMETRES.
!-----------------------------------------------------------------------
!
IF (fa%LFAMOP.AND.(fa%NIGRIB.EQ.-1.OR.fa%NIGRIB.EQ.3).AND. &
&    (kngrib.GT.-1.AND.kngrib.LT.3))     THEN
  WRITE (unit=fa%NULOUT,fmt=*)'-----------------'
  WRITE (unit=fa%NULOUT,fmt=*)                                   &
&          'FAGIOT: CAUTION!! Les champs spectraux ARPEGE ne',    &
&          ' devront pas etre ranges comme dans le modele ARPEGE'
  WRITE (unit=fa%NULOUT,fmt=*)'-----------------'
ENDIF
IF (fa%LFAMOP.AND.(kngrib.EQ.-1.OR.kngrib.EQ.3).AND. &
&    (fa%NIGRIB.GT.-1.AND.fa%NIGRIB.LT.3))     THEN
  WRITE (unit=fa%NULOUT,fmt=*)'-----------------'
  WRITE (unit=fa%NULOUT,fmt=*)                                     &
&          'FAGIOT: CAUTION!! Les champs spectraux ARPEGE devront', &
&          ' etre ranges comme dans le modele ARPEGE'
  WRITE (unit=fa%NULOUT,fmt=*)'-----------------'
ENDIF
fa%NIGRIB=kngrib
fa%NBIPDG=knarg1
fa%NBICSP=knarg2
fa%NSTROI=knarg3
fa%NPUILA=knarg4
fa%NMIDPL=knarg5
irep=0
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
!            VIA LE SOUS-PROGRAMME "FAIPAR" .
!-----------------------------------------------------------------------
!
1001 CONTINUE
llfata=llmoer(irep,0_jplikb )
!
!        Deverrouillage global eventuel.
!
IF (llverg) CALL lfiver_fort                         &
&                           (fa%LFI, fa%VRGLAS,'OFF')
!
IF (llfata) THEN
  inimes=2
ELSE
  inimes=fa%NIMSGA
ENDIF
!
IF (.NOT.llfata.AND.inimes.NE.2)  THEN 
  IF (lhook) CALL dr_hook('FAGIOT_MT',1,zhook_handle)
  RETURN
ENDIF
!
clnspr='FAGIOT'
!
WRITE (unit=clmess,fmt='(''KNGRIB='',I2,'', KNARG1='',I3,  &
&       '', KNARG2='',I3,'', KNARG3='',I2,'', KNARG4='',I3, &
&       '', KNARG5='',I3)')                                 &
&   kngrib,knarg1,knarg2,knarg3,knarg4,knarg5
inumer=jpniil
CALL faipar_fort                                     &
&               (fa, inumer,inimes,irep,llfata,clmess, &
&                clnspr,clacti,.false.)
!
IF (lhook) CALL dr_hook('FAGIOT_MT',1,zhook_handle)

CONTAINS

#include "facom2.llmoer.h"
#include "falgra.h"

END SUBROUTINE fagiot_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE fagiot64                                        &
&           (kngrib, knarg1, knarg2, knarg3, knarg4, knarg5)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KNGRIB                                 ! IN   
INTEGER (KIND=JPLIKB)  KNARG1                                 ! IN   
INTEGER (KIND=JPLIKB)  KNARG2                                 ! IN   
INTEGER (KIND=JPLIKB)  KNARG3                                 ! IN   
INTEGER (KIND=JPLIKB)  KNARG4                                 ! IN   
INTEGER (KIND=JPLIKB)  KNARG5                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fagiot_fort                                               &
&           (fa, kngrib, knarg1, knarg2, knarg3, knarg4, knarg5)

END SUBROUTINE fagiot64

SUBROUTINE fagiot                                          &
&           (kngrib, knarg1, knarg2, knarg3, knarg4, knarg5)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KNGRIB                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG1                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG2                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG3                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG4                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG5                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fagiot_mt                                                 &
&           (fa, kngrib, knarg1, knarg2, knarg3, knarg4, knarg5)

END SUBROUTINE fagiot

SUBROUTINE fagiot_mt                                           &
&           (fa, kngrib, knarg1, knarg2, knarg3, knarg4, knarg5)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KNGRIB                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG1                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG2                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG3                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG4                                 ! IN   
INTEGER (KIND=JPLIKM)  KNARG5                                 ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  INGRIB                                 ! IN   
INTEGER (KIND=JPLIKB)  INARG1                                 ! IN   
INTEGER (KIND=JPLIKB)  INARG2                                 ! IN   
INTEGER (KIND=JPLIKB)  INARG3                                 ! IN   
INTEGER (KIND=JPLIKB)  INARG4                                 ! IN   
INTEGER (KIND=JPLIKB)  INARG5                                 ! IN   
! Convert arguments

ingrib     = int(    kngrib, jplikb)
inarg1     = int(    knarg1, jplikb)
inarg2     = int(    knarg2, jplikb)
inarg3     = int(    knarg3, jplikb)
inarg4     = int(    knarg4, jplikb)
inarg5     = int(    knarg5, jplikb)

CALL fagiot_fort                                               &
&           (fa, ingrib, inarg1, inarg2, inarg3, inarg4, inarg5)


END SUBROUTINE fagiot_mt

!INTF KNGRIB        IN    
!INTF KNARG1        IN    
!INTF KNARG2        IN    
!INTF KNARG3        IN    
!INTF KNARG4        IN    
!INTF KNARG5        IN