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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe LFI
00002       SUBROUTINE LFIINI_MT (LFI, KOPTIO )
00003       USE LFIMOD, ONLY : LFICOM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        CE SOUS-PROGRAMME EST CHARGE DES INITIALISATIONS DU LOGICIEL
00008 C     DE FICHIERS INDEXES LFI .
00009 C**
00010 C        ARGUMENT : KOPTIO  ==> OPTION CONCERNANT LE MODE D'UTILISATION.
00011 C                  (ENTREE)     (MULTI-TACHE OU NON)
00012 C     VALEURS POSSIBLES : 0 ==> MODE MONO-TACHE PRESCRIT
00013 C                         1 ==> MODE MULTI-TACHE PRESCRIT
00014 C                         2 ==> UTILISATION DU MODE PAR DEFAUT SI C'EST
00015 C                               LE PREMIER APPEL; SINON ON GARDE LE MODE
00016 C                               PRESCRIT ANTERIEUREMENT .
00017 C
00018 #ifndef f77
00019 #include "precision.h"
00020 #endif
00021 C
00022       TYPE(LFICOM) :: LFI
00023       INTEGER KOPTIO, JNPAGE, J, JRANG, IREP, INIMES, INUMER, IRGPIM
00024 C
00025       LOGICAL LLNMUL, LLASGN, LLREL
00026 #include "lficom_mt.h"
00027 C
00028       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00029       IF (LHOOK) CALL DR_HOOK('LFIINI_MT',0,ZHOOK_HANDLE)
00030       IF (LFI%LFIINI_LLPREA) THEN
00031 C
00032 C         C'EST LE PREMIER APPEL AU SOUS-PROGRAMME - INITIALISATIONS .
00033 C
00034         LFI%NBFIOU=0
00035         LFI%NFACTM=0
00036         LFI%NULOFM=0
00037         LFI%NUIMEX=0
00038         LFI%NERFAG=1
00039         LFI%NISTAG=1
00040         LFI%NIMESG=1
00041         LFI%NPISAF=0
00042         LFI%LTAMLG=.FALSE.
00043         LFI%LTAMEG=.TRUE.
00044         LFI%LMISOP=.FALSE.
00045         LFI%LFRANC=.TRUE.
00046         LFI%LERFAT(0)=.TRUE.
00047         LFI%NIVMES(0)=0
00048 C
00049 C          L'indice zero dans LFI%MFACTU correspond au facteur multiplicatif
00050 C     "par defaut" .
00051 C
00052 #ifdef HIGHRES
00053         LFI%MFACTU(0)=6
00054 #else
00055         LFI%MFACTU(0)=1
00056 #endif
00057         LFI%MFACTM(0)=0
00058         LFI%NUMAPH(0)=LFI%JPNIL
00059 C
00060         LFI%CFGMXD(0)='locale'
00061         LFI%NBMOSD(0)=LFI%JPNBIM
00062         LFI%NBCASD(0)=LFI%JPNBIC
00063         LFI%CFGMXD(1)='ieee'
00064         LFI%NBMOSD(1)=32
00065         LFI%NBCASD(1)=8
00066         LFI%CFGMXD(2)='ultrix'
00067         LFI%NBMOSD(2)=32
00068         LFI%NBCASD(2)=8
00069         LFI%CFGMXD(3)='ieee_dp'
00070         LFI%NBMOSD(3)=64
00071         LFI%NBCASD(3)=8
00072         LFI%CFGMXD(4)='ultrix_dp'
00073         LFI%NBMOSD(4)=64
00074         LFI%NBCASD(4)=8
00075         LFI%CTYPMX='ircdl'
00076 C
00077         DO 101 JNPAGE=1,LFI%JPNXPI
00078         LFI%MCOPIF(JNPAGE)=LFI%JPNIL
00079         LFI%MRGPIF(JNPAGE)=LFI%JPNIL
00080         LFI%LECRPI(JNPAGE,1)=.FALSE.
00081         LFI%LECRPI(JNPAGE,2)=.FALSE.
00082   101   CONTINUE
00083 C
00084         DO 103 J=1,LFI%JPNPIA
00085 C
00086         DO 102 JRANG=1,LFI%JPNXFI
00087         IRGPIM=JRANG+(J-1)*LFI%JPNXFI
00088         LFI%MCOPIF(IRGPIM)=JRANG
00089         LFI%MRGPIM(J,JRANG)=IRGPIM
00090   102   CONTINUE
00091 C
00092   103   CONTINUE
00093 C
00094         DO 104 JRANG=1,LFI%JPNXFI
00095         LFI%MRGPIF(JRANG)=1
00096         LFI%NUMERO(JRANG)=LFI%JPNIL
00097         LFI%NUMAPH(JRANG)=LFI%JPNIL
00098   104   CONTINUE
00099 C
00100         DO 105 J=1,LFI%JPNCPN
00101         LFI%CHINCO(J:J)='?'
00102   105   CONTINUE
00103 C
00104         DO 106 J=1,LFI%JPIMEX
00105         LFI%MNUIEX(J)=LFI%JPNIL
00106         LFI%NREXPL(0,J)=0
00107   106   CONTINUE
00108 C
00109         LFI%LFIINI_LLPREA=.FALSE.
00110         LLNMUL=(KOPTIO.EQ.1).OR.(KOPTIO.EQ.2.AND.LFI%LFIINI_LLDEFM)
00111         LLASGN=LLNMUL
00112         LLREL=.FALSE.
00113 C
00114       ELSEIF (KOPTIO.EQ.2) THEN
00115 C
00116 C         CE N'EST PAS LE PREMIER APPEL, MAIS COMME L'ARGUMENT VAUT 2,
00117 C         ON LAISSE LES CHOSES EN PLACE .
00118 C
00119         LLNMUL=LFI%LMULTI
00120         LLASGN=.FALSE.
00121         LLREL =.FALSE.
00122       ELSE
00123 C
00124 C     CE N'EST PAS LE PREMIER APPEL ET LE MODE EST PASSE 'EXPLICITEMENT'
00125 C
00126         LLNMUL=KOPTIO.EQ.1
00127         LLASGN=LLNMUL.AND.(.NOT.LFI%LMULTI)
00128         LLREL =(.NOT.LLNMUL).AND.LFI%LMULTI
00129 C
00130         IF ((LLASGN.OR.LLREL).AND.LFI%NBFIOU.NE.0) THEN
00131           IREP=-4
00132           GOTO 1001
00133         ENDIF
00134 C
00135       ENDIF
00136 C
00137       LFI%LMULTI=LLNMUL
00138 C
00139 C        Le controle de coherence ci-dessous ne peut etre fait qu'apres
00140 C     l'initialisation eventuelle des variables globales du logiciel.
00141 C
00142       IF (KOPTIO.LT.0.OR.KOPTIO.GT.2) THEN
00143         IREP=-2
00144         GOTO 1001
00145       ENDIF
00146 C
00147       IREP=0
00148 C
00149       IF (LLASGN) THEN
00150         CALL LFIVER_MT (LFI, LFI%VERGLA,'ASGN')
00151       ELSEIF (LLREL) THEN
00152         CALL LFIVER_MT (LFI, LFI%VERGLA,'REL')
00153       ENDIF
00154 C
00155  1001 CONTINUE
00156 C
00157 C        MESSAGERIE EVENTUELLE, AVEC ABORT SI NECESSAIRE .
00158 C
00159       LLFATA=IREP.NE.0.AND.LFI%NERFAG.NE.2
00160 C
00161       IF (LLFATA) THEN
00162         INIMES=2
00163       ELSEIF (IREP.NE.0) THEN
00164         INIMES=0
00165       ELSEIF (LFI%NIMESG.EQ.2.OR.(LFI%NIMESG.EQ.1.AND.KOPTIO.NE.2)) THEN
00166         INIMES=LFI%NIMESG
00167       ELSE
00168         IF (LHOOK) CALL DR_HOOK('LFIINI_MT',1,ZHOOK_HANDLE)
00169         RETURN
00170       ENDIF
00171 C
00172       CLNSPR='LFIINI'
00173       INUMER=LFI%JPNIL
00174 C
00175       IF (MAX0 (INIMES,LFI%NIMESG).EQ.2) THEN
00176 C
00177         IF (LFI%LFRANC) THEN
00178           WRITE (UNIT=CLMESS,
00179      S           FMT='(''KOPTIO='',I5,'', CODE INTERNE='
00180 ',     S           I4)') KOPTIO,IREP
00181         ELSE
00182           WRITE (UNIT=CLMESS,
00183      S           FMT='(''KOPTIO='',I5,'', INTERNAL CODE='
00184 ',     S           I4)') KOPTIO,IREP
00185         ENDIF
00186 C
00187         IF (INIMES.NE.2) CALL LFIEMS_MT (LFI, INUMER,LFI%NIMESG,IREP,
00188      S                                   .FALSE.,CLMESS,
00189      S                                   CLNSPR,CLACTI)
00190       ENDIF
00191 C
00192       CALL LFIEMS_MT (LFI, INUMER,INIMES,IREP,LLFATA,
00193      S                CLMESS,CLNSPR,CLACTI)
00194 C
00195       IF (INIMES.GE.1.AND.KOPTIO.NE.2) THEN
00196 C
00197 C        Cette messagerie de niveau 1 n'est pas emise en cas d'erreur,
00198 C     meme non fatale.
00199 C
00200         IF (LFI%LFRANC) THEN
00201 C
00202           IF (KOPTIO.EQ.0) THEN
00203             CLMESS='$ Mode MONO-TACHE Prescrit explicitement... $'
00204           ELSE
00205             CLMESS='$ Mode MULTI-TACHE Prescrit explicitement... $'
00206           ENDIF
00207 C
00208         ELSE
00209 C
00210           IF (KOPTIO.EQ.0) THEN
00211             CLMESS='$ MONO-TASKING Mode explicitely Specified... $'
00212           ELSE
00213             CLMESS='$ MULTI-TASKING Mode explicitely Specified... $'
00214           ENDIF
00215 C
00216         ENDIF
00217 C
00218         CALL LFIEMS_MT (LFI, INUMER,INIMES,IREP,.FALSE.,
00219      S                  CLMESS,CLNSPR,CLACTI)
00220       ENDIF
00221 C
00222       IF (LHOOK) CALL DR_HOOK('LFIINI_MT',1,ZHOOK_HANDLE)
00223       END
00224