SURFEX v8.1
General documentation of Surfex
fainig.F90
Go to the documentation of this file.
1 ! Oct-2012 P. Marguinaud 64b LFI
2 ! Jan-2011 P. Marguinaud Thread-safe FA
3 ! Jun-2015 R. El Khatib Allow an unlimited number of vertical levels
4 SUBROUTINE fainig_fort &
5 & (fa, krep, krang, cdpref, knivau, cdsuff, &
6 & ldcosp, klcham, ksec1, ksec2, psec2, ksec3, &
7 & psec3, ksec4, ydgr1tab)
9 USE parkind1, ONLY : jprb
10 USE yomhook , ONLY : lhook, dr_hook
11 USE lfi_precision
12 IMPLICIT NONE
13 !****
14 ! Sous-programme INTERNE du logiciel de Fichiers ARPEGE:
15 ! INItialisation de l'entete Gribex d'un champ.
16 !**
17 ! Arguments : KREP (Sortie) ==> Code-reponse du sous-programme;
18 ! KRANG (Entree) ==> Rang de l'unite logique;
19 ! CDPREF (Entree) ==> Prefixe eventuel du nom d'article;
20 ! KNIVAU (Entree) ==> Niveau vertical eventuel;
21 ! CDSUFF (Entree) ==> Suffixe eventuel du nom d'article;
22 ! LDCOSP (Entree) ==> Vrai si le champ est represente
23 ! par des coefficients spectraux;
24 ! KLCHAM (Entree) ==> Longueur totale du champ;
25 ! ( Tableau ) KSEC1 (Sortie) ==> Image des parametres de la section 1
26 ! de GRIBEX;
27 ! KSEC2 (Sortie) ==> Image des parametres de la section 2
28 ! de GRIBEX, partie entiere;
29 ! PSEC2 (Sortie) ==> Image des parametres de la section 2
30 ! de GRIBEX, partie reelle;
31 ! KSEC3 (Sortie) ==> Image des parametres de la section 3
32 ! de GRIBEX, partie entiere;
33 ! PSEC3 (Sortie) ==> Image des parametres de la section 3
34 ! de GRIBEX, partie reelle;
35 ! KSEC4 (Sortie) ==> Image des parametres de la section 4
36 ! de GRIBEX, partie entiere;
37 !*
38 ! Modifications
39 ! -------------
40 ! R. El Ouaraini: 03-Oct-06 introduction du new EGGX pour tester ERPK
41 ! R. El Khatib : 11-Aug-2009 Bugfix for non-square geometries
42 !
43 !
44 !
45 !
46 !
47 TYPE(fa_com) :: FA
48 REAL (KIND=JPDBLR) PSEC3(*), PSEC2(*)
49 !
50 INTEGER (KIND=JPLIKB) KREP, KRANG, KNIVAU, KLCHAM
51 INTEGER (KIND=JPLIKB) KSEC1(fa%jpsec1)
52 INTEGER (KIND=JPLIKB) KSEC2(fa%jpsec2), KSEC3(2)
53 INTEGER (KIND=JPLIKB) KSEC4(fa%jpsec4)
54 !
55 CHARACTER CDPREF*(*), CDSUFF*(*)
56 !
57 LOGICAL LDCOSP
58 !
59 type(fagr1tab) :: ydgr1tab
60 !
61 INTEGER (KIND=JPLIKB) IRANGC, INIMES, INUMER
62 INTEGER (KIND=JPLIKB) INLAT, INIVAU, INBITS
63 INTEGER (KIND=JPLIKB) INIPAR(8), ICPACK
64 !
65 LOGICAL LLMLAM
66 !
67 INTRINSIC len_trim
68 !
69 CHARACTER(LEN=FA%JPLMES) CLMESS
70 CHARACTER(LEN=FA%JPLSPX) CLNSPR
71 LOGICAL LLFATA
72 !
73 
74 !**
75 ! 0. - CONTROLES ET INITIALISATIONS PREALABLES
76 !-----------------------------------------------------------------------
77 !
78 ! Controle de la bonne initialisation de la date
79 !
80 !
81 REAL(KIND=JPRB) :: ZHOOK_HANDLE
82 
83 IF (lhook) CALL dr_hook('FAINIG_MT',0,zhook_handle)
84 
85 IF (fa%FICHIER(krang)%LCREAF) THEN
86  krep=-85
87  GOTO 1001
88 ENDIF
89 
90 inumer=fa%FICHIER(krang)%NULOGI
91 
92 icpack=fa%FICHIER(krang)%NSTROF
93 irangc=fa%FICHIER(krang)%NUCADR
94 inlat=fa%CADRE(irangc)%NLATIT
95 inivau=fa%CADRE(irangc)%NNIVER
96 llmlam=fa%CADRE(irangc)%LIMLAM
97 
98 IF (ldcosp) THEN
99  inbits=fa%FICHIER(krang)%NBFCSP
100 ELSE
101  inbits=fa%FICHIER(krang)%NBFPDG
102 ENDIF
103 !
104 !**
105 ! 1. - SECTION 1: the product definition section
106 !-----------------------------------------------------------------------
107 !
108 ! Appel a FAISC1 une seule fois pour un fichier: initialisation
109 ! du tableau FA%NSEC1(2:21,KRANG) qui va servir comme base pour KSEC1:
110 !
111 IF (fa%FICHIER(krang)%LISEC1) THEN
112  CALL faisc1_fort &
113 & (fa, krep,krang)
114  IF (krep.NE.0) GOTO 1001
115  fa%FICHIER(krang)%LISEC1=.false.
116 ENDIF
117 ksec1(1:fa%JPSEC1)=0
118 ksec1(2:21)=fa%FICHIER(krang)%NSEC1(2:21)
119 !
120 ! Initialisation de INIPAR (5 elts de KSEC1 (1 et 6:9) et un indicateur
121 ! de type de champ: 0->RAS; 2->min/max; 4->cumul)
122 CALL faipag_fort &
123 & (fa, krep, inumer, cdpref, knivau, cdsuff, inipar,&
124 & ydgr1tab)
125 IF (krep.NE.0) GOTO 1001
126 ! Element 1: version number of code table 2
127 ksec1(1) = inipar(1)
128 ! Element 6: parameter indicator
129 ksec1(6) = inipar(2)
130 IF (inipar(2).LT.0.OR.inipar(2).GT.254.AND.fa%LFAMOP) THEN
131  WRITE (unit=fa%NULOUT,fmt=*) &
132 & '----------------------------------------------------'
133  WRITE (unit=fa%NULOUT,fmt=*) &
134 & ' FAINIG: warning, parameter indicator not defined'
135  WRITE (unit=fa%NULOUT,fmt=*) &
136 & 'for: ',cdpref,' ',cdsuff,'. Set to 255, by default'
137  WRITE (unit=fa%NULOUT,fmt=*) &
138 & '----------------------------------------------------'
139  ksec1(6) = 255
140 ENDIF
141 ! Element 7: type of level indicator
142 ksec1(7) = inipar(3)
143 ! Element 8: height, pressure, etc of level or top of level
144 ksec1(8) = inipar(4)
145 ! Element 9: height, pressure, etc of level or bottom of level
146 ksec1(9) = inipar(5)
147 
148 IF (fa%FICHIER(krang)%MADATX(jd_fmt-11) == 0) THEN
149 
150 ! Cas de la periode de reference
151  IF (inipar(6)==2) THEN
152 ! Convention dans FA (depuis fin 2000): l'echeance precedente
153 ! est stockee dans FA%MADATE(10,KRANG).
154  ksec1(17)=ksec1(16)
155  ksec1(16)=fa%FICHIER(krang)%MADATE(10)
156  ksec1(18)=2
157 ! Cas du cumul
158  ELSEIF (inipar(6)==4) THEN
159  ksec1(17)=ksec1(16)
160  ksec1(16)=fa%FICHIER(krang)%MADATE(10)
161  ksec1(18)=4
162 ! Nb de produits inclus dans le cumul: valeur bidon de 1
163  ksec1(19)=1
164  ELSEIF (inipar(6)==8) THEN
165 ! Cumul depuis le depart
166  ksec1(17)=ksec1(16)
167  ksec1(18)=4
168  ksec1(16)=0
169  ksec1(19)=0
170  ENDIF
171 
172 ELSEIF ((fa%FICHIER(krang)%MADATX(jd_fmt-11) == 1) .AND. &
173  & (fa%FICHIER(krang)%MADATX(jd_dex-11) == 1)) THEN
174 !
175 ! Cas d'une datation en minutes; on descend au quart d'heure
176 !
177  ksec1(15)=13
178  ksec1(16)=fa%FICHIER(krang)%MADATX(jd_set-11)/(15 * 60)
179 
180 ! Cas de la periode de reference
181  IF (inipar(6)==2) THEN
182 ! Convention dans FA (depuis fin 2000): l'echeance precedente
183 ! est stockee dans FA%MADATE(10,KRANG).
184  ksec1(17)=ksec1(16)
185  ksec1(16)=fa%FICHIER(krang)%MADATX(jd_ce1-11)/(15 * 60)
186  ksec1(18)=2
187 ! Cas du cumul
188  ELSEIF (inipar(6)==4) THEN
189  ksec1(17)=ksec1(16)
190  ksec1(16)=fa%FICHIER(krang)%MADATX(jd_ce1-11)/(15 * 60)
191  ksec1(18)=4
192 ! Nb de produits inclus dans le cumul: valeur bidon de 1
193  ksec1(19)=1
194  ELSEIF (inipar(6)==8) THEN
195 ! Cumul depuis le depart
196  ksec1(17)=ksec1(16)
197  ksec1(18)=4
198  ksec1(16)=0
199  ksec1(19)=0
200  ENDIF
201 
202 ENDIF
203 
204 ! Facteur decimal d'echelle
205 ksec1(23)=inipar(7)
206 !**
207 ! 2. - SECTION 2: the grid definition section
208 !-----------------------------------------------------------------------
209 !
210 ! Appel a FAISC2 une seule fois pour un cadre, pour initialiser
211 ! les tableaux NSEC2xxx et FA%XSEC2.
212 !
213 IF (fa%CADRE(irangc)%LISEC2) THEN
214  CALL faisc2_fort &
215 & (fa, krep,irangc)
216  IF (krep.NE.0) GOTO 1001
217  fa%CADRE(irangc)%LISEC2=.false.
218 ENDIF
219 !
220 ! Appel a FAIS2F une seule fois pour un fichier Aladin,
221 ! pour initialiser le tableau FA%NSC2ALF (sauf redefinition
222 ! de la ss-tronc dans FAGOTE).
223 !
224 IF (llmlam.AND.fa%FICHIER(krang)%LISC2F) THEN
225  CALL fais2f_fort &
226 & (fa, krep,krang)
227  IF (krep.NE.0) GOTO 1001
228  fa%FICHIER(krang)%LISC2F=.false.
229 ENDIF
230 
231 ksec2(1:fa%JPSEC2)=0
232 IF (llmlam) THEN
233  IF (ldcosp) THEN
234 ! Le champ spectral que l'on doit coder va etre represente sur une
235 ! grille lat-lon quasi-reguliere puisque ce type de coeff. spectraux
236 ! n'est pas pris en compte dans GRIBEX.
237  ksec2(1:22)=fa%CADRE(irangc)%NSEC2AL(1:22)
238  ksec2(23:21+fa%CADRE(irangc)%NOMPAR(2))= &
239 & fa%FICHIER(krang)%NSC2ALF(1:fa%CADRE(irangc)%NOMPAR(2)-1)
240  ELSE
241  IF (fa%CADRE(irangc)%SINLAT(1) .GE. 0) THEN
242 ! Old EGGX
243  IF (fa%CADRE(irangc)%SINLAT(10).LT.0) THEN
244 ! Parametre de projection negatif, donc pas de projection
245 ! La grille de ce cadre est une grille lat-lon reguliere
246 ! du type Full-Pos (pour champ ARPEGE ou Aladin)
247  ksec2(1:22)=fa%CADRE(irangc)%NSEC2LL(1:22)
248  ELSE
249 ! La grille de ce cadre est donc du type Lambert conforme
250 ! (cas general de la grille Aladin)
251  ksec2(1:22)=fa%CADRE(irangc)%NSEC2LA(1:22)
252  ENDIF
253  ELSE
254 ! New EGGX
255  IF (fa%CADRE(irangc)%SINLAT(2).LT.0) THEN
256  ksec2(1:22)=fa%CADRE(irangc)%NSEC2LL(1:22)
257  ELSE
258  ksec2(1:22)=fa%CADRE(irangc)%NSEC2LA(1:22)
259  ENDIF
260  ENDIF
261  ENDIF
262 ELSE
263  IF (ldcosp) THEN
264  ksec2(1:22)=fa%CADRE(irangc)%NSEC2SP(1:22)
265  ELSE
266  ksec2(1:22+inlat)=fa%CADRE(irangc)%NSEC2GG(1:22+inlat)
267  ENDIF
268 ENDIF
269 !
270 ! Controle ultime: on regarde le prefixe pour s'assurer de la
271 ! presence ou non d'une coordonnee hybride sur la verticale,
272 ! seul cas qui impose une description dans la section 2 reelle.
273 !
274 ! Pour encoder un nombre illimite de niveaux, on ne decrit que le niveau courant
275 ! et pas l'integralite de la coordonnee. De toute facon l'en-tete grib n'est pas
276 ! utilisee en relecture. REK
277 IF (cdpref=='S') THEN
278 !REK KSEC2(12)=2*(INIVAU+1)
279  ksec2(12)=2
280  psec2(1:10)=fa%CADRE(irangc)%XSEC2(1:10)
281  psec2(11)=fa%CADRE(irangc)%XSEC2(10+knivau)
282  psec2(12)=fa%CADRE(irangc)%XSEC2(10+inivau+2+knivau)
283 ELSE
284  ksec2(12)=0
285  psec2(1:10+ksec2(12))=fa%CADRE(irangc)%XSEC2(1:10+ksec2(12))
286 ENDIF
287 
288 !**
289 ! 3. - SECTION 3: the bitmap section
290 ! As KSEC1(5)=128, the Section 3 is omitted => dummy values
291 !-----------------------------------------------------------------------
292 !
293 ! 3.1 - INTEGER PART
294 !
295 ! Flag: 0->bitmap included in the GRIB message, 1->not included
296 ksec3(1)=1
297 ! Value used at missing data points in an INTEGER data field
298 ksec3(2)=0
299 !
300 ! 3.2 - REAL PART
301 !
302 ! Ignored
303 psec3(1)=0._jpdblr
304 ! Value used at missing data points in an REAL data field
305 psec3(2)=0._jpdblr
306 !**
307 ! 4. - SECTION 4: the binary data section (integer part only)
308 !-----------------------------------------------------------------------
309 !
310 ! 1: Nb of data values in array PSEC4 to be encoded
311 ksec4(1)=klcham
312 ! 2: Nb of bits used for each encoded value
313 ksec4(2)=inbits
314 ! 3: Type of data (0:grid point; 128:spherical harmonic coeff)
315 ksec4(3)=0
316 ! 4: Type of packing, only for spectral fields
317 ! but also to allow 2nd-order packing for grid points fields
318 ! and for Aladin spectral fields (seen as lat-lon grid points
319 ! by GRIBEX).
320 ! (0:simple packing; 64:complex packing and 2nd-order packing)
321 IF (fa%FICHIER(krang)%NCOGRIF(2)==0) THEN
322 ! If no Additional flags, then 2nd-order packing is not asked!
323  ksec4(4)=0
324 ELSE
325  ksec4(4)=64
326 ENDIF
327 IF (ldcosp.AND..NOT.llmlam) THEN
328 ! For spherical harmonics coeff, complex packing is always done
329  ksec4(3)=128
330  ksec4(4)=64
331 ENDIF
332 ! 5: Data representation (0:float; 32:integer)
333 ksec4(5)=0
334 ! 6: Additional flags indicator (0:no; 16:yes)
335 ksec4(6)=fa%FICHIER(krang)%NCOGRIF(2)
336 IF (ldcosp.AND..NOT.llmlam) THEN
337 ! For spherical harmonics coeff, additional flags indicator=0
338  ksec4(6)=0
339 ENDIF
340 ! 7: Reserved
341 ksec4(7)=fa%FICHIER(krang)%NCOGRIF(3)
342 ! 8: Nb of values indicator (0:single datum at each grid point; 64:matrix)
343 ksec4(8)=0
344 ! 9: Secondary bitmaps indicator (0:no; 32:yes)
345 ksec4(9)=fa%FICHIER(krang)%NCOGRIF(4)
346 ! 10: Values width indicator (0:2nd order values have constant width; 16:not)
347 ksec4(10)=fa%FICHIER(krang)%NCOGRIF(5)
348 ! 11: Nb of bits for 2nd order values when these have constant width
349 ksec4(11)=fa%FICHIER(krang)%NCOGRIF(6)
350 IF (ksec4(11).EQ.-99) ksec4(11)=1-inbits
351 ! 12: General extended 2nd order packing (0:no; 8:yes)
352 ! 13: Boustrophedonic ordering (0:no; 4:yes)
353 ! 14,15: give the order of spatial differencing; if 0,0 then option rejected
354 ksec4(12:15)=fa%FICHIER(krang)%NCOGRIF(7:10)
355 ! 16: For complex packing, a pointer to the start of packed data values (octet nb)
356 ksec4(16)=0
357 ! 17: For complex packing, the scaling factor factor P, stored as the INTEGER
358 ! value P*1000 (in the range -10000,+10000): defined later
359 ksec4(17)=0
360 ! 18: For complex packing, the pentagonal resolution parameter J specifying
361 ! the truncation of the subset of the data not packed (32 bits)
362 ksec4(18)=0
363 ! 19-20: Idem 18 for resolution parameters K and M
364 ksec4(19)=0
365 ksec4(20)=0
366 IF (ldcosp.AND..NOT.llmlam) THEN
367 ! For spherical harmonics coeff (ARPEGE) only
368  ksec4(18)=icpack
369  ksec4(19)=icpack
370  ksec4(20)=icpack
371 ENDIF
372 ! 21-33: Reserved
373 ! 34-42: 'X' decoding option
374 ksec4(21:fa%JPSEC4)=0
375 !**
376 ! 10. - PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
377 ! VIA LE SOUS-PROGRAMME "FAIPAR" .
378 !-----------------------------------------------------------------------
379 !
380 1001 CONTINUE
381 llfata=llmoer(krep,krang)
382 !
383 IF (fa%LFAMOP.OR.llfata) THEN
384  inimes=2
385  clnspr='FAINIG'
386 !
387  WRITE (unit=clmess,fmt='(''KREP='',I4,'', KRANG='',I4, &
388 & '', CDPREF='''''',A,'''''', KNIVAU='',I6, &
389 & '', CDSUFF='''''',A,'''''', LDCOSP= '',L1)') &
390 & krep,krang,cdpref(1:len_trim(cdpref)),knivau, &
391 & cdsuff(1:len_trim(cdsuff)),ldcosp
392  CALL faipar_fort &
393 & (fa, inumer,inimes,krep,.false.,clmess, &
394 & clnspr, &
395 & clnspr,.false.)
396 ENDIF
397 !
398 IF (lhook) CALL dr_hook('FAINIG_MT',1,zhook_handle)
399 
400 CONTAINS
401 
402 #include "facom2.llmoer.h"
403 
404 END SUBROUTINE fainig_fort
405 
406 
407 
408 ! Oct-2012 P. Marguinaud 64b LFI
409 SUBROUTINE fainig64 &
410 & (krep, krang, cdpref, knivau, cdsuff, ldcosp, &
411 & klcham, ksec1, ksec2, psec2, ksec3, psec3, ksec4,&
412 & ydgr1tab)
413 USE fa_mod, ONLY : fa => fa_com_default, &
415 & new_fa_default, &
416 & fagr1tab
417 USE lfi_precision
418 IMPLICIT NONE
419 ! Arguments
420 INTEGER (KIND=JPLIKB) KREP ! OUT
421 INTEGER (KIND=JPLIKB) KRANG ! IN
422 CHARACTER (LEN=*) CDPREF ! IN
423 INTEGER (KIND=JPLIKB) KNIVAU ! IN
424 CHARACTER (LEN=*) CDSUFF ! IN
425 LOGICAL LDCOSP ! IN
426 INTEGER (KIND=JPLIKB) KLCHAM ! IN
427 INTEGER (KIND=JPLIKB) KSEC1 (*) ! OUT
428 INTEGER (KIND=JPLIKB) KSEC2 (*) ! OUT
429 REAL (KIND=JPDBLR) PSEC2 (*) ! OUT
430 INTEGER (KIND=JPLIKB) KSEC3 (2) ! OUT
431 REAL (KIND=JPDBLR) PSEC3 (*) ! OUT
432 INTEGER (KIND=JPLIKB) KSEC4 (*) ! OUT
433 type(fagr1tab) ydgr1tab ! OUT
434 
435 IF (.NOT. fa_com_default_init) CALL new_fa_default ()
436 
437 CALL fainig_fort &
438 & (fa, krep, krang, cdpref, knivau, cdsuff, ldcosp, &
439 & klcham, ksec1, ksec2, psec2, ksec3, psec3, ksec4,&
440 & ydgr1tab)
441 
442 END SUBROUTINE fainig64
443 
444 SUBROUTINE fainig &
445 & (krep, krang, cdpref, knivau, cdsuff, ldcosp, &
446 & klcham, ksec1, ksec2, psec2, ksec3, psec3, ksec4,&
447 & ydgr1tab)
448 USE fa_mod, ONLY : fa => fa_com_default, &
450 & new_fa_default, &
451 & fagr1tab
452 USE lfi_precision
453 IMPLICIT NONE
454 ! Arguments
455 INTEGER (KIND=JPLIKM) KREP ! OUT
456 INTEGER (KIND=JPLIKM) KRANG ! IN
457 CHARACTER (LEN=*) CDPREF ! IN
458 INTEGER (KIND=JPLIKM) KNIVAU ! IN
459 CHARACTER (LEN=*) CDSUFF ! IN
460 LOGICAL LDCOSP ! IN
461 INTEGER (KIND=JPLIKM) KLCHAM ! IN
462 INTEGER (KIND=JPLIKM) KSEC1 (*) ! OUT
463 INTEGER (KIND=JPLIKM) KSEC2 (*) ! OUT
464 REAL (KIND=JPDBLR) PSEC2 (*) ! OUT
465 INTEGER (KIND=JPLIKM) KSEC3 (2) ! OUT
466 REAL (KIND=JPDBLR) PSEC3 (*) ! OUT
467 INTEGER (KIND=JPLIKM) KSEC4 (*) ! OUT
468 type(fagr1tab) ydgr1tab ! OUT
469 
470 IF (.NOT. fa_com_default_init) CALL new_fa_default ()
471 
472 CALL fainig_mt &
473 & (fa, krep, krang, cdpref, knivau, cdsuff, ldcosp, &
474 & klcham, ksec1, ksec2, psec2, ksec3, psec3, ksec4,&
475 & ydgr1tab)
476 
477 END SUBROUTINE fainig
478 
479 SUBROUTINE fainig_mt &
480 & (fa, krep, krang, cdpref, knivau, cdsuff, ldcosp, &
481 & klcham, ksec1, ksec2, psec2, ksec3, psec3, ksec4,&
482 & ydgr1tab)
483 USE fa_mod, ONLY : fa_com, fagr1tab
484 USE lfi_precision
485 IMPLICIT NONE
486 ! Arguments
487 type(fa_com) fa ! INOUT
488 INTEGER (KIND=JPLIKM) KREP ! OUT
489 INTEGER (KIND=JPLIKM) KRANG ! IN
490 CHARACTER (LEN=*) CDPREF ! IN
491 INTEGER (KIND=JPLIKM) KNIVAU ! IN
492 CHARACTER (LEN=*) CDSUFF ! IN
493 LOGICAL LDCOSP ! IN
494 INTEGER (KIND=JPLIKM) KLCHAM ! IN
495 INTEGER (KIND=JPLIKM) KSEC1 (fa%jpsec1) ! OUT
496 INTEGER (KIND=JPLIKM) KSEC2 (fa%jpsec2) ! OUT
497 REAL (KIND=JPDBLR) PSEC2 (*) ! OUT
498 INTEGER (KIND=JPLIKM) KSEC3 (2) ! OUT
499 REAL (KIND=JPDBLR) PSEC3 (*) ! OUT
500 INTEGER (KIND=JPLIKM) KSEC4 (fa%jpsec4) ! OUT
501 type(fagr1tab) ydgr1tab ! OUT
502 ! Local integers
503 INTEGER (KIND=JPLIKB) IREP ! OUT
504 INTEGER (KIND=JPLIKB) IRANG ! IN
505 INTEGER (KIND=JPLIKB) INIVAU ! IN
506 INTEGER (KIND=JPLIKB) ILCHAM ! IN
507 INTEGER (KIND=JPLIKB) ISEC1 (fa%jpsec1) ! OUT
508 INTEGER (KIND=JPLIKB) ISEC2 (fa%jpsec2) ! OUT
509 INTEGER (KIND=JPLIKB) ISEC3 (2) ! OUT
510 INTEGER (KIND=JPLIKB) ISEC4 (fa%jpsec4) ! OUT
511 ! Convert arguments
512 
513 irang = int( krang, jplikb)
514 inivau = int( knivau, jplikb)
515 ilcham = int( klcham, jplikb)
516 
517 CALL fainig_fort &
518 & (fa, irep, irang, cdpref, inivau, cdsuff, ldcosp, &
519 & ilcham, isec1, isec2, psec2, isec3, psec3, isec4,&
520 & ydgr1tab)
521 
522 krep = int( irep, jplikm)
523 ksec1 = int( isec1, jplikm)
524 ksec2 = int( isec2, jplikm)
525 ksec3 = int( isec3, jplikm)
526 ksec4 = int( isec4, jplikm)
527 
528 END SUBROUTINE fainig_mt
529 
530 !INTF KREP OUT
531 !INTF KRANG IN
532 !INTF CDPREF IN
533 !INTF KNIVAU IN
534 !INTF CDSUFF IN
535 !INTF LDCOSP IN
536 !INTF KLCHAM IN
537 !INTF KSEC1 OUT DIMS=FA%JPSEC1
538 !INTF KSEC2 OUT DIMS=FA%JPSEC2
539 !INTF PSEC2 OUT DIMS=*
540 !INTF KSEC3 OUT DIMS=2
541 !INTF PSEC3 OUT DIMS=*
542 !INTF KSEC4 OUT DIMS=FA%JPSEC4
543 !INTF YDGR1TAB OUT
integer, parameter jplikb
subroutine fainig_fort(FA, KREP, KRANG, CDPREF, KNIVAU, CDSUFF, LDCOSP, KLCHAM, KSEC1, KSEC2, PSEC2, KSEC3, PSEC3, KSEC4, YDGR1TAB)
Definition: fainig.F90:8
subroutine fainig(KREP, KRANG, CDPREF, KNIVAU, CDSUFF, LDCOSP, KLCHAM, KSEC1, KSEC2, PSEC2, KSEC3, PSEC3, KSEC4, YDGR1TAB)
Definition: fainig.F90:448
logical, save fa_com_default_init
Definition: fa_mod.F90:477
subroutine new_fa_default()
Definition: fa_mod.F90:649
subroutine fais2f_fort(FA, KREP, KRANG)
Definition: fais2f.F90:5
integer(kind=jplikb), parameter jd_ce1
Definition: fa_mod.F90:16
Definition: fa_mod.F90:1
integer, parameter jprb
Definition: parkind1.F90:32
subroutine fainig64(KREP, KRANG, CDPREF, KNIVAU, CDSUFF, LDCOSP, KLCHAM, KSEC1, KSEC2, PSEC2, KSEC3, PSEC3, KSEC4, YDGR1TAB)
Definition: fainig.F90:413
subroutine fainig_mt(FA, KREP, KRANG, CDPREF, KNIVAU, CDSUFF, LDCOSP, KLCHAM, KSEC1, KSEC2, PSEC2, KSEC3, PSEC3, KSEC4, YDGR1TAB)
Definition: fainig.F90:483
integer(kind=jplikb), parameter jd_set
Definition: fa_mod.F90:16
integer(kind=jplikb), parameter jd_fmt
Definition: fa_mod.F90:16
logical lhook
Definition: yomhook.F90:15
integer, parameter jplikm
type(fa_com), target, save fa_com_default
Definition: fa_mod.F90:476
subroutine faisc2_fort(FA, KREP, KRANGC)
Definition: faisc2.F90:5
integer(kind=jplikb), parameter jd_dex
Definition: fa_mod.F90:16
subroutine faipar_fort(FA, KNUMER, KNIMES, KCODE, LDFATA, CDMESS, CDNSPR, CDACTI, LDRLFI)
Definition: faipar.F90:6
subroutine faipag_fort(FA, KREP, KNUMER, CDPREF, KNIVAU, CDSUFF, KNIPAR, YDGR1TAB)
Definition: faipag.F90:6
subroutine faisc1_fort(FA, KREP, KRANG)
Definition: faisc1.F90:5
integer(kind=jplikb), parameter jpniil
Definition: fa_mod.F90:31