Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / fmmore / src / fmmore.f90
1 !      ############
2        PROGRAM FMMORE
3 !      ############
4 !
5 !!****  *FMMORE* - routine to list the content of a LFI file
6 !!
7 !!    PURPOSE
8 !!    -------
9 !
10 !       The purpose of FMMORE is to list the content of a LFI file
11 !
12 !!**  METHOD
13 !!    ------
14 !!
15 !!      The FM and LFI routines are used to open, list and close the LFI file
16 !!    This routine is embedded in a Unix shell script to mimic the "more"
17 !!    function.
18 !!
19 !!    EXTERNAL
20 !!    --------
21 !!
22 !!      FMOPEN, FMLOOK, LFINAF, LFILAF, FMCLOS
23 !!
24 !!    calls: READUNTOUCH containing FMREAD
25 !!
26 !!    REFERENCE
27 !!    ---------
28 !!
29 !!      The structure and content of the Meso-NH files (C. Fischer)
30 !!
31 !!    AUTHOR
32 !!    ------
33 !!
34 !!      C. FISCHER      *METEO-FRANCE*
35 !!
36 !!    MODIFICATIONS
37 !!    -------------
38 !!
39 !!      original                                                        03/95
40 !!      new I/O      (Mallet)                                           03/02
41 !!
42 !----------------------------------------------------------------------------
43 !
44 !*      0.    DECLARATIONS
45 !             ------------
46 !
47 #ifdef NAGf95
48   USE F90_UNIX
49 #endif
50 !
51 ! en attendant une Surcouche officielle...
52 !USE MODE_FM  
53 !
54 IMPLICIT NONE
55 !
56 !*      0.2   Declarations of local variables
57 !
58 INTEGER :: krep
59 INTEGER :: KNPRAR, KFTYPE,KVERB,KNINAR,KNUMBR
60 INTEGER :: KNALDO, KNTROU, KNARES, KNAMAX
61 LOGICAL :: LDTOUT
62 CHARACTER(LEN=32) :: CLUOUT,YLFINAME
63 CHARACTER(LEN=28) :: CFNAME
64 ! reading of filename as input argument
65 #ifndef NAGf95
66 INTEGER :: IARGC
67 ! CRAY specific
68 INTEGER :: arglen
69 !!!!!!!!!!!!!!!!!
70 #endif
71 INTEGER :: inarg,iresp
72 CHARACTER(LEN=50) :: yexe
73 !
74 !*      1.    INITIALIZATION
75 !             --------------
76 !
77 KFTYPE=2      ! pas de transfert dans fmclos
78 KVERB=0
79 !
80 CLUOUT='output_listing'
81 !
82 knaldo=0 ; kntrou=0 ; knares=0 ; knamax=0
83 LDTOUT=.TRUE.
84 !
85 !*      2.    READING FILENAME
86 !             ----------------
87 !READ(5,FMT='(A28)') CFNAME
88 INARG = IARGC()
89
90 #if defined(F90HP)
91 #define HPINCR 1
92 #else
93 #define HPINCR 0
94 #endif
95
96 #if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
97 CALL GETARG(0+HPINCR,yexe)
98 IF (LEN_TRIM(yexe) == 0) THEN
99   PRINT *, 'FATAL ERROR : Recompiler avec la macro -DF90HP'
100   STOP
101 END IF
102 #else
103 CALL PXFGETARG(0,yexe,arglen,iresp)
104 #endif
105 !  PRINT *,yexe, ' avec ',INARG,' arguments.'
106 IF (INARG == 1) THEN 
107 #if defined(FUJI) || defined(NAGf95) || defined(NEC) || defined(HP) || defined(pgf) || defined(G95) || defined(GFORTRAN)
108      CALL GETARG(1+HPINCR,CFNAME)
109 #else
110      CALL PXFGETARG(1,CFNAME,arglen,iresp)
111 #endif
112 ELSE 
113   PRINT *,'Usage : ', TRIM(yexe), ' [fichier fm]'
114   STOP
115 END IF
116 !
117 !*      3.    OPENING FILE
118 !             ------------
119
120 ! en attendant une Surcouche officielle...
121 !CALL FMOPEN_ll(CFNAME,'READ',CLUOUT,KNPRAR,KFTYPE,KVERB,&
122 CALL FMOPEN(CFNAME,'OLD',CLUOUT,KNPRAR,KFTYPE,KVERB,&
123                         KNINAR,krep)
124 IF (krep.NE.0) GOTO 1000
125 !
126 !*      4.    
127 !
128 YLFINAME=ADJUSTL(ADJUSTR(CFNAME)//'.lfi')
129 ! en attendant une Surcouche officielle...
130 !CALL FMLOOK_ll(YLFINAME,CLUOUT,knumbr,krep)
131 CALL FMLOOK(YLFINAME,CLUOUT,knumbr,krep)
132 IF (krep.NE.0) GOTO 1000
133 CALL LFINAF(krep,knumbr,knaldo,kntrou,knares,knamax)
134 IF (krep.NE.0) GOTO 1000
135 !WRITE(6,*) knaldo,kntrou,knares,knamax
136 IF (krep.NE.0) GOTO 1000
137 CALL LFILAF(krep,knumbr,LDTOUT)
138 !
139 CALL READUNTOUCH(CFNAME,CLUOUT)
140 !
141 ! en attendant une Surcouche officielle...
142 !CALL FMCLOS_ll(CFNAME,'KEEP',CLUOUT,krep)
143 CALL FMCLOS(CFNAME,'KEEP',CLUOUT,krep)
144 IF (krep.NE.0) THEN
145   GOTO 1000
146 ELSE
147   GOTO 1010
148 ENDIF
149 !
150 1000   WRITE (0,*) ' exit in FMMORE with :',krep
151 1010   CONTINUE
152 !
153 END PROGRAM