source: trunk/mesoscale/LMDZ.MARS/libf_gcm/bibio/readstd.F @ 57

Last change on this file since 57 was 57, checked in by aslmd, 14 years ago

mineur LMD_MM_MARS: ajout du GCM ancienne physique, systeme maintenant complet sur SVN (ne manque que la base de donnees d'etats initiaux)
File size: 8.0 KB
RevLine 
[57]1      SUBROUTINE readstd(imx,champ,imax)
2      IMPLICIT NONE
3
4c=======================================================================
5c
6c   Auteurs:   Jan Polcher, Frederic Hourdin  20/04/91
7c   --------
8c
9c   Objet:
10c   ------
11c
12c Subroutine qui lit les fichiers dans le format lmdstd
13c format etabli par :
14c  Jan Polcher,Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal,
15c Il peut etre utilise pour sortire  des evolutions
16c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D.
17c le character # place devant le format determine la fin de la
18c description du champ et permet eventulellement de rajouter
19c des informations (avant le #).
20c le programme de lecture lit , dans la description, les variables
21c qu'il connait et saute apres jusquau #. A partir de la
22c il commence a lire le champ dans le format specifie.
23c
24c-----------------------------------------------------------------------
25c
26c   Interface:
27c   ----------
28c
29c   ARGUMENTS
30c   ---------
31c
32c imx  : INTEGER
33c        taille du tableau contenant le champ
34c champ: REAL (imx)
35c        champ contenant les valeurs et de longeur icount
36c imax : INTEGER
37c        nombre d'element dans le champ
38c
39c   COMMON:
40c   -------
41c
42c=======================================================================
43c  INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h'
44c
45c     INTEGER bandmax
46c     PARAMETER(bandmax=24)
47c
48c     COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100),
49c    $                gentete,gdatedep,gdatefin
50c       
51c     CHARACTER*100 gtitre    !du champ
52c     CHARACTER*20  gunites   !unites du champ
53c     CHARACTER*20  gformat   !formats FORTRAN ou zxliN (N=1,2,3) ou ''
54c     CHARACTER*100 gfichier  !nom du fichier contenant le champ
55c     CHARACTER*100 gentete   !nom generique (exemple desript. du RUN)
56c     CHARACTER*8   gdatedep  !date de depart de la moy. ou evol. temp.
57c     CHARACTER*8   gdatefin  !date de fin '' si une seule datefin
58c     CHARACTER*20  glistfich !liste de champs a sortir
59c
60c     COMMON/lmdstdnu/ gminimum,gmaximum,
61c    $                 gdeltajour(bandmax),gdeltapas(bandmax),
62c    $                 gnbetats(bandmax),gnbfich
63c
64c     REAL    gminimum        ! \    min et max
65c     REAL    gmaximum        ! /    du champ
66c     INTEGER gnbfich         ! nombre de fichier a sortir
67c pour les evolutions temporelles:
68c     INTEGER gnbetats        ! nombre d'etats par bande
69c     INTEGER gdeltapas       ! nombre de pas de temps entre 2 sorties
70c     REAL    gdeltajour      ! ecart en jour des sorties sur bandes
71c
72c=======================================================================
73c-----------------------------------------------------------------------
74c   Declarations:
75c   -------------
76
77#include "lmdstd.h"
78
79c   Arguments:
80c   ----------
81
82      INTEGER imx,imax
83      REAL champ(imx)
84
85c   Local:
86c   ------
87
88      INTEGER i
89
90      CHARACTER*200 test(20)
91      CHARACTER*200 helptest(20)
92      CHARACTER*200 help
93      INTEGER reccount
94
95      LOGICAL check,continue
96
97      EXTERNAL lnblnk
98      INTEGER lnblnk
99
100c-----------------------------------------------------------------------
101c   Initialisations:
102c   ----------------
103
104      check = .FALSE.
105      DO 9876 i=1,20
106        helptest(i) = '        '
107 9876 CONTINUE
108
109
110c-----------------------------------------------------------------------
111c   lecture le l'entete:
112c   --------------------
113
114 2222 OPEN (unit=10,file=gfichier(1:lnblnk(gfichier)), form='formatted',
115     &      ERR = 9999, status='old')
116      GOTO 1111
117
118 9999 WRITE(*,*) 'Je ne peut pas lire le fichier: ',
119     & gfichier(1:lnblnk(gfichier))
120      CLOSE(10)
121      WRITE(*,*) 'Entrez S.V.P. un autre nom de fichier (path absolu) '
122      WRITE(*,*) 'ou RETURN pour stopper lexecution'
123      READ (*,'(a)') gfichier
124      IF(lnblnk(gfichier).EQ.0) STOP
125      GOTO 2222
126
127 1111 continue = .TRUE.
128      DO 2345 i=1,20
129        IF (continue) THEN
130          READ (10,'(a200)') test(i)
131          IF ( test(i)(1:1) .EQ. '#' .OR. test(i)(1:1) .EQ. 'f10' ) THEN
132            continue = .FALSE.
133            reccount = i
134          ENDIF
135        ENDIF
136 2345 CONTINUE
137
138      DO 1223 i=1,reccount-1
139        helptest(i) = test(i)
140 1223 CONTINUE
141      helptest(20) = test(reccount)
142
143
144      IF (check) THEN
145        WRITE(*,*) 'gentete'
146      ENDIF
147      IF ( helptest(1) .NE. ' ' ) THEN
148        read (helptest(1),'(a100)') gentete
149      ELSE
150c       WRITE(*,*) 'la description du run'
151c       READ (*,'(a100)') gentete
152        gentete = '    '
153      ENDIF
154
155      IF (check) THEN
156        WRITE(*,*) 'titre'
157      ENDIF
158      IF ( helptest(2) .NE. ' ' ) THEN
159        read (helptest(2),'(a100)') gtitre
160      ELSE
161c       WRITE(*,*) 'le titre du dessin'
162c       READ (*,'(a100)') gtitre
163        gtitre = '    '
164      ENDIF
165
166      IF (check) THEN
167        WRITE(*,*) 'datefins'
168      ENDIF
169      IF ( helptest(3) .NE. ' ' ) THEN
170        read (helptest(3),'(a8)') gdatedep
171        read (helptest(4),'(a8)') gdatefin
172      ELSE
173c       WRITE(*,*)
174c    &  'datefin du debut de la moyenne (ou le mois tout simplement)'
175c       READ (*,'(a8)') gdatedep
176c       WRITE(*,*) 'et celle de la fin (ou rien du tout)'
177c       READ (*,'(a8)') gdatefin
178        gdatedep = '       '
179        gdatefin = '       '
180      ENDIF
181
182      IF (check) THEN
183        WRITE(*,*) 'unitees'
184      ENDIF
185      IF ( helptest(5) .NE. ' ' ) THEN
186        read (helptest(5),'(a20)') gunites
187      ELSE
188c       WRITE(*,*) 'les unitees du champ'
189c       READ (*,'(a20)') gunites
190        gunites = '                    '
191      ENDIF
192
193      IF (check) THEN
194        WRITE(*,*) 'deltapas et nbetats'
195      ENDIF
196      IF ( helptest(6) .NE. ' ' ) THEN
197c       READ (helptest(6),*,ERR=1212)
198c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
199        GOTO 1213
200
201 1212   help =helptest(6)(1:lnblnk(helptest(6)))//
202     .        helptest(7)(1:lnblnk(helptest(7)))
203        helptest(6) = help
204        IF (check) THEN
205          WRITE(*,*) 'Problems while reading', help
206        ENDIF
207        DO  1214 i=7,reccount
208          helptest(i) = helptest(i+1)
209 1214   CONTINUE
210c       READ (helptest(6),*,ERR=1212)
211c    .       (gdeltapas(i),i=1,bandmax),(gnbetats(i),i=1,bandmax)
212
213 1213   CONTINUE
214      ENDIF
215
216      IF (check) THEN
217        WRITE(*,*) 'deltajour'
218      ENDIF
219      IF ( helptest(7) .NE. ' ' ) THEN
220c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
221        GOTO 1313
222
223 1312   help =helptest(7)(1:lnblnk(helptest(7)))//
224     .        helptest(8)(1:lnblnk(helptest(8)))
225        helptest(7) = help
226        IF (check) THEN
227          WRITE(*,*) 'Problems while reading', help
228        ENDIF
229        DO  1314 i=8,reccount
230          helptest(i) = helptest(i+1)
231 1314   CONTINUE
232c       READ (helptest(7),*,ERR=1312) (gdeltajour(i),i=1,bandmax)
233
234 1313   CONTINUE
235      ENDIF
236
237      IF (check) THEN
238        WRITE(*,*) 'min et max'
239      ENDIF
240      IF ( helptest(8) .NE. ' ' ) THEN
241c       READ (helptest(8),*)     gminimum,gmaximum
242      ENDIF
243
244      gformat = helptest(20)(2:20)
245
246      IF (check) THEN
247        WRITE(*,*) gentete
248        WRITE(*,*) gtitre
249        WRITE(*,*) gdatedep
250        WRITE(*,*) gdatefin
251        WRITE(*,*) gdeltapas,gnbetats
252        WRITE(*,*) gdeltajour
253        WRITE(*,*) gminimum,gmaximum
254        WRITE(*,*) gformat
255      ENDIF
256
257c-----------------------------------------------------------------------
258c   lecture du champ proprement dit:
259c   --------------------------------
260
261      READ (10,*)     imax
262   
263      IF(imax.GT.imx) THEN
264         WRITE(*,*) 'Vous essayez de lire un champ dont la taille est'
265         WRITE(*,*) 'superieure a la taille maximum autorisee'
266         WRITE(*,*) 'c est a dire a la dimension du champ utilise'
267         WRITE(*,*) 'pour lappel a la procedure writestd.'
268         STOP
269      ENDIF
270
271      IF (gformat(1:4) .EQ. 'zxli') THEN
272        CALL from36 (champ,imax,10)
273      ELSE
274         IF (lnblnk(gformat).LE.1.OR.lnblnk(gformat).GE.20) THEN
275            READ(10,*) (champ (i),i=1,imax)
276         ELSE
277            READ(10,'('//gformat(1:lnblnk(gformat))//')')
278     $      (champ (i),i=1,imax)
279         ENDIF
280      ENDIF
281
282      CLOSE (unit=10)
283
284
285      RETURN
286      END
Note: See TracBrowser for help on using the repository browser.