Changeset 7635 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2017-02-03T14:24:58+01:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7584 r7635 99 99 #if defined key_iomput 100 100 101 #if defined key_xios2102 101 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 103 102 TYPE(xios_date) :: start_date 104 #else105 TYPE(xios_time) :: dtime = xios_time(0, 0, 0, 0, 0, 0)106 CHARACTER(len=19) :: cldate107 #endif108 103 CHARACTER(len=10) :: clname 109 104 INTEGER :: ji, jkmin … … 112 107 !!---------------------------------------------------------------------- 113 108 114 #if defined key_xios2115 109 ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 116 #else117 ALLOCATE( zt_bnds(jpk,2), zw_bnds(jpk,2) )118 #endif119 110 120 111 clname = cdname … … 124 115 125 116 126 #if defined key_xios2127 117 ! Calendar type is now defined in xml file 128 118 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL … … 134 124 & start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 135 125 END SELECT 136 #else 137 ! calendar parameters 138 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 139 CASE ( 1) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "Gregorian") 140 CASE ( 0) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "NoLeap") 141 CASE (30) ; CALL xios_set_context_attr(TRIM(clname), calendar_type= "D360") 142 END SELECT 143 WRITE(cldate,"(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':',i2.2,':00')") nyear,nmonth,nday,nhour,nminute 144 CALL xios_set_context_attr(TRIM(clname), start_date=cldate ) 145 146 #endif 126 147 127 ! horizontal grid definition 148 128 CALL set_scalar … … 198 178 ! Add vertical grid bounds 199 179 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 200 #if defined key_xios2201 180 zt_bnds(2,: ) = gdept_1d(:) 202 181 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) … … 205 184 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 206 185 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 207 #else208 zt_bnds(: ,2) = gdept_1d(:)209 zt_bnds(jkmin:jpk,1) = gdept_1d(1:jpkm1)210 zt_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1)211 zw_bnds(: ,1) = gdepw_1d(:)212 zw_bnds(1:jpkm1 ,2) = gdepw_1d(jkmin:jpk)213 zw_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk)214 #endif215 186 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 216 187 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) … … 1281 1252 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1282 1253 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1283 #if defined key_xios21284 1254 LOGICAL, DIMENSION(:) , OPTIONAL, INTENT(in) :: mask 1285 #else 1286 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1287 #endif 1288 1289 1290 #if defined key_xios2 1255 1256 1291 1257 IF ( xios_is_valid_domain (cdid) ) THEN 1292 1258 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1301 1267 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear' ) 1302 1268 ENDIF 1303 #else 1304 IF ( xios_is_valid_domain (cdid) ) THEN 1305 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1306 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1307 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1308 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1309 & bounds_lat=bounds_lat, area=area ) 1310 ENDIF 1311 1312 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1313 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1314 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1315 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1316 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1317 & bounds_lat=bounds_lat, area=area ) 1318 ENDIF 1319 #endif 1269 1320 1270 CALL xios_solve_inheritance() 1321 1271 1322 1272 END SUBROUTINE iom_set_domain_attr 1323 1273 1324 #if defined key_xios2 1325 SUBROUTINE iom_set_zoom_domain_attr( cdid, ibegin, jbegin, ni, nj) 1326 CHARACTER(LEN=*) , INTENT(in) :: cdid 1327 INTEGER , OPTIONAL, INTENT(in) :: ibegin, jbegin, ni, nj 1328 1329 IF ( xios_is_valid_zoom_domain (cdid) ) THEN 1330 CALL xios_set_zoom_domain_attr ( cdid, ibegin=ibegin, jbegin=jbegin, ni=ni, & 1331 & nj=nj) 1332 ENDIF 1333 END SUBROUTINE iom_set_zoom_domain_attr 1334 #endif 1274 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 1283 END SUBROUTINE iom_set_zoom_domain_attr 1335 1284 1336 1285 … … 1340 1289 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1341 1290 1342 #if defined key_xios21343 1291 IF ( PRESENT(paxis) ) THEN 1344 1292 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, n_glo=SIZE(paxis), value=paxis ) 1345 1293 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 1346 1294 ENDIF 1347 #else1348 IF ( PRESENT(paxis) ) THEN1349 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis )1350 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis )1351 ENDIF1352 #endif1353 1295 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1354 1296 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) … … 1359 1301 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1360 1302 CHARACTER(LEN=*) , INTENT(in) :: cdid 1361 #if defined key_xios21362 1303 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_op 1363 1304 TYPE(xios_duration),OPTIONAL , INTENT(in) :: freq_offset 1364 #else1365 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op1366 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset1367 #endif1368 1305 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1369 1306 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) … … 1386 1323 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1387 1324 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix 1388 #if defined key_xios21389 1325 TYPE(xios_duration), OPTIONAL , INTENT(out) :: output_freq 1390 #else1391 CHARACTER(LEN=*) , OPTIONAL , INTENT(out) :: output_freq1392 #endif1393 1326 LOGICAL :: llexist1,llexist2,llexist3 1394 1327 !--------------------------------------------------------------------- 1395 1328 IF( PRESENT( name ) ) name = '' ! default values 1396 1329 IF( PRESENT( name_suffix ) ) name_suffix = '' 1397 #if defined key_xios21398 1330 IF( PRESENT( output_freq ) ) output_freq = xios_duration(0,0,0,0,0,0) 1399 #else1400 IF( PRESENT( output_freq ) ) output_freq = ''1401 #endif1402 1331 IF ( xios_is_valid_file (cdid) ) THEN 1403 1332 CALL xios_solve_inheritance() … … 1420 1349 CHARACTER(LEN=*) , INTENT(in) :: cdid 1421 1350 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1422 #if defined key_xios21423 1351 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask_3D=mask ) 1424 1352 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask_3D=mask ) 1425 #else1426 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask )1427 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask )1428 #endif1429 1353 CALL xios_solve_inheritance() 1430 1354 END SUBROUTINE iom_set_grid_attr … … 1468 1392 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1469 1393 1470 #if defined key_xios21471 1394 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) 1472 #else1473 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)1474 #endif1475 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) 1476 1396 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & … … 1486 1406 END SELECT 1487 1407 ! 1488 #if defined key_xios21489 1408 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj /)) /= 0. ) 1490 #else1491 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. )1492 #endif1493 1409 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 1494 1410 ENDIF … … 1625 1541 1626 1542 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1627 #if defined key_xios21628 1543 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1629 1544 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) … … 1631 1546 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1632 1547 CALL iom_set_zoom_domain_attr ("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 1633 #else1634 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj)1635 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj)1636 CALL iom_set_domain_attr("gznl", lonvalue = zlon, &1637 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))1638 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)1639 #endif1640 1548 ! 1641 1549 CALL iom_update_file_name('ptr') … … 1653 1561 !!---------------------------------------------------------------------- 1654 1562 1655 #if defined key_xios21656 1563 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea-1, jbegin=0, ni=1, nj=1) 1657 #else1658 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1)1659 #endif1660 1564 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1661 1565 … … 1686 1590 REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 1687 1591 REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 1688 #if defined key_xios21689 1592 TYPE(xios_duration) :: f_op, f_of 1690 #endif1691 1593 !!---------------------------------------------------------------------- 1692 1594 ! 1693 1595 ! frequency of the call of iom_put (attribut: freq_op) 1694 #if defined key_xios21695 1596 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1696 1597 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) … … 1698 1599 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1699 1600 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1700 #else1701 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op=cl1//'ts', freq_offset='0ts')1702 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op=cl1//'ts', freq_offset='0ts')1703 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC_scalar' , freq_op=cl1//'ts', freq_offset='0ts')1704 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op=cl1//'ts', freq_offset='0ts')1705 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op=cl1//'ts', freq_offset='0ts')1706 #endif1707 1601 1708 1602 ! output file names (attribut: name) … … 1726 1620 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1727 1621 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1728 #if defined key_xios21729 1622 CALL iom_set_zoom_domain_attr ('Eq'//cl1, jbegin=iy-1, ni=jpiglo) 1730 #else1731 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo)1732 #endif1733 1623 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1734 1624 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') … … 1810 1700 ENDIF 1811 1701 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1812 #if defined key_xios21813 1702 CALL iom_set_zoom_domain_attr (TRIM(clname)//cl1, ibegin= ix-1, jbegin= iy-1) 1814 #else1815 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy)1816 #endif1817 1703 1818 1704 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) … … 1844 1730 REAL(wp) :: zsec 1845 1731 LOGICAL :: llexist 1846 #if defined key_xios21847 1732 TYPE(xios_duration) :: output_freq 1848 #endif1849 1733 !!---------------------------------------------------------------------- 1850 1734 1851 1735 DO jn = 1,2 1852 1736 1853 #if defined key_xios21854 1737 output_freq = xios_duration(0,0,0,0,0,0) 1855 1738 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq ) 1856 #else1857 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq )1858 #endif1859 1739 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1860 1740 … … 1867 1747 END DO 1868 1748 1869 #if defined key_xios21870 1749 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1871 1750 DO WHILE ( idx /= 0 ) … … 1892 1771 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1893 1772 END DO 1894 #else 1895 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1896 DO WHILE ( idx /= 0 ) 1897 IF ( TRIM(clfreq) /= '' ) THEN 1898 itrlen = LEN_TRIM(clfreq) 1899 IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1) 1900 clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname)) 1901 ELSE 1902 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1903 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1904 ENDIF 1905 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1906 END DO 1907 #endif 1773 1908 1774 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1909 1775 DO WHILE ( idx /= 0 )
Note: See TracChangeset
for help on using the changeset viewer.
