IOIPSL/Histcom/histclo.f90

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, iv, ncvarid
    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			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, iv, ncvarid
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