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

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

    print *, "Call sequence information: histclo"

    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	print *, "Call sequence information: histclo"
28
29	IF (present(fid)) THEN
30	start_loop = fid
31	end_loop = fid
32	ELSE
33	start_loop = 1
34	end_loop = nb_files
35	END IF
36
37	DO ifile = start_loop, end_loop
38	ncid = ncdf_ids(ifile)
39	iret = nf90_close(ncid)
40	IF (iret/=nf90_noerr) THEN
41	WRITE(str70, '("This file has already been closed:", I3)') ifile
42	CALL histerr(2, 'histclo', str70, '', '')
43	END IF
44	END DO
45
46	END SUBROUTINE histclo
47
48	end module histclo_m