Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / external / io_grib2 / bacio-1.3 / baciof.F
blob271a34c782d98c4259a67715adb2b68dea818b85
1 C-----------------------------------------------------------------------
2       MODULE BACIO_MODULE
3 C$$$  F90-MODULE DOCUMENTATION BLOCK
5 C F90-MODULE: BACIO_MODULE   BYTE-ADDRESSABLE I/O MODULE
6 C   PRGMMR: IREDELL          ORG: NP23        DATE: 98-06-04
8 C ABSTRACT: MODULE TO SHARE FILE DESCRIPTORS
9 C   IN THE BYTE-ADDESSABLE I/O PACKAGE.
11 C PROGRAM HISTORY LOG:
12 C   98-06-04  IREDELL
14 C ATTRIBUTES:
15 C   LANGUAGE: FORTRAN 90
17 C$$$
18       INTEGER,EXTERNAL:: BACIO
19       INTEGER,DIMENSION(999),SAVE:: FD=999*0
20       INTEGER,DIMENSION(20),SAVE:: BAOPTS=0
21       INCLUDE 'baciof.h'
22       END
23 C-----------------------------------------------------------------------
24       SUBROUTINE BASETO(NOPT,VOPT)
25 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
27 C SUBPROGRAM: BASETO         BYTE-ADDRESSABLE SET OPTIONS
28 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
30 C ABSTRACT: SET OPTIONS FOR BYTE-ADDRESSABLE I/O.
31 C   ALL OPTIONS DEFAULT TO 0.
32 C   OPTION 1: BLOCKED READING OPTION
33 C             IF THE OPTION VALUE IS 1, THEN THE READING IS BLOCKED
34 C             INTO FOUR 4096-BYTE BUFFERS.  THIS MAY BE EFFICIENT IF
35 C             THE READS WILL BE REQUESTED IN MUCH SMALLER CHUNKS.
36 C             OTHERWISE, EACH CALL TO BAREAD INITIATES A PHYSICAL READ.
38 C PROGRAM HISTORY LOG:
39 C   1998-06-04  IREDELL
41 C USAGE:    CALL BASETO(NOPT,VOPT)
42 C   INPUT ARGUMENTS:
43 C     NOPT         INTEGER OPTION NUMBER
44 C     VOPT         INTEGER OPTION VALUE
46 C MODULES USED:
47 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
49 C ATTRIBUTES:
50 C   LANGUAGE: FORTRAN 90
52 C$$$
53       USE BACIO_MODULE
54       INTEGER NOPT,VOPT
55 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
56       IF(NOPT.GE.1.AND.NOPT.LE.20) BAOPTS(NOPT)=VOPT
57 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
58       END
59 C-----------------------------------------------------------------------
60       SUBROUTINE BAOPEN(LU,CFN,IRET)
61 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
63 C SUBPROGRAM: BAOPEN         BYTE-ADDRESSABLE OPEN
64 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
66 C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE.
68 C PROGRAM HISTORY LOG:
69 C   1998-06-04  IREDELL
71 C USAGE:    CALL BAOPEN(LU,CFN,IRET)
72 C   INPUT ARGUMENTS:
73 C     LU           INTEGER UNIT TO OPEN
74 C     CFN          CHARACTER FILENAME TO OPEN
75 C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
76 C   OUTPUT ARGUMENTS:
77 C     IRET         INTEGER RETURN CODE
79 C MODULES USED:
80 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
82 C SUBPROGRAMS CALLED:
83 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
85 C ATTRIBUTES:
86 C   LANGUAGE: FORTRAN 90
88 C$$$
89       USE BACIO_MODULE
90       CHARACTER CFN*(*)
91       CHARACTER(80) CMSG
92       INTEGER :: SIZE = 1
94 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
95       IF(LU.LT.001.OR.LU.GT.999) THEN
96         IRET=6
97         RETURN
98       ENDIF
99 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
100       IRET=BACIO(BACIO_OPENRW,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
101 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
102       END
103 C-----------------------------------------------------------------------
104       SUBROUTINE BAOPENR(LU,CFN,IRET)
105 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
107 C SUBPROGRAM: BAOPENR        BYTE-ADDRESSABLE OPEN
108 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
110 C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR READ ONLY.
112 C PROGRAM HISTORY LOG:
113 C   1998-06-04  IREDELL
115 C USAGE:    CALL BAOPENR(LU,CFN,IRET)
116 C   INPUT ARGUMENTS:
117 C     LU           INTEGER UNIT TO OPEN
118 C     CFN          CHARACTER FILENAME TO OPEN
119 C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
120 C   OUTPUT ARGUMENTS:
121 C     IRET         INTEGER RETURN CODE
123 C MODULES USED:
124 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
126 C SUBPROGRAMS CALLED:
127 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
129 C ATTRIBUTES:
130 C   LANGUAGE: FORTRAN 90
132 C$$$
133       USE BACIO_MODULE
134       CHARACTER CFN*(*)
135       INTEGER :: SIZE = 1
136 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
137       IF(LU.LT.001.OR.LU.GT.999) THEN
138         IRET=6
139         RETURN
140       ENDIF
141 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
142       IRET=BACIO(BACIO_OPENR,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
143 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
144       END
145 C-----------------------------------------------------------------------
146       SUBROUTINE BAOPENW(LU,CFN,IRET)
147 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
149 C SUBPROGRAM: BAOPENW        BYTE-ADDRESSABLE OPEN
150 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
152 C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY.
154 C PROGRAM HISTORY LOG:
155 C   1998-06-04  IREDELL
157 C USAGE:    CALL BAOPENW(LU,CFN,IRET)
158 C   INPUT ARGUMENTS:
159 C     LU           INTEGER UNIT TO OPEN
160 C     CFN          CHARACTER FILENAME TO OPEN
161 C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
162 C   OUTPUT ARGUMENTS:
163 C     IRET         INTEGER RETURN CODE
165 C MODULES USED:
166 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
168 C SUBPROGRAMS CALLED:
169 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
171 C ATTRIBUTES:
172 C   LANGUAGE: FORTRAN 90
174 C$$$
175       USE BACIO_MODULE
176       CHARACTER CFN*(*)
177       INTEGER :: SIZE = 1
178 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
179       IF(LU.LT.001.OR.LU.GT.999) THEN
180         IRET=6
181         RETURN
182       ENDIF
183 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
184       IRET=BACIO(BACIO_OPENWT,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
185 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
186       END
187 C-----------------------------------------------------------------------
188       SUBROUTINE BAOPENWT(LU,CFN,IRET)
189 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
191 C SUBPROGRAM: BAOPENWT       BYTE-ADDRESSABLE OPEN
192 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
194 C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY WITH TRUNCATION.
196 C PROGRAM HISTORY LOG:
197 C   1998-06-04  IREDELL
199 C USAGE:    CALL BAOPENWT(LU,CFN,IRET)
200 C   INPUT ARGUMENTS:
201 C     LU           INTEGER UNIT TO OPEN
202 C     CFN          CHARACTER FILENAME TO OPEN
203 C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
204 C   OUTPUT ARGUMENTS:
205 C     IRET         INTEGER RETURN CODE
207 C MODULES USED:
208 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
210 C SUBPROGRAMS CALLED:
211 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
213 C ATTRIBUTES:
214 C   LANGUAGE: FORTRAN 90
216 C$$$
217       USE BACIO_MODULE
218       CHARACTER CFN*(*)
219       INTEGER :: SIZE = 1
220 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
221       IF(LU.LT.001.OR.LU.GT.999) THEN
222         IRET=6
223         RETURN
224       ENDIF
225 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
226       IRET=BACIO(BACIO_OPENWT,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
227 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
228       END
229 C-----------------------------------------------------------------------
230       SUBROUTINE BAOPENWA(LU,CFN,IRET)
231 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
233 C SUBPROGRAM: BAOPENWA       BYTE-ADDRESSABLE OPEN
234 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
236 C ABSTRACT: OPEN A BYTE-ADDRESSABLE FILE FOR WRITE ONLY WITH APPEND.
238 C PROGRAM HISTORY LOG:
239 C   1998-06-04  IREDELL
241 C USAGE:    CALL BAOPENWA(LU,CFN,IRET)
242 C   INPUT ARGUMENTS:
243 C     LU           INTEGER UNIT TO OPEN
244 C     CFN          CHARACTER FILENAME TO OPEN
245 C                  (CONSISTING OF NONBLANK PRINTABLE CHARACTERS)
246 C   OUTPUT ARGUMENTS:
247 C     IRET         INTEGER RETURN CODE
249 C MODULES USED:
250 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
252 C SUBPROGRAMS CALLED:
253 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
255 C ATTRIBUTES:
256 C   LANGUAGE: FORTRAN 90
258 C$$$
259       USE BACIO_MODULE
260       CHARACTER CFN*(*)
261       INTEGER :: SIZE = 1
262 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
263       IF(LU.LT.001.OR.LU.GT.999) THEN
264         IRET=6
265         RETURN
266       ENDIF
267 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
268       IRET=BACIO(BACIO_OPENWA,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
269 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
270       END
271 C-----------------------------------------------------------------------
272       SUBROUTINE BACLOSE(LU,IRET)
273 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
275 C SUBPROGRAM: BACLOSE        BYTE-ADDRESSABLE CLOSE
276 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
278 C ABSTRACT: CLOSE A BYTE-ADDRESSABLE FILE.
280 C PROGRAM HISTORY LOG:
281 C   1998-06-04  IREDELL
283 C USAGE:    CALL BACLOSE(LU,IRET)
284 C   INPUT ARGUMENTS:
285 C     LU           INTEGER UNIT TO CLOSE
286 C   OUTPUT ARGUMENTS:
287 C     IRET         INTEGER RETURN CODE
289 C MODULES USED:
290 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
292 C SUBPROGRAMS CALLED:
293 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
295 C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
297 C ATTRIBUTES:
298 C   LANGUAGE: FORTRAN 90
300 C$$$
301       USE BACIO_MODULE
302       INTEGER :: SIZE = 1
303 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
304       IF(LU.LT.001.OR.LU.GT.999) THEN
305         IRET=6
306         RETURN
307       ENDIF
308 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
309       IRET=BACIO(BACIO_CLOSE,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
310       IF(IRET.EQ.0) FD(LU)=0
311 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
312       END
313 C-----------------------------------------------------------------------
314       SUBROUTINE BAREAD(LU,IB,NB,KA,A)
315 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
317 C SUBPROGRAM: BAREAD         BYTE-ADDRESSABLE READ
318 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
320 C ABSTRACT: READ A GIVEN NUMBER OF BYTES FROM AN UNBLOCKED FILE,
321 C   SKIPPING A GIVEN NUMBER OF BYTES.
322 C   THE PHYSICAL I/O IS BLOCKED INTO FOUR 4096-BYTE BUFFERS
323 C   IF THE BYTE-ADDRESSABLE OPTION 1 HAS BEEN SET TO 1 BY BASETO.
324 C   THIS BUFFERED READING IS INCOMPATIBLE WITH NO-SEEK READING.
326 C PROGRAM HISTORY LOG:
327 C   1998-06-04  IREDELL
329 C USAGE:    CALL BAREAD(LU,IB,NB,KA,A)
330 C   INPUT ARGUMENTS:
331 C     LU           INTEGER UNIT TO READ
332 C     IB           INTEGER NUMBER OF BYTES TO SKIP
333 C                  (IF IB<0, THEN THE FILE IS ACCESSED WITH NO SEEKING)
334 C     NB           INTEGER NUMBER OF BYTES TO READ
335 C   OUTPUT ARGUMENTS:
336 C     KA           INTEGER NUMBER OF BYTES ACTUALLY READ
337 C     A            CHARACTER*1 (NB) DATA READ
339 C MODULES USED:
340 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
342 C SUBPROGRAMS CALLED:
343 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
345 C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
347 C ATTRIBUTES:
348 C   LANGUAGE: FORTRAN 90
350 C$$$
351       USE BACIO_MODULE
352       CHARACTER A(NB)
353       CHARACTER CFN
354       PARAMETER(NY=4096,MY=4)
355       INTEGER NS(MY),NN(MY)
356       CHARACTER Y(NY,MY)
357       DATA LUX/0/
358       SAVE JY,NS,NN,Y,LUX
359       INTEGER :: SIZE=1
360       INTEGER :: ZERO=0
361 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
362       IF(FD(LU).LE.0) THEN
363         KA=0
364         RETURN
365       ENDIF
366       IF(IB.LT.0.AND.BAOPTS(1).EQ.1) THEN
367         KA=0
368         RETURN
369       ENDIF
370       IF(NB.LE.0) THEN
371         KA=0
372         RETURN
373       ENDIF
374 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
375 C  UNBUFFERED I/O
376       IF(BAOPTS(1).NE.1) THEN
377         IF(IB.GE.0) THEN
379           IRET=BACIO(BACIO_READ,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
380         ELSE
381           IRET=BACIO(BACIO_READ+BACIO_NOSEEK,ZERO,JB,SIZE,NB,KA,
382      &          FD(LU),CFN,A)
383         ENDIF
384 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
385 C  BUFFERED I/O
386 C  GET DATA FROM PREVIOUS CALL IF POSSIBLE
387       ELSE
388         KA=0
389         IF(LUX.NE.LU) THEN
390           JY=0
391           NS=0
392           NN=0
393         ELSE
394           DO I=1,MY
395             IY=MOD(JY+I-1,MY)+1
396             KY=IB+KA-NS(IY)
397             IF(KA.LT.NB.AND.KY.GE.0.AND.KY.LT.NN(IY)) THEN
398               K=MIN(NB-KA,NN(IY)-KY)
399               A(KA+1:KA+K)=Y(KY+1:KY+K,IY)
400               KA=KA+K
401             ENDIF
402           ENDDO
403         ENDIF
404 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
405 C  SET POSITION AND READ BUFFER AND GET DATA
406         IF(KA.LT.NB) THEN
407           LUX=ABS(LU)
408           JY=MOD(JY,MY)+1
409           NS(JY)=IB+KA
410           IRET=BACIO(BACIO_READ,NS(JY),JB,SIZE,NY,NN(JY),
411      &               FD(LUX),CFN,Y(1,JY))
412           IF(NN(JY).GT.0) THEN
413             K=MIN(NB-KA,NN(JY))
414             A(KA+1:KA+K)=Y(1:K,JY)
415             KA=KA+K
416           ENDIF
417 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
418 C  CONTINUE TO READ BUFFER AND GET DATA
419           DOWHILE(NN(JY).EQ.NY.AND.KA.LT.NB)
420             JY=MOD(JY,MY)+1
421             NS(JY)=NS(JY)+NN(JY)
422             IRET=BACIO(BACIO_READ+BACIO_NOSEEK,NS(JY),JB,SIZE,NY,NN(JY),
423      &                 FD(LUX),CFN,Y(1,JY))
424             IF(NN(JY).GT.0) THEN
425               K=MIN(NB-KA,NN(JY))
426               A(KA+1:KA+K)=Y(1:K,JY)
427               KA=KA+K
428             ENDIF
429           ENDDO
430         ENDIF
431       ENDIF
432 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
433       END
434 C-----------------------------------------------------------------------
435       SUBROUTINE BAWRITE(LU,IB,NB,KA,A)
436 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
438 C SUBPROGRAM: BAWRITE        BYTE-ADDRESSABLE WRITE
439 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
441 C ABSTRACT: WRITE A GIVEN NUMBER OF BYTES TO AN UNBLOCKED FILE,
442 C   SKIPPING A GIVEN NUMBER OF BYTES.
444 C PROGRAM HISTORY LOG:
445 C   1998-06-04  IREDELL
447 C USAGE:    CALL BAWRITE(LU,IB,NB,KA,A)
448 C   INPUT ARGUMENTS:
449 C     LU           INTEGER UNIT TO WRITE
450 C     IB           INTEGER NUMBER OF BYTES TO SKIP
451 C                  (IF IB<0, THEN THE FILE IS ACCESSED WITH NO SEEKING)
452 C     NB           INTEGER NUMBER OF BYTES TO WRITE
453 C     A            CHARACTER*1 (NB) DATA TO WRITE
454 C   OUTPUT ARGUMENTS:
455 C     KA           INTEGER NUMBER OF BYTES ACTUALLY WRITTEN
457 C MODULES USED:
458 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
460 C SUBPROGRAMS CALLED:
461 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
463 C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
465 C ATTRIBUTES:
466 C   LANGUAGE: FORTRAN 90
468 C$$$
469       USE BACIO_MODULE
470       CHARACTER A(NB)
471       CHARACTER CFN
472       INTEGER :: SIZE=1
473       INTEGER :: ZERO=0
474 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
475       IF(FD(LU).LE.0) THEN
476         KA=0
477         RETURN
478       ENDIF
479       IF(NB.LE.0) THEN
480         KA=0
481         RETURN
482       ENDIF
483 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
484       IF(IB.GE.0) THEN
485         IRET=BACIO(BACIO_WRITE,IB,JB,SIZE,NB,KA,FD(LU),CFN,A)
486       ELSE
487         IRET=BACIO(BACIO_WRITE+BACIO_NOSEEK,ZERO,JB,SIZE,NB,KA,
488      &        FD(LU),CFN,A)
489       ENDIF
490 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
491       END
492 C-----------------------------------------------------------------------
493       SUBROUTINE WRYTE(LU,NB,A)
494 C$$$  SUBPROGRAM DOCUMENTATION BLOCK
496 C SUBPROGRAM: WRYTE          WRITE DATA OUT BY BYTES
497 C   PRGMMR: IREDELL          ORG: W/NMC23     DATE: 1998-06-04
499 C ABSTRACT: WRITE A GIVEN NUMBER OF BYTES TO AN UNBLOCKED FILE.
501 C PROGRAM HISTORY LOG:
502 C   92-10-31  IREDELL
503 C   95-10-31  IREDELL     WORKSTATION VERSION
504 C   1998-06-04  IREDELL   BACIO VERSION
506 C USAGE:    CALL WRYTE(LU,NB,A)
507 C   INPUT ARGUMENTS:
508 C     LU           INTEGER UNIT TO WHICH TO WRITE
509 C     NB           INTEGER NUMBER OF BYTES TO WRITE
510 C     A            CHARACTER*1 (NB) DATA TO WRITE
512 C MODULES USED:
513 C   BACIO_MODULE   BYTE-ADDRESSABLE I/O FORTRAN INTERFACE
515 C SUBPROGRAMS CALLED:
516 C   BACIO          BYTE-ADDRESSABLE I/O C PACKAGE
518 C REMARKS:  A BAOPEN MUST HAVE ALREADY BEEN CALLED.
520 C ATTRIBUTES:
521 C   LANGUAGE: FORTRAN 90
523 C$$$
524       USE BACIO_MODULE
525       CHARACTER A(NB)
526       CHARACTER CFN
527       INTEGER :: SIZE=1
528       INTEGER :: ZERO=0
529 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
530       IF(FD(LU).LE.0) THEN
531         RETURN
532       ENDIF
533       IF(NB.LE.0) THEN
534         RETURN
535       ENDIF
536 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
537       IRET=BACIO(BACIO_WRITE+BACIO_NOSEEK,ZERO,JB,SIZE,NB,KA,FD(LU),
538      &        CFN,A)
539 C - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
540       RETURN
541       END