SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/FA/mt/falimu

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FALIMU_MT (FA,  KXNIVV, KXTRON, KXLATI, KXLONG )
00003       USE FA_MOD, ONLY : FA_COM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        Sous-programme servant a obtenir les valeurs courantes
00008 C     des LIMites Utilisateur en termes de Resolutions horizontale
00009 C     et verticale, valides globalement pour tous les Fichiers et Cadres
00010 C     ARPEGE manipules par le programme utilisateur.
00011 C**
00012 C        Arguments : KXNIVV ==> Nombre maximum de niveaux verticaux;
00013 C  (tous de Sortie)  KXTRON ==> Troncature maximum;
00014 C                    KXLATI ==> Nombre maximum de latitudes pole a pole;
00015 C                    KXLONG ==> Nombre maxi de longitudes par parallele.
00016 C
00017 #include "precision.h"
00018 C
00019 C
00020       TYPE(FA_COM) :: FA
00021       INTEGER KXNIVV, KXTRON, KXLATI, KXLONG
00022 C
00023       INTEGER INUMER, INIMES, IREP
00024 C
00025       LOGICAL LLVERG
00026 C
00027 C
00028 C
00029 #include "facom2.h"
00030 #include "facom_mt.h"
00031 C**
00032 C     1.  -  SI PREMIERE UTILISATION, APPEL AU SOUS-PROGRAMME "FARINE".
00033 C-----------------------------------------------------------------------
00034 C
00035       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00036       IF (LHOOK) CALL DR_HOOK('FALIMU_MT',0,ZHOOK_HANDLE)
00037       IF (FA%FALIMU_LLPREA) THEN
00038         CALL FARINE_MT (FA, 2)
00039         FA%FALIMU_LLPREA=.FALSE.
00040       ENDIF
00041 C
00042 C             Verrouillage global, si necessaire.
00043 C
00044       IF (FA%LFAMUL) CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'ON')
00045       LLVERG=FA%LFAMUL
00046 C**
00047 C     2.  -  RECOPIE DES VALEURS EN COMMON DANS LES ARGUMENTS.
00048 C-----------------------------------------------------------------------
00049 C
00050       KXNIVV=FA%NXNIVV
00051       KXTRON=FA%NXTRON
00052       KXLATI=FA%NXLATI
00053       KXLONG=FA%NXLONG
00054 C**
00055 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00056 C            VIA LE sous-programme "FAIPAR" .
00057 C-----------------------------------------------------------------------
00058 C
00059  1001 CONTINUE
00060 C
00061 C          Deverrouillage global eventuel.
00062 C
00063       IF (LLVERG) CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'OFF')
00064 C
00065       IF (FA%NIMSGA.EQ.2) THEN
00066         IREP=0
00067         INIMES=2
00068         CLNSPR='FALIMU'
00069         INUMER=FA%JPNIIL
00070         WRITE (UNIT=CLMESS,FMT='(''KXNIVV='',I4,'', KXTRON='
00071 ',I4,     S         '', KXLATI='',I4,'', KXLONG='',I4)')
00072      S     KXNIVV,KXTRON,KXLATI,KXLONG
00073         CALL FAIPAR_MT (FA, INUMER,INIMES,IREP,LLFATA,CLMESS,
00074      S               CLNSPR,CLACTI,.FALSE.)
00075       ENDIF
00076 C
00077       IF (LHOOK) CALL DR_HOOK('FALIMU_MT',1,ZHOOK_HANDLE)
00078       END
00079