- Timestamp:
- 2015-07-16T13:55:15+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5105 r5602 38 38 USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes 39 39 #if defined key_lim3 40 USE par_ice40 USE ice , ONLY : jpl 41 41 #elif defined key_lim2 42 42 USE par_ice_2 … … 66 66 #if defined key_iomput 67 67 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 68 PRIVATE set_grid, set_ scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate68 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 69 69 # endif 70 70 … … 103 103 CHARACTER(len=10) :: clname 104 104 INTEGER :: ji 105 !!---------------------------------------------------------------------- 105 ! 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 107 !!---------------------------------------------------------------------- 108 109 ALLOCATE( z_bnds(jpk,2) ) 106 110 107 111 clname = cdname 108 112 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(cdname) 109 # if defined key_mpp_mpi110 113 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 111 # else112 CALL xios_context_initialize(TRIM(clname), 0)113 # endif114 114 CALL iom_swap( cdname ) 115 115 … … 126 126 CALL set_scalar 127 127 128 IF( TRIM(cdname) == "nemo") THEN128 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 129 129 CALL set_grid( "T", glamt, gphit ) 130 130 CALL set_grid( "U", glamu, gphiu ) 131 131 CALL set_grid( "V", glamv, gphiv ) 132 132 CALL set_grid( "W", glamt, gphit ) 133 ENDIF 134 135 IF( TRIM(cdname) == "nemo_crs" ) THEN 133 CALL set_grid_znl( gphit ) 134 ! 135 IF( ln_cfmeta ) THEN ! Add additional grid metadata 136 CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej)) 137 CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) 138 CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej)) 139 CALL iom_set_domain_attr("grid_W", area = e12t(nldi:nlei, nldj:nlej)) 140 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 141 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 142 CALL set_grid_bounds( "V", glamu, gphiu, glamv, gphiv ) 143 CALL set_grid_bounds( "W", glamf, gphif, glamt, gphit ) 144 ENDIF 145 ENDIF 146 147 IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN 136 148 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 137 149 ! … … 140 152 CALL set_grid( "V", glamv_crs, gphiv_crs ) 141 153 CALL set_grid( "W", glamt_crs, gphit_crs ) 154 CALL set_grid_znl( gphit_crs ) 142 155 ! 143 156 CALL dom_grid_glo ! Return to parent grid domain 144 ENDIF 145 157 ! 158 IF( ln_cfmeta ) THEN ! Add additional grid metadata 159 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 160 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 161 CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 162 CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 163 CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 164 CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 165 CALL set_grid_bounds( "V", glamu_crs, gphiu_crs, glamv_crs, gphiv_crs ) 166 CALL set_grid_bounds( "W", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 167 ENDIF 168 ENDIF 146 169 147 170 ! vertical grid definition … … 150 173 CALL iom_set_axis_attr( "depthv", gdept_1d ) 151 174 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 175 176 ! Add vertical grid bounds 177 z_bnds(: ,1) = gdepw_1d(:) 178 z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 179 z_bnds(jpk: ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 180 CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 181 CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 182 CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 183 z_bnds(: ,2) = gdept_1d(:) 184 z_bnds(2:jpk,1) = gdept_1d(1:jpkm1) 185 z_bnds(1 ,1) = gdept_1d(1) - e3w_1d(1) 186 CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 187 152 188 # if defined key_floats 153 189 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) … … 157 193 #endif 158 194 CALL iom_set_axis_attr( "icbcla", class_num ) 195 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 196 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 159 197 160 198 ! automatic definitions of some of the xml attributs … … 167 205 168 206 CALL xios_update_calendar(0) 207 208 DEALLOCATE( z_bnds ) 209 169 210 #endif 170 211 … … 548 589 END SUBROUTINE iom_g1d 549 590 550 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )591 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 551 592 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 552 593 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 556 597 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 557 598 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 599 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 600 ! look for and use a file attribute 601 ! called open_ocean_jstart to set the start 602 ! value for the 2nd dimension (netcdf only) 558 603 ! 559 604 IF( kiomid > 0 ) THEN 560 605 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 561 & ktime=ktime, kstart=kstart, kcount=kcount ) 606 & ktime=ktime, kstart=kstart, kcount=kcount, & 607 & lrowattr=lrowattr ) 562 608 ENDIF 563 609 END SUBROUTINE iom_g2d 564 610 565 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )611 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 566 612 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 567 613 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 571 617 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 572 618 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 619 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 620 ! look for and use a file attribute 621 ! called open_ocean_jstart to set the start 622 ! value for the 2nd dimension (netcdf only) 573 623 ! 574 624 IF( kiomid > 0 ) THEN 575 625 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 576 & ktime=ktime, kstart=kstart, kcount=kcount ) 626 & ktime=ktime, kstart=kstart, kcount=kcount, & 627 & lrowattr=lrowattr ) 577 628 ENDIF 578 629 END SUBROUTINE iom_g3d … … 581 632 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , & 582 633 & pv_r1d, pv_r2d, pv_r3d, & 583 & ktime , kstart, kcount ) 634 & ktime , kstart, kcount, & 635 & lrowattr ) 584 636 !!----------------------------------------------------------------------- 585 637 !! *** ROUTINE iom_get_123d *** … … 598 650 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 599 651 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 652 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 653 ! look for and use a file attribute 654 ! called open_ocean_jstart to set the start 655 ! value for the 2nd dimension (netcdf only) 600 656 ! 601 657 LOGICAL :: llnoov ! local definition to read overlap 658 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute 659 INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute 602 660 INTEGER :: jl ! loop on number of dimension 603 661 INTEGER :: idom ! type of domain … … 609 667 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 610 668 INTEGER :: ji, jj ! loop counters 611 INTEGER :: irankpv 669 INTEGER :: irankpv ! 612 670 INTEGER :: ind1, ind2 ! substring index 613 671 INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis … … 633 691 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 634 692 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 693 694 luse_jattr = .false. 695 IF( PRESENT(lrowattr) ) THEN 696 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 697 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 698 ENDIF 699 IF( luse_jattr ) THEN 700 SELECT CASE (iom_file(kiomid)%iolib) 701 CASE (jpioipsl, jprstdimg ) 702 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 703 luse_jattr = .false. 704 CASE (jpnf90 ) 705 ! Ok 706 CASE DEFAULT 707 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 708 END SELECT 709 ENDIF 635 710 636 711 ! Search for the variable in the data base (eventually actualize data) … … 706 781 ELSE 707 782 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 708 IF( idom == jpdom_data ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /) ! icnt(1:2) done bellow 709 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done bellow 783 IF( idom == jpdom_data ) THEN 784 jstartrow = 1 785 IF( luse_jattr ) THEN 786 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 787 jstartrow = MAX(1,jstartrow) 788 ENDIF 789 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 790 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 710 791 ENDIF 711 792 ! we do not read the overlap -> we start to read at nldi, nldj … … 1072 1153 1073 1154 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1074 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1075 CHARACTER(LEN=*) , INTENT(in) :: cdid 1076 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1077 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1078 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 1079 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1080 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1155 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1156 & nvertex, bounds_lon, bounds_lat, area ) 1157 CHARACTER(LEN=*) , INTENT(in) :: cdid 1158 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1159 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1160 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1161 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1162 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1163 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1081 1164 1082 1165 IF ( xios_is_valid_domain (cdid) ) THEN … … 1084 1167 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1085 1168 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1086 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1169 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1170 & bounds_lat=bounds_lat, area=area ) 1087 1171 ENDIF 1088 1172 … … 1091 1175 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1092 1176 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1093 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1177 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1178 & bounds_lat=bounds_lat, area=area ) 1094 1179 ENDIF 1095 1180 CALL xios_solve_inheritance() … … 1098 1183 1099 1184 1100 SUBROUTINE iom_set_axis_attr( cdid, paxis )1185 SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 1101 1186 CHARACTER(LEN=*) , INTENT(in) :: cdid 1102 REAL(wp), DIMENSION(:), INTENT(in) :: paxis 1103 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis ) 1104 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 1187 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 1188 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1189 IF ( PRESENT(paxis) ) THEN 1190 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1191 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1192 ENDIF 1193 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1194 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 1105 1195 CALL xios_solve_inheritance() 1106 1196 END SUBROUTINE iom_set_axis_attr … … 1165 1255 CALL iom_swap( cdname ) ! swap to cdname context 1166 1256 CALL xios_update_calendar(kt) 1167 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1257 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1168 1258 ! 1169 1259 END SUBROUTINE iom_setkt … … 1175 1265 CALL iom_swap( cdname ) ! swap to cdname context 1176 1266 CALL xios_context_finalize() ! finalize the context 1177 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1267 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1178 1268 ENDIF 1179 1269 ! … … 1207 1297 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1208 1298 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. ) 1209 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jp i,:) ; CALL lbc_lnk( zmask, 'V', 1. )1299 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. ) 1210 1300 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1211 1301 END SELECT … … 1218 1308 1219 1309 1310 SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 1311 !!---------------------------------------------------------------------- 1312 !! *** ROUTINE set_grid_bounds *** 1313 !! 1314 !! ** Purpose : define horizontal grid corners 1315 !! 1316 !!---------------------------------------------------------------------- 1317 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1318 ! 1319 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1320 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j) 1321 ! 1322 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1323 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1324 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1325 ! 1326 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1327 ! ! represents the bottom-left corner of cell (i,j) 1328 INTEGER :: ji, jj, jn, ni, nj 1329 1330 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1331 1332 ! Offset of coordinate representing bottom-left corner 1333 SELECT CASE ( TRIM(cdgrd) ) 1334 CASE ('T', 'W') 1335 icnr = -1 ; jcnr = -1 1336 CASE ('U') 1337 icnr = 0 ; jcnr = -1 1338 CASE ('V') 1339 icnr = -1 ; jcnr = 0 1340 END SELECT 1341 1342 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1343 1344 z_fld(:,:) = 1._wp 1345 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1346 1347 ! Cell vertices that can be defined 1348 DO jj = 2, jpjm1 1349 DO ji = 2, jpim1 1350 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1351 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1352 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1353 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1354 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1355 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1356 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1357 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1358 END DO 1359 END DO 1360 1361 ! Cell vertices on boundries 1362 DO jn = 1, 4 1363 CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 1364 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1365 END DO 1366 1367 ! Zero-size cells at closed boundaries if cell points provided, 1368 ! otherwise they are closed cells with unrealistic bounds 1369 IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 1370 IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1371 DO jn = 1, 4 ! (West or jpni = 1), closed E-W 1372 z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:) 1373 END DO 1374 ENDIF 1375 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1376 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 1377 z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 1378 END DO 1379 ENDIF 1380 IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 1381 DO jn = 1, 4 ! South or (jpnj = 1, not symmetric) 1382 z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1) 1383 END DO 1384 ENDIF 1385 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 1386 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 1387 z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 1388 END DO 1389 ENDIF 1390 ENDIF 1391 1392 ! Rotate cells at the north fold 1393 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 1394 DO jj = 1, jpj 1395 DO ji = 1, jpi 1396 IF( z_fld(ji,jj) == -1. ) THEN 1397 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 1398 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 1399 z_bnds(:,ji,jj,:) = z_rot(:,:) 1400 ENDIF 1401 END DO 1402 END DO 1403 1404 ! Invert cells at the symmetric equator 1405 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1406 DO ji = 1, jpi 1407 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 1408 z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 1409 z_bnds(:,ji,1,:) = z_rot(:,:) 1410 END DO 1411 ENDIF 1412 1413 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1414 bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1415 1416 DEALLOCATE( z_bnds, z_fld, z_rot ) 1417 1418 END SUBROUTINE set_grid_bounds 1419 1420 1421 SUBROUTINE set_grid_znl( plat ) 1422 !!---------------------------------------------------------------------- 1423 !! *** ROUTINE set_grid_znl *** 1424 !! 1425 !! ** Purpose : define grids for zonal mean 1426 !! 1427 !!---------------------------------------------------------------------- 1428 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1429 ! 1430 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1431 INTEGER :: ni,nj, ix, iy 1432 1433 1434 ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk) 1435 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1436 1437 CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-1, jbegin=njmpp+nldj-1, ni=ni, nj=nj) 1438 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1439 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 1440 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1441 ! 1442 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1443 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1444 CALL iom_update_file_name('ptr') 1445 ! 1446 END SUBROUTINE set_grid_znl 1447 1220 1448 SUBROUTINE set_scalar 1221 1449 !!---------------------------------------------------------------------- … … 1225 1453 !! 1226 1454 !!---------------------------------------------------------------------- 1227 REAL(wp), DIMENSION(1) :: zz = 1.1455 REAL(wp), DIMENSION(1) :: zz = 1. 1228 1456 !!---------------------------------------------------------------------- 1229 1457 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 1230 1458 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1459 1231 1460 zz=REAL(narea,wp) 1232 1461 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) … … 1301 1530 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1302 1531 CALL set_mooring( zlonpira, zlatpira ) 1532 1303 1533 1304 1534 END SUBROUTINE set_xmlatt
Note: See TracChangeset
for help on using the changeset viewer.
