IOIPSL/Histcom/histclo.f

module histclo_m

  implicit none

contains

  SUBROUTINE histclo(fid)

    ! This subroutine will close the file corresponding
    ! to the argument, if the argument is present. Else it will close
    ! all opened files.

    USE errioipsl, ONLY: histerr
    use histbeg_totreg_m, ONLY: nb_files
    USE histcom_var, ONLY: ncdf_ids
    USE netcdf, ONLY: nf90_close, nf90_noerr

    INTEGER, INTENT (IN), OPTIONAL:: fid ! file id

    ! Variables local to the procedure:
    INTEGER ifile, ncid, iret
    INTEGER start_loop, end_loop
    CHARACTER(len=70) str70

    !---------------------------------------------------------------------

    IF (present(fid)) THEN
       start_loop = fid
       end_loop = fid
    ELSE
       start_loop = 1
       end_loop = nb_files
    END IF

    DO ifile = start_loop, end_loop
       ncid = ncdf_ids(ifile)
       iret = nf90_close(ncid)
       IF (iret/=nf90_noerr) THEN
          WRITE(str70, '("This file has already been closed:", I3)') ifile
          CALL histerr(2, 'histclo', str70, '', '')
       END IF
    END DO

  END SUBROUTINE histclo

end module histclo_m
1	guez	61	module histclo_m
2
3			implicit none
4
5			contains
6
7			SUBROUTINE histclo(fid)
8
9			! This subroutine will close the file corresponding
10			! to the argument, if the argument is present. Else it will close
11			! all opened files.
12
13			USE errioipsl, ONLY: histerr
14	guez	138	use histbeg_totreg_m, ONLY: nb_files
15			USE histcom_var, ONLY: ncdf_ids
16	guez	61	USE netcdf, ONLY: nf90_close, nf90_noerr
17
18			INTEGER, INTENT (IN), OPTIONAL:: fid ! file id
19
20			! Variables local to the procedure:
21	guez	79	INTEGER ifile, ncid, iret
22	guez	61	INTEGER start_loop, end_loop
23			CHARACTER(len=70) str70
24
25			!---------------------------------------------------------------------
26
27			IF (present(fid)) THEN
28			start_loop = fid
29			end_loop = fid
30			ELSE
31			start_loop = 1
32			end_loop = nb_files
33			END IF
34
35			DO ifile = start_loop, end_loop
36			ncid = ncdf_ids(ifile)
37			iret = nf90_close(ncid)
38			IF (iret/=nf90_noerr) THEN
39			WRITE(str70, '("This file has already been closed:", I3)') ifile
40			CALL histerr(2, 'histclo', str70, '', '')
41			END IF
42			END DO
43
44			END SUBROUTINE histclo
45
46			end module histclo_m