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 histcom_var, ONLY: nb_files, 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	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	USE histcom_var, ONLY: nb_files, ncdf_ids
15	USE netcdf, ONLY: nf90_close, nf90_noerr
16
17	INTEGER, INTENT (IN), OPTIONAL:: fid ! file id
18
19	! Variables local to the procedure:
20	INTEGER ifile, ncid, iret
21	INTEGER start_loop, end_loop
22	CHARACTER(len=70) str70
23
24	!---------------------------------------------------------------------
25
26	IF (present(fid)) THEN
27	start_loop = fid
28	end_loop = fid
29	ELSE
30	start_loop = 1
31	end_loop = nb_files
32	END IF
33
34	DO ifile = start_loop, end_loop
35	ncid = ncdf_ids(ifile)
36	iret = nf90_close(ncid)
37	IF (iret/=nf90_noerr) THEN
38	WRITE(str70, '("This file has already been closed:", I3)') ifile
39	CALL histerr(2, 'histclo', str70, '', '')
40	END IF
41	END DO
42
43	END SUBROUTINE histclo
44
45	end module histclo_m