- Timestamp:
- 2018-07-23T11:33:03+02:00 (6 years ago)
- Location:
- branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r7960 r9987 30 30 CHARACTER(lc) :: cn_ocerst_outdir !: restart output directory 31 31 LOGICAL :: ln_rstart !: start from (F) rest or (T) a restart file 32 LOGICAL :: ln_rstdate !: datestamping of restarts 32 33 LOGICAL :: ln_rst_list !: output restarts at list of times (T) or by frequency (F) 33 34 INTEGER :: nn_no !: job number -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7960 r9987 94 94 CHARACTER(len=*), INTENT(in) :: cdname 95 95 #if defined key_iomput 96 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) 97 CHARACTER(len=19) :: cldate 98 CHARACTER(len=10) :: clname 99 INTEGER :: ji 96 #if ! defined key_xios2 97 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0) 98 CHARACTER(len=19) :: cldate 99 #else 100 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 101 TYPE(xios_date) :: start_date 102 #endif 103 CHARACTER(len=10) :: clname 104 INTEGER :: ji 100 105 ! 101 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 102 107 !!---------------------------------------------------------------------- 103 108 #if ! defined key_xios2 104 109 ALLOCATE( z_bnds(jpk,2) ) 110 #else 111 ALLOCATE( z_bnds(2,jpk) ) 112 #endif 105 113 106 114 clname = cdname … … 110 118 111 119 ! calendar parameters 120 #if ! defined key_xios2 112 121 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 113 122 CASE ( 1) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") … … 117 126 WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' 00:00:00')") nyear,nmonth,nday 118 127 CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 119 128 #else 129 ! Calendar type is now defined in xml file 130 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 131 CASE ( 1) ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 132 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 133 CASE ( 0) ; CALL xios_define_calendar( TYPE = "NoLeap" , time_origin = xios_date(1900,01,01,00,00,00), & 134 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 135 CASE (30) ; CALL xios_define_calendar( TYPE = "D360" , time_origin = xios_date(1900,01,01,00,00,00), & 136 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 137 END SELECT 138 #endif 120 139 ! horizontal grid definition 140 121 141 CALL set_scalar 122 142 … … 170 190 171 191 ! Add vertical grid bounds 192 #if ! defined key_xios2 172 193 z_bnds(: ,1) = gdepw_1d(:) 173 194 z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 174 195 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 196 #else 197 z_bnds(1 ,:) = gdepw_1d(:) 198 z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 199 z_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 200 #endif 201 175 202 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 176 203 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 177 204 CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 178 z_bnds(: ,2) = gdept_1d(:) 179 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 180 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 205 206 #if ! defined key_xios2 207 z_bnds(: ,2) = gdept_1d(:) 208 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 209 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 210 #else 211 z_bnds(2,: ) = gdept_1d(:) 212 z_bnds(1,2:jpk) = gdept_1d(1:jpkm1) 213 z_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 214 #endif 181 215 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 216 182 217 183 218 # if defined key_floats … … 193 228 ! automatic definitions of some of the xml attributs 194 229 CALL set_xmlatt 230 231 CALL set_1point 195 232 196 233 ! end file definition … … 673 710 CHARACTER(LEN=256) :: clname ! file name 674 711 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 712 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 675 713 !--------------------------------------------------------------------- 676 714 ! … … 685 723 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 686 724 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 687 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 725 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 726 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 688 727 689 728 luse_jattr = .false. … … 718 757 ! update idom definition... 719 758 ! Identify the domain in case of jpdom_auto(glo/dta) definition 759 IF( idom == jpdom_autoglo_xy ) THEN 760 ll_depth_spec = .TRUE. 761 idom = jpdom_autoglo 762 ELSE 763 ll_depth_spec = .FALSE. 764 ENDIF 720 765 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 721 766 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global … … 771 816 istart(idmspc+1) = itime 772 817 773 IF( PRESENT(kstart)) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)818 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 774 819 ELSE 775 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)820 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc) 776 821 ELSE 777 822 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array … … 796 841 ENDIF 797 842 IF( PRESENT(pv_r3d) ) THEN 798 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta 799 ELSE ; icnt(3) = jpk 843 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta 844 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3) 845 ELSE ; icnt(3) = jpk 800 846 ENDIF 801 847 ENDIF … … 988 1034 !!---------------------------------------------------------------------- 989 1035 SUBROUTINE iom_g0d_intatt( kiomid, cdatt, pvar ) 990 INTEGER , INTENT(in ) :: kiomid ! 1036 INTEGER , INTENT(in ) :: kiomid !Identifier of the file 991 1037 CHARACTER(len=*), INTENT(in ) :: cdatt ! Name of the attribute 992 1038 INTEGER , INTENT( out) :: pvar ! read field … … 1104 1150 CHARACTER(LEN=*), INTENT(in) :: cdname 1105 1151 REAL(wp) , INTENT(in) :: pfield0d 1152 #if ! defined key_xios2 1106 1153 REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1154 #endif 1107 1155 #if defined key_iomput 1156 #if ! defined key_xios2 1108 1157 zz(:,:)=pfield0d 1109 1158 CALL xios_send_field(cdname, zz) 1110 !CALL xios_send_field(cdname, (/pfield0d/)) 1159 #else 1160 CALL xios_send_field(cdname, (/pfield0d/)) 1161 #endif 1111 1162 #else 1112 1163 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 1156 1207 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1157 1208 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1158 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1159 1209 #if ! defined key_xios2 1210 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1211 #else 1212 LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1213 #endif 1214 1215 #if ! defined key_xios2 1160 1216 IF ( xios_is_valid_domain (cdid) ) THEN 1161 1217 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1164 1220 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1165 1221 & bounds_lat=bounds_lat, area=area ) 1166 ENDIF 1167 1222 ENDIF 1168 1223 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1169 1224 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1173 1228 & bounds_lat=bounds_lat, area=area ) 1174 1229 ENDIF 1230 1231 #else 1232 IF ( xios_is_valid_domain (cdid) ) THEN 1233 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1234 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1235 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1236 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1237 ENDIF 1238 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1239 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1240 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1241 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1242 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1243 ENDIF 1244 #endif 1175 1245 CALL xios_solve_inheritance() 1176 1246 1177 1247 END SUBROUTINE iom_set_domain_attr 1248 1249 #if defined key_xios2 1250 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1251 CHARACTER(LEN=*) , INTENT(in) :: cdid 1252 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1253 1254 IF ( xios_is_valid_zoom_domain (cdid) ) THEN 1255 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1256 & nj=nj) 1257 ENDIF 1258 END SUBROUTINE iom_set_zoom_domain_attr 1259 #endif 1178 1260 1179 1261 … … 1183 1265 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1184 1266 IF ( PRESENT(paxis) ) THEN 1267 #if ! defined key_xios2 1185 1268 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1186 1269 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1270 #else 1271 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1272 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1273 #endif 1187 1274 ENDIF 1188 1275 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) … … 1191 1278 END SUBROUTINE iom_set_axis_attr 1192 1279 1193 1194 1280 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1195 1281 CHARACTER(LEN=*) , INTENT(in) :: cdid 1196 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1197 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1198 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1199 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1282 #if ! defined key_xios2 1283 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_op 1284 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_offset 1285 #else 1286 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1287 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1288 #endif 1289 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1290 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1291 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1292 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1200 1293 CALL xios_solve_inheritance() 1201 1294 END SUBROUTINE iom_set_field_attr 1202 1203 1295 1204 1296 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) … … 1213 1305 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1214 1306 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1215 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq 1307 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix 1308 #if ! defined key_xios2 1309 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: output_freq 1310 #else 1311 TYPE(xios_duration) ,OPTIONAL , INTENT(out) :: output_freq 1312 #endif 1216 1313 LOGICAL :: llexist1,llexist2,llexist3 1217 1314 !--------------------------------------------------------------------- 1218 1315 IF( PRESENT( name ) ) name = '' ! default values 1219 1316 IF( PRESENT( name_suffix ) ) name_suffix = '' 1317 #if ! defined key_xios2 1220 1318 IF( PRESENT( output_freq ) ) output_freq = '' 1319 #else 1320 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1321 #endif 1221 1322 IF ( xios_is_valid_file (cdid) ) THEN 1222 1323 CALL xios_solve_inheritance() … … 1239 1340 CHARACTER(LEN=*) , INTENT(in) :: cdid 1240 1341 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1342 #if ! defined key_xios2 1241 1343 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask ) 1242 1344 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask ) 1345 #else 1346 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1347 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1348 #endif 1243 1349 CALL xios_solve_inheritance() 1244 1350 END SUBROUTINE iom_set_grid_attr … … 1282 1388 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1283 1389 1284 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1390 #if ! defined key_xios2 1391 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1392 #else 1393 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) 1394 #endif 1285 1395 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1286 1396 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & … … 1296 1406 END SELECT 1297 1407 ! 1408 #if ! defined key_xios2 1298 1409 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. ) 1410 #else 1411 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj /)) /= 0. ) 1412 #endif 1299 1413 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 1300 1414 ENDIF … … 1430 1544 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1431 1545 1546 CALL dom_ngb( -168.7, 65.6, ix, iy, 'T' ) ! i-line that passes across Bering strait to avoid land processor (used in plots) 1547 #if ! defined key_xios2 1432 1548 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1433 1549 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1435 1551 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1436 1552 ! 1437 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)1438 1553 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1554 #else 1555 ! Pas teste : attention aux indices ! 1556 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1557 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1558 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 1559 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1560 CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 1561 #endif 1562 1439 1563 CALL iom_update_file_name('ptr') 1440 1564 ! … … 1450 1574 REAL(wp), DIMENSION(1) :: zz = 1. 1451 1575 !!---------------------------------------------------------------------- 1576 #if ! defined key_xios2 1452 1577 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 1578 #else 1579 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 1580 #endif 1453 1581 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1454 1582 1455 1583 zz=REAL(narea,wp) 1456 1584 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1457 1585 1458 1586 END SUBROUTINE set_scalar 1587 1588 SUBROUTINE set_1point 1589 !!---------------------------------------------------------------------- 1590 !! *** ROUTINE set_1point *** 1591 !! 1592 !! ** Purpose : define zoom grid for scalar fields 1593 !! 1594 !!---------------------------------------------------------------------- 1595 REAL(wp), DIMENSION(1) :: zz = 1. 1596 INTEGER :: ix, iy 1597 !!---------------------------------------------------------------------- 1598 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! Nearest point to north pole should be ocean 1599 CALL iom_set_domain_attr('1point', zoom_ibegin=ix, zoom_jbegin=iy) 1600 1601 END SUBROUTINE set_1point 1602 1459 1603 1460 1604 … … 1479 1623 REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 1480 1624 REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 1625 #if defined key_xios2 1626 TYPE(xios_duration) :: f_op, f_of 1627 #endif 1628 1481 1629 !!---------------------------------------------------------------------- 1482 1630 ! 1483 1631 ! frequency of the call of iom_put (attribut: freq_op) 1484 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 1485 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts') 1486 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op = cl1//'ts', freq_offset='0ts') 1487 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts') 1488 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts') 1632 #if ! defined key_xios2 1633 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts') 1634 WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('trendT_even' , freq_op=cl1//'ts', freq_offset='0ts') 1635 WRITE(cl1,'(i1)') 2 ; CALL iom_set_field_attr('trendT_odd' , freq_op=cl1//'ts', freq_offset='-1ts') 1636 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts') 1637 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts') 1638 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op=cl1//'ts', freq_offset='0ts') 1639 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op=cl1//'ts', freq_offset='0ts') 1640 #else 1641 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1642 f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('trendT_even' , freq_op=f_op, freq_offset=f_of) 1643 f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd' , freq_op=f_op, freq_offset=f_of) 1644 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1645 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 1646 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1647 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1648 #endif 1489 1649 1490 1650 ! output file names (attribut: name) … … 1508 1668 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1509 1669 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1670 #if ! defined key_xios2 1510 1671 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1672 #else 1673 CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 1674 #endif 1511 1675 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1512 1676 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') … … 1588 1752 ENDIF 1589 1753 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1754 #if ! defined key_xios2 1590 1755 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1756 #else 1757 CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 1758 #endif 1591 1759 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) 1592 1760 CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) … … 1617 1785 REAL(wp) :: zsec 1618 1786 LOGICAL :: llexist 1619 !!---------------------------------------------------------------------- 1787 #if defined key_xios2 1788 TYPE(xios_duration) :: output_freq 1789 #endif 1790 !!---------------------------------------------------------------------- 1791 1620 1792 1621 1793 DO jn = 1,2 1622 1794 #if ! defined key_xios2 1623 1795 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq ) 1796 #else 1797 output_freq = xios_duration(0,0,0,0,0,0) 1798 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq ) 1799 #endif 1624 1800 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1625 1801 … … 1632 1808 END DO 1633 1809 1810 #if ! defined key_xios2 1634 1811 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1635 1812 DO WHILE ( idx /= 0 ) … … 1644 1821 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1645 1822 END DO 1646 1823 #else 1824 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1825 DO WHILE ( idx /= 0 ) 1826 IF ( output_freq%timestep /= 0) THEN 1827 WRITE(clfreq,'(I18,A2)')INT(output_freq%timestep),'ts' 1828 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1829 ELSE IF ( output_freq%hour /= 0 ) THEN 1830 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 1831 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1832 ELSE IF ( output_freq%day /= 0 ) THEN 1833 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 1834 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1835 ELSE IF ( output_freq%month /= 0 ) THEN 1836 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 1837 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1838 ELSE IF ( output_freq%year /= 0 ) THEN 1839 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 1840 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1841 ELSE 1842 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1843 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1844 ENDIF 1845 clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 1846 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1847 END DO 1848 #endif 1647 1849 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1648 1850 DO WHILE ( idx /= 0 ) … … 1673 1875 END DO 1674 1876 1877 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1675 1878 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1676 1879 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 1720 1923 ENDIF 1721 1924 1925 !$AGRIF_DO_NOT_TREAT 1926 ! Should be fixed in the conv 1722 1927 IF( llfull ) THEN 1723 1928 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1730 1935 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1731 1936 ENDIF 1937 !$AGRIF_END_DO_NOT_TREAT 1732 1938 1733 1939 END FUNCTION iom_sdate -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r7960 r9987 26 26 INTEGER, PARAMETER, PUBLIC :: jpdom_unknown = 7 !: No dimension checking 27 27 INTEGER, PARAMETER, PUBLIC :: jpdom_autoglo = 8 !: 28 INTEGER, PARAMETER, PUBLIC :: jpdom_autodta = 9 !: 28 INTEGER, PARAMETER, PUBLIC :: jpdom_autoglo_xy = 9 !: Automatically set horizontal dimensions only 29 INTEGER, PARAMETER, PUBLIC :: jpdom_autodta = 10 !: 29 30 30 31 INTEGER, PARAMETER, PUBLIC :: jpioipsl = 100 !: Use ioipsl (fliocom only) library … … 57 58 INTEGER :: nvars !: number of identified varibles in the file 58 59 INTEGER :: iduld !: id of the unlimited dimension 60 INTEGER :: lenuld !: length of the unlimited dimension (number of records in file) 59 61 INTEGER :: irec !: writing record position 60 62 CHARACTER(LEN=32) :: uldname !: name of the unlimited dimension -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r7960 r9987 154 154 CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 155 155 IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN 156 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld, & 157 & name = iom_file(kiomid)%uldname), clinfo) 156 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld, & 157 & name = iom_file(kiomid)%uldname, & 158 & len = iom_file(kiomid)%lenuld ), clinfo ) 158 159 ENDIF 159 160 IF(lwp) WRITE(numout,*) ' ---> '//TRIM(cdname)//' OK' -
branches/UKMO/dev_r5518_obs_oper_update_icethick/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r7960 r9987 21 21 USE in_out_manager ! I/O manager 22 22 USE iom ! I/O module 23 USE ioipsl, ONLY : ju2ymds ! for calendar 23 24 USE eosbn2 ! equation of state (eos bn2 routine) 24 25 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 25 26 USE divcur ! hor. divergence and curl (div & cur routines) 27 USE sbc_oce ! for icesheet freshwater input variables 26 28 27 29 IMPLICIT NONE … … 54 56 !!---------------------------------------------------------------------- 55 57 INTEGER, INTENT(in) :: kt ! ocean time-step 58 INTEGER :: iyear, imonth, iday 59 REAL (wp) :: zsec 60 REAL (wp) :: zfjulday 56 61 !! 57 62 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 58 63 CHARACTER(LEN=50) :: clname ! ocean output restart file name 59 CHARACTER( lc):: clpath ! full path to ocean output restart file64 CHARACTER(LEN=150) :: clpath ! full path to ocean output restart file 60 65 !!---------------------------------------------------------------------- 61 66 ! … … 81 86 IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 82 87 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 83 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 84 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 85 ELSE ; WRITE(clkt, '(i8.8)') nitrst 88 IF ( ln_rstdate ) THEN 89 zfjulday = fjulday + rdttra(1) / rday 90 IF( ABS(zfjulday - REAL(NINT(zfjulday),wp)) < 0.1 / rday ) zfjulday = REAL(NINT(zfjulday),wp) ! avoid truncation error 91 CALL ju2ymds( zfjulday, iyear, imonth, iday, zsec ) 92 WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 93 ELSE 94 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 95 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 96 ELSE ; WRITE(clkt, '(i8.8)') nitrst 97 ENDIF 86 98 ENDIF 87 99 ! create the file … … 145 157 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 146 158 #endif 159 IF( lk_oasis) THEN 160 ! nn_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 161 IF( nn_coupled_iceshelf_fluxes .eq. 1 ) THEN 162 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ) 163 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 164 CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 165 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 166 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 167 CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 168 ENDIF 169 ENDIF 170 147 171 IF( kt == nitrst ) THEN 148 172 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 258 282 #endif 259 283 ! 284 IF( iom_varid( numror, 'greenland_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 285 CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass ) 286 CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 287 CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 288 ELSE 289 greenland_icesheet_mass = 0.0 290 greenland_icesheet_mass_rate_of_change = 0.0 291 greenland_icesheet_timelapsed = 0.0 292 ENDIF 293 IF( iom_varid( numror, 'antarctica_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 294 CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 295 CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 296 CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 297 ELSE 298 antarctica_icesheet_mass = 0.0 299 antarctica_icesheet_mass_rate_of_change = 0.0 300 antarctica_icesheet_timelapsed = 0.0 301 ENDIF 302 260 303 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 261 304 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values
Note: See TracChangeset
for help on using the changeset viewer.