- Timestamp:
- 2015-06-03T19:07:18+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r5134_UKMO4_CF_compliance/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5199 r5342 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 … … 139 139 ENDIF 140 140 141 IF ( ln_cfmeta ) THEN ! add cell bounds 142 CALL set_grid_bounds( "T", cdname ) 143 CALL set_grid_bounds( "U", cdname ) 144 CALL set_grid_bounds( "V", cdname ) 145 CALL set_grid_bounds( "W", cdname ) 146 ENDIF 141 147 142 148 ! vertical grid definition … … 1109 1115 1110 1116 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1111 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1112 CHARACTER(LEN=*) , INTENT(in) :: cdid 1113 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1114 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1115 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 1116 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1117 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1117 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1118 & nvertex, bounds_lon, bounds_lat ) 1119 CHARACTER(LEN=*) , INTENT(in) :: cdid 1120 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1121 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1122 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1123 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1124 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat 1125 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1118 1126 1119 1127 IF ( xios_is_valid_domain (cdid) ) THEN … … 1121 1129 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1122 1130 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1123 & lonvalue=lonvalue, latvalue=latvalue, mask=mask)1131 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, bounds_lat=bounds_lat ) 1124 1132 ENDIF 1125 1133 … … 1128 1136 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1129 1137 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1130 & lonvalue=lonvalue, latvalue=latvalue, mask=mask)1138 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, bounds_lat=bounds_lat ) 1131 1139 ENDIF 1132 1140 CALL xios_solve_inheritance() … … 1253 1261 1254 1262 END SUBROUTINE set_grid 1263 1264 1265 SUBROUTINE set_grid_bounds( cdgrd, cdname ) 1266 !!---------------------------------------------------------------------- 1267 !! *** ROUTINE set_grid_bounds *** 1268 !! 1269 !! ** Purpose : define horizontal grid corners 1270 !! 1271 !!---------------------------------------------------------------------- 1272 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1273 CHARACTER(LEN=*) , INTENT(in) :: cdname 1274 ! 1275 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1276 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1277 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_pnt ! Lat/lon coordinates of the point of cell (i,j) 1278 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1279 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1280 ! 1281 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1282 ! ! represents the bottom-left corner of cell (i,j) 1283 INTEGER :: ji, jj, jn, ni, nj 1284 1285 ALLOCATE( z_bnds(4,jpi,jpj,2), z_cnr(jpi,jpj,2), z_pnt(jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1286 1287 ! Grid information 1288 SELECT CASE ( TRIM(cdgrd) ) 1289 CASE ('T', 'W') 1290 icnr = -1 ; jcnr = -1 1291 IF( TRIM(cdname) == "nemo_crs" ) THEN 1292 z_cnr(:,:,1) = gphif_crs ; z_cnr(:,:,2) = glamf_crs 1293 z_pnt(:,:,1) = gphit_crs ; z_pnt(:,:,2) = glamt_crs 1294 ELSE 1295 z_cnr(:,:,1) = gphif ; z_cnr(:,:,2) = glamf 1296 z_pnt(:,:,1) = gphit ; z_pnt(:,:,2) = glamt 1297 ENDIF 1298 CASE ('U') 1299 icnr = 0 ; jcnr = -1 1300 IF( TRIM(cdname) == "nemo_crs" ) THEN 1301 z_cnr(:,:,1) = gphiv_crs ; z_cnr(:,:,2) = glamv_crs 1302 z_pnt(:,:,1) = gphiu_crs ; z_pnt(:,:,2) = glamu_crs 1303 ELSE 1304 z_cnr(:,:,1) = gphiv ; z_cnr(:,:,2) = glamv 1305 z_pnt(:,:,1) = gphiu ; z_pnt(:,:,2) = glamu 1306 ENDIF 1307 CASE ('V') 1308 icnr = -1 ; jcnr = 0 1309 IF( TRIM(cdname) == "nemo_crs" ) THEN 1310 z_cnr(:,:,1) = gphiu_crs ; z_cnr(:,:,2) = glamu_crs 1311 z_pnt(:,:,1) = gphiv_crs ; z_pnt(:,:,2) = glamv_crs 1312 ELSE 1313 z_cnr(:,:,1) = gphiu ; z_cnr(:,:,2) = glamu 1314 z_pnt(:,:,1) = gphiv ; z_pnt(:,:,2) = glamv 1315 ENDIF 1316 END SELECT 1317 1318 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1319 1320 z_fld(:,:) = 1._wp 1321 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1322 1323 ! Cell vertices that can be defined 1324 DO jj = 2, jpjm1 1325 DO ji = 2, jpim1 1326 z_bnds(1,ji,jj,:) = z_cnr(ji+icnr, jj+jcnr ,:) ! Bottom-left 1327 z_bnds(2,ji,jj,:) = z_cnr(ji+icnr+1,jj+jcnr ,:) ! Bottom-right 1328 z_bnds(3,ji,jj,:) = z_cnr(ji+icnr+1,jj+jcnr+1,:) ! Top-right 1329 z_bnds(4,ji,jj,:) = z_cnr(ji+icnr, jj+jcnr+1,:) ! Top-left 1330 END DO 1331 END DO 1332 1333 ! Cell vertices on boundries 1334 DO jn = 1, 4 1335 CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 1336 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1337 END DO 1338 1339 ! Zero-size cells at closed boundaries 1340 IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1341 DO jn = 1, 4 ; z_bnds(jn,1,:,:) = z_pnt(1,:,:) ; END DO ! (West or jpni = 1), closed E-W 1342 ENDIF 1343 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1344 DO jn = 1, 4 ; z_bnds(jn,nlci,:,:) = z_pnt(nlci,:,:) ; END DO ! (East or jpni = 1), closed E-W 1345 ENDIF 1346 IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 1347 DO jn = 1, 4 ; z_bnds(jn,:,1,:) = z_pnt(:,1,:) ; END DO ! South or (jpnj = 1, not symmetric) 1348 ENDIF 1349 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 1350 DO jn = 1, 4 ; z_bnds(jn,:,nlcj,:) = z_pnt(:,nlcj,:) ; END DO ! (North or jpnj = 1), no north fold 1351 ENDIF 1352 1353 ! ===================================================================================================== 1354 ! Do we need to set zero-size cells at Mediterranean / Persian Gulf region? 1355 ! ===================================================================================================== 1356 1357 ! Rotate cells at the north fold 1358 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 1359 DO jj = 1, jpj 1360 DO ji = 1, jpi 1361 IF( z_fld(ji,jj) == -1. ) THEN 1362 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 1363 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 1364 z_bnds(:,ji,jj,:) = z_rot(:,:) 1365 ENDIF 1366 END DO 1367 END DO 1368 1369 ! Invert cells at the symmetric equator 1370 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1371 DO ji = 1, jpi 1372 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 1373 z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 1374 z_bnds(:,ji,1,:) = z_rot(:,:) 1375 END DO 1376 ENDIF 1377 1378 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1379 bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1380 1381 DEALLOCATE( z_bnds, z_cnr, z_pnt, z_fld, z_rot ) 1382 1383 END SUBROUTINE set_grid_bounds 1255 1384 1256 1385
Note: See TracChangeset
for help on using the changeset viewer.
