SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/LFI/mt/lfifmd

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIFMD_MT (LFI, KFACMD )
00003       USE LFIMOD, ONLY : LFICOM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        Ce sous-programme permet de changer le Facteur Multiplicatif
00008 C     par Defaut du logiciel de fichiers indexes LFI.
00009 C        Apres appel reussi a ce sous-programme, toute ouverture d'unite
00010 C     logique LFI pour laquelle il n'y a pas de facteur multiplicatif
00011 C     predefini (via *LFIAFM*) se fera en traitant le fichier avec une
00012 C     longueur PHYSIQUE d'article de LFI%JPLARD*KFACMD mots.
00013 C
00014 C        La valeur implicite de ce Facteur Multiplicatif par Defaut est
00015 C     definie dans *LFIINI* ( en l'occurrence, il s'agit de 1 ) .
00016 C**
00017 C       ARGUMENT  : KFACMD (Entree) ==> Facteur Multiplicatif par Defaut
00018 C
00019 #ifndef f77
00020 #include "precision.h"
00021 #endif
00022 C
00023       TYPE(LFICOM) :: LFI
00024       INTEGER KFACMD, INIMES, IREP, INUMER
00025 #include "lficom_mt.h"
00026 C
00027       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00028       IF (LHOOK) CALL DR_HOOK('LFIFMD_MT',0,ZHOOK_HANDLE)
00029       IF (LFI%LFIFMD_LLPREA) THEN
00030         CALL LFIINI_MT (LFI, 2)
00031         LFI%LFIFMD_LLPREA=.FALSE.
00032       ENDIF
00033 C
00034       IF (KFACMD.LE.0) THEN
00035         IREP=-14
00036       ELSEIF (KFACMD.GT.LFI%JPFACX) THEN
00037         IREP=-28
00038       ELSE
00039         IREP=0
00040 C
00041 C          Modification, sous Verrouillage Global eventuel.
00042 C
00043         IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'ON')
00044 C
00045         LFI%MFACTU(0)=KFACMD
00046 C
00047         IF (LFI%LMULTI) CALL LFIVER_MT (LFI, LFI%VERGLA,'OFF')
00048       ENDIF
00049 C
00050 C        MESSAGERIE EVENTUELLE, AVEC ABORT SI NECESSAIRE .
00051 C
00052       LLFATA=IREP.NE.0.AND.LFI%NERFAG.NE.2
00053 C
00054       IF (LLFATA) THEN
00055         INIMES=2
00056       ELSEIF (IREP.NE.0) THEN
00057         INIMES=0
00058       ELSEIF (LFI%NIMESG.EQ.0) THEN
00059         IF (LHOOK) CALL DR_HOOK('LFIFMD_MT',1,ZHOOK_HANDLE)
00060         RETURN
00061       ELSE
00062         INIMES=LFI%NIMESG
00063       ENDIF
00064 C
00065       CLNSPR='LFIFMD'
00066       INUMER=LFI%JPNIL
00067 C
00068       IF (INIMES.EQ.2) THEN
00069 C
00070         IF (LFI%LFRANC) THEN
00071           WRITE (UNIT=CLMESS,
00072      S           FMT='(''KFACMD='',I5,'', CODE INTERNE='
00073 ',     S           I4)') KFACMD,IREP
00074         ELSE
00075           WRITE (UNIT=CLMESS,
00076      S           FMT='(''KFACMD='',I5,'', INTERNAL CODE='
00077 ',     S           I4)') KFACMD,IREP
00078         ENDIF
00079 C
00080         CALL LFIEMS_MT (LFI, INUMER,INIMES,IREP,LLFATA,
00081      S                  CLMESS,CLNSPR,CLACTI)
00082       ENDIF
00083 C
00084       IF (INIMES.GE.1) THEN
00085 C
00086         IF (LFI%LFRANC) THEN
00087           WRITE (UNIT=CLMESS,FMT=
00088      S         '(''Reglage du Facteur Multiplicatif par Defaut a'',I3)')
00089      S         KFACMD
00090         ELSE
00091           WRITE (UNIT=CLMESS,FMT=
00092      S         '(''Default Multiply Factor set to'',I3)')
00093      S         KFACMD
00094         ENDIF
00095 C
00096       ENDIF
00097 C
00098       CALL LFIEMS_MT (LFI, INUMER,INIMES,IREP,LLFATA,
00099      S                CLMESS,CLNSPR,CLACTI)
00100 C
00101       IF (LHOOK) CALL DR_HOOK('LFIFMD_MT',1,ZHOOK_HANDLE)
00102       END
00103