- Timestamp:
- 2017-03-09T13:52:43+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5785_SSS_obsoper/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
- Property svn:keywords deleted
r5682 r7773 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 141 #if ! defined key_xios2 121 142 CALL set_scalar 143 #endif 122 144 123 145 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN … … 170 192 171 193 ! Add vertical grid bounds 194 #if ! defined key_xios2 172 195 z_bnds(: ,1) = gdepw_1d(:) 173 196 z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 174 197 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 198 #else 199 z_bnds(1 ,:) = gdepw_1d(:) 200 z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 201 z_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 202 #endif 203 175 204 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 176 205 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 177 206 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) 207 208 #if ! defined key_xios2 209 z_bnds(: ,2) = gdept_1d(:) 210 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 211 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 212 #else 213 z_bnds(2,: ) = gdept_1d(:) 214 z_bnds(1,2:jpk) = gdept_1d(1:jpkm1) 215 z_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 216 #endif 181 217 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 218 182 219 183 220 # if defined key_floats … … 1158 1195 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1159 1196 1197 #if ! defined key_xios2 1160 1198 IF ( xios_is_valid_domain (cdid) ) THEN 1161 1199 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1164 1202 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1165 1203 & bounds_lat=bounds_lat, area=area ) 1166 ENDIF 1167 1204 ENDIF 1168 1205 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1169 1206 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1173 1210 & bounds_lat=bounds_lat, area=area ) 1174 1211 ENDIF 1212 1213 #else 1214 IF ( xios_is_valid_domain (cdid) ) THEN 1215 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1216 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1217 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1218 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1219 ENDIF 1220 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1221 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1222 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1223 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_2D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1224 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1225 ENDIF 1226 #endif 1175 1227 CALL xios_solve_inheritance() 1176 1228 1177 1229 END SUBROUTINE iom_set_domain_attr 1230 1231 #if defined key_xios2 1232 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1233 CHARACTER(LEN=*) , INTENT(in) :: cdid 1234 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1235 1236 IF ( xios_is_valid_domain (cdid) ) THEN 1237 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1238 & nj=nj) 1239 ENDIF 1240 END SUBROUTINE iom_set_zoom_domain_attr 1241 #endif 1178 1242 1179 1243 … … 1183 1247 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1184 1248 IF ( PRESENT(paxis) ) THEN 1249 #if ! defined key_xios2 1185 1250 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1186 1251 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1252 #else 1253 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1254 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1255 #endif 1187 1256 ENDIF 1188 1257 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) … … 1191 1260 END SUBROUTINE iom_set_axis_attr 1192 1261 1193 1194 1262 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1195 1263 CHARACTER(LEN=*) , INTENT(in) :: cdid 1196 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1197 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1264 #if ! defined key_xios2 1265 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_op 1266 CHARACTER(LEN=*) ,OPTIONAL , INTENT(in) :: freq_offset 1267 #else 1268 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1269 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1270 #endif 1198 1271 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1199 1272 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) … … 1202 1275 CALL xios_solve_inheritance() 1203 1276 END SUBROUTINE iom_set_field_attr 1204 1205 1277 1206 1278 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) … … 1215 1287 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1216 1288 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1217 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq 1289 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix 1290 #if ! defined key_xios2 1291 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: output_freq 1292 #else 1293 TYPE(xios_duration) ,OPTIONAL , INTENT(out) :: output_freq 1294 #endif 1218 1295 LOGICAL :: llexist1,llexist2,llexist3 1219 1296 !--------------------------------------------------------------------- 1220 1297 IF( PRESENT( name ) ) name = '' ! default values 1221 1298 IF( PRESENT( name_suffix ) ) name_suffix = '' 1299 #if ! defined key_xios2 1222 1300 IF( PRESENT( output_freq ) ) output_freq = '' 1301 #else 1302 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1303 #endif 1223 1304 IF ( xios_is_valid_file (cdid) ) THEN 1224 1305 CALL xios_solve_inheritance() … … 1241 1322 CHARACTER(LEN=*) , INTENT(in) :: cdid 1242 1323 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1324 #if ! defined key_xios2 1243 1325 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask ) 1244 1326 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask ) 1327 #else 1328 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask3=mask ) 1329 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask3=mask ) 1330 #endif 1245 1331 CALL xios_solve_inheritance() 1246 1332 END SUBROUTINE iom_set_grid_attr … … 1284 1370 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1285 1371 1286 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) 1372 #if ! defined key_xios2 1373 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) 1374 #else 1375 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) 1376 #endif 1287 1377 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1288 1378 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & … … 1432 1522 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1433 1523 1524 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1525 #if ! defined key_xios2 1434 1526 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1435 1527 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1437 1529 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1438 1530 ! 1439 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)1440 1531 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1532 #else 1533 ! Pas teste : attention aux indices ! 1534 CALL iom_set_domain_attr("ptr", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1535 CALL iom_set_domain_attr("ptr", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1536 CALL iom_set_domain_attr("ptr", lonvalue = zlon, & 1537 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1538 CALL iom_set_zoom_domain_attr ('ptr', ibegin=ix, nj=jpjglo) 1539 #endif 1540 1441 1541 CALL iom_update_file_name('ptr') 1442 1542 ! … … 1457 1557 zz=REAL(narea,wp) 1458 1558 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1459 1559 1460 1560 END SUBROUTINE set_scalar 1461 1561 … … 1481 1581 REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 1482 1582 REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 1583 #if defined key_xios2 1584 TYPE(xios_duration) :: f_op, f_of 1585 #endif 1586 1483 1587 !!---------------------------------------------------------------------- 1484 1588 ! 1485 1589 ! frequency of the call of iom_put (attribut: freq_op) 1486 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 1487 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts') 1488 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op = cl1//'ts', freq_offset='0ts') 1489 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts') 1490 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts') 1590 #if ! defined key_xios2 1591 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts') 1592 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts') 1593 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts') 1594 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op=cl1//'ts', freq_offset='0ts') 1595 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op=cl1//'ts', freq_offset='0ts') 1596 #else 1597 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1598 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1599 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 1600 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1601 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1602 #endif 1491 1603 1492 1604 ! output file names (attribut: name) … … 1510 1622 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1511 1623 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1624 #if ! defined key_xios2 1512 1625 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1626 #else 1627 CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 1628 #endif 1513 1629 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1514 1630 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') … … 1590 1706 ENDIF 1591 1707 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1708 #if ! defined key_xios2 1592 1709 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1710 #else 1711 CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 1712 #endif 1593 1713 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) 1594 1714 CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) … … 1619 1739 REAL(wp) :: zsec 1620 1740 LOGICAL :: llexist 1621 !!---------------------------------------------------------------------- 1741 #if defined key_xios2 1742 TYPE(xios_duration) :: output_freq 1743 #endif 1744 !!---------------------------------------------------------------------- 1745 1622 1746 1623 1747 DO jn = 1,2 1624 1748 #if ! defined key_xios2 1625 1749 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq ) 1750 #else 1751 output_freq = xios_duration(0,0,0,0,0,0) 1752 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq ) 1753 #endif 1626 1754 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1627 1755 … … 1634 1762 END DO 1635 1763 1764 #if ! defined key_xios2 1636 1765 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1637 1766 DO WHILE ( idx /= 0 ) … … 1646 1775 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1647 1776 END DO 1648 1777 #else 1778 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1779 DO WHILE ( idx /= 0 ) 1780 IF ( output_freq%hour /= 0 ) THEN 1781 WRITE(clfreq,'(I19,A1)')INT(output_freq%hour),'h' 1782 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1783 ELSE IF ( output_freq%day /= 0 ) THEN 1784 WRITE(clfreq,'(I19,A1)')INT(output_freq%day),'d' 1785 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1786 ELSE IF ( output_freq%month /= 0 ) THEN 1787 WRITE(clfreq,'(I19,A1)')INT(output_freq%month),'m' 1788 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1789 ELSE IF ( output_freq%year /= 0 ) THEN 1790 WRITE(clfreq,'(I19,A1)')INT(output_freq%year),'y' 1791 itrlen = LEN_TRIM(ADJUSTL(clfreq)) 1792 ELSE 1793 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1794 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1795 ENDIF 1796 clname = clname(1:idx-1)//TRIM(ADJUSTL(clfreq))//clname(idx+6:LEN_TRIM(clname)) 1797 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1798 END DO 1799 #endif 1649 1800 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1650 1801 DO WHILE ( idx /= 0 )
Note: See TracChangeset
for help on using the changeset viewer.