Changeset 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM
- Timestamp:
- 2015-05-12T12:37:15+02:00 (9 years ago)
- Location:
- branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 5 edited
-
in_out_manager.F90 (modified) (1 diff)
-
iom.F90 (modified) (19 diffs)
-
iom_nf90.F90 (modified) (1 diff)
-
prtctl.F90 (modified) (1 diff)
-
restart.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r4624 r5260 111 111 INTEGER :: numstp = -1 !: logical unit for time step 112 112 INTEGER :: numtime = -1 !: logical unit for timing 113 INTEGER :: numout = 6 !: logical unit for output print 113 INTEGER :: numout = 6 !: logical unit for output print; Set to stdout to ensure any early 114 ! output can be collected; do not change 114 115 INTEGER :: numnam_ref = -1 !: logical unit for reference namelist 115 116 INTEGER :: numnam_cfg = -1 !: logical unit for configuration specific namelist 116 INTEGER :: numond = 7!: logical unit for Output Namelist Dynamics117 INTEGER :: numond = -1 !: logical unit for Output Namelist Dynamics 117 118 INTEGER :: numnam_ice_ref = -1 !: logical unit for ice reference namelist 118 119 INTEGER :: numnam_ice_cfg = -1 !: logical unit for ice reference namelist 119 INTEGER :: numoni = 8!: logical unit for Output Namelist Ice120 INTEGER :: numoni = -1 !: logical unit for Output Namelist Ice 120 121 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 121 122 INTEGER :: numsol = -1 !: logical unit for solver statistics -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r4650 r5260 32 32 USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers 33 33 USE icb_oce, ONLY : nclasses, class_num ! !: iceberg classes 34 #if defined key_lim3 35 USE ice , ONLY : jpl 36 #elif defined key_lim2 37 USE par_ice_2 38 #endif 34 39 USE domngb ! ocean space and time domain 35 40 USE phycst ! physical constants … … 49 54 #endif 50 55 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 51 PUBLIC iom_getatt, iom_ context_finalize56 PUBLIC iom_getatt, iom_use, iom_context_finalize 52 57 53 58 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d … … 143 148 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 144 149 # endif 150 #if defined key_lim3 || defined key_lim2 151 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 152 #endif 145 153 CALL iom_set_axis_attr( "icbcla", class_num ) 146 154 … … 535 543 END SUBROUTINE iom_g1d 536 544 537 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )545 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 538 546 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 539 547 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 543 551 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kstart ! start axis position of the reading 544 552 INTEGER , INTENT(in ), DIMENSION(2) , OPTIONAL :: kcount ! number of points in each axis 553 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 554 ! look for and use a file attribute 555 ! called open_ocean_jstart to set the start 556 ! value for the 2nd dimension (netcdf only) 545 557 ! 546 558 IF( kiomid > 0 ) THEN 547 559 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 548 & ktime=ktime, kstart=kstart, kcount=kcount ) 560 & ktime=ktime, kstart=kstart, kcount=kcount, & 561 & lrowattr=lrowattr ) 549 562 ENDIF 550 563 END SUBROUTINE iom_g2d 551 564 552 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )565 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 553 566 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 554 567 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 558 571 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kstart ! start axis position of the reading 559 572 INTEGER , INTENT(in ), DIMENSION(3) , OPTIONAL :: kcount ! number of points in each axis 573 LOGICAL , INTENT(in ) , OPTIONAL :: lrowattr ! logical flag telling iom_get to 574 ! look for and use a file attribute 575 ! called open_ocean_jstart to set the start 576 ! value for the 2nd dimension (netcdf only) 560 577 ! 561 578 IF( kiomid > 0 ) THEN 562 579 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 563 & ktime=ktime, kstart=kstart, kcount=kcount ) 580 & ktime=ktime, kstart=kstart, kcount=kcount, & 581 & lrowattr=lrowattr ) 564 582 ENDIF 565 583 END SUBROUTINE iom_g3d … … 568 586 SUBROUTINE iom_get_123d( kiomid, kdom , cdvar , & 569 587 & pv_r1d, pv_r2d, pv_r3d, & 570 & ktime , kstart, kcount ) 588 & ktime , kstart, kcount, & 589 & lrowattr ) 571 590 !!----------------------------------------------------------------------- 572 591 !! *** ROUTINE iom_get_123d *** … … 585 604 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kstart ! start position of the reading in each axis 586 605 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 606 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 607 ! look for and use a file attribute 608 ! called open_ocean_jstart to set the start 609 ! value for the 2nd dimension (netcdf only) 587 610 ! 588 611 LOGICAL :: llnoov ! local definition to read overlap 612 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute 613 INTEGER :: jstartrow ! start point for 2nd dimension optionally set by file attribute 589 614 INTEGER :: jl ! loop on number of dimension 590 615 INTEGER :: idom ! type of domain … … 596 621 INTEGER :: ix1, ix2, iy1, iy2 ! subdomain indexes 597 622 INTEGER :: ji, jj ! loop counters 598 INTEGER :: irankpv 623 INTEGER :: irankpv ! 599 624 INTEGER :: ind1, ind2 ! substring index 600 625 INTEGER, DIMENSION(jpmax_dims) :: istart ! starting point to read for each axis … … 620 645 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 621 646 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown ) CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown') 647 648 luse_jattr = .false. 649 IF( PRESENT(lrowattr) ) THEN 650 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 651 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 652 ENDIF 653 IF( luse_jattr ) THEN 654 SELECT CASE (iom_file(kiomid)%iolib) 655 CASE (jpioipsl, jprstdimg ) 656 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 657 luse_jattr = .false. 658 CASE (jpnf90 ) 659 ! Ok 660 CASE DEFAULT 661 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 662 END SELECT 663 ENDIF 622 664 623 665 ! Search for the variable in the data base (eventually actualize data) … … 693 735 ELSE 694 736 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 695 IF( idom == jpdom_data ) THEN ; istart(1:2) = (/ mig(1), mjg(1) /) ! icnt(1:2) done bellow 696 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done bellow 737 IF( idom == jpdom_data ) THEN 738 jstartrow = 1 739 IF( luse_jattr ) THEN 740 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 741 jstartrow = MAX(1,jstartrow) 742 ENDIF 743 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 744 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 697 745 ENDIF 698 746 ! we do not read the overlap -> we start to read at nldi, nldj … … 1015 1063 CHARACTER(LEN=*), INTENT(in) :: cdname 1016 1064 REAL(wp) , INTENT(in) :: pfield0d 1065 REAL(wp) , DIMENSION(jpi,jpj) :: zz ! masson 1017 1066 #if defined key_iomput 1018 CALL xios_send_field(cdname, (/pfield0d/)) 1067 zz(:,:)=pfield0d 1068 CALL xios_send_field(cdname, zz) 1069 !CALL xios_send_field(cdname, (/pfield0d/)) 1019 1070 #else 1020 1071 IF( .FALSE. ) WRITE(numout,*) cdname, pfield0d ! useless test to avoid compilation warnings … … 1155 1206 SUBROUTINE iom_context_finalize( cdname ) 1156 1207 CHARACTER(LEN=*), INTENT(in) :: cdname 1157 ! 1158 CALL iom_swap( cdname ) ! swap to cdname context 1159 CALL xios_context_finalize() ! finalize the context 1160 IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context 1208 ! 1209 IF( xios_is_valid_context(cdname) ) THEN 1210 CALL iom_swap( cdname ) ! swap to cdname context 1211 CALL xios_context_finalize() ! finalize the context 1212 IF( cdname /= "nemo" ) CALL iom_swap( "nemo" ) ! return back to nemo context 1213 ENDIF 1161 1214 ! 1162 1215 END SUBROUTINE iom_context_finalize … … 1189 1242 CASE('T') ; zmask(:,:,:) = tmask(:,:,:) 1190 1243 CASE('U') ; zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) ; CALL lbc_lnk( zmask, 'U', 1. ) 1191 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jp i,:) ; CALL lbc_lnk( zmask, 'V', 1. )1244 CASE('V') ; zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) ; CALL lbc_lnk( zmask, 'V', 1. ) 1192 1245 CASE('W') ; zmask(:,:,2:jpk ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk) ; zmask(:,:,1) = tmask(:,:,1) 1193 1246 END SELECT … … 1207 1260 !! 1208 1261 !!---------------------------------------------------------------------- 1209 REAL(wp), DIMENSION(1 ,1) :: zz = 1.1262 REAL(wp), DIMENSION(1) :: zz = 1. 1210 1263 !!---------------------------------------------------------------------- 1211 1264 CALL iom_set_domain_attr('scalarpoint', ni_glo=jpnij, nj_glo=1, ibegin=narea, jbegin=1, ni=1, nj=1) 1212 CALL iom_set_domain_attr('scalarpoint', data_dim=1) 1213 CALL iom_set_domain_attr('scalarpoint', lonvalue=(/ zz /), latvalue=(/ zz /)) 1265 CALL iom_set_domain_attr('scalarpoint', data_dim=2, data_ibegin = 1, data_ni = 1, data_jbegin = 1, data_nj = 1) 1266 zz=REAL(narea,wp) 1267 CALL iom_set_domain_attr('scalarpoint', lonvalue=zz, latvalue=zz) 1214 1268 1215 1269 END SUBROUTINE set_scalar … … 1226 1280 CHARACTER(len=256) :: clsuff ! suffix name 1227 1281 CHARACTER(len=1) :: cl1 ! 1 character 1228 CHARACTER(len=2) :: cl2 ! 1 character 1282 CHARACTER(len=2) :: cl2 ! 2 characters 1283 CHARACTER(len=3) :: cl3 ! 3 characters 1229 1284 INTEGER :: ji, jg ! loop counters 1230 1285 INTEGER :: ix, iy ! i-,j- index … … 1252 1307 WRITE(cl2,'(i2.2)') ji 1253 1308 CALL iom_update_file_name('file'//cl2) 1309 END DO 1310 DO ji = 1, 999 1311 WRITE(cl3,'(i3.3)') ji 1312 CALL iom_update_file_name('file'//cl3) 1254 1313 END DO 1255 1314 … … 1277 1336 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1278 1337 CALL set_mooring( zlonpira, zlatpira ) 1338 1339 ! diaptr : zonal mean 1340 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 ! 1279 1344 1280 1345 END SUBROUTINE set_xmlatt … … 1499 1564 1500 1565 #endif 1566 1567 LOGICAL FUNCTION iom_use( cdname ) 1568 CHARACTER(LEN=*), INTENT(in) :: cdname 1569 #if defined key_iomput 1570 iom_use = xios_field_is_active( cdname ) 1571 #else 1572 iom_use = .FALSE. 1573 #endif 1574 END FUNCTION iom_use 1501 1575 1502 1576 !!====================================================================== -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r4292 r5260 217 217 CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo) ! dimensions ids 218 218 iom_file(kiomid)%luld(kiv) = .FALSE. ! default value 219 iom_file(kiomid)%dimsz(:,kiv) = 0 ! reset dimsz in case previously used219 iom_file(kiomid)%dimsz(:,kiv) = 0 ! reset dimsz in case previously used 220 220 DO ji = 1, i_nvd ! dimensions size 221 221 CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo) -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r4520 r5260 164 164 ENDIF 165 165 166 IF ( clinfo3 == 'tra' ) THEN 167 zvctl1 = t_ctll(jn) 168 zvctl2 = s_ctll(jn) 169 ELSEIF ( clinfo3 == 'dyn' ) THEN 170 zvctl1 = u_ctll(jn) 171 zvctl2 = v_ctll(jn) 166 IF( PRESENT(clinfo3)) THEN 167 IF ( clinfo3 == 'tra' ) THEN 168 zvctl1 = t_ctll(jn) 169 zvctl2 = s_ctll(jn) 170 ELSEIF ( clinfo3 == 'dyn' ) THEN 171 zvctl1 = u_ctll(jn) 172 zvctl2 = v_ctll(jn) 173 ENDIF 172 174 ENDIF 173 175 -
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r4334 r5260 22 22 USE iom ! I/O module 23 23 USE eosbn2 ! equation of state (eos bn2 routine) 24 USE trdm ld_oce ! ocean active mixed layer tracers trends variables24 USE trdmxl_oce ! ocean active mixed layer tracers trends variables 25 25 USE divcur ! hor. divergence and curl (div & cur routines) 26 26 USE sbc_ice, ONLY : lk_lim3 … … 120 120 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) 121 121 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb ) 122 ! 123 IF( lk_lim3 ) CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 122 124 ! 123 125 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields … … 133 135 #endif 134 136 IF( lk_lim3 ) THEN 135 CALL iom_rstput( kt, nitrst, numrow, 'iatte' , iatte ) !clem modif 136 CALL iom_rstput( kt, nitrst, numrow, 'oatte' , oatte ) !clem modif 137 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev' , fraqsr_1lev ) !clem modif 137 138 ENDIF 138 139 IF( kt == nitrst ) THEN 139 140 CALL iom_close( numrow ) ! close the restart file (only at last time step) 140 IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 141 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 142 !!gm not sure what to do here ===>>> ask to Sebastian 143 lrst_oce = .FALSE. 141 144 ENDIF 142 145 ! 143 146 END SUBROUTINE rst_write 147 144 148 145 149 SUBROUTINE rst_read_open … … 155 159 LOGICAL :: llok 156 160 !!---------------------------------------------------------------------- 157 158 IF( numror .LE.0 ) THEN161 ! 162 IF( numror <= 0 ) THEN 159 163 IF(lwp) THEN ! Contol prints 160 164 WRITE(numout,*) … … 210 214 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) 211 215 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb ) 216 IF( lk_lim3 ) CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) ) 212 217 ELSE 213 218 neuler = 0 … … 245 250 hdivb(:,:,:) = hdivn(:,:,:) 246 251 sshb (:,:) = sshn (:,:) 247 ENDIF 248 ! 249 IF( lk_lim3 ) THEN 250 CALL iom_get( numror, jpdom_autoglo, 'iatte' , iatte ) ! clem modif 251 CALL iom_get( numror, jpdom_autoglo, 'oatte' , oatte ) ! clem modif 252 253 IF( lk_vvl ) THEN 254 DO jk = 1, jpk 255 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) 256 END DO 257 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 ) 252 269 ENDIF 253 270 !
Note: See TracChangeset
for help on using the changeset viewer.
