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	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 histbeg_totreg_m, ONLY: nb_files
15	USE histcom_var, ONLY: ncdf_ids
16	USE netcdf, ONLY: nf90_close, nf90_noerr
17
18	INTEGER, INTENT (IN), OPTIONAL:: fid ! file id
19
20	! Variables local to the procedure:
21	INTEGER ifile, ncid, iret
22	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