SURFEX v8.1
General documentation of Surfex
lfiled.F90
Go to the documentation of this file.
1 ! Oct-2012 P. Marguinaud 64b LFI
2 ! Jan-2011 P. Marguinaud Thread-safe LFI
3 ! Sep-2012 P. Marguinaud Fix out of 72 character limit code
4 SUBROUTINE lfiled_fort &
5 & (lfi, krep, krang, ktab, klong, krgpim, &
6 & kposex, kretin )
7 USE lfimod, ONLY : lficom
8 USE parkind1, ONLY : jprb
9 USE yomhook , ONLY : lhook, dr_hook
10 USE lfi_precision
11 IMPLICIT NONE
12 !****
13 ! SOUS-PROGRAMME *INTERNE* DU LOGICIEL DE FICHIERS INDEXES LFI
14 ! LECTURE DES DONNEES PROPREMENT DITES, UNE FOIS L'ARTICLE LOGIQUE
15 ! DEFINI (PAR NOM, OU PAR POSITION) .
16 !**
17 ! ARGUMENTS : KREP (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
18 ! KRANG (ENTREE) ==> RANG ( DANS LA TABLE *LFI%NUMERO* )
19 ! DE L'UNITE LOGIQUE CONCERNEE;
20 ! KTAB (ENTREE) ==> PREMIER MOT A LIRE;
21 ! KLONG (ENTREE) ==> LONGUEUR DE L'ARTICLE A LIRE;
22 ! KRGPIM (ENTREE) ==> RANG DANS LES TABLES LFI%CNOMAR,LFI%MLGPOS,
23 ! ETC. DE LA P.P.I. OU FIGURE
24 ! L'ARTICLE;
25 ! KPOSEX (ENTREE) ==> POSITION ( DANS LE FICHIER ) OU
26 ! COMMENCER A LIRE L'ARTICLE;
27 ! KRETIN (SORTIE) ==> CODE-RETOUR INTERNE.
28 !
29 !
30 TYPE(lficom) :: LFI
31 INTEGER (KIND=JPLIKB) KREP, KRANG, KLONG, KRGPIM
32 INTEGER (KIND=JPLIKB) KPOSEX, KRETIN
33 INTEGER (KIND=JPLIKB) KTAB (klong), IFOURT (lfi%jplarx)
34 INTEGER (KIND=JPLIKB) INUCPL (lfi%jpnpdf), INAPHY
35 INTEGER (KIND=JPLIKB) INUMER, ILARPH
36 INTEGER (KIND=JPLIKB) IPODEB, IPOFIN
37 INTEGER (KIND=JPLIKB) IARDEB, IARFIN, IDCDEB, IDCFIN
38 INTEGER (KIND=JPLIKB) ICPLTI, ICPLTF, ICPTTN
39 INTEGER (KIND=JPLIKB) ICPTTX, INCPLT, INUMAP, J, JD
40 INTEGER (KIND=JPLIKB) IDECDE, IPAREC, ITAMLI
41 INTEGER (KIND=JPLIKB) INUMPJ, INUMPD, IARTIC, INPDRE
42 INTEGER (KIND=JPLIKB) INPDTA, INPDIS, INDIK1
43 INTEGER (KIND=JPLIKB) INDIK2, INDIC1, INDIC2, JI
44 INTEGER (KIND=JPLIKB) IFACTM, IRETOU, INIMES
45 INTEGER (KIND=JPLIKB) IRETIN
46 !
47 LOGICAL LLADON, LLDERN
48 !
49 CHARACTER(LEN=LFI%JPLSPX) CLNSPR
50 CHARACTER(LEN=LFI%JPLMES) CLMESS
51 CHARACTER(LEN=LFI%JPLFTX) CLACTI
52 LOGICAL LLFATA
53 
54 !**
55 ! 1. - CONTROLES DES PARAMETRES D'APPEL, PUIS INITIALISATIONS.
56 !-----------------------------------------------------------------------
57 !
58 REAL(KIND=JPRB) :: ZHOOK_HANDLE
59 IF (lhook) CALL dr_hook('LFILED_FORT',0,zhook_handle)
60 clacti=''
61 iretou=0
62 !
63 IF (krang.LE.0.OR.krang.GT.lfi%JPNXFI &
64 & .OR.krgpim.LE.0.OR.kposex.EQ.0) &
65 & THEN
66  krep=-16
67  GOTO 1001
68 ENDIF
69 !
70 ! ON COMPLETE LES CARACTERISTIQUES DE L'ARTICLE.
71 !
72 inaphy=0
73 !
74 IF (.NOT.lfi%LPHASP(krgpim)) THEN
75 !
76  CALL lfipha_fort &
77 & (lfi, krep,krang,krgpim,iretin)
78 !
79  IF (iretin.EQ.1) THEN
80  GOTO 903
81  ELSEIF (iretin.EQ.2) THEN
82  GOTO 904
83  ELSEIF (iretin.NE.0) THEN
84  GOTO 1001
85  ENDIF
86 !
87 ENDIF
88 !
89 inumer=lfi%NUMERO(krang)
90 ifactm=lfi%MFACTM(krang)
91 ilarph=lfi%JPLARD*ifactm
92 krep=0
93 !**
94 ! 2. - LECTURE DES DONNEES .
95 !-----------------------------------------------------------------------
96 !*
97 ! 2.1 - UTILISATION DES ARTICLES PHYSIQUES PRESENTS EN MEMOIRE,
98 ! ET QUE L'ON S'APPRETE A LIRE *EN ENTIER*;
99 !-----------------------------------------------------------------------
100 !
101 ipodeb=kposex
102 ipofin=kposex+klong-1
103 iardeb=1+(ipodeb-1)/ilarph
104 iarfin=1+(ipofin-1)/ilarph
105 idcdeb=mod(ipodeb-1,ilarph)
106 idcfin=mod(ipofin ,ilarph)
107 lldern=idcfin.NE.0.AND.((iarfin.NE.iardeb) &
108 & .OR.(iarfin.EQ.iardeb.AND.idcdeb.EQ.0))
109 icplti=iardeb+(idcdeb+ilarph-1)/ilarph
110 icpltf=iarfin-1+(ilarph-idcfin)/ilarph
111 icpttn=icpltf+1
112 icpttx=icplti-1
113 incplt=0
114 !
115 IF (lfi%LMISOP) THEN
116  WRITE (unit=lfi%NULOUT,fmt=*)'KPOSEX= ',kposex,', IPODEB= ', &
117 & ipodeb,', IPOFIN= ',ipofin
118  WRITE (unit=lfi%NULOUT,fmt=*)'IARDEB= ',iardeb,', IARFIN= ', &
119 & iarfin,', IDCDEB= ',idcdeb
120  WRITE (unit=lfi%NULOUT,fmt=*)'IDCFIN= ',idcfin,', ICPLTI= ', &
121 & icplti,', ICPLTF= ',icpltf
122  WRITE (unit=lfi%NULOUT,fmt=*)'ICPTTN= ',icpttn,', ICPTTX= ', &
123 & icpttx,', LLDERN= ',lldern
124 ENDIF
125 !
126 IF (icpltf.GE.icplti) THEN
127 !
128  DO j=0,lfi%JPNPDF-1
129  inumap=lfi%NUMAPD(j,krang)
130 !
131  IF (inumap.GE.icplti.AND.inumap.LE.icpltf) THEN
132  incplt=incplt+1
133  inucpl(incplt)=inumap
134  icpttn=min(icpttn,inumap)
135  icpttx=max(icpttx,inumap)
136  idecde=(inumap-iardeb)*ilarph-idcdeb
137 !
138  IF (lfi%NLONPD(j,krang).LT.ilarph) THEN
139 !
140  IF (inumap.GT.lfi%MDES1D(ixm(lfi%JPAXPD,krang)).OR. &
141 & .NOT.lfi%LECRPD(j,krang)) THEN
142  krep=-16
143  GOTO 1001
144  ELSE
145  inaphy=inumap
146  CALL lfildo_fort &
147 & (lfi, krep,inumer,inumap, &
148 & ifourt,lfi%NBREAD(krang), &
149 & ifactm,lfi%YLFIC (krang), &
150 & iretin)
151 !
152  IF (iretin.NE.0) THEN
153  GOTO 904
154  ENDIF
155 !
156  DO jd=lfi%NLONPD(j,krang)+1,ilarph
157  lfi%MTAMPD(ixt(jd,j,krang))=ifourt(jd)
158  ENDDO
159 !
160  ENDIF
161 !
162  lfi%NLONPD(j,krang)=ilarph
163  ENDIF
164 !
165  DO jd=1,ilarph
166  ktab(idecde+jd)=lfi%MTAMPD(ixt(jd,j,krang))
167  ENDDO
168 !
169  IF (incplt.GT.(icpltf-icplti)) THEN
170  GOTO 220
171  ENDIF
172 !
173  ENDIF
174 !
175  ENDDO
176 !
177 ENDIF
178 !
179 220 CONTINUE
180 !*
181 ! 2.2 - TRAITEMENT DE LA PREMIERE PAGE DE DONNEES, SI L'ARTICLE
182 ! LOGIQUE NE COMMENCE PAS JUSTE EN DEBUT D'ARTICLE PHYSIQUE.
183 ! CETTE PAGE EST CONSERVEE... DES FOIS QUE L'ACCES
184 ! SUIVANT AU FICHIER SOIT POUR L'ARTICLE LOGIQUE IMMEDIATEMENT
185 ! DEVANT (CAS DE BALAYAGE INVERSE DU FICHIER, PAR EXEMPLE) .
186 !-----------------------------------------------------------------------
187 !
188 idecde=0
189 !
190 IF (idcdeb.EQ.0) THEN
191  iparec=0
192  itamli=lfi%JPNPDF
193 ELSE
194  iparec=min(ilarph*iardeb,ipofin)-kposex+1
195  itamli=lfi%JPNPDF-1
196 !
197 ! L'ARTICLE DE DONNEES A LIRE NE COMMENCE PAS AU DEBUT D'UN
198 ! ARTICLE PHYSIQUE. IL FAUT DONC AVOIR CET ARTICLE PHYSIQUE
199 ! EN MEMOIRE POUR LE COMPLETER.
200 !
201  DO j=0,lfi%JPNPDF-1
202  inumpj=mod(lfi%NDERPD(krang)+j,lfi%JPNPDF)
203 !
204  IF (lfi%NUMAPD(inumpj,krang).EQ.iardeb) THEN
205 !
206 ! ARTICLE PHYSIQUE CHERCHE EN MEMOIRE.
207 !
208  IF (lfi%NLONPD(inumpj,krang).LT.(idcdeb+iparec)) THEN
209 !
210  IF (iardeb.GT.lfi%MDES1D(ixm(lfi%JPAXPD,krang))) THEN
211  krep=-16
212  GOTO 1001
213  ELSEIF (lfi%LECRPD(inumpj,krang)) THEN
214  inaphy=iardeb
215  CALL lfildo_fort &
216 & (lfi, krep,inumer,iardeb,ifourt,&
217 & lfi%NBREAD(krang),ifactm, &
218 & lfi%YLFIC (krang),iretin)
219 !
220  IF (iretin.NE.0) THEN
221  GOTO 904
222  ENDIF
223 !
224  DO jd=lfi%NLONPD(inumpj,krang)+1,ilarph
225  lfi%MTAMPD(ixt(jd,inumpj,krang))=ifourt(jd)
226  ENDDO
227 !
228  ELSE
229  lfi%NUMAPD(inumpj,krang)=lfi%JPNIL
230  inaphy=iardeb
231  CALL lfildo_fort &
232 & (lfi, krep,inumer,iardeb, &
233 & lfi%MTAMPD(ixt(1_jplikb ,inumpj,krang)), &
234 & lfi%NBREAD(krang),ifactm, &
235 & lfi%YLFIC (krang),iretin)
236 !
237  IF (iretin.NE.0) THEN
238  GOTO 904
239  ENDIF
240 !
241  lfi%NUMAPD(inumpj,krang)=iardeb
242  ENDIF
243 !
244  lfi%NLONPD(inumpj,krang)=ilarph
245  ENDIF
246 !
247  inumpd=inumpj
248  GOTO 223
249  ENDIF
250 !
251  ENDDO
252 !
253 ! ARTICLE PHYSIQUE CHERCHE PAS EN MEMOIRE... ON DOIT DONC LE LIRE.
254 !
255  inumpd=mod(1+lfi%NDERPD(krang),lfi%JPNPDF)
256  inaphy=0
257 !
258  IF (lfi%LECRPD(inumpd,krang)) THEN
259 !
260  CALL lfivid_fort &
261 & (lfi, krep,krang,inumpd,ifourt,iretin)
262 !
263  IF (iretin.EQ.1) THEN
264  GOTO 903
265  ELSEIF (iretin.EQ.2) THEN
266  GOTO 904
267  ELSEIF (iretin.NE.0) THEN
268  GOTO 1001
269  ENDIF
270 !
271  ENDIF
272 !
273  lfi%NUMAPD(inumpd,krang)=lfi%JPNIL
274  inaphy=iardeb
275  CALL lfildo_fort &
276 & (lfi, krep,inumer,iardeb, &
277 & lfi%MTAMPD(ixt(1_jplikb ,inumpd,krang)), &
278 & lfi%NBREAD(krang),ifactm, &
279 & lfi%YLFIC (krang),iretin)
280 !
281  IF (iretin.NE.0) THEN
282  GOTO 904
283  ENDIF
284 !
285  lfi%NUMAPD(inumpd,krang)=iardeb
286  lfi%NLONPD(inumpd,krang)=ilarph
287 !
288 223 CONTINUE
289 !
290 ! TRANSFERT DE LA PARTIE UTILE DES DONNEES POUR CE DEBUT
291 ! D'ARTICLE LOGIQUE.
292 !
293  DO jd=1,iparec
294  ktab(jd)=lfi%MTAMPD(ixt(idcdeb+jd,inumpd,krang))
295  ENDDO
296 !
297  lfi%NDERPD(krang)=inumpd
298 ENDIF
299 !*
300 ! 2.3 - LECTURE DES ARTICLES PHYSIQUES COMPLETS NE TENANT PAS OU NE
301 ! DEVANT PAS ETRE STOCKES DANS LES PAGES DE DONNEES "TAMPON".
302 !-----------------------------------------------------------------------
303 !
304 IF (.NOT.lfi%LTAMPL(krang)) THEN
305  itamli=0
306 ELSEIF (lldern) THEN
307  itamli=itamli-1
308 ENDIF
309 !
310 iartic=icplti-1
311 inpdre=(klong-iparec-idcfin+ilarph-1)/ilarph-incplt
312 inpdta=min(inpdre,itamli)
313 inpdis=inpdre-itamli
314 indik1=1
315 indik2=incplt
316 lladon=.true.
317 !
318 DO j=1,inpdis
319 !
320 231 CONTINUE
321 iartic=iartic+1
322 IF (lfi%LMISOP) WRITE (unit=lfi%NULOUT,fmt=*) &
323 & 'BOUCLE 235, J= ',j,', IARTIC= ',iartic,', IDECDE= ',idecde
324 !
325 IF (iartic.GE.icpttn.AND.iartic.LE.icpttx) THEN
326  IF (iartic.EQ.icpttn) icpttn=icpttn+1
327  IF (iartic.EQ.icpttx) icpttx=icpttx-1
328  indic1=indik1
329  indic2=indik2
330 !
331 ! ON FILTRE LES ARTICLES PHYSIQUES DEJA STOCKES DANS DES PAGES
332 ! DE DONNEES LORS DE LA PARTIE 2.1 ...
333 !
334  DO ji=indic1,indic2
335 !
336  IF (iartic.EQ.inucpl(ji)) THEN
337  IF (ji.EQ.indik1) indik1=indik1+1
338  IF (ji.EQ.indik2) indik2=indik2-1
339  GOTO 231
340  ENDIF
341 !
342  ENDDO
343 !
344 ENDIF
345 !
346 idecde=(iartic-iardeb)*ilarph-idcdeb
347 inaphy=iartic
348 CALL lfildo_fort &
349 & (lfi, krep,inumer,iartic,ktab(idecde+1), &
350 & lfi%NBREAD(krang),ifactm, &
351 & lfi%YLFIC (krang),iretin)
352 !
353 IF (iretin.NE.0) THEN
354  GOTO 904
355 ENDIF
356 
357 ENDDO
358 !*
359 ! 2.4 - LECTURE DES ARTICLES PHYSIQUES COMPLETS QUE L'ON PEUT STOC-
360 ! KER DANS LES PAGES DE DONNEES "TAMPON".
361 ! ( TOUT EN PRESERVANT LES EMPLACEMENTS DE LA PREMIERE ET/OU
362 ! DE LA DERNIERE PAGE DE DONNEES, SI INCOMPLETE(S) )
363 !-----------------------------------------------------------------------
364 !
365 DO j=1,inpdta
366 inumpd=mod(lfi%NDERPD(krang)+j,lfi%JPNPDF)
367 !
368 241 CONTINUE
369 iartic=iartic+1
370 !
371 IF (iartic.GE.icpttn.AND.iartic.LE.icpttx) THEN
372  IF (iartic.EQ.icpttn) icpttn=icpttn+1
373  IF (iartic.EQ.icpttx) icpttx=icpttx-1
374  indic1=indik1
375  indic2=indik2
376 !
377 ! ON FILTRE LES ARTICLES PHYSIQUES DEJA STOCKES DANS DES PAGES
378 ! DE DONNEES LORS DE LA PARTIE 2.1 ...
379 !
380  DO ji=indic1,indic2
381 !
382  IF (iartic.EQ.inucpl(ji)) THEN
383  IF (ji.EQ.indik1) indik1=indik1+1
384  IF (ji.EQ.indik2) indik2=indik2-1
385  GOTO 241
386  ENDIF
387 !
388  ENDDO
389 !
390 ENDIF
391 !
392 ! SI NECESSAIRE, "VIDAGE" SUR FICHIER DE LA PAGE A UTILISER.
393 !
394 inaphy=0
395 !
396 IF (lfi%LECRPD(inumpd,krang)) THEN
397 !
398  CALL lfivid_fort &
399 & (lfi, krep,krang,inumpd,ifourt,iretin)
400 !
401  IF (iretin.EQ.1) THEN
402  GOTO 903
403  ELSEIF (iretin.EQ.2) THEN
404  GOTO 904
405  ELSEIF (iretin.NE.0) THEN
406  GOTO 1001
407  ENDIF
408 !
409 ENDIF
410 !
411 ! LECTURE SUR FICHIER DE LA PAGE DE DONNEES TAMPON.
412 !
413 lfi%NUMAPD(inumpd,krang)=lfi%JPNIL
414 inaphy=iartic
415 CALL lfildo_fort &
416 & (lfi, krep,inumer,iartic, &
417 & lfi%MTAMPD(ixt(1_jplikb ,inumpd,krang)), &
418 & lfi%NBREAD(krang),ifactm, &
419 & lfi%YLFIC (krang),iretin)
420 !
421 IF (iretin.NE.0) THEN
422  GOTO 904
423 ENDIF
424 !
425 lfi%NUMAPD(inumpd,krang)=iartic
426 lfi%NLONPD(inumpd,krang)=ilarph
427 idecde=(iartic-iardeb)*ilarph-idcdeb
428 !
429 ! TRANSFERT DANS LA ZONE UTILISATEUR.
430 !
431 DO jd=1,ilarph
432 ktab(idecde+jd)=lfi%MTAMPD(ixt(jd,inumpd,krang))
433 ENDDO
434 !
435 ENDDO
436 !
437 lfi%NDERPD(krang)=mod(lfi%NDERPD(krang)+inpdta,lfi%JPNPDF)
438 !*
439 ! 2.5 - TRAITEMENT DE LA DERNIERE PAGE DE DONNEES SI ELLE EST
440 ! INCOMPLETE, ET SI ON EST DANS L'UN DES 2 CAS SUIVANTS
441 ! SOIT ELLE DIFFERE DE LA PREMIERE, SOIT C'EST LA MEME QUE LA
442 ! PREMIERE ET ELLE COMMENCE JUSTE EN DEBUT D'ARTICLE.
443 ! CETTE PAGE EST CONSERVEE... CAR ON ESPERE QUE L'ACCES
444 ! SUIVANT AU FICHIER SERA POUR L'ARTICLE LOGIQUE IMMEDIATEMENT
445 ! DERRIERE ( LECTURE SEQUENTIELLE DU FICHIER, PAR EXEMPLE ) .
446 !-----------------------------------------------------------------------
447 !
448 IF (lldern) THEN
449 !
450  DO j=1,lfi%JPNPDF
451  inumpj=mod(lfi%NDERPD(krang)+j,lfi%JPNPDF)
452 !
453  IF (lfi%NUMAPD(inumpj,krang).EQ.iarfin) THEN
454 !
455 ! ARTICLE PHYSIQUE CHERCHE EN MEMOIRE.
456 !
457  IF (lfi%NLONPD(inumpj,krang).LT.idcfin) THEN
458 !
459  IF (iarfin.GT.lfi%MDES1D(ixm(lfi%JPAXPD,krang))) THEN
460  krep=-16
461  GOTO 1001
462  ELSEIF (lfi%LECRPD(inumpj,krang)) THEN
463  inaphy=iarfin
464  CALL lfildo_fort &
465 & (lfi, krep,inumer,iarfin,ifourt, &
466 & lfi%NBREAD(krang),ifactm, &
467 & lfi%YLFIC (krang),iretin)
468 !
469  IF (iretin.NE.0) THEN
470  GOTO 904
471  ENDIF
472 !
473  DO jd=lfi%NLONPD(inumpj,krang)+1,ilarph
474  lfi%MTAMPD(ixt(jd,inumpj,krang))=ifourt(jd)
475  ENDDO
476 !
477  ELSE
478  lfi%NUMAPD(inumpj,krang)=lfi%JPNIL
479  inaphy=iarfin
480  CALL lfildo_fort &
481 & (lfi, krep,inumer,iarfin, &
482 & lfi%MTAMPD(ixt(1_jplikb ,inumpj,krang)), &
483 & lfi%NBREAD(krang),ifactm, &
484 & lfi%YLFIC (krang),iretin)
485 !
486  IF (iretin.NE.0) THEN
487  GOTO 904
488  ENDIF
489 !
490  lfi%NUMAPD(inumpj,krang)=iarfin
491  ENDIF
492 !
493  lfi%NLONPD(inumpj,krang)=ilarph
494  ENDIF
495 !
496  inumpd=inumpj
497  GOTO 253
498  ENDIF
499 !
500  ENDDO
501 !
502 ! ARTICLE PHYSIQUE CHERCHE PAS EN MEMOIRE...
503 !
504  inumpd=mod(1+lfi%NDERPD(krang),lfi%JPNPDF)
505  inaphy=0
506 !
507  IF (lfi%LECRPD(inumpd,krang)) THEN
508 !
509  CALL lfivid_fort &
510 & (lfi, krep,krang,inumpd,ifourt,iretin)
511 !
512  IF (iretin.EQ.1) THEN
513  GOTO 903
514  ELSEIF (iretin.EQ.2) THEN
515  GOTO 904
516  ELSEIF (iretin.NE.0) THEN
517  GOTO 1001
518  ENDIF
519 !
520  ENDIF
521 !
522  IF (iarfin.LE.lfi%MDES1D(ixm(lfi%JPAXPD,krang))) THEN
523  lfi%NUMAPD(inumpd,krang)=lfi%JPNIL
524  inaphy=iarfin
525  CALL lfildo_fort &
526 & (lfi, krep,inumer,iarfin, &
527 & lfi%MTAMPD(ixt(1_jplikb ,inumpd,krang)), &
528 & lfi%NBREAD(krang),ifactm, &
529 & lfi%YLFIC (krang),iretin)
530 !
531  IF (iretin.NE.0) THEN
532  GOTO 904
533  ENDIF
534 !
535  lfi%NLONPD(inumpd,krang)=ilarph
536  ELSE
537  lfi%NLONPD(inumpd,krang)=0
538  ENDIF
539 !
540  lfi%NUMAPD(inumpd,krang)=iarfin
541 !
542 253 CONTINUE
543  idecde=(iarfin-iardeb)*ilarph-idcdeb
544 !
545 ! COMPLEMENT DE LA PAGE DE DONNEES ASSOCIEE AU DERNIER ARTICLE
546 ! PHYSIQUE OU DOIVENT ETRE STOCKEES LES DONNEES A ECRIRE.
547 !
548  DO jd=1,idcfin
549  ktab(idecde+jd)=lfi%MTAMPD(ixt(jd,inumpd,krang))
550  ENDDO
551 !
552  lfi%NDERPD(krang)=inumpd
553 ENDIF
554 !
555 GOTO 1001
556 !**
557 ! 9. - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S.
558 ! AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF.
559 !-----------------------------------------------------------------------
560 !
561 903 CONTINUE
562 iretou=1
563 clacti='WRITE'
564 GOTO 909
565 !
566 904 CONTINUE
567 iretou=2
568 clacti='READ'
569 !
570 909 CONTINUE
571 krep=abs(krep)
572 IF (inaphy.NE.0) lfi%NUMAPH(krang)=inaphy
573 !**
574 ! 10. - PHASE TERMINALE : MESSAGERIE INTERNE EVENTUELLE,
575 ! VIA LE SOUS-PROGRAMME "LFIEMS", PUIS RETOUR.
576 !-----------------------------------------------------------------------
577 !
578 1001 CONTINUE
579 llfata=llmoer(krep,krang)
580 !
581 IF (krep.EQ.0) THEN
582  kretin=0
583 ELSEIF (krep.GT.0) THEN
584  kretin=iretou
585 ELSE
586  kretin=3
587 ENDIF
588 !
589 IF (lfi%LMISOP.OR.llfata) THEN
590  inimes=2
591  clnspr='LFILED'
592  WRITE (unit=clmess,fmt='(''KREP='',I4,'', KRANG='',I3, &
593 & '', KLONG='',I7,'', KRGPIM='',I3,'', KPOSEX='',I8, &
594 & '', KRETIN='',I2)') krep,krang,klong,krgpim,kposex,kretin
595  CALL lfiems_fort &
596 & (lfi, inumer,inimes,krep,.false., &
597 & clmess,clnspr,clacti)
598 ENDIF
599 !
600 IF (lhook) CALL dr_hook('LFILED_FORT',1,zhook_handle)
601 
602 CONTAINS
603 
604 #include "lficom2.ixm.h"
605 #include "lficom2.ixt.h"
606 #include "lficom2.llmoer.h"
607 
608 END SUBROUTINE lfiled_fort
609 
610 
611 
612 ! Oct-2012 P. Marguinaud 64b LFI
613 SUBROUTINE lfiled64 &
614 & (krep, krang, ktab, klong, krgpim, kposex, kretin)
615 USE lfimod, ONLY : lfi => lficom_default, &
616 & lficom_default_init, &
617 & new_lfi_default
618 USE lfi_precision
619 IMPLICIT NONE
620 ! Arguments
621 INTEGER (KIND=JPLIKB) KREP ! OUT
622 INTEGER (KIND=JPLIKB) KRANG ! IN
623 INTEGER (KIND=JPLIKB) KLONG ! IN
624 INTEGER (KIND=JPLIKB) KTAB (klong) ! IN
625 INTEGER (KIND=JPLIKB) KRGPIM ! IN
626 INTEGER (KIND=JPLIKB) KPOSEX ! IN
627 INTEGER (KIND=JPLIKB) KRETIN ! OUT
628 
629 IF (.NOT. lficom_default_init) CALL new_lfi_default ()
630 
631 CALL lfiled_fort &
632 & (lfi, krep, krang, ktab, klong, krgpim, kposex, &
633 & kretin)
634 
635 END SUBROUTINE lfiled64
636 
637 SUBROUTINE lfiled &
638 & (krep, krang, ktab, klong, krgpim, kposex, kretin)
639 USE lfimod, ONLY : lfi => lficom_default, &
640 & lficom_default_init, &
641 & new_lfi_default
642 USE lfi_precision
643 IMPLICIT NONE
644 ! Arguments
645 INTEGER (KIND=JPLIKM) KREP ! OUT
646 INTEGER (KIND=JPLIKM) KRANG ! IN
647 INTEGER (KIND=JPLIKM) KLONG ! IN
648 INTEGER (KIND=JPLIKB) KTAB (klong) ! IN
649 INTEGER (KIND=JPLIKM) KRGPIM ! IN
650 INTEGER (KIND=JPLIKM) KPOSEX ! IN
651 INTEGER (KIND=JPLIKM) KRETIN ! OUT
652 
653 IF (.NOT. lficom_default_init) CALL new_lfi_default ()
654 
655 CALL lfiled_mt &
656 & (lfi, krep, krang, ktab, klong, krgpim, kposex, &
657 & kretin)
658 
659 END SUBROUTINE lfiled
660 
661 SUBROUTINE lfiled_mt &
662 & (lfi, krep, krang, ktab, klong, krgpim, kposex, &
663 & kretin)
664 USE lfimod, ONLY : lficom
665 USE lfi_precision
666 IMPLICIT NONE
667 ! Arguments
668 type(lficom) lfi ! INOUT
669 INTEGER (KIND=JPLIKM) KREP ! OUT
670 INTEGER (KIND=JPLIKM) KRANG ! IN
671 INTEGER (KIND=JPLIKM) KLONG ! IN
672 INTEGER (KIND=JPLIKB) KTAB (klong) ! IN
673 INTEGER (KIND=JPLIKM) KRGPIM ! IN
674 INTEGER (KIND=JPLIKM) KPOSEX ! IN
675 INTEGER (KIND=JPLIKM) KRETIN ! OUT
676 ! Local integers
677 INTEGER (KIND=JPLIKB) IREP ! OUT
678 INTEGER (KIND=JPLIKB) IRANG ! IN
679 INTEGER (KIND=JPLIKB) ILONG ! IN
680 INTEGER (KIND=JPLIKB) IRGPIM ! IN
681 INTEGER (KIND=JPLIKB) IPOSEX ! IN
682 INTEGER (KIND=JPLIKB) IRETIN ! OUT
683 ! Convert arguments
684 
685 irang = int( krang, jplikb)
686 ilong = int( klong, jplikb)
687 irgpim = int( krgpim, jplikb)
688 iposex = int( kposex, jplikb)
689 
690 CALL lfiled_fort &
691 & (lfi, irep, irang, ktab, ilong, irgpim, iposex, &
692 & iretin)
693 
694 krep = int( irep, jplikm)
695 kretin = int( iretin, jplikm)
696 
697 END SUBROUTINE lfiled_mt
698 
699 !INTF KREP OUT
700 !INTF KRANG IN
701 !INTF KTAB IN DIMS=KLONG KIND=JPLIKB
702 !INTF KLONG IN
703 !INTF KRGPIM IN
704 !INTF KPOSEX IN
705 !INTF KRETIN OUT
lfi_precision::jplikb
integer, parameter jplikb
Definition: lfi_precision.F90:25
lfildo_fort
subroutine lfildo_fort(LFI, KREP, KNUMER, KREC, KTAB, KNBLEC, KFACTM, YDFIC, KRETIN)
Definition: lfildo.F90:6
yomhook::dr_hook
Definition: yomhook.F90:20
lfimod::new_lfi_default
subroutine new_lfi_default()
Definition: lfimod.F90:376
lfimod::lficom_default_init
logical, save lficom_default_init
Definition: lfimod.F90:371
parkind1::jprb
integer, parameter jprb
Definition: parkind1.F90:32
lfiled64
subroutine lfiled64(KREP, KRANG, KTAB, KLONG, KRGPIM, KPOSEX, KRETIN)
Definition: lfiled.F90:615
lfimod::lficom_default
type(lficom), target, save lficom_default
Definition: lfimod.F90:370
lfiled
subroutine lfiled(KREP, KRANG, KTAB, KLONG, KRGPIM, KPOSEX, KRETIN)
Definition: lfiled.F90:639
yomhook::lhook
logical lhook
Definition: yomhook.F90:15
lfipha_fort
subroutine lfipha_fort(LFI, KREP, KRANG, KRGPIM, KRETIN)
Definition: lfipha.F90:5
lfiled_fort
subroutine lfiled_fort(LFI, KREP, KRANG, KTAB, KLONG, KRGPIM, KPOSEX, KRETIN)
Definition: lfiled.F90:7
lfi_precision::jplikm
integer, parameter jplikm
Definition: lfi_precision.F90:25
lfiled_mt
subroutine lfiled_mt(LFI, KREP, KRANG, KTAB, KLONG, KRGPIM, KPOSEX, KRETIN)
Definition: lfiled.F90:664
lfiems_fort
subroutine lfiems_fort(LFI, KNUMER, KNIMES, KCODE, LDFATA, CDMESS, CDNSPR, CDACTI)
Definition: lfiems.F90:7
lfivid_fort
subroutine lfivid_fort(LFI, KREP, KRANG, KNUMPD, KTAMPO, KRETIN)
Definition: lfivid.F90:5
lfimod
Definition: lfimod.F90:1
lfi_precision
Definition: lfi_precision.F90:1
Generated on Tue Jan 16 2018 16:23:21 for SURFEX v8.1 by   doxygen 1.8.13