| 1 | SUBROUTINE readstd(imx,champ,imax) |
|---|
| 2 | IMPLICIT NONE |
|---|
| 3 | |
|---|
| 4 | c======================================================================= |
|---|
| 5 | c |
|---|
| 6 | c Auteurs: Jan Polcher, Frederic Hourdin 20/04/91 |
|---|
| 7 | c -------- |
|---|
| 8 | c |
|---|
| 9 | c Objet: |
|---|
| 10 | c ------ |
|---|
| 11 | c |
|---|
| 12 | c Subroutine qui lit les fichiers dans le format lmdstd |
|---|
| 13 | c format etabli par : |
|---|
| 14 | c Jan Polcher,Zhao-Xin Li, Frederic Hourdin, Emmanuelle Cohen-Solal, |
|---|
| 15 | c Il peut etre utilise pour sortire des evolutions |
|---|
| 16 | c temporelles, des champs 2D (iim,jjm ou jjm,llm) ou des champs 3D. |
|---|
| 17 | c le character # place devant le format determine la fin de la |
|---|
| 18 | c description du champ et permet eventulellement de rajouter |
|---|
| 19 | c des informations (avant le #). |
|---|
| 20 | c le programme de lecture lit , dans la description, les variables |
|---|
| 21 | c qu'il connait et saute apres jusquau #. A partir de la |
|---|
| 22 | c il commence a lire le champ dans le format specifie. |
|---|
| 23 | c |
|---|
| 24 | c----------------------------------------------------------------------- |
|---|
| 25 | c |
|---|
| 26 | c Interface: |
|---|
| 27 | c ---------- |
|---|
| 28 | c |
|---|
| 29 | c ARGUMENTS |
|---|
| 30 | c --------- |
|---|
| 31 | c |
|---|
| 32 | c imx : INTEGER |
|---|
| 33 | c taille du tableau contenant le champ |
|---|
| 34 | c champ: REAL (imx) |
|---|
| 35 | c champ contenant les valeurs et de longeur icount |
|---|
| 36 | c imax : INTEGER |
|---|
| 37 | c nombre d'element dans le champ |
|---|
| 38 | c |
|---|
| 39 | c COMMON: |
|---|
| 40 | c ------- |
|---|
| 41 | c |
|---|
| 42 | c======================================================================= |
|---|
| 43 | c INCLUDE '/usr/local/lmdgraph/libio/lmdstd.h' |
|---|
| 44 | c |
|---|
| 45 | c INTEGER bandmax |
|---|
| 46 | c PARAMETER(bandmax=24) |
|---|
| 47 | c |
|---|
| 48 | c COMMON/lmdstdch/gtitre,gunites,gformat,gfichier,glistfich(100), |
|---|
| 49 | c $ gentete,gdatedep,gdatefin |
|---|
| 50 | c |
|---|
| 51 | c CHARACTER*100 gtitre !du champ |
|---|
| 52 | c CHARACTER*20 gunites !unites du champ |
|---|
| 53 | c CHARACTER*20 gformat !formats FORTRAN ou zxliN (N=1,2,3) ou '' |
|---|
| 54 | c CHARACTER*100 gfichier !nom du fichier contenant le champ |
|---|
| 55 | c CHARACTER*100 gentete !nom generique (exemple desript. du RUN) |
|---|
| 56 | c CHARACTER*8 gdatedep !date de depart de la moy. ou evol. temp. |
|---|
| 57 | c CHARACTER*8 gdatefin !date de fin '' si une seule datefin |
|---|
| 58 | c CHARACTER*20 glistfich !liste de champs a sortir |
|---|
| 59 | c |
|---|
| 60 | c COMMON/lmdstdnu/ gminimum,gmaximum, |
|---|
| 61 | c $ gdeltajour(bandmax),gdeltapas(bandmax), |
|---|
| 62 | c $ gnbetats(bandmax),gnbfich |
|---|
| 63 | c |
|---|
| 64 | c REAL gminimum ! \ min et max |
|---|
| 65 | c REAL gmaximum ! / du champ |
|---|
| 66 | c INTEGER gnbfich ! nombre de fichier a sortir |
|---|
| 67 | c pour les evolutions temporelles: |
|---|
| 68 | c INTEGER gnbetats ! nombre d'etats par bande |
|---|
| 69 | c INTEGER gdeltapas ! nombre de pas de temps entre 2 sorties |
|---|
| 70 | c REAL gdeltajour ! ecart en jour des sorties sur bandes |
|---|
| 71 | c |
|---|
| 72 | c======================================================================= |
|---|
| 73 | c----------------------------------------------------------------------- |
|---|
| 74 | c Declarations: |
|---|
| 75 | c ------------- |
|---|
| 76 | |
|---|
| 77 | #include "lmdstd.h" |
|---|
| 78 | |
|---|
| 79 | c Arguments: |
|---|
| 80 | c ---------- |
|---|
| 81 | |
|---|
| 82 | INTEGER imx,imax |
|---|
| 83 | REAL champ(imx) |
|---|
| 84 | |
|---|
| 85 | c Local: |
|---|
| 86 | c ------ |
|---|
| 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 | |
|---|
| 100 | c----------------------------------------------------------------------- |
|---|
| 101 | c Initialisations: |
|---|
| 102 | c ---------------- |
|---|
| 103 | |
|---|
| 104 | check = .FALSE. |
|---|
| 105 | DO 9876 i=1,20 |
|---|
| 106 | helptest(i) = ' ' |
|---|
| 107 | 9876 CONTINUE |
|---|
| 108 | |
|---|
| 109 | |
|---|
| 110 | c----------------------------------------------------------------------- |
|---|
| 111 | c lecture le l'entete: |
|---|
| 112 | c -------------------- |
|---|
| 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 |
|---|
| 150 | c WRITE(*,*) 'la description du run' |
|---|
| 151 | c 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 |
|---|
| 161 | c WRITE(*,*) 'le titre du dessin' |
|---|
| 162 | c 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 |
|---|
| 173 | c WRITE(*,*) |
|---|
| 174 | c & 'datefin du debut de la moyenne (ou le mois tout simplement)' |
|---|
| 175 | c READ (*,'(a8)') gdatedep |
|---|
| 176 | c WRITE(*,*) 'et celle de la fin (ou rien du tout)' |
|---|
| 177 | c 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 |
|---|
| 188 | c WRITE(*,*) 'les unitees du champ' |
|---|
| 189 | c 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 |
|---|
| 197 | c READ (helptest(6),*,ERR=1212) |
|---|
| 198 | c . (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 |
|---|
| 210 | c READ (helptest(6),*,ERR=1212) |
|---|
| 211 | c . (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 |
|---|
| 220 | c 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 |
|---|
| 232 | c 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 |
|---|
| 241 | c 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 | |
|---|
| 257 | c----------------------------------------------------------------------- |
|---|
| 258 | c lecture du champ proprement dit: |
|---|
| 259 | c -------------------------------- |
|---|
| 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 |
|---|
