Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM
- Timestamp:
- 2015-12-03T09:10:32+01:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 4 edited
-
in_out_manager.F90 (modified) (5 diffs)
-
iom.F90 (modified) (21 diffs)
-
iom_nf90.F90 (modified) (2 diffs)
-
restart.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r5260 r5989 26 26 CHARACTER(lc) :: cn_exp !: experiment name used for output filename 27 27 CHARACTER(lc) :: cn_ocerst_in !: suffix of ocean restart name (input) 28 CHARACTER(lc) :: cn_ocerst_indir !: restart input directory 28 29 CHARACTER(lc) :: cn_ocerst_out !: suffix of ocean restart name (output) 30 CHARACTER(lc) :: cn_ocerst_outdir !: restart output directory 29 31 LOGICAL :: ln_rstart !: start from (F) rest or (T) a restart file 32 LOGICAL :: ln_rst_list !: output restarts at list of times (T) or by frequency (F) 30 33 INTEGER :: nn_no !: job number 31 34 INTEGER :: nn_rstctl !: control of the time step (0, 1 or 2) … … 38 41 INTEGER :: nn_write !: model standard output frequency 39 42 INTEGER :: nn_stock !: restart file frequency 43 INTEGER, DIMENSION(10) :: nn_stocklist !: restart dump times 40 44 LOGICAL :: ln_dimgnnn !: type of dimgout. (F): 1 file for all proc 41 45 !: (T): 1 file per proc 42 46 LOGICAL :: ln_mskland !: mask land points in NetCDF outputs (costly: + ~15%) 47 LOGICAL :: ln_cfmeta !: output additional data to netCDF files required for compliance with the CF metadata standard 43 48 LOGICAL :: ln_clobber !: clobber (overwrite) an existing file 44 49 INTEGER :: nn_chunksz !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) … … 78 83 INTEGER :: nwrite !: model standard output frequency 79 84 INTEGER :: nstock !: restart file frequency 85 INTEGER, DIMENSION(10) :: nstocklist !: restart dump times 80 86 81 87 !!---------------------------------------------------------------------- … … 84 90 INTEGER :: nitrst !: time step at which restart file should be written 85 91 LOGICAL :: lrst_oce !: logical to control the oce restart write 86 INTEGER :: numror, numrow !: logical unit for cean restart (read and write) 92 INTEGER :: numror = 0 !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 93 INTEGER :: numrow !: logical unit for ocean restart (write) 94 INTEGER :: nrst_lst !: number of restart to output next 87 95 88 96 !!---------------------------------------------------------------------- … … 142 150 LOGICAL :: lwp = .FALSE. !: boolean : true on the 1st processor only .OR. ln_ctl 143 151 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 152 CHARACTER(lc) :: cxios_context !: context name used in xios 144 153 145 154 !!---------------------------------------------------------------------- -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5260 r5989 61 61 #if defined key_iomput 62 62 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 63 PRIVATE set_grid, set_ scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate63 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 64 64 # endif 65 65 … … 98 98 CHARACTER(len=10) :: clname 99 99 INTEGER :: ji 100 !!---------------------------------------------------------------------- 100 ! 101 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 102 !!---------------------------------------------------------------------- 103 104 ALLOCATE( z_bnds(jpk,2) ) 101 105 102 106 clname = cdname 103 107 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 104 # if defined key_mpp_mpi105 108 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 106 # else107 CALL xios_context_initialize(TRIM(clname), 0)108 # endif109 109 CALL iom_swap( cdname ) 110 110 … … 121 121 CALL set_scalar 122 122 123 IF( TRIM(cdname) == "nemo") THEN123 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 124 124 CALL set_grid( "T", glamt, gphit ) 125 125 CALL set_grid( "U", glamu, gphiu ) 126 126 CALL set_grid( "V", glamv, gphiv ) 127 127 CALL set_grid( "W", glamt, gphit ) 128 ENDIF 129 130 IF( TRIM(cdname) == "nemo_crs" ) THEN 128 CALL set_grid_znl( gphit ) 129 ! 130 IF( ln_cfmeta ) THEN ! Add additional grid metadata 131 CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 132 CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 133 CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 134 CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 135 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 136 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 137 CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 138 CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 139 ENDIF 140 ENDIF 141 142 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 131 143 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 132 144 ! … … 135 147 CALL set_grid( "V", glamv_crs, gphiv_crs ) 136 148 CALL set_grid( "W", glamt_crs, gphit_crs ) 149 CALL set_grid_znl( gphit_crs ) 137 150 ! 138 151 CALL dom_grid_glo ! Return to parent grid domain 139 ENDIF 140 152 ! 153 IF( ln_cfmeta ) THEN ! Add additional grid metadata 154 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 155 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 156 CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 157 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 158 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 159 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 160 CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs ) 161 CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 162 ENDIF 163 ENDIF 141 164 142 165 ! vertical grid definition … … 145 168 CALL iom_set_axis_attr( "depthv", gdept_1d ) 146 169 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 170 171 ! Add vertical grid bounds 172 z_bnds(: ,1) = gdepw_1d(:) 173 z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 174 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 175 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 176 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 177 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) 181 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 182 147 183 # if defined key_floats 148 184 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) … … 152 188 #endif 153 189 CALL iom_set_axis_attr( "icbcla", class_num ) 190 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 191 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 154 192 155 193 ! automatic definitions of some of the xml attributs … … 162 200 163 201 CALL xios_update_calendar(0) 202 203 DEALLOCATE( z_bnds ) 204 164 205 #endif 165 206 … … 862 903 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 863 904 ELSEIF( PRESENT(pv_r2d) ) THEN 864 !CDIR COLLAPSE865 905 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 866 !CDIR COLLAPSE867 906 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 868 907 ELSEIF( PRESENT(pv_r3d) ) THEN 869 !CDIR COLLAPSE870 908 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 871 !CDIR COLLAPSE872 909 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 873 910 ENDIF … … 1107 1144 1108 1145 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1109 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1110 CHARACTER(LEN=*) , INTENT(in) :: cdid 1111 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1112 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1113 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 1114 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1115 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1146 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1147 & nvertex, bounds_lon, bounds_lat, area ) 1148 CHARACTER(LEN=*) , INTENT(in) :: cdid 1149 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1150 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1151 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1152 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1153 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1154 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1116 1155 1117 1156 IF ( xios_is_valid_domain (cdid) ) THEN … … 1119 1158 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1120 1159 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1121 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1160 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1161 & bounds_lat=bounds_lat, area=area ) 1122 1162 ENDIF 1123 1163 … … 1126 1166 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1127 1167 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1128 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1168 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1169 & bounds_lat=bounds_lat, area=area ) 1129 1170 ENDIF 1130 1171 CALL xios_solve_inheritance() … … 1133 1174 1134 1175 1135 SUBROUTINE iom_set_axis_attr( cdid, paxis )1176 SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 1136 1177 CHARACTER(LEN=*) , INTENT(in) :: cdid 1137 REAL(wp), DIMENSION(:), INTENT(in) :: paxis 1138 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis ) 1139 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 1178 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 1179 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1180 IF ( PRESENT(paxis) ) THEN 1181 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1182 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1183 ENDIF 1184 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1185 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 1140 1186 CALL xios_solve_inheritance() 1141 1187 END SUBROUTINE iom_set_axis_attr … … 1146 1192 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1147 1193 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1148 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1149 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1194 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1195 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1196 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1197 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1150 1198 CALL xios_solve_inheritance() 1151 1199 END SUBROUTINE iom_set_field_attr … … 1200 1248 CALL iom_swap( cdname ) ! swap to cdname context 1201 1249 CALL xios_update_calendar(kt) 1202 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1250 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1203 1251 ! 1204 1252 END SUBROUTINE iom_setkt … … 1210 1258 CALL iom_swap( cdname ) ! swap to cdname context 1211 1259 CALL xios_context_finalize() ! finalize the context 1212 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1260 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1213 1261 ENDIF 1214 1262 ! … … 1253 1301 1254 1302 1303 SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 1304 !!---------------------------------------------------------------------- 1305 !! *** ROUTINE set_grid_bounds *** 1306 !! 1307 !! ** Purpose : define horizontal grid corners 1308 !! 1309 !!---------------------------------------------------------------------- 1310 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1311 ! 1312 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1313 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j) 1314 ! 1315 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1316 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1317 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1318 ! 1319 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1320 ! ! represents the bottom-left corner of cell (i,j) 1321 INTEGER :: ji, jj, jn, ni, nj 1322 1323 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1324 1325 ! Offset of coordinate representing bottom-left corner 1326 SELECT CASE ( TRIM(cdgrd) ) 1327 CASE ('T', 'W') 1328 icnr = -1 ; jcnr = -1 1329 CASE ('U') 1330 icnr = 0 ; jcnr = -1 1331 CASE ('V') 1332 icnr = -1 ; jcnr = 0 1333 END SELECT 1334 1335 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1336 1337 z_fld(:,:) = 1._wp 1338 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1339 1340 ! Cell vertices that can be defined 1341 DO jj = 2, jpjm1 1342 DO ji = 2, jpim1 1343 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1344 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1345 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1346 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1347 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1348 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1349 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1350 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1351 END DO 1352 END DO 1353 1354 ! Cell vertices on boundries 1355 DO jn = 1, 4 1356 CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 1357 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1358 END DO 1359 1360 ! Zero-size cells at closed boundaries if cell points provided, 1361 ! otherwise they are closed cells with unrealistic bounds 1362 IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 1363 IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1364 DO jn = 1, 4 ! (West or jpni = 1), closed E-W 1365 z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:) 1366 END DO 1367 ENDIF 1368 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1369 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 1370 z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 1371 END DO 1372 ENDIF 1373 IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 1374 DO jn = 1, 4 ! South or (jpnj = 1, not symmetric) 1375 z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1) 1376 END DO 1377 ENDIF 1378 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 1379 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 1380 z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 1381 END DO 1382 ENDIF 1383 ENDIF 1384 1385 ! Rotate cells at the north fold 1386 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 1387 DO jj = 1, jpj 1388 DO ji = 1, jpi 1389 IF( z_fld(ji,jj) == -1. ) THEN 1390 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 1391 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 1392 z_bnds(:,ji,jj,:) = z_rot(:,:) 1393 ENDIF 1394 END DO 1395 END DO 1396 1397 ! Invert cells at the symmetric equator 1398 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1399 DO ji = 1, jpi 1400 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 1401 z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 1402 z_bnds(:,ji,1,:) = z_rot(:,:) 1403 END DO 1404 ENDIF 1405 1406 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1407 bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1408 1409 DEALLOCATE( z_bnds, z_fld, z_rot ) 1410 1411 END SUBROUTINE set_grid_bounds 1412 1413 1414 SUBROUTINE set_grid_znl( plat ) 1415 !!---------------------------------------------------------------------- 1416 !! *** ROUTINE set_grid_znl *** 1417 !! 1418 !! ** Purpose : define grids for zonal mean 1419 !! 1420 !!---------------------------------------------------------------------- 1421 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1422 ! 1423 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1424 INTEGER :: ni,nj, ix, iy 1425 1426 1427 ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk) 1428 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1429 1430 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1431 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1432 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 1433 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1434 ! 1435 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1436 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1437 CALL iom_update_file_name('ptr') 1438 ! 1439 END SUBROUTINE set_grid_znl 1440 1255 1441 SUBROUTINE set_scalar 1256 1442 !!---------------------------------------------------------------------- … … 1260 1446 !! 1261 1447 !!---------------------------------------------------------------------- 1262 REAL(wp), DIMENSION(1) :: zz = 1.1448 REAL(wp), DIMENSION(1) :: zz = 1. 1263 1449 !!---------------------------------------------------------------------- 1264 1450 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 1265 1451 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1452 1266 1453 zz=REAL(narea,wp) 1267 1454 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) … … 1337 1524 CALL set_mooring( zlonpira, zlatpira ) 1338 1525 1339 ! diaptr : zonal mean1340 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots)1341 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo)1342 CALL iom_update_file_name('ptr')1343 !1344 1526 1345 1527 END SUBROUTINE set_xmlatt … … 1489 1671 END DO 1490 1672 1673 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1491 1674 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1492 1675 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 1536 1719 ENDIF 1537 1720 1721 !$AGRIF_DO_NOT_TREAT 1722 ! Should be fixed in the conv 1538 1723 IF( llfull ) THEN 1539 1724 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1546 1731 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1547 1732 ENDIF 1733 !$AGRIF_END_DO_NOT_TREAT 1548 1734 1549 1735 END FUNCTION iom_sdate -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r5260 r5989 61 61 INTEGER, DIMENSION(2,5), INTENT(in ), OPTIONAL :: kdompar ! domain parameters: 62 62 63 CHARACTER(LEN= 100) :: clinfo ! info character64 CHARACTER(LEN= 100) :: cltmp ! temporary character63 CHARACTER(LEN=256) :: clinfo ! info character 64 CHARACTER(LEN=256) :: cltmp ! temporary character 65 65 INTEGER :: iln ! lengths of character 66 66 INTEGER :: istop ! temporary storage of nstop … … 393 393 INTEGER, DIMENSION(4) :: idimsz ! dimensions size 394 394 INTEGER, DIMENSION(4) :: idimid ! dimensions id 395 CHARACTER(LEN= 100) :: clinfo ! info character395 CHARACTER(LEN=256) :: clinfo ! info character 396 396 CHARACTER(LEN= 12), DIMENSION(4) :: cltmp ! temporary character 397 397 INTEGER :: if90id ! nf90 file identifier -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5260 r5989 9 9 !! 3.3 ! 2010-04 (M. Leclair, G. Madec) modified LF-RA 10 10 !! - - ! 2010-10 (C. Ethe, G. Madec) TRC-TRA merge (T-S in 4D) 11 !! 3.7 ! 2014-01 (G. Madec) suppression of curl and hdiv from the restart 12 !! - ! 2014-12 (G. Madec) remove KPP scheme 11 13 !!---------------------------------------------------------------------- 12 14 … … 18 20 USE oce ! ocean dynamics and tracers 19 21 USE dom_oce ! ocean space and time domain 22 USE sbc_ice ! only lk_lim3 20 23 USE phycst ! physical constants 24 USE eosbn2 ! equation of state (eos bn2 routine) 25 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 26 ! 21 27 USE in_out_manager ! I/O manager 22 28 USE iom ! I/O module 23 USE eosbn2 ! equation of state (eos bn2 routine)24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables25 USE divcur ! hor. divergence and curl (div & cur routines)26 USE sbc_ice, ONLY : lk_lim327 29 28 30 IMPLICIT NONE … … 57 59 !! 58 60 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 59 CHARACTER(LEN=50) :: clname ! ice output restart file name 61 CHARACTER(LEN=50) :: clname ! ocean output restart file name 62 CHARACTER(lc) :: clpath ! full path to ocean output restart file 60 63 !!---------------------------------------------------------------------- 61 64 ! 62 65 IF( kt == nit000 ) THEN ! default definitions 63 66 lrst_oce = .FALSE. 64 nitrst = nitend 65 ENDIF 66 IF( MOD( kt - 1, nstock ) == 0 ) THEN 67 IF( ln_rst_list ) THEN 68 nrst_lst = 1 69 nitrst = nstocklist( nrst_lst ) 70 ELSE 71 nitrst = nitend 72 ENDIF 73 ENDIF 74 75 ! frequency-based restart dumping (nn_stock) 76 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 67 77 ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 68 78 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing … … 73 83 ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 74 84 IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 75 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 76 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 77 ELSE ; WRITE(clkt, '(i8.8)') nitrst 78 ENDIF 79 ! create the file 80 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 81 IF(lwp) THEN 82 WRITE(numout,*) 83 SELECT CASE ( jprstlib ) 84 CASE ( jprstdimg ) ; WRITE(numout,*) ' open ocean restart binary file: '//clname 85 CASE DEFAULT ; WRITE(numout,*) ' open ocean restart NetCDF file: '//clname 86 END SELECT 87 IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression' 88 IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt 89 ELSE ; WRITE(numout,*) ' kt = ' , kt 85 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 86 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 87 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 88 ELSE ; WRITE(clkt, '(i8.8)') nitrst 90 89 ENDIF 91 ENDIF 92 ! 93 CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 94 lrst_oce = .TRUE. 90 ! create the file 91 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 92 clpath = TRIM(cn_ocerst_outdir) 93 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 94 IF(lwp) THEN 95 WRITE(numout,*) 96 SELECT CASE ( jprstlib ) 97 CASE ( jprstdimg ) ; WRITE(numout,*) & 98 ' open ocean restart binary file: ',TRIM(clpath)//clname 99 CASE DEFAULT ; WRITE(numout,*) & 100 ' open ocean restart NetCDF file: ',TRIM(clpath)//clname 101 END SELECT 102 IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression' 103 IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt 104 ELSE ; WRITE(numout,*) ' kt = ' , kt 105 ENDIF 106 ENDIF 107 ! 108 CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 109 lrst_oce = .TRUE. 110 ENDIF 95 111 ENDIF 96 112 ! … … 117 133 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem) ) 118 134 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal) ) 119 CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb )120 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb )121 135 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 122 !123 IF( lk_lim3 ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )124 136 ! 125 137 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields … … 127 139 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem) ) 128 140 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal) ) 129 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn )130 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn )131 141 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn ) 132 142 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 133 #if defined key_zdfkpp134 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd )135 #endif136 IF( lk_lim3 ) THEN137 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif138 ENDIF139 143 IF( kt == nitrst ) THEN 140 144 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 142 146 !!gm not sure what to do here ===>>> ask to Sebastian 143 147 lrst_oce = .FALSE. 148 IF( ln_rst_list ) THEN 149 nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 150 nitrst = nstocklist( nrst_lst ) 151 ENDIF 152 lrst_oce = .FALSE. 144 153 ENDIF 145 154 ! … … 156 165 !! the file has already been opened 157 166 !!---------------------------------------------------------------------- 158 INTEGER :: jlibalt = jprstlib 159 LOGICAL :: llok 167 INTEGER :: jlibalt = jprstlib 168 LOGICAL :: llok 169 CHARACTER(lc) :: clpath ! full path to ocean output restart file 160 170 !!---------------------------------------------------------------------- 161 171 ! … … 171 181 ENDIF 172 182 183 clpath = TRIM(cn_ocerst_indir) 184 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 173 185 IF ( jprstlib == jprstdimg ) THEN 174 186 ! eventually read netcdf file (monobloc) for restarting on different number of processors 175 187 ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90 176 INQUIRE( FILE = TRIM(cn_ocerst_in )//'.nc', EXIST = llok )188 INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 177 189 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 178 190 ENDIF 179 CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt )191 CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 180 192 ENDIF 181 193 END SUBROUTINE rst_read_open 194 182 195 183 196 SUBROUTINE rst_read … … 211 224 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) ) 212 225 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) ) 213 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb )214 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb )215 226 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 216 IF( lk_lim3 ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )217 227 ELSE 218 228 neuler = 0 … … 224 234 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) ) 225 235 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 226 IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN227 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn )228 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn )229 ELSE230 CALL div_cur( 0 ) ! Horizontal divergence & Relative vorticity231 ENDIF232 236 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 233 237 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density … … 235 239 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) 236 240 ENDIF 237 #if defined key_zdfkpp238 IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN239 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd ) ! now in situ density anomaly240 ELSE241 CALL eos( tsn, rhd, fsdept_n(:,:,:) ) ! compute rhd242 ENDIF243 #endif244 241 ! 245 242 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) … … 247 244 ub (:,:,:) = un (:,:,:) 248 245 vb (:,:,:) = vn (:,:,:) 249 rotb (:,:,:) = rotn (:,:,:)250 hdivb(:,:,:) = hdivn(:,:,:)251 246 sshb (:,:) = sshn (:,:) 252 247 ! 253 248 IF( lk_vvl ) THEN 254 249 DO jk = 1, jpk … … 256 251 END DO 257 252 ENDIF 258 259 IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN 260 DO jk = 1, jpk 261 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 262 END DO 263 ENDIF 264 265 ENDIF 266 ! 267 IF( lk_lim3 ) THEN 268 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 253 ! 269 254 ENDIF 270 255 !
Note: See TracChangeset
for help on using the changeset viewer.
