- Timestamp:
- 2015-08-12T17:46:45+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r4990 r5682 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/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5043 r5682 33 33 USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes 34 34 #if defined key_lim3 35 USE par_ice35 USE ice , ONLY : jpl 36 36 #elif defined key_lim2 37 37 USE par_ice_2 … … 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 = e12t(nldi:nlei, nldj:nlej)) 132 CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) 133 CALL iom_set_domain_attr("grid_V", area = e12v(nldi:nlei, nldj:nlej)) 134 CALL iom_set_domain_attr("grid_W", area = e12t(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 … … 543 584 END SUBROUTINE iom_g1d 544 585 545 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )586 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 546 587 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 547 588 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 551 592 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 552 593 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 594 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 595 ! look for and use a file attribute 596 ! called open_ocean_jstart to set the start 597 ! value for the 2nd dimension (netcdf only) 553 598 ! 554 599 IF( kiomid > 0 ) THEN 555 600 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 556 & ktime=ktime, kstart=kstart, kcount=kcount ) 601 & ktime=ktime, kstart=kstart, kcount=kcount, & 602 & lrowattr=lrowattr ) 557 603 ENDIF 558 604 END SUBROUTINE iom_g2d 559 605 560 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )606 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 561 607 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 562 608 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 566 612 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 567 613 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 614 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 615 ! look for and use a file attribute 616 ! called open_ocean_jstart to set the start 617 ! value for the 2nd dimension (netcdf only) 568 618 ! 569 619 IF( kiomid > 0 ) THEN 570 620 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 571 & ktime=ktime, kstart=kstart, kcount=kcount ) 621 & ktime=ktime, kstart=kstart, kcount=kcount, & 622 & lrowattr=lrowattr ) 572 623 ENDIF 573 624 END SUBROUTINE iom_g3d … … 576 627 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , & 577 628 & pv_r1d, pv_r2d, pv_r3d, & 578 & ktime , kstart, kcount ) 629 & ktime , kstart, kcount, & 630 & lrowattr ) 579 631 !!----------------------------------------------------------------------- 580 632 !! *** ROUTINE iom_get_123d *** … … 593 645 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 594 646 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 647 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 648 ! look for and use a file attribute 649 ! called open_ocean_jstart to set the start 650 ! value for the 2nd dimension (netcdf only) 595 651 ! 596 652 LOGICAL :: llnoov ! local definition to read overlap 653 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute 654 INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute 597 655 INTEGER :: jl ! loop on number of dimension 598 656 INTEGER :: idom ! type of domain … … 604 662 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 605 663 INTEGER :: ji, jj ! loop counters 606 INTEGER :: irankpv 664 INTEGER :: irankpv ! 607 665 INTEGER :: ind1, ind2 ! substring index 608 666 INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis … … 628 686 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 629 687 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 688 689 luse_jattr = .false. 690 IF( PRESENT(lrowattr) ) THEN 691 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 692 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 693 ENDIF 694 IF( luse_jattr ) THEN 695 SELECT CASE (iom_file(kiomid)%iolib) 696 CASE (jpioipsl, jprstdimg ) 697 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 698 luse_jattr = .false. 699 CASE (jpnf90 ) 700 ! Ok 701 CASE DEFAULT 702 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 703 END SELECT 704 ENDIF 630 705 631 706 ! Search for the variable in the data base (eventually actualize data) … … 701 776 ELSE 702 777 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 703 IF( idom == jpdom_data ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /) ! icnt(1:2) done bellow 704 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done bellow 778 IF( idom == jpdom_data ) THEN 779 jstartrow = 1 780 IF( luse_jattr ) THEN 781 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 782 jstartrow = MAX(1,jstartrow) 783 ENDIF 784 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 785 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 705 786 ENDIF 706 787 ! we do not read the overlap -> we start to read at nldi, nldj … … 1067 1148 1068 1149 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1069 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1070 CHARACTER(LEN=*) , INTENT(in) :: cdid 1071 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1072 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1073 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj 1074 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1075 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1150 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask, & 1151 & nvertex, bounds_lon, bounds_lat, area ) 1152 CHARACTER(LEN=*) , INTENT(in) :: cdid 1153 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1154 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj 1155 INTEGER , OPTIONAL, INTENT(in) :: zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, nvertex 1156 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: lonvalue, latvalue 1157 REAL(wp), DIMENSION(:,:) , OPTIONAL, INTENT(in) :: bounds_lon, bounds_lat, area 1158 LOGICAL, DIMENSION(:,:) , OPTIONAL, INTENT(in) :: mask 1076 1159 1077 1160 IF ( xios_is_valid_domain (cdid) ) THEN … … 1079 1162 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1080 1163 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1081 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1164 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1165 & bounds_lat=bounds_lat, area=area ) 1082 1166 ENDIF 1083 1167 … … 1086 1170 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1087 1171 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1088 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1172 & lonvalue=lonvalue, latvalue=latvalue, mask=mask, nvertex=nvertex, bounds_lon=bounds_lon, & 1173 & bounds_lat=bounds_lat, area=area ) 1089 1174 ENDIF 1090 1175 CALL xios_solve_inheritance() … … 1093 1178 1094 1179 1095 SUBROUTINE iom_set_axis_attr( cdid, paxis )1180 SUBROUTINE iom_set_axis_attr( cdid, paxis, bounds ) 1096 1181 CHARACTER(LEN=*) , INTENT(in) :: cdid 1097 REAL(wp), DIMENSION(:), INTENT(in) :: paxis 1098 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis ) 1099 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 1182 REAL(wp), DIMENSION(:) , OPTIONAL, INTENT(in) :: paxis 1183 REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) :: bounds 1184 IF ( PRESENT(paxis) ) THEN 1185 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=SIZE(paxis), value=paxis ) 1186 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=SIZE(paxis), value=paxis ) 1187 ENDIF 1188 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, bounds=bounds ) 1189 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 1100 1190 CALL xios_solve_inheritance() 1101 1191 END SUBROUTINE iom_set_axis_attr … … 1106 1196 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1107 1197 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1108 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1109 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1198 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr & 1199 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1200 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr & 1201 & ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1110 1202 CALL xios_solve_inheritance() 1111 1203 END SUBROUTINE iom_set_field_attr … … 1160 1252 CALL iom_swap( cdname ) ! swap to cdname context 1161 1253 CALL xios_update_calendar(kt) 1162 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1254 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1163 1255 ! 1164 1256 END SUBROUTINE iom_setkt … … 1170 1262 CALL iom_swap( cdname ) ! swap to cdname context 1171 1263 CALL xios_context_finalize() ! finalize the context 1172 IF( cdname /= "nemo" ) CALL iom_swap( "nemo") ! return back to nemo context1264 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1173 1265 ENDIF 1174 1266 ! … … 1213 1305 1214 1306 1307 SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 1308 !!---------------------------------------------------------------------- 1309 !! *** ROUTINE set_grid_bounds *** 1310 !! 1311 !! ** Purpose : define horizontal grid corners 1312 !! 1313 !!---------------------------------------------------------------------- 1314 CHARACTER(LEN=1) , INTENT(in) :: cdgrd 1315 ! 1316 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plon_cnr, plat_cnr ! Lat/lon coordinates of a contiguous vertex of cell (i,j) 1317 REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt ! Lat/lon coordinates of the point of cell (i,j) 1318 ! 1319 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds ! Lat/lon coordinates of the vertices of cell (i,j) 1320 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_fld ! Working array to determine where to rotate cells 1321 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_rot ! Lat/lon working array for rotation of cells 1322 ! 1323 INTEGER :: icnr, jcnr ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 1324 ! ! represents the bottom-left corner of cell (i,j) 1325 INTEGER :: ji, jj, jn, ni, nj 1326 1327 ALLOCATE( z_bnds(4,jpi,jpj,2), z_fld(jpi,jpj), z_rot(4,2) ) 1328 1329 ! Offset of coordinate representing bottom-left corner 1330 SELECT CASE ( TRIM(cdgrd) ) 1331 CASE ('T', 'W') 1332 icnr = -1 ; jcnr = -1 1333 CASE ('U') 1334 icnr = 0 ; jcnr = -1 1335 CASE ('V') 1336 icnr = -1 ; jcnr = 0 1337 END SELECT 1338 1339 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1340 1341 z_fld(:,:) = 1._wp 1342 CALL lbc_lnk( z_fld, cdgrd, -1. ) ! Working array for location of northfold 1343 1344 ! Cell vertices that can be defined 1345 DO jj = 2, jpjm1 1346 DO ji = 2, jpim1 1347 z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1348 z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1349 z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1350 z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1351 z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr ) ! Bottom-left 1352 z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr ) ! Bottom-right 1353 z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 1354 z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr, jj+jcnr+1) ! Top-left 1355 END DO 1356 END DO 1357 1358 ! Cell vertices on boundries 1359 DO jn = 1, 4 1360 CALL lbc_lnk( z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 1361 CALL lbc_lnk( z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 1362 END DO 1363 1364 ! Zero-size cells at closed boundaries if cell points provided, 1365 ! otherwise they are closed cells with unrealistic bounds 1366 IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 1367 IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1368 DO jn = 1, 4 ! (West or jpni = 1), closed E-W 1369 z_bnds(jn,1,:,1) = plat_pnt(1,:) ; z_bnds(jn,1,:,2) = plon_pnt(1,:) 1370 END DO 1371 ENDIF 1372 IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 1373 DO jn = 1, 4 ! (East or jpni = 1), closed E-W 1374 z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:) ; z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 1375 END DO 1376 ENDIF 1377 IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 1378 DO jn = 1, 4 ! South or (jpnj = 1, not symmetric) 1379 z_bnds(jn,:,1,1) = plat_pnt(:,1) ; z_bnds(jn,:,1,2) = plon_pnt(:,1) 1380 END DO 1381 ENDIF 1382 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio < 3 ) THEN 1383 DO jn = 1, 4 ! (North or jpnj = 1), no north fold 1384 z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj) ; z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 1385 END DO 1386 ENDIF 1387 ENDIF 1388 1389 ! Rotate cells at the north fold 1390 IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN 1391 DO jj = 1, jpj 1392 DO ji = 1, jpi 1393 IF( z_fld(ji,jj) == -1. ) THEN 1394 z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 1395 z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 1396 z_bnds(:,ji,jj,:) = z_rot(:,:) 1397 ENDIF 1398 END DO 1399 END DO 1400 1401 ! Invert cells at the symmetric equator 1402 ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN 1403 DO ji = 1, jpi 1404 z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 1405 z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 1406 z_bnds(:,ji,1,:) = z_rot(:,:) 1407 END DO 1408 ENDIF 1409 1410 CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), & 1411 bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 1412 1413 DEALLOCATE( z_bnds, z_fld, z_rot ) 1414 1415 END SUBROUTINE set_grid_bounds 1416 1417 1418 SUBROUTINE set_grid_znl( plat ) 1419 !!---------------------------------------------------------------------- 1420 !! *** ROUTINE set_grid_znl *** 1421 !! 1422 !! ** Purpose : define grids for zonal mean 1423 !! 1424 !!---------------------------------------------------------------------- 1425 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1426 ! 1427 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1428 INTEGER :: ni,nj, ix, iy 1429 1430 1431 ni=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk) 1432 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1433 1434 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 CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1436 CALL iom_set_domain_attr("gznl", lonvalue = zlon, & 1437 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1438 ! 1439 CALL dom_ngb( 180., 90., ix, iy, 'T' ) ! i-line that passes near the North Pole : Reference latitude (used in plots) 1440 CALL iom_set_domain_attr ('ptr', zoom_ibegin=ix, zoom_nj=jpjglo) 1441 CALL iom_update_file_name('ptr') 1442 ! 1443 END SUBROUTINE set_grid_znl 1444 1215 1445 SUBROUTINE set_scalar 1216 1446 !!---------------------------------------------------------------------- … … 1220 1450 !! 1221 1451 !!---------------------------------------------------------------------- 1222 REAL(wp), DIMENSION(1) :: zz = 1.1452 REAL(wp), DIMENSION(1) :: zz = 1. 1223 1453 !!---------------------------------------------------------------------- 1224 1454 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 1225 1455 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1456 1226 1457 zz=REAL(narea,wp) 1227 1458 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) … … 1296 1527 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1297 1528 CALL set_mooring( zlonpira, zlatpira ) 1529 1298 1530 1299 1531 END SUBROUTINE set_xmlatt … … 1443 1675 END DO 1444 1676 1677 IF( jn == 1 .AND. TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 1445 1678 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1446 1679 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) … … 1490 1723 ENDIF 1491 1724 1725 !$AGRIF_DO_NOT_TREAT 1726 ! Should be fixed in the conv 1492 1727 IF( llfull ) THEN 1493 1728 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" … … 1500 1735 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1501 1736 ENDIF 1737 !$AGRIF_END_DO_NOT_TREAT 1502 1738 1503 1739 END FUNCTION iom_sdate -
branches/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r4689 r5682 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/2015/dev_r5072_UKMO2_OBS_simplification/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4990 r5682 24 24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 25 25 USE divcur ! hor. divergence and curl (div & cur routines) 26 USE sbc_ice, ONLY : lk_lim327 26 28 27 IMPLICIT NONE … … 57 56 !! 58 57 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 59 CHARACTER(LEN=50) :: clname ! ice output restart file name 58 CHARACTER(LEN=50) :: clname ! ocean output restart file name 59 CHARACTER(lc) :: clpath ! full path to ocean output restart file 60 60 !!---------------------------------------------------------------------- 61 61 ! 62 62 IF( kt == nit000 ) THEN ! default definitions 63 63 lrst_oce = .FALSE. 64 nitrst = nitend 65 ENDIF 66 IF( MOD( kt - 1, nstock ) == 0 ) THEN 64 IF( ln_rst_list ) THEN 65 nrst_lst = 1 66 nitrst = nstocklist( nrst_lst ) 67 ELSE 68 nitrst = nitend 69 ENDIF 70 ENDIF 71 72 ! frequency-based restart dumping (nn_stock) 73 IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN 67 74 ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 68 75 nitrst = kt + nstock - 1 ! define the next value of nitrst for restart writing … … 73 80 ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 74 81 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 82 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 83 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 84 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 85 ELSE ; WRITE(clkt, '(i8.8)') nitrst 90 86 ENDIF 91 ENDIF 92 ! 93 CALL iom_open( clname, numrow, ldwrt = .TRUE., kiolib = jprstlib ) 94 lrst_oce = .TRUE. 87 ! create the file 88 clname = TRIM(cexper)//"_"//TRIM(ADJUSTL(clkt))//"_"//TRIM(cn_ocerst_out) 89 clpath = TRIM(cn_ocerst_outdir) 90 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 91 IF(lwp) THEN 92 WRITE(numout,*) 93 SELECT CASE ( jprstlib ) 94 CASE ( jprstdimg ) ; WRITE(numout,*) & 95 ' open ocean restart binary file: ',TRIM(clpath)//clname 96 CASE DEFAULT ; WRITE(numout,*) & 97 ' open ocean restart NetCDF file: ',TRIM(clpath)//clname 98 END SELECT 99 IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression' 100 IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt 101 ELSE ; WRITE(numout,*) ' kt = ' , kt 102 ENDIF 103 ENDIF 104 ! 105 CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 106 lrst_oce = .TRUE. 107 ENDIF 95 108 ENDIF 96 109 ! … … 120 133 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) 121 134 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 122 !123 IF( lk_lim3 ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) )124 135 ! 125 136 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields … … 134 145 CALL iom_rstput( kt, nitrst, numrow, 'rhd' , rhd ) 135 146 #endif 136 IF( lk_lim3 ) THEN137 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif138 ENDIF139 147 IF( kt == nitrst ) THEN 140 148 CALL iom_close( numrow ) ! close the restart file (only at last time step) … … 142 150 !!gm not sure what to do here ===>>> ask to Sebastian 143 151 lrst_oce = .FALSE. 152 IF( ln_rst_list ) THEN 153 nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 154 nitrst = nstocklist( nrst_lst ) 155 ENDIF 156 lrst_oce = .FALSE. 144 157 ENDIF 145 158 ! … … 156 169 !! the file has already been opened 157 170 !!---------------------------------------------------------------------- 158 INTEGER :: jlibalt = jprstlib 159 LOGICAL :: llok 171 INTEGER :: jlibalt = jprstlib 172 LOGICAL :: llok 173 CHARACTER(lc) :: clpath ! full path to ocean output restart file 160 174 !!---------------------------------------------------------------------- 161 175 ! … … 171 185 ENDIF 172 186 187 clpath = TRIM(cn_ocerst_indir) 188 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 173 189 IF ( jprstlib == jprstdimg ) THEN 174 190 ! eventually read netcdf file (monobloc) for restarting on different number of processors 175 191 ! if {cn_ocerst_in}.nc exists, then set jlibalt to jpnf90 176 INQUIRE( FILE = TRIM(cn_ocerst_in )//'.nc', EXIST = llok )192 INQUIRE( FILE = TRIM(cn_ocerst_indir)//'/'//TRIM(cn_ocerst_in)//'.nc', EXIST = llok ) 177 193 IF ( llok ) THEN ; jlibalt = jpnf90 ; ELSE ; jlibalt = jprstlib ; ENDIF 178 194 ENDIF 179 CALL iom_open( cn_ocerst_in, numror, kiolib = jlibalt )195 CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 180 196 ENDIF 181 197 END SUBROUTINE rst_read_open … … 214 230 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 215 231 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 216 IF( lk_lim3 ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )217 232 ELSE 218 233 neuler = 0 … … 257 272 ENDIF 258 273 259 IF( lk_lim3 .AND. .NOT. lk_vvl ) THEN260 DO jk = 1, jpk261 fse3t_b(:,:,jk) = fse3t_n(:,:,jk)262 END DO263 ENDIF264 265 ENDIF266 !267 IF( lk_lim3 ) THEN268 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )269 274 ENDIF 270 275 !
Note: See TracChangeset
for help on using the changeset viewer.