Changeset 8882 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/IOM
- Timestamp:
- 2017-12-01T18:44:09+01:00 (7 years ago)
- Location:
- branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 4 edited
-
in_out_manager.F90 (modified) (3 diffs)
-
iom.F90 (modified) (60 diffs)
-
iom_def.F90 (modified) (2 diffs)
-
iom_nf90.F90 (modified) (35 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r7646 r8882 88 88 INTEGER :: nitrst !: time step at which restart file should be written 89 89 LOGICAL :: lrst_oce !: logical to control the oce restart write 90 LOGICAL :: lrst_ice !: logical to control the ice restart write 90 91 INTEGER :: numror = 0 !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 92 INTEGER :: numrir !: logical unit for ice restart (read) 91 93 INTEGER :: numrow !: logical unit for ocean restart (write) 94 INTEGER :: numriw !: logical unit for ice restart (write) 92 95 INTEGER :: nrst_lst !: number of restart to output next 93 96 … … 96 99 !!---------------------------------------------------------------------- 97 100 LOGICAL :: ln_ctl !: run control for debugging 101 LOGICAL :: ln_timing !: run control for timing 102 !!gm to be removed at the end of the 2017 merge party 98 103 INTEGER :: nn_timing !: run control for timing 99 INTEGER :: nn_diacfl !: flag whether to create CFL diagnostics 104 !!gm end 105 LOGICAL :: ln_diacfl !: flag whether to create CFL diagnostics 100 106 INTEGER :: nn_print !: level of print (0 no print) 101 107 INTEGER :: nn_ictls !: Start i indice for the SUM control … … 126 132 INTEGER :: numoni = -1 !: logical unit for Output Namelist Ice 127 133 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 128 INTEGER :: num sol = -1 !: logical unit for solverstatistics134 INTEGER :: numrun = -1 !: logical unit for run statistics 129 135 INTEGER :: numdct_in = -1 !: logical unit for transports computing 130 136 INTEGER :: numdct_vol = -1 !: logical unit for voulume transports output -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8698 r8882 1 1 MODULE iom 2 !!===================================================================== 2 !!====================================================================== 3 3 !! *** MODULE iom *** 4 4 !! Input/Output manager : Library to read input files 5 !!==================================================================== 5 !!====================================================================== 6 6 !! History : 2.0 ! 2005-12 (J. Belier) Original code 7 7 !! 2.0 ! 2006-02 (S. Masson) Adaptation to NEMO … … 10 10 !! 3.6 ! 2014-15 DIMG format removed 11 11 !! 3.6 ! 2015-15 (J. Harle) Added procedure to read REAL attributes 12 !!-------------------------------------------------------------------- 13 14 !!-------------------------------------------------------------------- 12 !! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 13 !!---------------------------------------------------------------------- 14 15 !!---------------------------------------------------------------------- 15 16 !! iom_open : open a file read only 16 17 !! iom_close : close a file or all files opened by iom … … 19 20 !! iom_varid : get the id of a variable in a file 20 21 !! iom_rstput : write a field in a restart file (interfaced to several routines) 21 !!-------------------------------------------------------------------- 22 !!---------------------------------------------------------------------- 22 23 USE dom_oce ! ocean space and time domain 23 24 USE c1d ! 1D vertical configuration … … 29 30 USE lib_mpp ! MPP library 30 31 #if defined key_iomput 31 USE sbc_oce , ONLY : nn_fsbc ! ocean space and time domain32 USE trc_oce , ONLY : nn_dttrc ! !: frequency of step on passive tracers33 USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes32 USE sbc_oce , ONLY : nn_fsbc ! ocean space and time domain 33 USE trc_oce , ONLY : nn_dttrc ! !: frequency of step on passive tracers 34 USE icb_oce , ONLY : nclasses, class_num ! !: iceberg classes 34 35 #if defined key_lim3 35 USE ice , ONLY : jpl 36 #elif defined key_lim2 37 USE par_ice_2 36 USE ice , ONLY : jpl 38 37 #endif 39 38 USE domngb ! ocean space and time domain … … 82 81 83 82 !!---------------------------------------------------------------------- 84 !! NEMO/OPA 3.3 , NEMO Consortium (2010)83 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 85 84 !! $Id$ 86 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 87 86 !!---------------------------------------------------------------------- 88 89 87 CONTAINS 90 88 … … 97 95 !!---------------------------------------------------------------------- 98 96 CHARACTER(len=*), INTENT(in) :: cdname 97 ! 99 98 #if defined key_iomput 100 99 ! 101 100 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 102 101 TYPE(xios_date) :: start_date … … 106 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 107 106 !!---------------------------------------------------------------------- 108 107 ! 109 108 ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 110 109 ! 111 110 clname = cdname 112 111 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) … … 127 126 ! horizontal grid definition 128 127 CALL set_scalar 129 128 ! 130 129 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 131 130 CALL set_grid( "T", glamt, gphit ) … … 146 145 ENDIF 147 146 ENDIF 148 147 ! 149 148 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 150 149 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain … … 169 168 ENDIF 170 169 ENDIF 171 170 ! 172 171 ! vertical grid definition 173 172 CALL iom_set_axis_attr( "deptht", gdept_1d ) … … 175 174 CALL iom_set_axis_attr( "depthv", gdept_1d ) 176 175 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 177 176 ! 178 177 ! Add vertical grid bounds 179 178 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) … … 188 187 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 189 188 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 190 191 189 ! 192 190 # if defined key_floats 193 191 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 194 192 # endif 195 # if defined key_lim3 || defined key_lim2193 # if defined key_lim3 196 194 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 197 #endif 195 ! SIMIP diagnostics (4 main arctic straits) 196 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 197 # endif 198 198 CALL iom_set_axis_attr( "icbcla", class_num ) 199 199 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) … … 202 202 ! automatic definitions of some of the xml attributs 203 203 CALL set_xmlatt 204 204 ! 205 205 ! end file definition 206 206 dtime%second = rdt 207 CALL xios_set_timestep( dtime)207 CALL xios_set_timestep( dtime ) 208 208 CALL xios_close_context_definition() 209 210 CALL xios_update_calendar(0) 211 209 CALL xios_update_calendar( 0 ) 210 ! 212 211 DEALLOCATE( zt_bnds, zw_bnds ) 213 212 ! 214 213 #endif 215 214 ! 216 215 END SUBROUTINE iom_init 217 216 … … 239 238 240 239 241 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )240 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof, kdlev ) 242 241 !!--------------------------------------------------------------------- 243 242 !! *** SUBROUTINE iom_open *** … … 252 251 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 253 252 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 254 253 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels 254 ! 255 255 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 256 256 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) … … 405 405 IF( istop == nstop ) THEN ! no error within this routine 406 406 SELECT CASE (iolib) 407 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar )407 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 408 408 CASE DEFAULT 409 409 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) … … 644 644 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 645 645 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 646 647 648 646 ! ! look for and use a file attribute 647 ! ! called open_ocean_jstart to set the start 648 ! ! value for the 2nd dimension (netcdf only) 649 649 ! 650 650 LOGICAL :: llnoov ! local definition to read overlap … … 672 672 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 673 673 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 674 INTEGER :: inlev ! number of levels for 3D data 674 675 !--------------------------------------------------------------------- 675 676 ! 677 inlev = -1 678 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 676 679 clname = iom_file(kiomid)%name ! esier to read 677 680 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 775 778 776 779 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 777 istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 780 istart(1:idmspc) = kstart(1:idmspc) 781 icnt (1:idmspc) = kcount(1:idmspc) 778 782 ELSE 779 783 IF(idom == jpdom_unknown ) THEN … … 801 805 ENDIF 802 806 IF( PRESENT(pv_r3d) ) THEN 803 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkglo804 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3);icnt(3) = kcount(3)805 ELSE ; icnt(3) = jpk807 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 808 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 809 ELSE ; icnt(3) = inlev 806 810 ENDIF 807 811 ENDIF … … 886 890 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 887 891 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 888 IF( icnt(3) == jpk) THEN892 IF( icnt(3) == inlev ) THEN 889 893 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 890 894 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) … … 1135 1139 END SUBROUTINE iom_rp0d 1136 1140 1141 1137 1142 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1138 1143 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1155 1160 END SUBROUTINE iom_rp1d 1156 1161 1162 1157 1163 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1158 1164 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1175 1181 END SUBROUTINE iom_rp2d 1176 1182 1183 1177 1184 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1178 1185 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1236 1243 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1237 1244 #if defined key_iomput 1238 CALL xios_send_field( cdname, pfield3d)1245 CALL xios_send_field( cdname, pfield3d ) 1239 1246 #else 1240 1247 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 1241 1248 #endif 1242 1249 END SUBROUTINE iom_p3d 1250 1251 #if defined key_iomput 1243 1252 !!---------------------------------------------------------------------- 1244 1245 #if defined key_iomput 1253 !! 'key_iomput' IOM interface 1254 !!---------------------------------------------------------------------- 1246 1255 1247 1256 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1248 1257 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1249 1258 & nvertex, bounds_lon, bounds_lat, area ) 1250 CHARACTER(LEN=*) , INTENT(in) :: cdid 1251 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1252 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1253 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1254 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1255 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1256 LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1257 1258 1259 IF ( xios_is_valid_domain (cdid) ) THEN 1259 !!---------------------------------------------------------------------- 1260 !!---------------------------------------------------------------------- 1261 CHARACTER(LEN=*) , INTENT(in) :: cdid 1262 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1263 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1264 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1265 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1266 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1267 LOGICAL , DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1268 !!---------------------------------------------------------------------- 1269 ! 1270 IF( xios_is_valid_domain (cdid) ) THEN 1260 1271 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1261 1272 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & … … 1263 1274 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1264 1275 ENDIF 1265 IF 1276 IF( xios_is_valid_domaingroup(cdid) ) THEN 1266 1277 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1267 1278 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & … … 1269 1280 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1270 1281 ENDIF 1271 1282 ! 1272 1283 CALL xios_solve_inheritance() 1273 1284 ! 1274 1285 END SUBROUTINE iom_set_domain_attr 1275 1286 1276 1287 1277 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1278 CHARACTER(LEN=*) , INTENT(in) :: cdid 1279 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1280 1281 IF ( xios_is_valid_zoom_domain (cdid) ) THEN 1282 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1283 & nj=nj) 1284 ENDIF 1288 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj ) 1289 !!---------------------------------------------------------------------- 1290 !!---------------------------------------------------------------------- 1291 CHARACTER(LEN=*) , INTENT(in) :: cdid 1292 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1293 !!---------------------------------------------------------------------- 1294 IF( xios_is_valid_zoom_domain(cdid) ) CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj ) 1285 1295 END SUBROUTINE iom_set_zoom_domain_attr 1286 1296 1287 1297 1288 1298 SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 1299 !!---------------------------------------------------------------------- 1300 !!---------------------------------------------------------------------- 1289 1301 CHARACTER(LEN=*) , INTENT(in) :: cdid 1290 1302 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 1291 1303 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1292 1293 IF 1294 IF 1295 IF 1296 ENDIF 1297 IF 1298 IF 1304 !!---------------------------------------------------------------------- 1305 IF( PRESENT(paxis) ) THEN 1306 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1307 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1308 ENDIF 1309 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1310 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 1299 1311 CALL xios_solve_inheritance() 1300 1312 END SUBROUTINE iom_set_axis_attr … … 1302 1314 1303 1315 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1304 CHARACTER(LEN=*) , INTENT(in) :: cdid 1305 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1306 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1307 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1308 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1309 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1310 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1316 !!---------------------------------------------------------------------- 1317 !!---------------------------------------------------------------------- 1318 CHARACTER(LEN=*) , INTENT(in) :: cdid 1319 TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_op 1320 TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_offset 1321 !!---------------------------------------------------------------------- 1322 IF( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1323 IF( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1311 1324 CALL xios_solve_inheritance() 1312 1325 END SUBROUTINE iom_set_field_attr … … 1314 1327 1315 1328 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 1329 !!---------------------------------------------------------------------- 1330 !!---------------------------------------------------------------------- 1316 1331 CHARACTER(LEN=*) , INTENT(in) :: cdid 1317 1332 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix 1318 IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1319 IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1333 !!---------------------------------------------------------------------- 1334 IF( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1335 IF( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1320 1336 CALL xios_solve_inheritance() 1321 1337 END SUBROUTINE iom_set_file_attr … … 1323 1339 1324 1340 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1341 !!---------------------------------------------------------------------- 1342 !!---------------------------------------------------------------------- 1325 1343 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1326 1344 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix … … 1331 1349 IF( PRESENT( name_suffix ) ) name_suffix = '' 1332 1350 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1333 IF 1351 IF( xios_is_valid_file (cdid) ) THEN 1334 1352 CALL xios_solve_inheritance() 1335 1353 CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) … … 1338 1356 IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq ) 1339 1357 ENDIF 1340 IF 1358 IF( xios_is_valid_filegroup(cdid) ) THEN 1341 1359 CALL xios_solve_inheritance() 1342 1360 CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) … … 1349 1367 1350 1368 SUBROUTINE iom_set_grid_attr( cdid, mask ) 1369 !!---------------------------------------------------------------------- 1370 !!---------------------------------------------------------------------- 1351 1371 CHARACTER(LEN=*) , INTENT(in) :: cdid 1352 1372 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1353 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1354 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1373 !!---------------------------------------------------------------------- 1374 IF( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1375 IF( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1355 1376 CALL xios_solve_inheritance() 1356 1377 END SUBROUTINE iom_set_grid_attr 1357 1378 1358 1379 SUBROUTINE iom_setkt( kt, cdname ) 1380 !!---------------------------------------------------------------------- 1381 !!---------------------------------------------------------------------- 1359 1382 INTEGER , INTENT(in) :: kt 1360 1383 CHARACTER(LEN=*), INTENT(in) :: cdname 1361 ! 1384 !!---------------------------------------------------------------------- 1362 1385 CALL iom_swap( cdname ) ! swap to cdname context 1363 1386 CALL xios_update_calendar(kt) 1364 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1365 ! 1387 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1366 1388 END SUBROUTINE iom_setkt 1367 1389 1368 1390 SUBROUTINE iom_context_finalize( cdname ) 1391 !!---------------------------------------------------------------------- 1392 !!---------------------------------------------------------------------- 1369 1393 CHARACTER(LEN=*), INTENT(in) :: cdname 1370 ! 1394 !!---------------------------------------------------------------------- 1371 1395 IF( xios_is_valid_context(cdname) ) THEN 1372 1396 CALL iom_swap( cdname ) ! swap to cdname context … … 1374 1398 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1375 1399 ENDIF 1376 !1377 1400 END SUBROUTINE iom_context_finalize 1378 1401 … … 1383 1406 !! 1384 1407 !! ** Purpose : define horizontal grids 1385 !!1386 1408 !!---------------------------------------------------------------------- 1387 1409 CHARACTER(LEN=1) , INTENT(in) :: cdgrd … … 1389 1411 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1390 1412 ! 1413 INTEGER :: ni, nj 1391 1414 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1392 INTEGER :: ni,nj 1393 1394 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1395 1415 !!---------------------------------------------------------------------- 1416 ! 1417 ni = nlei-nldi+1 1418 nj = nlej-nldj+1 1419 ! 1396 1420 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1397 1421 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1398 1422 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & 1399 1423 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1400 1424 ! 1401 1425 IF ( ln_mskland ) THEN 1402 1426 ! mask land points, keep values on coast line -> specific mask for U, V and W points … … 1411 1435 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 1412 1436 ENDIF 1413 1437 ! 1414 1438 END SUBROUTINE set_grid 1415 1439 … … 1422 1446 !! 1423 1447 !!---------------------------------------------------------------------- 1424 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1425 ! 1426 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1427 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j) 1428 ! 1429 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1430 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1431 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1432 ! 1433 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1434 ! ! represents the bottom-left corner of cell (i,j) 1448 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1449 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coord. of a contiguous vertex of cell (i,j) 1450 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 1451 ! 1435 1452 INTEGER :: ji, jj, jn, ni, nj 1436 1453 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1454 ! ! represents the bottom-left corner of cell (i,j) 1455 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1456 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1457 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1458 !!---------------------------------------------------------------------- 1459 ! 1437 1460 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1438 1461 ! 1439 1462 ! Offset of coordinate representing bottom-left corner 1440 1463 SELECT CASE ( TRIM(cdgrd) ) 1441 CASE ('T', 'W') 1442 icnr = -1 ; jcnr = -1 1443 CASE ('U') 1444 icnr = 0 ; jcnr = -1 1445 CASE ('V') 1446 icnr = -1 ; jcnr = 0 1464 CASE ('T', 'W') ; icnr = -1 ; jcnr = -1 1465 CASE ('U') ; icnr = 0 ; jcnr = -1 1466 CASE ('V') ; icnr = -1 ; jcnr = 0 1447 1467 END SELECT 1448 1449 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1450 1468 ! 1469 ni = nlei-nldi+1 ! Dimensions of subdomain interior 1470 nj = nlej-nldj+1 1471 ! 1451 1472 z_fld(:,:) = 1._wp 1452 1473 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1453 1474 ! 1454 1475 ! Cell vertices that can be defined 1455 1476 DO jj = 2, jpjm1 … … 1465 1486 END DO 1466 1487 END DO 1467 1488 ! 1468 1489 ! Cell vertices on boundries 1469 1490 DO jn = 1, 4 … … 1471 1492 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1472 1493 END DO 1473 1494 ! 1474 1495 ! Zero-size cells at closed boundaries if cell points provided, 1475 1496 ! otherwise they are closed cells with unrealistic bounds … … 1496 1517 ENDIF 1497 1518 ENDIF 1498 1499 ! Rotate cells at the north fold 1500 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 1519 ! 1520 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN ! Rotate cells at the north fold 1501 1521 DO jj = 1, jpj 1502 1522 DO ji = 1, jpi … … 1508 1528 END DO 1509 1529 END DO 1510 1511 ! Invert cells at the symmetric equator 1512 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1530 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN ! Invert cells at the symmetric equator 1513 1531 DO ji = 1, jpi 1514 1532 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) … … 1517 1535 END DO 1518 1536 ENDIF 1519 1537 ! 1520 1538 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1521 1522 1539 & bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1540 ! 1523 1541 DEALLOCATE( z_bnds, z_fld, z_rot ) 1524 1542 ! 1525 1543 END SUBROUTINE set_grid_bounds 1526 1544 … … 1535 1553 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1536 1554 ! 1555 INTEGER :: ni, nj, ix, iy 1537 1556 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1538 INTEGER :: ni,nj, ix, iy1539 1540 1541 n i=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk)1542 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1543 1557 !!---------------------------------------------------------------------- 1558 ! 1559 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk) 1560 nj=nlej-nldj+1 1561 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 1562 ! 1544 1563 CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 1564 ! CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1545 1565 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1546 1566 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1553 1573 END SUBROUTINE set_grid_znl 1554 1574 1575 1555 1576 SUBROUTINE set_scalar 1556 1577 !!---------------------------------------------------------------------- … … 1562 1583 REAL(wp), DIMENSION(1) :: zz = 1. 1563 1584 !!---------------------------------------------------------------------- 1564 1585 ! 1565 1586 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 1566 1587 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1567 1568 zz =REAL(narea,wp)1588 ! 1589 zz = REAL( narea, wp ) 1569 1590 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1570 1591 ! 1571 1592 END SUBROUTINE set_scalar 1572 1593 … … 1596 1617 ! 1597 1618 ! frequency of the call of iom_put (attribut: freq_op) 1598 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of)1599 f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('trendT_even' , freq_op=f_op, freq_offset=f_of)1600 f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd' , freq_op=f_op, freq_offset=f_of)1601 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of)1602 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of)1603 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of)1604 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of)1619 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1620 f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('trendT_even' , freq_op=f_op, freq_offset=f_of) 1621 f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd' , freq_op=f_op, freq_offset=f_of) 1622 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1623 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 1624 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1625 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1605 1626 1606 1627 ! output file names (attribut: name) … … 1641 1662 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1642 1663 CALL set_mooring( zlonpira, zlatpira ) 1643 1644 1664 ! 1645 1665 END SUBROUTINE set_xmlatt 1646 1666 1647 1667 1648 SUBROUTINE set_mooring( plon, plat )1668 SUBROUTINE set_mooring( plon, plat ) 1649 1669 !!---------------------------------------------------------------------- 1650 1670 !! *** ROUTINE set_mooring *** … … 1653 1673 !! 1654 1674 !!---------------------------------------------------------------------- 1655 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat! longitudes/latitudes oft the mooring1675 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring 1656 1676 ! 1657 1677 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name … … 1736 1756 TYPE(xios_duration) :: output_freq 1737 1757 !!---------------------------------------------------------------------- 1738 1739 DO jn = 1, 21740 1758 ! 1759 DO jn = 1, 2 1760 ! 1741 1761 output_freq = xios_duration(0,0,0,0,0,0) 1742 1762 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq ) 1743 1763 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1744 1764 ! 1745 1765 IF ( TRIM(clname) /= '' ) THEN 1746 1766 ! 1747 1767 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1748 1768 DO WHILE ( idx /= 0 ) … … 1750 1770 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1751 1771 END DO 1752 1772 ! 1753 1773 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1754 1774 DO WHILE ( idx /= 0 ) … … 1781 1801 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1782 1802 END DO 1783 1803 ! 1784 1804 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1785 1805 DO WHILE ( idx /= 0 ) … … 1788 1808 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1789 1809 END DO 1790 1810 ! 1791 1811 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1792 1812 DO WHILE ( idx /= 0 ) … … 1795 1815 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1796 1816 END DO 1797 1817 ! 1798 1818 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1799 1819 DO WHILE ( idx /= 0 ) … … 1802 1822 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1803 1823 END DO 1804 1824 ! 1805 1825 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1806 1826 DO WHILE ( idx /= 0 ) … … 1809 1829 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1810 1830 END DO 1811 1831 ! 1812 1832 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1813 1833 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1814 1834 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) 1815 1816 ENDIF 1817 1835 ! 1836 ENDIF 1837 ! 1818 1838 END DO 1819 1839 ! 1820 1840 END SUBROUTINE iom_update_file_name 1821 1841 … … 1826 1846 !! 1827 1847 !! ** Purpose : send back the date corresponding to the given julian day 1828 !! 1829 !!---------------------------------------------------------------------- 1830 REAL(wp), INTENT(in ) :: pjday ! julian day 1831 LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00 1832 LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss 1848 !!---------------------------------------------------------------------- 1849 REAL(wp), INTENT(in ) :: pjday ! julian day 1850 LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00 1851 LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss 1833 1852 ! 1834 1853 CHARACTER(LEN=20) :: iom_sdate … … 1837 1856 REAL(wp) :: zsec 1838 1857 LOGICAL :: ll24, llfull 1858 !!---------------------------------------------------------------------- 1839 1859 ! 1840 1860 IF( PRESENT(ld24) ) THEN ; ll24 = ld24 1841 1861 ELSE ; ll24 = .FALSE. 1842 1862 ENDIF 1843 1863 ! 1844 1864 IF( PRESENT(ldfull) ) THEN ; llfull = ldfull 1845 1865 ELSE ; llfull = .FALSE. 1846 1866 ENDIF 1847 1867 ! 1848 1868 CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 1849 1869 isec = NINT(zsec) 1850 1870 ! 1851 1871 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 1852 1872 CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 1853 1873 isec = 86400 1854 1874 ENDIF 1855 1875 ! 1856 1876 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 1857 1877 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 1858 1878 ENDIF 1859 1879 ! 1860 1880 !$AGRIF_DO_NOT_TREAT 1861 ! Should be fixed in the conv1881 ! needed in the conv 1862 1882 IF( llfull ) THEN 1863 1883 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1871 1891 ENDIF 1872 1892 !$AGRIF_END_DO_NOT_TREAT 1873 1893 ! 1874 1894 END FUNCTION iom_sdate 1875 1895 1876 1896 #else 1877 1897 !!---------------------------------------------------------------------- 1898 !! NOT 'key_iomput' a few dummy routines 1899 !!---------------------------------------------------------------------- 1878 1900 1879 1901 SUBROUTINE iom_setkt( kt, cdname ) … … 1891 1913 1892 1914 LOGICAL FUNCTION iom_use( cdname ) 1915 !!---------------------------------------------------------------------- 1916 !!---------------------------------------------------------------------- 1893 1917 CHARACTER(LEN=*), INTENT(in) :: cdname 1918 !!---------------------------------------------------------------------- 1894 1919 #if defined key_iomput 1895 1920 iom_use = xios_field_is_active( cdname ) -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r7646 r8882 1 1 MODULE iom_def 2 !!===================================================================== 2 !!====================================================================== 3 3 !! *** MODULE iom_def *** 4 4 !! IOM variables definitions 5 !!==================================================================== 6 !! History : 9.0 ! 06 09 (S. Masson) Original code 7 !! " ! 07 07 (D. Storkey) Add uldname 8 !!-------------------------------------------------------------------- 9 !!--------------------------------------------------------------------------------- 10 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 11 !! $Id$ 12 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 13 !!--------------------------------------------------------------------------------- 14 5 !!====================================================================== 6 !! History : 9.0 ! 2006 09 (S. Masson) Original code 7 !! - ! 2007 07 (D. Storkey) Add uldname 8 !! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 9 !!---------------------------------------------------------------------- 15 10 USE par_kind 16 11 … … 64 59 REAL(kind=wp), DIMENSION(jpmax_vars) :: scf !: scale_factor of the variables 65 60 REAL(kind=wp), DIMENSION(jpmax_vars) :: ofs !: add_offset of the variables 61 INTEGER :: nlev ! number of vertical levels 66 62 END TYPE file_descriptor 67 63 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files 68 64 !$AGRIF_END_DO_NOT_TREAT 69 65 70 !!===================================================================== 66 !!---------------------------------------------------------------------- 67 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 68 !! $Id$ 69 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 70 !!====================================================================== 71 71 END MODULE iom_def -
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r7646 r8882 1 1 MODULE iom_nf90 2 !!===================================================================== 2 !!====================================================================== 3 3 !! *** MODULE iom_nf90 *** 4 4 !! Input/Output manager : Library to read input files with NF90 (only fliocom module) 5 !!==================================================================== 5 !!====================================================================== 6 6 !! History : 9.0 ! 05 12 (J. Belier) Original code 7 7 !! 9.0 ! 06 02 (S. Masson) Adaptation to NEMO 8 8 !! " ! 07 07 (D. Storkey) Changes to iom_nf90_gettime 9 9 !! 3.6 ! 2015-15 (J. Harle) Added procedure to read REAL attributes 10 !! --------------------------------------------------------------------11 !! gm caution add !DIR nec: improved performance to be checked as well as no result changes12 13 !!-------------------------------------------------------------------- 10 !! 4.0 ! 2017-11 (M. Andrejczuk) Extend IOM interface to write any 3D fields 11 !!---------------------------------------------------------------------- 12 13 !!---------------------------------------------------------------------- 14 14 !! iom_open : open a file read only 15 15 !! iom_close : close a file or all files opened by iom … … 18 18 !! iom_varid : get the id of a variable in a file 19 19 !! iom_rstput : write a field in a restart file (interfaced to several routines) 20 !!-------------------------------------------------------------------- 20 !!---------------------------------------------------------------------- 21 21 USE dom_oce ! ocean space and time domain 22 22 USE lbclnk ! lateal boundary condition / mpp exchanges … … 29 29 PRIVATE 30 30 31 PUBLIC iom_nf90_open , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput31 PUBLIC iom_nf90_open , iom_nf90_close, iom_nf90_varid, iom_nf90_get, iom_nf90_gettime, iom_nf90_rstput 32 32 PUBLIC iom_nf90_getatt, iom_nf90_putatt 33 33 … … 46 46 47 47 !!---------------------------------------------------------------------- 48 !! NEMO/OPA 3.3 , NEMO Consortium (2010)48 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 49 49 !! $Id$ 50 50 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 51 51 !!---------------------------------------------------------------------- 52 53 52 CONTAINS 54 53 55 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar )54 SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev ) 56 55 !!--------------------------------------------------------------------- 57 56 !! *** SUBROUTINE iom_open *** … … 64 63 LOGICAL , INTENT(in ) :: ldok ! check the existence 65 64 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 65 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! size of the third dimension 66 66 67 67 CHARACTER(LEN=256) :: clinfo ! info character … … 76 76 INTEGER :: ihdf5 ! local variable for retrieval of value for NF90_HDF5 77 77 LOGICAL :: llclobber ! local definition of ln_clobber 78 !--------------------------------------------------------------------- 79 78 INTEGER :: ilevels ! vertical levels 79 !--------------------------------------------------------------------- 80 ! 80 81 clinfo = ' iom_nf90_open ~~~ ' 81 istop = nstop ! store the actual value of nstop 82 istop = nstop ! store the actual value of nstop 83 ! 84 ! !number of vertical levels 85 IF( PRESENT(kdlev) ) THEN ; ilevels = kdlev ! use input value (useful for sea-ice) 86 ELSE ; ilevels = jpk ! by default jpk 87 ENDIF 88 ! 82 89 IF( nn_chunksz > 0 ) THEN ; ichunk = nn_chunksz 83 90 ELSE ; ichunk = NF90_SIZEHINT_DEFAULT … … 85 92 ! 86 93 llclobber = ldwrt .AND. ln_clobber 87 IF( ldok .AND. .NOT. llclobber ) THEN ! Open existing file...88 ! ! =============94 IF( ldok .AND. .NOT. llclobber ) THEN !== Open existing file ==! 95 ! !=========================! 89 96 IF( ldwrt ) THEN ! ... in write mode 90 97 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in WRITE mode' … … 99 106 CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo) 100 107 ENDIF 101 ELSE ! the file does not exist(or we overwrite it)102 ! ! =============108 ELSE !== the file doesn't exist ==! (or we overwrite it) 109 ! !============================! 103 110 iln = INDEX( cdname, '.nc' ) 104 IF( ldwrt ) THEN !the file should be open in write mode so we create it...111 IF( ldwrt ) THEN !* the file should be open in write mode so we create it... 105 112 IF( jpnij > 1 ) THEN 106 113 WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' … … 126 133 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1) , idmy ), clinfo) 127 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1) , idmy ), clinfo) 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk, idmy ), clinfo)135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', ilevels , idmy ), clinfo) 129 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo) 130 137 ! global attributes … … 139 146 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end' , kdompar(:,5) ), clinfo) 140 147 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type' , 'BOX' ), clinfo) 141 ELSE !the file should be open for read mode so it must exist...148 ELSE !* the file should be open for read mode so it must exist... 142 149 CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 143 150 ENDIF 144 151 ENDIF 152 ! 145 153 ! start to fill file informations 146 154 ! ============= … … 156 164 iom_file(kiomid)%nvars = 0 157 165 iom_file(kiomid)%irec = -1 ! useless for NetCDF files, used to know if the file is in define mode 166 iom_file(kiomid)%nlev = ilevels 158 167 CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 159 IF 160 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,&161 & name = iom_file(kiomid)%uldname,&162 &len = iom_file(kiomid)%lenuld ), clinfo )168 IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 169 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld, & 170 & name = iom_file(kiomid)%uldname, & 171 & len = iom_file(kiomid)%lenuld ), clinfo ) 163 172 ENDIF 164 173 IF(lwp) WRITE(numout,*) ' ---> '//TRIM(cdname)//' OK' … … 179 188 CHARACTER(LEN=100) :: clinfo ! info character 180 189 !--------------------------------------------------------------------- 181 !182 190 clinfo = ' iom_nf90_close , file: '//TRIM(iom_file(kiomid)%name) 183 191 CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo) 184 !185 192 END SUBROUTINE iom_nf90_close 186 193 … … 275 282 clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 276 283 CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 277 !278 284 END SUBROUTINE iom_nf90_g0d 279 285 … … 357 363 ivarid = NF90_GLOBAL 358 364 ENDIF 359 !365 ! 360 366 IF( llok) THEN 361 367 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', giatt: '//TRIM(cdatt) … … 368 374 END SUBROUTINE iom_nf90_giatt 369 375 370 SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar) 376 377 SUBROUTINE iom_nf90_gratt( kiomid, cdatt, pv_r0d, cdvar ) 371 378 !!----------------------------------------------------------------------- 372 379 !! *** ROUTINE iom_nf90_gratt *** … … 376 383 !! attribute if optional variable name is supplied (cdvar)) 377 384 !!----------------------------------------------------------------------- 378 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 379 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 380 REAL(wp) , INTENT( out) :: pv_r0d ! read field 381 CHARACTER(len=*), INTENT(in ), OPTIONAL & 382 & :: cdvar ! name of the variable 383 ! 384 INTEGER :: if90id ! temporary integer 385 INTEGER :: ivarid ! NetCDF variable Id 386 LOGICAL :: llok ! temporary logical 387 CHARACTER(LEN=100) :: clinfo ! info character 385 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 386 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 387 REAL(wp) , INTENT( out) :: pv_r0d ! read field 388 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 389 ! 390 INTEGER :: if90id ! temporary integer 391 INTEGER :: ivarid ! NetCDF variable Id 392 LOGICAL :: llok ! temporary logical 393 CHARACTER(LEN=100) :: clinfo ! info character 388 394 !--------------------------------------------------------------------- 389 395 ! … … 402 408 ivarid = NF90_GLOBAL 403 409 ENDIF 404 !410 ! 405 411 IF( llok) THEN 406 412 clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', gratt: '//TRIM(cdatt) … … 413 419 END SUBROUTINE iom_nf90_gratt 414 420 415 SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar) 421 422 SUBROUTINE iom_nf90_gcatt( kiomid, cdatt, pv_c0d, cdvar ) 416 423 !!----------------------------------------------------------------------- 417 424 !! *** ROUTINE iom_nf90_gcatt *** … … 421 428 !! attribute if optional variable name is supplied (cdvar)) 422 429 !!----------------------------------------------------------------------- 423 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 424 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 425 CHARACTER(len=*), INTENT( out) :: pv_c0d ! read field 426 CHARACTER(len=*), INTENT(in ), OPTIONAL & 427 & :: cdvar ! name of the variable 428 ! 429 INTEGER :: if90id ! temporary integer 430 INTEGER :: ivarid ! NetCDF variable Id 431 LOGICAL :: llok ! temporary logical 432 CHARACTER(LEN=100) :: clinfo ! info character 430 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 431 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 432 CHARACTER(len=*) , INTENT( out) :: pv_c0d ! read field 433 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 434 ! 435 INTEGER :: if90id ! temporary integer 436 INTEGER :: ivarid ! NetCDF variable Id 437 LOGICAL :: llok ! temporary logical 438 CHARACTER(LEN=100) :: clinfo ! info character 433 439 !--------------------------------------------------------------------- 434 440 ! … … 458 464 END SUBROUTINE iom_nf90_gcatt 459 465 466 460 467 !!---------------------------------------------------------------------- 461 468 !! INTERFACE iom_nf90_putatt … … 495 502 ivarid = NF90_GLOBAL 496 503 ENDIF 497 !504 ! 498 505 IF( llok) THEN 499 506 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', piatt: '//TRIM(cdatt) … … 517 524 END SUBROUTINE iom_nf90_piatt 518 525 519 SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar) 526 527 SUBROUTINE iom_nf90_pratt( kiomid, cdatt, pv_r0d, cdvar ) 520 528 !!----------------------------------------------------------------------- 521 529 !! *** ROUTINE iom_nf90_pratt *** … … 525 533 !! attribute if optional variable name is supplied (cdvar)) 526 534 !!----------------------------------------------------------------------- 527 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 528 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 529 REAL(wp) , INTENT(in ) :: pv_r0d ! write field 530 CHARACTER(len=*), INTENT(in ), OPTIONAL & 531 & :: cdvar ! name of the variable 532 ! 533 INTEGER :: if90id ! temporary integer 534 INTEGER :: ivarid ! NetCDF variable Id 535 LOGICAL :: llok ! temporary logical 536 LOGICAL :: lenddef ! temporary logical 537 CHARACTER(LEN=100) :: clinfo ! info character 535 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 536 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 537 REAL(wp) , INTENT(in ) :: pv_r0d ! write field 538 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 539 ! 540 INTEGER :: if90id ! temporary integer 541 INTEGER :: ivarid ! NetCDF variable Id 542 LOGICAL :: llok ! temporary logical 543 LOGICAL :: lenddef ! temporary logical 544 CHARACTER(LEN=100) :: clinfo ! info character 538 545 !--------------------------------------------------------------------- 539 546 ! … … 550 557 ivarid = NF90_GLOBAL 551 558 ENDIF 552 !559 ! 553 560 IF( llok) THEN 554 561 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pratt: '//TRIM(cdatt) … … 572 579 END SUBROUTINE iom_nf90_pratt 573 580 574 SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar) 581 582 SUBROUTINE iom_nf90_pcatt( kiomid, cdatt, pv_c0d, cdvar ) 575 583 !!----------------------------------------------------------------------- 576 584 !! *** ROUTINE iom_nf90_pcatt *** … … 580 588 !! attribute if optional variable name is supplied (cdvar)) 581 589 !!----------------------------------------------------------------------- 582 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 583 CHARACTER(len=*), INTENT(in ) :: cdatt ! attribute name 584 CHARACTER(len=*), INTENT(in ) :: pv_c0d ! write field 585 CHARACTER(len=*), INTENT(in ), OPTIONAL & 586 & :: cdvar ! name of the variable 587 ! 588 INTEGER :: if90id ! temporary integer 589 INTEGER :: ivarid ! NetCDF variable Id 590 LOGICAL :: llok ! temporary logical 591 LOGICAL :: lenddef ! temporary logical 592 CHARACTER(LEN=100) :: clinfo ! info character 590 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 591 CHARACTER(len=*) , INTENT(in ) :: cdatt ! attribute name 592 CHARACTER(len=*) , INTENT(in ) :: pv_c0d ! write field 593 CHARACTER(len=*), OPTIONAL, INTENT(in ) :: cdvar ! name of the variable 594 ! 595 INTEGER :: if90id ! temporary integer 596 INTEGER :: ivarid ! NetCDF variable Id 597 LOGICAL :: llok ! temporary logical 598 LOGICAL :: lenddef ! temporary logical 599 CHARACTER(LEN=100) :: clinfo ! info character 593 600 !--------------------------------------------------------------------- 594 601 ! … … 605 612 ivarid = NF90_GLOBAL 606 613 ENDIF 607 !614 ! 608 615 IF( llok) THEN 609 616 clinfo = 'iom_nf90_putatt, file: '//TRIM(iom_file(kiomid)%name)//', pcatt: '//TRIM(cdatt) … … 658 665 659 666 SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid , ktype, & 660 & pv_r0d, pv_r1d, pv_r2d, pv_r3d )667 & pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 661 668 !!-------------------------------------------------------------------- 662 669 !! *** SUBROUTINE iom_nf90_rstput *** … … 687 694 INTEGER :: itype ! variable type 688 695 INTEGER, DIMENSION(4) :: ichunksz ! NetCDF4 chunk sizes. Will be computed using 689 ! nn_nchunks_[i,j,k,t] namelist parameters 690 INTEGER :: ichunkalg, ishuffle,& 691 ideflate, ideflate_level 692 ! NetCDF4 internally fixed parameters 696 ! ! nn_nchunks_[i,j,k,t] namelist parameters 697 INTEGER :: ichunkalg, ishuffle, ideflate, ideflate_level 698 ! ! NetCDF4 internally fixed parameters 693 699 LOGICAL :: lchunk ! logical switch to activate chunking and compression 694 ! when appropriate (currently chunking is applied to 4d fields only) 700 ! ! when appropriate (currently chunking is applied to 4d fields only) 701 INTEGER :: idlv ! local variable 695 702 !--------------------------------------------------------------------- 696 703 ! … … 706 713 ENDIF 707 714 ! define the dimension variables if it is not already done 708 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter' /) 715 IF(iom_file(kiomid)%nlev == jpk ) THEN 716 cltmp = (/ 'nav_lon ', 'nav_lat ', 'nav_lev ', 'time_counter' /) 717 ELSE 718 cltmp = (/ 'nav_lon ', 'nav_lat ', 'numcat ', 'time_counter' /) 719 ENDIF 709 720 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 710 721 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) … … 755 766 IF( PRESENT(pv_r0d) ) THEN 756 767 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, & 757 & iom_file(kiomid)%nvid(idvar) ), clinfo)768 & iom_file(kiomid)%nvid(idvar) ), clinfo ) 758 769 ELSE 759 770 CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cdvar), itype, idimid(1:idims), & 760 & iom_file(kiomid)%nvid(idvar) ), clinfo)771 & iom_file(kiomid)%nvid(idvar) ), clinfo ) 761 772 ENDIF 762 773 lchunk = .false. 763 IF( snc4set%luse .AND. idims .eq.4 )lchunk = .true.774 IF( snc4set%luse .AND. idims == 4 ) lchunk = .true. 764 775 ! update informations structure related the new variable we want to add... 765 776 iom_file(kiomid)%nvars = idvar … … 782 793 ichunksz(3) = MIN( ichunksz(3),MAX( (ichunksz(3)-1)/snc4set%nk + 1 , 1 ) ) ! Suggested default nc4set%nk=6 783 794 ichunksz(4) = 1 ! Do not allow chunks to span the 784 795 ! ! unlimited dimension 785 796 CALL iom_nf90_check(SET_NF90_DEF_VAR_CHUNKING(if90id, idvar, ichunkalg, ichunksz), clinfo) 786 797 CALL iom_nf90_check(SET_NF90_DEF_VAR_DEFLATE(if90id, idvar, ishuffle, ideflate, ideflate_level), clinfo) … … 791 802 idvar = kvid 792 803 ENDIF 793 804 ! 794 805 ! time step kwrite : write the variable 795 806 IF( kt == kwrite ) THEN … … 815 826 ! trick: is defined to 0 => dimension variable are defined but not yet written 816 827 IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 817 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lon' , idmy ), clinfo) 818 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo) 819 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lat' , idmy ), clinfo) 820 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo) 821 CALL iom_nf90_check(NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo) 822 CALL iom_nf90_check(NF90_PUT_VAR( if90id, idmy, gdept_1d ), clinfo) 828 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon' , idmy ) , clinfo ) 829 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 830 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat' , idmy ) , clinfo ) 831 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 832 IF(iom_file(kiomid)%nlev == jpk ) THEN 833 !NEMO 834 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev' , idmy ), clinfo ) 835 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, gdept_1d ), clinfo ) 836 ELSE 837 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'numcat' , idmy ), clinfo) 838 CALL iom_nf90_check( NF90_PUT_VAR ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 839 ENDIF 823 840 ! +++ WRONG VALUE: to be improved but not really useful... 824 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo)825 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt ), clinfo)841 CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 842 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt ), clinfo ) 826 843 ! update the values of the variables dimensions size 827 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo)828 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo)844 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 845 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 829 846 iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 830 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo)847 CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 831 848 iom_file(kiomid)%dimsz(1 , 4) = 1 ! unlimited dimension 832 849 IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' … … 837 854 ! ============= 838 855 IF( PRESENT(pv_r0d) ) THEN 839 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r0d ), clinfo)856 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r0d ), clinfo ) 840 857 ELSEIF( PRESENT(pv_r1d) ) THEN 841 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r1d( :) ), clinfo)858 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r1d(:) ), clinfo ) 842 859 ELSEIF( PRESENT(pv_r2d) ) THEN 843 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2, iy1:iy2 ) ), clinfo)860 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r2d(ix1:ix2,iy1:iy2) ), clinfo ) 844 861 ELSEIF( PRESENT(pv_r3d) ) THEN 845 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2, iy1:iy2, :) ), clinfo)862 CALL iom_nf90_check( NF90_PUT_VAR( if90id, idvar, pv_r3d(ix1:ix2,iy1:iy2,:) ), clinfo ) 846 863 ENDIF 847 864 ! add 1 to the size of the temporal dimension (not really useful...)
Note: See TracChangeset
for help on using the changeset viewer.
