Newer
Older
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
MODULE iom
!!======================================================================
!! *** MODULE iom ***
!! Input/Output manager : Library to read input files
!!======================================================================
!! History : 2.0 ! 2005-12 (J. Belier) Original code
!! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO
!! 3.0 ! 2007-07 (D. Storkey) Changes to iom_gettime
!! 3.4 ! 2012-12 (R. Bourdalle-Badie and G. Reffray) add C1D case
!! 3.6 ! 2014-15 DIMG format removed
!! 3.6 ! 2015-15 (J. Harle) Added procedure to read REAL attributes
!! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields
!!----------------------------------------------------------------------
!!----------------------------------------------------------------------
!! iom_open : open a file read only
!! iom_close : close a file or all files opened by iom
!! iom_get : read a field (interfaced to several routines)
!! iom_varid : get the id of a variable in a file
!! iom_rstput : write a field in a restart file (interfaced to several routines)
!!----------------------------------------------------------------------
USE dom_oce ! ocean space and time domain
USE domutl !
USE flo_oce ! floats module declarations
USE lbclnk ! lateal boundary condition / mpp exchanges
USE iom_def ! iom variables definitions
USE iom_nf90 ! NetCDF format with native NetCDF library
USE in_out_manager ! I/O manager
USE lib_mpp ! MPP library
USE sbc_oce , ONLY : nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1
USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes
#if defined key_si3
USE ice , ONLY : jpl
#endif
USE phycst ! physical constants
USE dianam ! build name of file
#if defined key_xios
USE xios
# endif
USE ioipsl, ONLY : ju2ymds ! for calendar
USE crs ! Grid coarsening
#if defined key_top
USE trc, ONLY : profsed
#endif
USE lib_fortran
USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal
USE iom_nf90
USE netcdf
IMPLICIT NONE
PUBLIC ! must be public to be able to access iom_def through iom
#if defined key_xios
LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag
#else
LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag
#endif
PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var
PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put
PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val
PUBLIC iom_xios_setid
PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
PRIVATE iom_get_123d
PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
#if defined key_xios
PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr
PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate
PRIVATE iom_set_rst_context, iom_set_vars_active
# endif
PRIVATE set_xios_context
PRIVATE iom_set_rstw_active
INTERFACE iom_get
MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp
MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp
END INTERFACE
INTERFACE iom_getatt
MODULE PROCEDURE iom_g0d_iatt, iom_g1d_iatt, iom_g0d_ratt, iom_g1d_ratt, iom_g0d_catt
END INTERFACE
INTERFACE iom_putatt
MODULE PROCEDURE iom_p0d_iatt, iom_p1d_iatt, iom_p0d_ratt, iom_p1d_ratt, iom_p0d_catt
END INTERFACE
INTERFACE iom_rstput
MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp
MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp
END INTERFACE
INTERFACE iom_put
MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp
MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp
END INTERFACE iom_put
!! * Substitutions
# include "do_loop_substitute.h90"
!!----------------------------------------------------------------------
!! NEMO/OCE 4.0 , NEMO Consortium (2018)
!! $Id: iom.F90 15033 2021-06-21 10:24:45Z smasson $
!! Software governed by the CeCILL license (see ./LICENSE)
!!----------------------------------------------------------------------
CONTAINS
SUBROUTINE iom_init( cdname, kdid, ld_closedef )
!!----------------------------------------------------------------------
!! *** ROUTINE ***
!!
!! ** Purpose :
!!
!!----------------------------------------------------------------------
CHARACTER(len=*), INTENT(in) :: cdname
INTEGER , OPTIONAL, INTENT(in) :: kdid
LOGICAL , OPTIONAL, INTENT(in) :: ld_closedef
#if defined key_xios
!
TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0)
TYPE(xios_date) :: start_date
Guillaume Samson
committed
CHARACTER(len=lc) :: clname, cltmpn
INTEGER :: irefyear, irefmonth, irefday
INTEGER :: ji
LOGICAL :: llrst_context ! is context related to restart
LOGICAL :: llrstr, llrstw
INTEGER :: inum
Guillaume Samson
committed
INTEGER :: iln
!
REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds
REAL(wp), DIMENSION(2,jpkam1) :: za_bnds ! ABL vertical boundaries
LOGICAL :: ll_closedef
LOGICAL :: ll_exist
!!----------------------------------------------------------------------
!
ll_closedef = .TRUE.
IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef
!
ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) )
!
Guillaume Samson
committed
clname = TRIM(cdname)
IF ( .NOT. Agrif_Root() ) THEN
iln = INDEX(clname,'/', BACK=.TRUE.)
cltmpn = clname(1:iln)
clname = clname(iln+1:LEN_TRIM(clname))
clname = TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname)
ENDIF
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
CALL xios_context_initialize(TRIM(clname), mpi_comm_oce)
CALL iom_swap( cdname )
llrstr = (cdname == cr_ocerst_cxt) .OR. (cdname == cr_icerst_cxt)
llrstr = llrstr .OR. (cdname == cr_ablrst_cxt)
llrstr = llrstr .OR. (cdname == cr_toprst_cxt)
llrstr = llrstr .OR. (cdname == cr_sedrst_cxt)
llrstw = (cdname == cw_ocerst_cxt) .OR. (cdname == cw_icerst_cxt)
llrstw = llrstw .OR. (cdname == cw_ablrst_cxt)
llrstw = llrstw .OR. (cdname == cw_toprst_cxt)
llrstw = llrstw .OR. (cdname == cw_sedrst_cxt)
llrst_context = llrstr .OR. llrstw
! Calendar type is now defined in xml file
IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear = 1900
IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01
IF (.NOT.(xios_getvar('ref_day' ,irefday ))) irefday = 01
SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), &
& start_date = xios_date( nyear, nmonth, nday,0,0,0) )
CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), &
& start_date = xios_date( nyear, nmonth, nday,0,0,0) )
CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0), &
& start_date = xios_date( nyear, nmonth, nday,0,0,0) )
END SELECT
! horizontal grid definition
IF(.NOT.llrst_context) CALL set_scalar
!
IF( cdname == cxios_context ) THEN
CALL set_grid( "T", glamt, gphit, .FALSE., .FALSE. )
CALL set_grid( "U", glamu, gphiu, .FALSE., .FALSE. )
CALL set_grid( "V", glamv, gphiv, .FALSE., .FALSE. )
CALL set_grid( "W", glamt, gphit, .FALSE., .FALSE. )
CALL set_grid( "F", glamf, gphif, .FALSE., .FALSE. )
CALL set_grid_znl( gphit )
!
IF( ln_cfmeta ) THEN ! Add additional grid metadata
CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp))
CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp))
CALL iom_set_domain_attr("grid_W", area = REAL( e1e2t(Nis0:Nie0, Njs0:Nje0), dp))
CALL iom_set_domain_attr("grid_F", area = real( e1e2f(Nis0:Nie0, Njs0:Nje0), dp))
CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit )
CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu )
CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv )
CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit )
CALL set_grid_bounds( "F", glamt, gphit, glamf, gphif )
ENDIF
ENDIF
!
Loading
Loading full blame...