- Timestamp:
- 2017-11-27T12:03:07+01:00 (6 years ago)
- Location:
- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 3 edited
-
iom.F90 (modified) (53 diffs)
-
iom_def.F90 (modified) (2 diffs)
-
iom_nf90.F90 (modified) (35 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8586 r8817 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 : jpl36 USE ice , ONLY : jpl 36 37 #endif 37 38 USE domngb ! ocean space and time domain … … 80 81 81 82 !!---------------------------------------------------------------------- 82 !! NEMO/OPA 3.3 , NEMO Consortium (2010)83 !! NEMO/OPA 4.0 , NEMO Consortium (2017) 83 84 !! $Id$ 84 85 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 85 86 !!---------------------------------------------------------------------- 86 87 87 CONTAINS 88 88 … … 95 95 !!---------------------------------------------------------------------- 96 96 CHARACTER(len=*), INTENT(in) :: cdname 97 ! 97 98 #if defined key_iomput 98 99 ! 99 100 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 100 101 TYPE(xios_date) :: start_date … … 104 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 105 106 !!---------------------------------------------------------------------- 106 107 ! 107 108 ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 108 109 ! 109 110 clname = cdname 110 111 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) … … 125 126 ! horizontal grid definition 126 127 CALL set_scalar 127 128 ! 128 129 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 129 130 CALL set_grid( "T", glamt, gphit ) … … 144 145 ENDIF 145 146 ENDIF 146 147 ! 147 148 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 148 149 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain … … 167 168 ENDIF 168 169 ENDIF 169 170 ! 170 171 ! vertical grid definition 171 172 CALL iom_set_axis_attr( "deptht", gdept_1d ) … … 173 174 CALL iom_set_axis_attr( "depthv", gdept_1d ) 174 175 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 175 176 ! 176 177 ! Add vertical grid bounds 177 178 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) … … 186 187 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 187 188 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 188 189 189 ! 190 190 # if defined key_floats 191 191 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 192 192 # endif 193 # if defined key_lim3193 # if defined key_lim3 194 194 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 195 195 ! SIMIP diagnostics (4 main arctic straits) 196 196 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 197 # endif197 # 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 … … 209 209 210 210 CALL xios_update_calendar(0) 211 211 ! 212 212 DEALLOCATE( zt_bnds, zw_bnds ) 213 213 ! 214 214 #endif 215 215 ! 216 216 END SUBROUTINE iom_init 217 217 … … 239 239 240 240 241 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof )241 SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, kiolib, ldstop, ldiof, kdlev ) 242 242 !!--------------------------------------------------------------------- 243 243 !! *** SUBROUTINE iom_open *** … … 252 252 LOGICAL , INTENT(in ), OPTIONAL :: ldstop ! stop if open to read a non-existing file (default = .TRUE.) 253 253 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 254 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels 254 255 255 256 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] … … 405 406 IF( istop == nstop ) THEN ! no error within this routine 406 407 SELECT CASE (iolib) 407 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar )408 CASE (jpnf90 ) ; CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 408 409 CASE DEFAULT 409 410 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed) ' ) … … 672 673 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 673 674 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 675 INTEGER :: inlev ! number of levels for 3D data 674 676 !--------------------------------------------------------------------- 675 677 ! 678 inlev = -1 679 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 676 680 clname = iom_file(kiomid)%name ! esier to read 677 681 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) … … 774 778 istart(idmspc+1) = itime 775 779 776 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 780 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 781 istart(1:idmspc) = kstart(1:idmspc) 782 icnt(1:idmspc) = kcount(1:idmspc) 777 783 ELSE 778 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc) 784 IF(idom == jpdom_unknown ) THEN 785 icnt(1:idmspc) = idimsz(1:idmspc) 779 786 ELSE 780 787 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array … … 799 806 ENDIF 800 807 IF( PRESENT(pv_r3d) ) THEN 801 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkglo808 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 802 809 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3) 803 ELSE ; icnt(3) = jpk810 ELSE ; icnt(3) = inlev 804 811 ENDIF 805 812 ENDIF … … 884 891 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 885 892 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 886 IF( icnt(3) == jpk) THEN893 IF( icnt(3) == inlev ) THEN 887 894 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 888 895 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) … … 1133 1140 END SUBROUTINE iom_rp0d 1134 1141 1142 1135 1143 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1136 1144 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1153 1161 END SUBROUTINE iom_rp1d 1154 1162 1163 1155 1164 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1156 1165 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1173 1182 END SUBROUTINE iom_rp2d 1174 1183 1184 1175 1185 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1176 1186 INTEGER , INTENT(in) :: kt ! ocean time-step … … 1234 1244 REAL(wp), DIMENSION(:,:,:), INTENT(in) :: pfield3d 1235 1245 #if defined key_iomput 1236 CALL xios_send_field( cdname, pfield3d)1246 CALL xios_send_field( cdname, pfield3d ) 1237 1247 #else 1238 1248 IF( .FALSE. ) WRITE(numout,*) cdname, pfield3d ! useless test to avoid compilation warnings 1239 1249 #endif 1240 1250 END SUBROUTINE iom_p3d 1251 1252 #if defined key_iomput 1253 1241 1254 !!---------------------------------------------------------------------- 1242 1243 #if defined key_iomput 1255 !! 'key_iomput' IOM interface 1256 !!---------------------------------------------------------------------- 1244 1257 1245 1258 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1246 1259 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1247 1260 & nvertex, bounds_lon, bounds_lat, area ) 1248 CHARACTER(LEN=*) , INTENT(in) :: cdid 1249 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1250 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1251 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1252 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1253 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1254 LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1255 1256 1257 IF ( xios_is_valid_domain (cdid) ) THEN 1261 !!---------------------------------------------------------------------- 1262 !!---------------------------------------------------------------------- 1263 CHARACTER(LEN=*) , INTENT(in) :: cdid 1264 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1265 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1266 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1267 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1268 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1269 LOGICAL , DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1270 !!---------------------------------------------------------------------- 1271 ! 1272 IF( xios_is_valid_domain (cdid) ) THEN 1258 1273 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1259 1274 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & … … 1261 1276 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1262 1277 ENDIF 1263 IF 1278 IF( xios_is_valid_domaingroup(cdid) ) THEN 1264 1279 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1265 1280 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & … … 1267 1282 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1268 1283 ENDIF 1269 1284 ! 1270 1285 CALL xios_solve_inheritance() 1271 1286 ! 1272 1287 END SUBROUTINE iom_set_domain_attr 1273 1288 1274 1289 1275 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1276 CHARACTER(LEN=*) , INTENT(in) :: cdid 1277 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1278 1279 IF ( xios_is_valid_zoom_domain (cdid) ) THEN 1280 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1281 & nj=nj) 1282 ENDIF 1290 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj ) 1291 !!---------------------------------------------------------------------- 1292 !!---------------------------------------------------------------------- 1293 CHARACTER(LEN=*) , INTENT(in) :: cdid 1294 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1295 !!---------------------------------------------------------------------- 1296 IF( xios_is_valid_zoom_domain(cdid) ) CALL xios_set_zoom_domain_attr( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj ) 1283 1297 END SUBROUTINE iom_set_zoom_domain_attr 1284 1298 1285 1299 1286 1300 SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 1301 !!---------------------------------------------------------------------- 1302 !!---------------------------------------------------------------------- 1287 1303 CHARACTER(LEN=*) , INTENT(in) :: cdid 1288 1304 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 1289 1305 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1290 1291 IF 1292 IF 1293 IF 1294 ENDIF 1295 IF 1296 IF 1306 !!---------------------------------------------------------------------- 1307 IF( PRESENT(paxis) ) THEN 1308 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1309 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1310 ENDIF 1311 IF( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1312 IF( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 1297 1313 CALL xios_solve_inheritance() 1298 1314 END SUBROUTINE iom_set_axis_attr … … 1300 1316 1301 1317 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1302 CHARACTER(LEN=*) , INTENT(in) :: cdid 1303 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1304 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1305 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1306 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1307 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1308 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1318 !!---------------------------------------------------------------------- 1319 !!---------------------------------------------------------------------- 1320 CHARACTER(LEN=*) , INTENT(in) :: cdid 1321 TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_op 1322 TYPE(xios_duration), OPTIONAL, INTENT(in) :: freq_offset 1323 !!---------------------------------------------------------------------- 1324 IF( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1325 IF( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1309 1326 CALL xios_solve_inheritance() 1310 1327 END SUBROUTINE iom_set_field_attr … … 1312 1329 1313 1330 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 1331 !!---------------------------------------------------------------------- 1332 !!---------------------------------------------------------------------- 1314 1333 CHARACTER(LEN=*) , INTENT(in) :: cdid 1315 1334 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix 1316 IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1317 IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1335 !!---------------------------------------------------------------------- 1336 IF( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1337 IF( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1318 1338 CALL xios_solve_inheritance() 1319 1339 END SUBROUTINE iom_set_file_attr … … 1321 1341 1322 1342 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1343 !!---------------------------------------------------------------------- 1344 !!---------------------------------------------------------------------- 1323 1345 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1324 1346 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix … … 1329 1351 IF( PRESENT( name_suffix ) ) name_suffix = '' 1330 1352 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1331 IF 1353 IF( xios_is_valid_file (cdid) ) THEN 1332 1354 CALL xios_solve_inheritance() 1333 1355 CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) … … 1336 1358 IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq ) 1337 1359 ENDIF 1338 IF 1360 IF( xios_is_valid_filegroup(cdid) ) THEN 1339 1361 CALL xios_solve_inheritance() 1340 1362 CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) … … 1347 1369 1348 1370 SUBROUTINE iom_set_grid_attr( cdid, mask ) 1371 !!---------------------------------------------------------------------- 1372 !!---------------------------------------------------------------------- 1349 1373 CHARACTER(LEN=*) , INTENT(in) :: cdid 1350 1374 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1351 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1352 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1375 !!---------------------------------------------------------------------- 1376 IF( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1377 IF( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1353 1378 CALL xios_solve_inheritance() 1354 1379 END SUBROUTINE iom_set_grid_attr 1355 1380 1356 1381 SUBROUTINE iom_setkt( kt, cdname ) 1382 !!---------------------------------------------------------------------- 1383 !!---------------------------------------------------------------------- 1357 1384 INTEGER , INTENT(in) :: kt 1358 1385 CHARACTER(LEN=*), INTENT(in) :: cdname 1359 ! 1386 !!---------------------------------------------------------------------- 1360 1387 CALL iom_swap( cdname ) ! swap to cdname context 1361 1388 CALL xios_update_calendar(kt) 1362 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1363 ! 1389 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1364 1390 END SUBROUTINE iom_setkt 1365 1391 1366 1392 SUBROUTINE iom_context_finalize( cdname ) 1393 !!---------------------------------------------------------------------- 1394 !!---------------------------------------------------------------------- 1367 1395 CHARACTER(LEN=*), INTENT(in) :: cdname 1368 ! 1396 !!---------------------------------------------------------------------- 1369 1397 IF( xios_is_valid_context(cdname) ) THEN 1370 1398 CALL iom_swap( cdname ) ! swap to cdname context … … 1372 1400 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1373 1401 ENDIF 1374 !1375 1402 END SUBROUTINE iom_context_finalize 1376 1403 … … 1381 1408 !! 1382 1409 !! ** Purpose : define horizontal grids 1383 !!1384 1410 !!---------------------------------------------------------------------- 1385 1411 CHARACTER(LEN=1) , INTENT(in) :: cdgrd … … 1387 1413 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1388 1414 ! 1415 INTEGER :: ni,nj 1389 1416 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1390 INTEGER :: ni,nj1391 1417 !!---------------------------------------------------------------------- 1418 ! 1392 1419 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1393 1420 ! 1394 1421 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) 1395 1422 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1396 1423 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & 1397 1424 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1398 1425 ! 1399 1426 IF ( ln_mskland ) THEN 1400 1427 ! mask land points, keep values on coast line -> specific mask for U, V and W points … … 1409 1436 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 1410 1437 ENDIF 1411 1438 ! 1412 1439 END SUBROUTINE set_grid 1413 1440 … … 1420 1447 !! 1421 1448 !!---------------------------------------------------------------------- 1422 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1423 ! 1424 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1425 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j) 1426 ! 1427 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1428 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1429 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1430 ! 1431 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1432 ! ! represents the bottom-left corner of cell (i,j) 1449 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1450 REAL(wp), DIMENSION(jpi,jpj) , INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coord. of a contiguous vertex of cell (i,j) 1451 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coord. of the point of cell (i,j) 1452 ! 1433 1453 INTEGER :: ji, jj, jn, ni, nj 1434 1454 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1455 ! ! represents the bottom-left corner of cell (i,j) 1456 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1457 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1458 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1459 !!---------------------------------------------------------------------- 1460 ! 1435 1461 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1436 1462 ! 1437 1463 ! Offset of coordinate representing bottom-left corner 1438 1464 SELECT CASE ( TRIM(cdgrd) ) 1439 CASE ('T', 'W') 1440 icnr = -1 ; jcnr = -1 1441 CASE ('U') 1442 icnr = 0 ; jcnr = -1 1443 CASE ('V') 1444 icnr = -1 ; jcnr = 0 1465 CASE ('T', 'W') ; icnr = -1 ; jcnr = -1 1466 CASE ('U') ; icnr = 0 ; jcnr = -1 1467 CASE ('V') ; icnr = -1 ; jcnr = 0 1445 1468 END SELECT 1446 1469 ! 1447 1470 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1448 1471 ! 1449 1472 z_fld(:,:) = 1._wp 1450 1473 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1451 1474 ! 1452 1475 ! Cell vertices that can be defined 1453 1476 DO jj = 2, jpjm1 … … 1463 1486 END DO 1464 1487 END DO 1465 1488 ! 1466 1489 ! Cell vertices on boundries 1467 1490 DO jn = 1, 4 … … 1469 1492 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1470 1493 END DO 1471 1494 ! 1472 1495 ! Zero-size cells at closed boundaries if cell points provided, 1473 1496 ! otherwise they are closed cells with unrealistic bounds … … 1494 1517 ENDIF 1495 1518 ENDIF 1496 1497 ! Rotate cells at the north fold 1498 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 1499 1521 DO jj = 1, jpj 1500 1522 DO ji = 1, jpi … … 1506 1528 END DO 1507 1529 END DO 1508 1509 ! Invert cells at the symmetric equator 1510 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1530 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN ! Invert cells at the symmetric equator 1511 1531 DO ji = 1, jpi 1512 1532 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) … … 1515 1535 END DO 1516 1536 ENDIF 1517 1537 ! 1518 1538 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1519 1520 1539 & bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1540 ! 1521 1541 DEALLOCATE( z_bnds, z_fld, z_rot ) 1522 1542 ! 1523 1543 END SUBROUTINE set_grid_bounds 1524 1544 … … 1535 1555 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1536 1556 INTEGER :: ni,nj, ix, iy 1537 1538 1557 !!---------------------------------------------------------------------- 1558 ! 1539 1559 ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk) 1540 1560 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1541 1542 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1561 ! 1562 CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) 1563 ! CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1543 1564 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1544 1565 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1551 1572 END SUBROUTINE set_grid_znl 1552 1573 1574 1553 1575 SUBROUTINE set_scalar 1554 1576 !!---------------------------------------------------------------------- … … 1560 1582 REAL(wp), DIMENSION(1) :: zz = 1. 1561 1583 !!---------------------------------------------------------------------- 1562 1584 ! 1563 1585 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 1564 1586 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1565 1566 zz =REAL(narea,wp)1587 ! 1588 zz = REAL( narea, wp ) 1567 1589 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1568 1590 ! 1569 1591 END SUBROUTINE set_scalar 1570 1592 … … 1637 1659 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1638 1660 CALL set_mooring( zlonpira, zlatpira ) 1639 1640 1661 ! 1641 1662 END SUBROUTINE set_xmlatt 1642 1663 1643 1664 1644 SUBROUTINE set_mooring( plon, plat )1665 SUBROUTINE set_mooring( plon, plat ) 1645 1666 !!---------------------------------------------------------------------- 1646 1667 !! *** ROUTINE set_mooring *** … … 1649 1670 !! 1650 1671 !!---------------------------------------------------------------------- 1651 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat! longitudes/latitudes oft the mooring1672 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring 1652 1673 ! 1653 1674 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name … … 1798 1819 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1799 1820 END DO 1800 1821 ! 1801 1822 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1802 1823 DO WHILE ( idx /= 0 ) … … 1805 1826 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1806 1827 END DO 1807 1828 ! 1808 1829 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1809 1830 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1810 1831 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) 1811 1812 ENDIF 1813 1832 ! 1833 ENDIF 1834 ! 1814 1835 END DO 1815 1836 ! 1816 1837 END SUBROUTINE iom_update_file_name 1817 1838 … … 1822 1843 !! 1823 1844 !! ** Purpose : send back the date corresponding to the given julian day 1824 !!1825 1845 !!---------------------------------------------------------------------- 1826 1846 REAL(wp), INTENT(in ) :: pjday ! julian day … … 1833 1853 REAL(wp) :: zsec 1834 1854 LOGICAL :: ll24, llfull 1855 !!---------------------------------------------------------------------- 1835 1856 ! 1836 1857 IF( PRESENT(ld24) ) THEN ; ll24 = ld24 1837 1858 ELSE ; ll24 = .FALSE. 1838 1859 ENDIF 1839 1860 ! 1840 1861 IF( PRESENT(ldfull) ) THEN ; llfull = ldfull 1841 1862 ELSE ; llfull = .FALSE. 1842 1863 ENDIF 1843 1864 ! 1844 1865 CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 1845 1866 isec = NINT(zsec) 1846 1867 ! 1847 1868 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 1848 1869 CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 1849 1870 isec = 86400 1850 1871 ENDIF 1851 1872 ! 1852 1873 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 1853 1874 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 1854 1875 ENDIF 1855 1876 ! 1856 1877 !$AGRIF_DO_NOT_TREAT 1857 ! Should be fixed in the conv1878 ! needed in the conv 1858 1879 IF( llfull ) THEN 1859 1880 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1867 1888 ENDIF 1868 1889 !$AGRIF_END_DO_NOT_TREAT 1869 1890 ! 1870 1891 END FUNCTION iom_sdate 1871 1892 1872 1893 #else 1873 1874 1894 1875 1895 SUBROUTINE iom_setkt( kt, cdname ) -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r7646 r8817 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_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r7646 r8817 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.
