Changeset 9367 for branches/2017
- Timestamp:
- 2018-02-28T17:23:20+01:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM
- Files:
-
- 31 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/CONFIG/SHARED/namelist_ref
r9356 r9367 54 54 ln_clobber = .true. ! clobber (overwrite) an existing file 55 55 nn_chunksz = 0 ! chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 56 ln_xios_read = .FALSE. ! use XIOS to read restart file (only for a single file restart) 57 nn_wxios = 0 ! use XIOS to write restart file 0 - no, 1 - single file output, 2 - multiple file output 56 58 / 57 59 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90
r9213 r9367 313 313 IF( ln_timing ) CALL timing_start( 'nemo_init') 314 314 ! 315 CALL phy_cst ! Physical constants316 CALL eos_init ! Equation of state317 IF( lk_c1d ) CALL c1d_init ! 1D column configuration318 CALL dom_init 319 IF( ln_ctl ) CALL prt_ctl_init ! Print control315 CALL phy_cst ! Physical constants 316 CALL eos_init ! Equation of state 317 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 318 CALL dom_init("OPA") ! Domain 319 IF( ln_ctl ) CALL prt_ctl_init ! Print control 320 320 321 321 CALL istate_init ! ocean initial state (Dynamics and tracers) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/CRS/crs.F90
r9179 r9367 122 122 !: 1 = binning centers at equator (north fold my have artifacts) 123 123 !: for even reduction factors, equator placed in bin biased south 124 LOGICAL :: ln_msh_crs = .TRUE.!: =T Create a meshmask file for CRS124 LOGICAL :: ln_msh_crs = .TRUE. !: =T Create a meshmask file for CRS 125 125 INTEGER :: nn_crs_kz = 0 !: type of Kz coarsening ( =0->VOL ; =1->MAX ; =2->MIN) 126 126 LOGICAL :: ln_crs_wn = .FALSE. !: coarsening wn or computation using horizontal divergence -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r9227 r9367 260 260 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp 261 261 IF(lwp) WRITE(numout,*) 262 CALL iom_get( numror, 'frc_v', frc_v )263 CALL iom_get( numror, 'frc_t', frc_t )264 CALL iom_get( numror, 'frc_s', frc_s )262 CALL iom_get( numror, 'frc_v', frc_v, ldxios = lrxios ) 263 CALL iom_get( numror, 'frc_t', frc_t, ldxios = lrxios ) 264 CALL iom_get( numror, 'frc_s', frc_s, ldxios = lrxios ) 265 265 IF( ln_linssh ) THEN 266 CALL iom_get( numror, 'frc_wn_t', frc_wn_t )267 CALL iom_get( numror, 'frc_wn_s', frc_wn_s )266 CALL iom_get( numror, 'frc_wn_t', frc_wn_t, ldxios = lrxios ) 267 CALL iom_get( numror, 'frc_wn_s', frc_wn_s, ldxios = lrxios ) 268 268 ENDIF 269 CALL iom_get( numror, jpdom_autoglo, 'surf_ini' , surf_ini) ! ice sheet coupling270 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini' , ssh_ini(:,:))271 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini' , e3t_ini(:,:,:))272 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini (:,:,:))273 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini (:,:,:))269 CALL iom_get( numror, jpdom_autoglo, 'surf_ini' , surf_ini , ldxios = lrxios ) ! ice sheet coupling 270 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini' , ssh_ini , ldxios = lrxios ) 271 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini' , e3t_ini , ldxios = lrxios ) 272 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios ) 273 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios ) 274 274 IF( ln_linssh ) THEN 275 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini (:,:))276 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini (:,:))275 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lrxios ) 276 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lrxios ) 277 277 ENDIF 278 278 ELSE 279 279 IF(lwp) WRITE(numout,*) 280 280 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : initialise hsb at initial state ' … … 314 314 IF(lwp) WRITE(numout,*) 315 315 ! 316 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 317 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 318 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 316 IF( lwxios ) CALL iom_swap( cwxios_context ) 317 CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v, ldxios = lwxios ) 318 CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t, ldxios = lwxios ) 319 CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s, ldxios = lwxios ) 319 320 IF( ln_linssh ) THEN 320 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t )321 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s )321 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t, ldxios = lwxios ) 322 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s, ldxios = lwxios ) 322 323 ENDIF 323 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini) ! ice sheet coupling324 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini(:,:))325 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini(:,:,:))326 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini (:,:,:))327 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini (:,:,:))324 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini , ldxios = lwxios ) ! ice sheet coupling 325 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini , ldxios = lwxios ) 326 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini , ldxios = lwxios ) 327 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini, ldxios = lwxios ) 328 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini, ldxios = lwxios ) 328 329 IF( ln_linssh ) THEN 329 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini (:,:))330 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini (:,:))330 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lwxios ) 331 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lwxios ) 331 332 ENDIF 333 IF( lwxios ) CALL iom_swap( cxios_context ) 332 334 ! 333 335 ENDIF … … 373 375 IF( .NOT. ln_diahsb ) RETURN 374 376 377 IF(lwxios) THEN 378 ! define variables in restart file when writing with XIOS 379 CALL iom_set_rstw_var_active('frc_v') 380 CALL iom_set_rstw_var_active('frc_t') 381 CALL iom_set_rstw_var_active('frc_s') 382 CALL iom_set_rstw_var_active('surf_ini') 383 CALL iom_set_rstw_var_active('ssh_ini') 384 CALL iom_set_rstw_var_active('e3t_ini') 385 CALL iom_set_rstw_var_active('hc_loc_ini') 386 CALL iom_set_rstw_var_active('sc_loc_ini') 387 IF( ln_linssh ) THEN 388 CALL iom_set_rstw_var_active('ssh_hc_loc_ini') 389 CALL iom_set_rstw_var_active('ssh_sc_loc_ini') 390 CALL iom_set_rstw_var_active('frc_wn_t') 391 CALL iom_set_rstw_var_active('frc_wn_s') 392 ENDIF 393 ENDIF 375 394 ! ------------------- ! 376 395 ! 1 - Allocate memory ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r9124 r9367 143 143 CALL day( nit000 ) 144 144 ! 145 IF( lwxios ) THEN 146 ! define variables in restart file when writing with XIOS 147 CALL iom_set_rstw_var_active('kt') 148 CALL iom_set_rstw_var_active('ndastp') 149 CALL iom_set_rstw_var_active('adatrj') 150 CALL iom_set_rstw_var_active('ntime') 151 ENDIF 152 145 153 END SUBROUTINE day_init 146 154 … … 318 326 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 319 327 ! Get Calendar informations 320 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run328 CALL iom_get( numror, 'kt', zkt, ldxios = lrxios ) ! last time-step of previous run 321 329 IF(lwp) THEN 322 330 WRITE(numout,*) ' *** Info read in restart : ' … … 337 345 IF ( nrstdt == 2 ) THEN 338 346 ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 339 CALL iom_get( numror, 'ndastp', zndastp )347 CALL iom_get( numror, 'ndastp', zndastp, ldxios = lrxios ) 340 348 ndastp = NINT( zndastp ) 341 CALL iom_get( numror, 'adatrj', adatrj )342 CALL iom_get( numror, 'ntime' , ktime)349 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios ) 350 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios ) 343 351 nn_time0=INT(ktime) 344 352 ! calculate start time in hours and minutes … … 399 407 ENDIF 400 408 ! calendar control 401 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 402 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 403 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since 404 ! ! the begining of the run [s] 405 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp) ) ! time 409 IF( lwxios ) CALL iom_swap( cwxios_context ) 410 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) , ldxios = lwxios ) ! time-step 411 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) , ldxios = lwxios ) ! date 412 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj , ldxios = lwxios ) ! number of elapsed days since 413 ! ! the begining of the run [s] 414 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp), ldxios = lwxios ) ! time 415 IF( lwxios ) CALL iom_swap( cxios_context ) 406 416 ENDIF 407 417 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r9209 r9367 58 58 CONTAINS 59 59 60 SUBROUTINE dom_init 60 SUBROUTINE dom_init(cdstr) 61 61 !!---------------------------------------------------------------------- 62 62 !! *** ROUTINE dom_init *** … … 76 76 INTEGER :: iconf = 0 ! local integers 77 77 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 78 CHARACTER (len=*), INTENT(IN) :: cdstr ! model: NEMO or SAS. Determines core restart variables 78 79 INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level 79 80 REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0 … … 117 118 CALL dom_glo ! global domain versus local domain 118 119 CALL dom_nam ! read namelist ( namrun, namdom ) 120 ! 121 IF( lwxios ) THEN 122 !define names for restart write and set core output (restart.F90) 123 CALL iom_set_rst_vars(rst_wfields) 124 CALL iom_set_rstw_core(cdstr) 125 ENDIF 126 !reset namelist for SAS 127 IF(cdstr == 'SAS') THEN 128 IF(lrxios) THEN 129 IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS' 130 lrxios = .FALSE. 131 ENDIF 132 ENDIF 133 ! 119 134 CALL dom_hgr ! Horizontal mesh 120 135 CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry … … 275 290 & nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , & 276 291 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , & 277 & ln_cfmeta, ln_iscpl 292 & ln_cfmeta, ln_iscpl, ln_xios_read, nn_wxios 278 293 NAMELIST/namdom/ ln_linssh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs, ln_meshmask 279 294 #if defined key_netcdf4 … … 287 302 WRITE(numout,*) '~~~~~~~ ' 288 303 ENDIF 304 ! 289 305 ! 290 306 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run … … 324 340 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 325 341 WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl 342 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 343 WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read 344 WRITE(numout,*) ' Write restart using XIOS nn_wxios = ', nn_wxios 345 ELSE 346 WRITE(numout,*) " AGRIF: nn_wxios will be ingored. See setting for parent" 347 WRITE(numout,*) " AGRIF: ln_xios_read will be ingored. See setting for parent" 348 ENDIF 326 349 ENDIF 327 350 … … 398 421 rdt = rn_rdt 399 422 423 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 424 lrxios = ln_xios_read.AND.ln_rstart 425 !set output file type for XIOS based on NEMO namelist 426 IF (nn_wxios > 0) lwxios = .TRUE. 427 nxioso = nn_wxios 428 ENDIF 429 400 430 #if defined key_netcdf4 401 431 ! ! NetCDF 4 case ("key_netcdf4" defined) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r9190 r9367 237 237 ENDIF 238 238 ENDIF 239 ! 240 IF(lwxios) THEN 241 ! define variables in restart file when writing with XIOS 242 CALL iom_set_rstw_var_active('e3t_b') 243 CALL iom_set_rstw_var_active('e3t_n') 244 ! ! ----------------------- ! 245 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 246 ! ! ----------------------- ! 247 CALL iom_set_rstw_var_active('tilde_e3t_b') 248 CALL iom_set_rstw_var_active('tilde_e3t_n') 249 END IF 250 ! ! -------------! 251 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 252 ! ! ------------ ! 253 CALL iom_set_rstw_var_active('hdiv_lf') 254 ENDIF 255 ! 256 ENDIF 257 258 IF( ln_timing ) CALL timing_stop('dom_vvl_init') 239 259 ! 240 260 END SUBROUTINE dom_vvl_init … … 781 801 IF( ln_rstart ) THEN !* Read the restart file 782 802 CALL rst_read_open ! open the restart file if necessary 783 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn )803 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, ldxios = lrxios ) 784 804 ! 785 805 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 792 812 ! ! --------- ! 793 813 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 794 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )795 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )814 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 815 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 796 816 ! needed to restart if land processor not computed 797 817 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' … … 807 827 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 808 828 IF(lwp) write(numout,*) 'neuler is forced to 0' 809 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) )829 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), ldxios = lrxios ) 810 830 e3t_n(:,:,:) = e3t_b(:,:,:) 811 831 neuler = 0 … … 814 834 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 815 835 IF(lwp) write(numout,*) 'neuler is forced to 0' 816 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) )836 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), ldxios = lrxios ) 817 837 e3t_b(:,:,:) = e3t_n(:,:,:) 818 838 neuler = 0 … … 839 859 ! ! ----------------------- ! 840 860 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 841 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) )842 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) )861 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 862 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 843 863 ELSE ! one at least array is missing 844 864 tilde_e3t_b(:,:,:) = 0.0_wp … … 849 869 ! ! ------------ ! 850 870 IF( id5 > 0 ) THEN ! required array exists 851 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) )871 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 852 872 ELSE ! array is missing 853 873 hdiv_lf(:,:,:) = 0.0_wp … … 928 948 ! ! =================== 929 949 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 950 IF( lwxios ) CALL iom_swap( cwxios_context ) 930 951 ! ! --------- ! 931 952 ! ! all cases ! 932 953 ! ! --------- ! 933 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) )934 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) )954 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:), ldxios = lwxios ) 955 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) 935 956 ! ! ----------------------- ! 936 957 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 937 958 ! ! ----------------------- ! 938 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) 939 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) 959 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lwxios) 960 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lwxios) 940 961 END IF 941 962 ! ! -------------! 942 963 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 943 964 ! ! ------------ ! 944 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) ) 945 ENDIF 946 ! 965 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lwxios) 966 ENDIF 967 ! 968 IF( lwxios ) CALL iom_swap( cxios_context ) 947 969 ENDIF 948 970 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r9169 r9367 58 58 ! 59 59 ! ! get restart variable 60 CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b ) ! need to extrapolate T/S61 CALL iom_get( numror, jpdom_autoglo, 'umask' , zumask_b ) ! need to correct barotropic velocity62 CALL iom_get( numror, jpdom_autoglo, 'vmask' , zvmask_b ) ! need to correct barotropic velocity63 CALL iom_get( numror, jpdom_autoglo, 'smask' , zsmask_b ) ! need to correct barotropic velocity64 CALL iom_get( numror, jpdom_autoglo, 'e3t_n' , ze3t_b(:,:,:) ) ! need to compute temperature correction65 CALL iom_get( numror, jpdom_autoglo, 'e3u_n' , ze3u_b(:,:,:) ) ! need to correct barotropic velocity66 CALL iom_get( numror, jpdom_autoglo, 'e3v_n' , ze3v_b(:,:,:) ) ! need to correct barotropic velocity67 CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl)60 CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b, ldxios = lrxios ) ! need to extrapolate T/S 61 CALL iom_get( numror, jpdom_autoglo, 'umask' , zumask_b, ldxios = lrxios ) ! need to correct barotropic velocity 62 CALL iom_get( numror, jpdom_autoglo, 'vmask' , zvmask_b, ldxios = lrxios ) ! need to correct barotropic velocity 63 CALL iom_get( numror, jpdom_autoglo, 'smask' , zsmask_b, ldxios = lrxios ) ! need to correct barotropic velocity 64 CALL iom_get( numror, jpdom_autoglo, 'e3t_n' , ze3t_b(:,:,:), ldxios = lrxios ) ! need to compute temperature correction 65 CALL iom_get( numror, jpdom_autoglo, 'e3u_n' , ze3u_b(:,:,:), ldxios = lrxios ) ! need to correct barotropic velocity 66 CALL iom_get( numror, jpdom_autoglo, 'e3v_n' , ze3v_b(:,:,:), ldxios = lrxios ) ! need to correct barotropic velocity 67 CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:), ldxios = lrxios ) ! need to interpol vertical profile (vvl) 68 68 ! 69 69 CALL iscpl_init() ! read namelist -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r9169 r9367 1347 1347 ! 1348 1348 IF( TRIM(cdrw) == 'READ' ) THEN 1349 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) )1350 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) )1351 CALL iom_get( numror, jpdom_autoglo, 'un_bf' , un_bf (:,:) )1352 CALL iom_get( numror, jpdom_autoglo, 'vn_bf' , vn_bf (:,:) )1349 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:), ldxios = lrxios ) 1350 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:), ldxios = lrxios ) 1351 CALL iom_get( numror, jpdom_autoglo, 'un_bf' , un_bf (:,:), ldxios = lrxios ) 1352 CALL iom_get( numror, jpdom_autoglo, 'vn_bf' , vn_bf (:,:), ldxios = lrxios ) 1353 1353 IF( .NOT.ln_bt_av ) THEN 1354 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) )1355 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:) )1356 CALL iom_get( numror, jpdom_autoglo, 'vbb_e' , vbb_e(:,:) )1357 CALL iom_get( numror, jpdom_autoglo, 'sshb_e' , sshb_e(:,:) )1358 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:) )1359 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:) )1354 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:), ldxios = lrxios ) 1355 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:), ldxios = lrxios ) 1356 CALL iom_get( numror, jpdom_autoglo, 'vbb_e' , vbb_e(:,:), ldxios = lrxios ) 1357 CALL iom_get( numror, jpdom_autoglo, 'sshb_e' , sshb_e(:,:), ldxios = lrxios ) 1358 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:), ldxios = lrxios ) 1359 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:), ldxios = lrxios ) 1360 1360 ENDIF 1361 1361 #if defined key_agrif 1362 1362 ! Read time integrated fluxes 1363 1363 IF ( .NOT.Agrif_Root() ) THEN 1364 CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b' , ub2_i_b(:,:) )1365 CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b' , vb2_i_b(:,:) )1364 CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b' , ub2_i_b(:,:), ldxios = lrxios ) 1365 CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b' , vb2_i_b(:,:), ldxios = lrxios ) 1366 1366 ENDIF 1367 1367 #endif 1368 1368 ! 1369 1369 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 1370 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:) ) 1371 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:) ) 1372 CALL iom_rstput( kt, nitrst, numrow, 'un_bf' , un_bf (:,:) ) 1373 CALL iom_rstput( kt, nitrst, numrow, 'vn_bf' , vn_bf (:,:) ) 1370 IF( lwxios ) CALL iom_swap( cwxios_context ) 1371 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:), ldxios = lwxios ) 1372 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:), ldxios = lwxios ) 1373 CALL iom_rstput( kt, nitrst, numrow, 'un_bf' , un_bf (:,:), ldxios = lwxios ) 1374 CALL iom_rstput( kt, nitrst, numrow, 'vn_bf' , vn_bf (:,:), ldxios = lwxios ) 1374 1375 ! 1375 1376 IF (.NOT.ln_bt_av) THEN 1376 CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e' , sshbb_e(:,:) )1377 CALL iom_rstput( kt, nitrst, numrow, 'ubb_e' , ubb_e(:,:) )1378 CALL iom_rstput( kt, nitrst, numrow, 'vbb_e' , vbb_e(:,:) )1379 CALL iom_rstput( kt, nitrst, numrow, 'sshb_e' , sshb_e(:,:) )1380 CALL iom_rstput( kt, nitrst, numrow, 'ub_e' , ub_e(:,:) )1381 CALL iom_rstput( kt, nitrst, numrow, 'vb_e' , vb_e(:,:) )1377 CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e' , sshbb_e(:,:), ldxios = lwxios ) 1378 CALL iom_rstput( kt, nitrst, numrow, 'ubb_e' , ubb_e(:,:), ldxios = lwxios ) 1379 CALL iom_rstput( kt, nitrst, numrow, 'vbb_e' , vbb_e(:,:), ldxios = lwxios ) 1380 CALL iom_rstput( kt, nitrst, numrow, 'sshb_e' , sshb_e(:,:), ldxios = lwxios ) 1381 CALL iom_rstput( kt, nitrst, numrow, 'ub_e' , ub_e(:,:), ldxios = lwxios ) 1382 CALL iom_rstput( kt, nitrst, numrow, 'vb_e' , vb_e(:,:), ldxios = lwxios ) 1382 1383 ENDIF 1383 1384 #if defined key_agrif 1384 1385 ! Save time integrated fluxes 1385 1386 IF ( .NOT.Agrif_Root() ) THEN 1386 CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b' , ub2_i_b(:,:) )1387 CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b' , vb2_i_b(:,:) )1387 CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b' , ub2_i_b(:,:), ldxios = lwxios ) 1388 CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b' , vb2_i_b(:,:), ldxios = lwxios ) 1388 1389 ENDIF 1389 1390 #endif 1391 IF( lwxios ) CALL iom_swap( cxios_context ) 1390 1392 ENDIF 1391 1393 ! … … 1482 1484 IF( neuler /= 0 .AND. ln_bt_fw ) CALL ts_rst( nit000, 'READ' ) 1483 1485 ! 1486 IF( lwxios ) THEN 1487 ! define variables in restart file when writing with XIOS 1488 CALL iom_set_rstw_var_active('ub2_b') 1489 CALL iom_set_rstw_var_active('vb2_b') 1490 CALL iom_set_rstw_var_active('un_bf') 1491 CALL iom_set_rstw_var_active('vn_bf') 1492 ! 1493 IF (.NOT.ln_bt_av) THEN 1494 CALL iom_set_rstw_var_active('sshbb_e') 1495 CALL iom_set_rstw_var_active('ubb_e') 1496 CALL iom_set_rstw_var_active('vbb_e') 1497 CALL iom_set_rstw_var_active('sshb_e') 1498 CALL iom_set_rstw_var_active('ub_e') 1499 CALL iom_set_rstw_var_active('vb_e') 1500 ENDIF 1501 #if defined key_agrif 1502 ! Save time integrated fluxes 1503 IF ( .NOT.Agrif_Root() ) THEN 1504 CALL iom_set_rstw_var_active('ub2_i_b') 1505 CALL iom_set_rstw_var_active('vb2_i_b') 1506 ENDIF 1507 #endif 1508 ENDIF 1509 ! 1484 1510 END SUBROUTINE dyn_spg_ts_init 1485 1511 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r9124 r9367 44 44 LOGICAL :: ln_clobber !: clobber (overwrite) an existing file 45 45 INTEGER :: nn_chunksz !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 46 LOGICAL :: ln_xios_read !: use xios to read single file restart 47 INTEGER :: nn_wxios !: write resart using xios 0 - no, 1 - single, 2 - multiple file output 46 48 47 49 #if defined key_netcdf4 … … 153 155 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 154 156 CHARACTER(lc) :: cxios_context !: context name used in xios 157 CHARACTER(lc) :: crxios_context !: context name used in xios to read restart 158 CHARACTER(lc) :: cwxios_context !: context name used in xios to write restart file 155 159 156 160 !!---------------------------------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r9019 r9367 43 43 USE ioipsl, ONLY : ju2ymds ! for calendar 44 44 USE crs ! Grid coarsening 45 USE lib_fortran 46 USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 45 47 46 48 IMPLICIT NONE … … 62 64 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 65 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 66 PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 67 PUBLIC iom_set_rstw_var_active, iom_set_rst_vars 64 68 # endif 65 69 … … 87 91 CONTAINS 88 92 89 SUBROUTINE iom_init( cdname )93 SUBROUTINE iom_init( cdname, fname ) 90 94 !!---------------------------------------------------------------------- 91 95 !! *** ROUTINE *** … … 95 99 !!---------------------------------------------------------------------- 96 100 CHARACTER(len=*), INTENT(in) :: cdname 97 !101 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 98 102 #if defined key_iomput 99 103 ! 100 104 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 101 105 TYPE(xios_date) :: start_date 102 CHARACTER(len= 10) :: clname106 CHARACTER(len=lc) :: clname 103 107 INTEGER :: ji, jkmin 108 LOGICAL :: llrst_context ! is context related to restart 104 109 ! 105 110 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds … … 112 117 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 113 118 CALL iom_swap( cdname ) 114 119 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 115 120 116 121 ! Calendar type is now defined in xml file … … 125 130 126 131 ! horizontal grid definition 127 CALL set_scalar132 IF(.NOT.llrst_context) CALL set_scalar 128 133 ! 129 134 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 130 CALL set_grid( "T", glamt, gphit )131 CALL set_grid( "U", glamu, gphiu )132 CALL set_grid( "V", glamv, gphiv )133 CALL set_grid( "W", glamt, gphit )135 CALL set_grid( "T", glamt, gphit, .FALSE. ) 136 CALL set_grid( "U", glamu, gphiu, .FALSE. ) 137 CALL set_grid( "V", glamv, gphiv, .FALSE. ) 138 CALL set_grid( "W", glamt, gphit, .FALSE. ) 134 139 CALL set_grid_znl( gphit ) 135 140 ! … … 149 154 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 150 155 ! 151 CALL set_grid( "T", glamt_crs, gphit_crs )152 CALL set_grid( "U", glamu_crs, gphiu_crs )153 CALL set_grid( "V", glamv_crs, gphiv_crs )154 CALL set_grid( "W", glamt_crs, gphit_crs )156 CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE. ) 157 CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE. ) 158 CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE. ) 159 CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE. ) 155 160 CALL set_grid_znl( gphit_crs ) 156 161 ! 157 162 CALL dom_grid_glo ! Return to parent grid domain 158 163 ! 159 IF( ln_cfmeta ) THEN ! Add additional grid metadata164 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 160 165 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 161 166 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) … … 170 175 ! 171 176 ! vertical grid definition 172 CALL iom_set_axis_attr( "deptht", gdept_1d ) 173 CALL iom_set_axis_attr( "depthu", gdept_1d ) 174 CALL iom_set_axis_attr( "depthv", gdept_1d ) 175 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 176 ! 177 ! Add vertical grid bounds 178 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 179 zt_bnds(2,: ) = gdept_1d(:) 180 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 181 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 182 zw_bnds(1,: ) = gdepw_1d(:) 183 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 184 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 185 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 186 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 187 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 188 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 189 ! 177 IF(.NOT.llrst_context) THEN 178 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 179 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 180 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 181 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 182 183 ! Add vertical grid bounds 184 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 185 zt_bnds(2,: ) = gdept_1d(:) 186 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 187 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 188 zw_bnds(1,: ) = gdepw_1d(:) 189 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 190 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 191 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 192 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 193 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 194 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 195 ! 190 196 # if defined key_floats 191 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )197 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 192 198 # endif 193 199 # if defined key_lim3 194 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )195 ! SIMIP diagnostics (4 main arctic straits)196 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )200 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 201 ! SIMIP diagnostics (4 main arctic straits) 202 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 197 203 # endif 198 CALL iom_set_axis_attr( "icbcla", class_num ) 199 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 200 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 201 204 CALL iom_set_axis_attr( "icbcla", class_num ) 205 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 206 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 207 ENDIF 208 ! 202 209 ! automatic definitions of some of the xml attributs 203 CALL set_xmlatt 210 IF( TRIM(cdname) == TRIM(crxios_context) ) THEN 211 !set names of the fields in restart file IF using XIOS to read data 212 CALL iom_set_rst_context() 213 CALL iom_set_rst_vars(rst_rfields) 214 !set which fields are to be read from restart file 215 CALL iom_set_rstr_active() 216 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 217 !set names of the fields in restart file IF using XIOS to write data 218 CALL iom_set_rst_context() 219 CALL iom_set_rst_vars(rst_wfields) 220 !set which fields are to be written to a restart file 221 CALL iom_set_rstw_active(fname) 222 ELSE 223 CALL set_xmlatt 224 ENDIF 204 225 ! 205 226 ! end file definition … … 215 236 END SUBROUTINE iom_init 216 237 238 SUBROUTINE iom_set_rstw_var_active(field) 239 !!--------------------------------------------------------------------- 240 !! *** SUBROUTINE iom_set_rstw_var_active *** 241 !! 242 !! ** Purpose : enable variable in restart file when writing with XIOS 243 !!--------------------------------------------------------------------- 244 CHARACTER(len = *), INTENT(IN) :: field 245 INTEGER :: i 246 LOGICAL :: llis_set 247 248 llis_set = .FALSE. 249 250 DO i = 1, max_rst_fields 251 IF(TRIM(rst_wfields(i)%vname) == field) THEN 252 rst_wfields(i)%active = .TRUE. 253 llis_set = .TRUE. 254 EXIT 255 ENDIF 256 ENDDO 257 !Warn if variable is not in defined in rst_wfields 258 IF(.NOT.llis_set) THEN 259 IF(lwp) THEN 260 write(numout,cform_err) 261 write(numout,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 262 ENDIF 263 nstop = nstop + 1 264 ENDIF 265 266 END SUBROUTINE iom_set_rstw_var_active 267 268 SUBROUTINE iom_set_rstr_active() 269 !!--------------------------------------------------------------------- 270 !! *** SUBROUTINE iom_set_rstr_active *** 271 !! 272 !! ** Purpose : define file name in XIOS context for reading restart file, 273 !! enable variables present in restart file for reading with XIOS 274 !!--------------------------------------------------------------------- 275 276 !sets enabled = .TRUE. for each field in restart file 277 CHARACTER(len=256) :: rst_file 278 TYPE(xios_field) :: field_hdl 279 TYPE(xios_file) :: file_hdl 280 TYPE(xios_filegroup) :: filegroup_hdl 281 INTEGER :: i 282 CHARACTER(lc) :: clpath 283 284 clpath = TRIM(cn_ocerst_indir) 285 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 286 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 287 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 288 ELSE 289 rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in) 290 ENDIF 291 !set name of the restart file and enable available fields 292 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 293 CALL xios_get_handle("file_definition", filegroup_hdl ) 294 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 295 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 296 par_access="collective", enabled=.TRUE., mode="read", & 297 output_freq=xios_timestep) 298 !define variables for restart context 299 DO i = 1, max_rst_fields 300 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 301 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 302 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 303 SELECT CASE (TRIM(rst_rfields(i)%grid)) 304 CASE ("grid_N_3D") 305 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 306 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 307 CASE ("grid_N") 308 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 309 domain_ref="grid_N", operation = "instant") 310 CASE ("grid_vector") 311 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 312 axis_ref="nav_lev", operation = "instant") 313 CASE ("grid_scalar") 314 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 315 scalar_ref = "grid_scalar", operation = "instant") 316 END SELECT 317 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 318 ENDIF 319 ENDIF 320 END DO 321 END SUBROUTINE iom_set_rstr_active 322 323 SUBROUTINE iom_set_rstw_core(cdmdl) 324 !!--------------------------------------------------------------------- 325 !! *** SUBROUTINE iom_set_rstw_core *** 326 !! 327 !! ** Purpose : set variables which are always in restart file 328 !!--------------------------------------------------------------------- 329 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 330 331 IF(cdmdl == "OPA") THEN 332 !from restart.F90 333 CALL iom_set_rstw_var_active("rdt") 334 IF ( .NOT. ln_diurnal_only ) THEN 335 CALL iom_set_rstw_var_active('ub' ) 336 CALL iom_set_rstw_var_active('vb' ) 337 CALL iom_set_rstw_var_active('tb' ) 338 CALL iom_set_rstw_var_active('sb' ) 339 CALL iom_set_rstw_var_active('sshb') 340 ! 341 CALL iom_set_rstw_var_active('un' ) 342 CALL iom_set_rstw_var_active('vn' ) 343 CALL iom_set_rstw_var_active('tn' ) 344 CALL iom_set_rstw_var_active('sn' ) 345 CALL iom_set_rstw_var_active('sshn') 346 CALL iom_set_rstw_var_active('rhop') 347 ! extra variable needed for the ice sheet coupling 348 IF ( ln_iscpl ) THEN 349 CALL iom_set_rstw_var_active('tmask') 350 CALL iom_set_rstw_var_active('umask') 351 CALL iom_set_rstw_var_active('vmask') 352 CALL iom_set_rstw_var_active('smask') 353 CALL iom_set_rstw_var_active('e3t_n') 354 CALL iom_set_rstw_var_active('e3u_n') 355 CALL iom_set_rstw_var_active('e3v_n') 356 CALL iom_set_rstw_var_active('gdepw_n') 357 END IF 358 ENDIF 359 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 360 !from trasbc.F90 361 CALL iom_set_rstw_var_active('sbc_hc_b') 362 CALL iom_set_rstw_var_active('sbc_sc_b') 363 ENDIF 364 END SUBROUTINE iom_set_rstw_core 365 366 SUBROUTINE iom_set_rst_vars(fields) 367 !!--------------------------------------------------------------------- 368 !! *** SUBROUTINE iom_set_rstr_active *** 369 !! 370 !! ** Purpose : Fill array fields with the information about all 371 !! possible variables and corresponding grids definition 372 !! for reading/writing restart with XIOS 373 !!--------------------------------------------------------------------- 374 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 375 376 INTEGER :: i 377 i = 0 378 i = i + 1; fields(i)%vname="rdt"; fields(i)%grid="grid_scalar" 379 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 380 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 381 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 382 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 383 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 384 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 385 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 386 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 387 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 388 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 389 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 390 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 391 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 392 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 393 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 394 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 395 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 396 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 397 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 398 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 399 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 400 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" 401 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 402 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 403 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 404 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 405 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 406 i = i + 1; fields(i)%vname="greenland_icesheet_mass" 407 fields(i)%grid="grid_scalar" 408 i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed" 409 fields(i)%grid="grid_scalar" 410 i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc" 411 fields(i)%grid="grid_scalar" 412 i = i + 1; fields(i)%vname="antarctica_icesheet_mass" 413 fields(i)%grid="grid_scalar" 414 i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed" 415 fields(i)%grid="grid_scalar" 416 i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc" 417 fields(i)%grid="grid_scalar" 418 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 419 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 420 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 421 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 422 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 423 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 424 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 425 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 426 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 427 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 428 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 429 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 430 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 431 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 432 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 433 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 434 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 435 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 436 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 437 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 438 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 439 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 440 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 441 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 442 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 443 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 444 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 445 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 446 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 447 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 448 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 449 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 450 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 451 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 452 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 453 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 454 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 455 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 456 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 457 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 458 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 459 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 460 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 461 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 462 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 463 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 464 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 465 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 466 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 467 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 468 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 469 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 470 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 471 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D" 472 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N" 473 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N" 474 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N" 475 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N" 476 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D" 477 478 IF( i-1 > max_rst_fields) THEN 479 IF(lwp) write(numout,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 480 nstop = nstop + 1 481 ENDIF 482 483 END SUBROUTINE iom_set_rst_vars 484 485 486 SUBROUTINE iom_set_rstw_active(cdrst_file) 487 !!--------------------------------------------------------------------- 488 !! *** SUBROUTINE iom_set_rstr_active *** 489 !! 490 !! ** Purpose : define file name in XIOS context for writing restart 491 !! enable variables present in restart file for writing 492 !!--------------------------------------------------------------------- 493 !sets enabled = .TRUE. for each field in restart file 494 CHARACTER(len=*) :: cdrst_file 495 #if defined key_iomput 496 TYPE(xios_field) :: field_hdl 497 TYPE(xios_file) :: file_hdl 498 TYPE(xios_filegroup) :: filegroup_hdl 499 INTEGER :: i 500 CHARACTER(lc) :: clpath 501 502 !set name of the restart file and enable available fields 503 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 504 CALL xios_get_handle("file_definition", filegroup_hdl ) 505 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 506 IF(nxioso.eq.1) THEN 507 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 508 mode="write", output_freq=xios_timestep) 509 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 510 ELSE 511 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 512 mode="write", output_freq=xios_timestep) 513 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 514 ENDIF 515 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 516 !define fields for restart context 517 DO i = 1, max_rst_fields 518 IF( rst_wfields(i)%active ) THEN 519 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 520 SELECT CASE (TRIM(rst_wfields(i)%grid)) 521 CASE ("grid_N_3D") 522 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 523 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 524 CASE ("grid_N") 525 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 526 domain_ref="grid_N", prec = 8, operation = "instant") 527 CASE ("grid_vector") 528 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 529 axis_ref="nav_lev", prec = 8, operation = "instant") 530 CASE ("grid_scalar") 531 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 532 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 533 END SELECT 534 ENDIF 535 END DO 536 #endif 537 END SUBROUTINE iom_set_rstw_active 538 539 SUBROUTINE iom_set_rst_context( ) 540 !!--------------------------------------------------------------------- 541 !! *** SUBROUTINE iom_set_rstr_active *** 542 !! 543 !! ** Purpose : Define domain, axis and grid for restart (read/write) 544 !! context 545 !! 546 !!--------------------------------------------------------------------- 547 #if defined key_iomput 548 TYPE(xios_domaingroup) :: domaingroup_hdl 549 TYPE(xios_domain) :: domain_hdl 550 TYPE(xios_axisgroup) :: axisgroup_hdl 551 TYPE(xios_axis) :: axis_hdl 552 TYPE(xios_scalar) :: scalar_hdl 553 TYPE(xios_scalargroup) :: scalargroup_hdl 554 555 CALL xios_get_handle("domain_definition",domaingroup_hdl) 556 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 557 CALL set_grid("N", glamt, gphit, .TRUE.) 558 559 CALL xios_get_handle("axis_definition",axisgroup_hdl) 560 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 561 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 562 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 563 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 564 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 565 566 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 567 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 568 #endif 569 END SUBROUTINE iom_set_rst_context 217 570 218 571 SUBROUTINE iom_swap( cdname ) … … 347 700 icnt = icnt + 1 348 701 END DO 702 ELSE 703 lxios_sini = .TRUE. 349 704 ENDIF 350 705 IF( llwrt ) THEN … … 530 885 !! INTERFACE iom_get 531 886 !!---------------------------------------------------------------------- 532 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )887 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios ) 533 888 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 534 889 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 535 890 REAL(wp) , INTENT( out) :: pvar ! read field 536 891 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 892 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart 537 893 ! 538 894 INTEGER :: idvar ! variable id … … 542 898 CHARACTER(LEN=100) :: clname ! file name 543 899 CHARACTER(LEN=1) :: cldmspc ! 544 ! 545 itime = 1 546 IF( PRESENT(ktime) ) itime = ktime 547 ! 548 clname = iom_file(kiomid)%name 549 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 550 ! 551 IF( kiomid > 0 ) THEN 552 idvar = iom_varid( kiomid, cdvar ) 553 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 554 idmspc = iom_file ( kiomid )%ndims( idvar ) 555 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 556 WRITE(cldmspc , fmt='(i1)') idmspc 557 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 558 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 559 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 560 SELECT CASE (iom_file(kiomid)%iolib) 561 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 562 CASE DEFAULT 563 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 564 END SELECT 565 ENDIF 900 LOGICAL :: llxios 901 ! 902 llxios = .FALSE. 903 IF( PRESENT(ldxios) ) llxios = ldxios 904 905 IF(.NOT.llxios) THEN ! read data using default library 906 itime = 1 907 IF( PRESENT(ktime) ) itime = ktime 908 ! 909 clname = iom_file(kiomid)%name 910 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 911 ! 912 IF( kiomid > 0 ) THEN 913 idvar = iom_varid( kiomid, cdvar ) 914 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 915 idmspc = iom_file ( kiomid )%ndims( idvar ) 916 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 917 WRITE(cldmspc , fmt='(i1)') idmspc 918 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 919 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 920 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 921 SELECT CASE (iom_file(kiomid)%iolib) 922 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 923 CASE DEFAULT 924 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 925 END SELECT 926 ENDIF 927 ENDIF 928 ELSE 929 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 930 CALL iom_swap( TRIM(crxios_context) ) 931 CALL xios_recv_field( trim(cdvar), pvar) 932 CALL iom_swap( TRIM(cxios_context) ) 566 933 ENDIF 567 934 END SUBROUTINE iom_g0d 568 935 569 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )936 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 570 937 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 571 938 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 575 942 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 576 943 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 944 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 577 945 ! 578 946 IF( kiomid > 0 ) THEN 579 947 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 580 & ktime=ktime, kstart=kstart, kcount=kcount ) 948 & ktime=ktime, kstart=kstart, kcount=kcount, & 949 & ldxios=ldxios ) 581 950 ENDIF 582 951 END SUBROUTINE iom_g1d 583 952 584 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr 953 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 585 954 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 586 955 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 594 963 ! called open_ocean_jstart to set the start 595 964 ! value for the 2nd dimension (netcdf only) 965 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 596 966 ! 597 967 IF( kiomid > 0 ) THEN 598 968 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 599 969 & ktime=ktime, kstart=kstart, kcount=kcount, & 600 & lrowattr=lrowattr 970 & lrowattr=lrowattr, ldxios=ldxios) 601 971 ENDIF 602 972 END SUBROUTINE iom_g2d 603 973 604 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )974 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 605 975 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 606 976 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 614 984 ! called open_ocean_jstart to set the start 615 985 ! value for the 2nd dimension (netcdf only) 986 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 616 987 ! 617 988 IF( kiomid > 0 ) THEN 618 989 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 619 990 & ktime=ktime, kstart=kstart, kcount=kcount, & 620 & lrowattr=lrowattr )991 & lrowattr=lrowattr, ldxios=ldxios ) 621 992 ENDIF 622 993 END SUBROUTINE iom_g3d … … 626 997 & pv_r1d, pv_r2d, pv_r3d, & 627 998 & ktime , kstart, kcount, & 628 & lrowattr 999 & lrowattr, ldxios ) 629 1000 !!----------------------------------------------------------------------- 630 1001 !! *** ROUTINE iom_get_123d *** … … 644 1015 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 645 1016 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 646 ! ! look for and use a file attribute 647 ! ! called open_ocean_jstart to set the start 648 ! ! value for the 2nd dimension (netcdf only) 649 ! 1017 ! look for and use a file attribute 1018 ! called open_ocean_jstart to set the start 1019 ! value for the 2nd dimension (netcdf only) 1020 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1021 ! 1022 LOGICAL :: llxios ! local definition for XIOS read 650 1023 LOGICAL :: llnoov ! local definition to read overlap 651 1024 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 673 1046 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 674 1047 INTEGER :: inlev ! number of levels for 3D data 1048 REAL(wp) :: gma, gmi 675 1049 !--------------------------------------------------------------------- 676 1050 ! 677 1051 inlev = -1 678 1052 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 679 clname = iom_file(kiomid)%name ! esier to read 680 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 681 ! local definition of the domain ? 1053 ! 1054 llxios = .FALSE. 1055 if(PRESENT(ldxios)) llxios = ldxios 1056 idvar = iom_varid( kiomid, cdvar ) 682 1057 idom = kdom 683 ! do we read the overlap 684 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 685 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 686 ! check kcount and kstart optionals parameters... 687 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 688 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 689 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 690 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 691 692 luse_jattr = .false. 693 IF( PRESENT(lrowattr) ) THEN 694 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 695 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 696 ENDIF 697 IF( luse_jattr ) THEN 698 SELECT CASE (iom_file(kiomid)%iolib) 699 CASE (jpnf90 ) 700 ! Ok 701 CASE DEFAULT 702 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 703 END SELECT 704 ENDIF 705 706 ! Search for the variable in the data base (eventually actualize data) 707 istop = nstop 708 idvar = iom_varid( kiomid, cdvar ) 709 ! 710 IF( idvar > 0 ) THEN 711 ! to write iom_file(kiomid)%dimsz in a shorter way ! 712 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 713 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 714 idmspc = inbdim ! number of spatial dimensions in the file 715 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 716 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1058 ! 1059 IF(.NOT.llxios) THEN 1060 clname = iom_file(kiomid)%name ! esier to read 1061 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 1062 ! local definition of the domain ? 1063 ! do we read the overlap 1064 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 1065 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 1066 ! check kcount and kstart optionals parameters... 1067 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1068 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1069 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 1070 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 1071 1072 luse_jattr = .false. 1073 IF( PRESENT(lrowattr) ) THEN 1074 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 1075 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 1076 ENDIF 1077 IF( luse_jattr ) THEN 1078 SELECT CASE (iom_file(kiomid)%iolib) 1079 CASE (jpnf90 ) 1080 ! Ok 1081 CASE DEFAULT 1082 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1083 END SELECT 1084 ENDIF 1085 1086 ! Search for the variable in the data base (eventually actualize data) 1087 istop = nstop 717 1088 ! 718 ! update idom definition... 719 ! Identify the domain in case of jpdom_auto(glo/dta) definition 720 IF( idom == jpdom_autoglo_xy ) THEN 721 ll_depth_spec = .TRUE. 722 idom = jpdom_autoglo 723 ELSE 724 ll_depth_spec = .FALSE. 725 ENDIF 726 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 727 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 728 ELSE ; idom = jpdom_data 1089 IF( idvar > 0 ) THEN 1090 ! to write iom_file(kiomid)%dimsz in a shorter way ! 1091 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 1092 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 1093 idmspc = inbdim ! number of spatial dimensions in the file 1094 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 1095 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1096 ! 1097 ! update idom definition... 1098 ! Identify the domain in case of jpdom_auto(glo/dta) definition 1099 IF( idom == jpdom_autoglo_xy ) THEN 1100 ll_depth_spec = .TRUE. 1101 idom = jpdom_autoglo 1102 ELSE 1103 ll_depth_spec = .FALSE. 729 1104 ENDIF 730 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 731 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 732 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 733 ENDIF 734 ! Identify the domain in case of jpdom_local definition 735 IF( idom == jpdom_local ) THEN 736 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 737 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 738 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 739 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 1105 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 1106 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 1107 ELSE ; idom = jpdom_data 1108 ENDIF 1109 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 1110 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 1111 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 740 1112 ENDIF 741 ENDIF 742 ! 743 ! check the consistency between input array and data rank in the file 744 ! 745 ! initializations 746 itime = 1 747 IF( PRESENT(ktime) ) itime = ktime 748 749 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 750 WRITE(clrankpv, fmt='(i1)') irankpv 751 WRITE(cldmspc , fmt='(i1)') idmspc 752 ! 753 IF( idmspc < irankpv ) THEN 754 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 755 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 756 ELSEIF( idmspc == irankpv ) THEN 757 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 758 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 759 ELSEIF( idmspc > irankpv ) THEN 760 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 761 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 762 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 763 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 764 idmspc = idmspc - 1 765 ELSE 766 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 767 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 768 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1113 ! Identify the domain in case of jpdom_local definition 1114 IF( idom == jpdom_local ) THEN 1115 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 1116 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 1117 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 1118 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 769 1119 ENDIF 770 ENDIF 771 772 ! 773 ! definition of istart and icnt 774 ! 775 icnt (:) = 1 776 istart(:) = 1 777 istart(idmspc+1) = itime 778 779 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 780 istart(1:idmspc) = kstart(1:idmspc) 781 icnt (1:idmspc) = kcount(1:idmspc) 782 ELSE 783 IF(idom == jpdom_unknown ) THEN 784 icnt(1:idmspc) = idimsz(1:idmspc) 785 ELSE 786 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 787 IF( idom == jpdom_data ) THEN 788 jstartrow = 1 789 IF( luse_jattr ) THEN 790 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 791 jstartrow = MAX(1,jstartrow) 1120 ENDIF 1121 ! 1122 ! check the consistency between input array and data rank in the file 1123 ! 1124 ! initializations 1125 itime = 1 1126 IF( PRESENT(ktime) ) itime = ktime 1127 ! 1128 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 1129 WRITE(clrankpv, fmt='(i1)') irankpv 1130 WRITE(cldmspc , fmt='(i1)') idmspc 1131 ! 1132 IF( idmspc < irankpv ) THEN 1133 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1134 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1135 ELSEIF( idmspc == irankpv ) THEN 1136 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 1137 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 1138 ELSEIF( idmspc > irankpv ) THEN 1139 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 1140 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 1141 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1142 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1143 idmspc = idmspc - 1 1144 ELSE 1145 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 1146 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 1147 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1148 ENDIF 1149 ENDIF 1150 ! 1151 ! definition of istart and icnt 1152 ! 1153 icnt (:) = 1 1154 istart(:) = 1 1155 istart(idmspc+1) = itime 1156 1157 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 1158 istart(1:idmspc) = kstart(1:idmspc) 1159 icnt (1:idmspc) = kcount(1:idmspc) 1160 ELSE 1161 IF(idom == jpdom_unknown ) THEN 1162 icnt(1:idmspc) = idimsz(1:idmspc) 1163 ELSE 1164 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 1165 IF( idom == jpdom_data ) THEN 1166 jstartrow = 1 1167 IF( luse_jattr ) THEN 1168 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 1169 jstartrow = MAX(1,jstartrow) 1170 ENDIF 1171 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 1172 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 792 1173 ENDIF 793 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 794 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 795 ENDIF 796 ! we do not read the overlap -> we start to read at nldi, nldj 1174 ! we do not read the overlap -> we start to read at nldi, nldj 797 1175 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 798 1176 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 799 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)1177 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 800 1178 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 801 1179 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 802 1180 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 803 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 804 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 805 ENDIF 806 IF( PRESENT(pv_r3d) ) THEN 807 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 808 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 809 ELSE ; icnt(3) = inlev 1181 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1182 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 1183 ENDIF 1184 IF( PRESENT(pv_r3d) ) THEN 1185 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 1186 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 1187 ELSE ; icnt(3) = inlev 1188 ENDIF 810 1189 ENDIF 811 1190 ENDIF 812 1191 ENDIF 813 1192 ENDIF 814 ENDIF 815 816 ! check that istart and icnt can be used with this file 817 !- 818 DO jl = 1, jpmax_dims 819 itmp = istart(jl)+icnt(jl)-1 820 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 821 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 822 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 823 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 824 ENDIF 825 END DO 826 827 ! check that icnt matches the input array 828 !- 829 IF( idom == jpdom_unknown ) THEN 830 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 831 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 832 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 833 ctmp1 = 'd' 834 ELSE 835 IF( irankpv == 2 ) THEN 1193 1194 ! check that istart and icnt can be used with this file 1195 !- 1196 DO jl = 1, jpmax_dims 1197 itmp = istart(jl)+icnt(jl)-1 1198 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 1199 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 1200 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 1201 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1202 ENDIF 1203 END DO 1204 1205 ! check that icnt matches the input array 1206 !- 1207 IF( idom == jpdom_unknown ) THEN 1208 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 1209 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 1210 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 1211 ctmp1 = 'd' 1212 ELSE 1213 IF( irankpv == 2 ) THEN 836 1214 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 837 1215 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 838 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 839 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1216 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1217 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1218 ENDIF 1219 ENDIF 1220 IF( irankpv == 3 ) THEN 1221 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1222 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 1223 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1224 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1225 ENDIF 840 1226 ENDIF 841 1227 ENDIF 842 IF( irankpv == 3 ) THEN843 ! JMM + SM: ugly patch before getting the new version of lib_mpp)844 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'845 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'846 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'847 ENDIF848 ENDIF849 ENDIF850 1228 851 DO jl = 1, irankpv852 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)853 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )854 END DO855 856 ENDIF857 858 ! read the data859 !-860 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...861 !1229 DO jl = 1, irankpv 1230 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 1231 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 1232 END DO 1233 1234 ENDIF 1235 1236 ! read the data 1237 !- 1238 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1239 ! 862 1240 ! find the right index of the array to be read 863 1241 ! JMM + SM: ugly patch before getting the new version of lib_mpp) … … 865 1243 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 866 1244 ! ENDIF 867 IF( llnoov ) THEN 868 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 869 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1245 IF( llnoov ) THEN 1246 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1247 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1248 ENDIF 1249 ELSE 1250 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1251 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1252 ENDIF 1253 ENDIF 1254 1255 SELECT CASE (iom_file(kiomid)%iolib) 1256 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 1257 & pv_r1d, pv_r2d, pv_r3d ) 1258 CASE DEFAULT 1259 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1260 END SELECT 1261 1262 IF( istop == nstop ) THEN ! no additional errors until this point... 1263 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 1264 1265 !--- overlap areas and extra hallows (mpp) 1266 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1267 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1268 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1269 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1270 IF( icnt(3) == inlev ) THEN 1271 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1272 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1273 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1274 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1275 ENDIF 1276 ENDIF 1277 ! 1278 ELSE 1279 ! return if istop == nstop is false 1280 RETURN 870 1281 ENDIF 871 1282 ELSE 872 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 873 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1283 ! return if statment idvar > 0 .AND. istop == nstop is false 1284 RETURN 1285 ENDIF 1286 ! 1287 ELSE ! read using XIOS. Only if KEY_IOMPUT is defined 1288 #if defined key_iomput 1289 !would be good to be able to check which context is active and swap only if current is not restart 1290 CALL iom_swap( TRIM(crxios_context) ) 1291 IF( PRESENT(pv_r3d) ) THEN 1292 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1293 CALL xios_recv_field( trim(cdvar), pv_r3d) 1294 IF(idom /= jpdom_unknown ) then 1295 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 874 1296 ENDIF 875 ENDIF 876 877 SELECT CASE (iom_file(kiomid)%iolib) 878 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 879 & pv_r1d, pv_r2d, pv_r3d ) 880 CASE DEFAULT 881 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 882 END SELECT 883 884 IF( istop == nstop ) THEN ! no additional errors until this point... 885 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 886 887 !--- overlap areas and extra hallows (mpp) 888 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 889 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 890 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 891 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 892 IF( icnt(3) == inlev ) THEN 893 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 894 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 895 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 896 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 897 ENDIF 1297 ELSEIF( PRESENT(pv_r2d) ) THEN 1298 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1299 CALL xios_recv_field( trim(cdvar), pv_r2d) 1300 IF(idom /= jpdom_unknown ) THEN 1301 CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 898 1302 ENDIF 899 900 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 901 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 902 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 903 904 !--- Apply scale_factor and offset 905 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 906 zofs = iom_file(kiomid)%ofs(idvar) ! offset 907 IF( PRESENT(pv_r1d) ) THEN 908 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 909 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 910 ELSEIF( PRESENT(pv_r2d) ) THEN 911 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 912 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 913 ELSEIF( PRESENT(pv_r3d) ) THEN 914 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 915 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 916 ENDIF 917 ! 918 ENDIF 919 ! 1303 ELSEIF( PRESENT(pv_r1d) ) THEN 1304 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1305 CALL xios_recv_field( trim(cdvar), pv_r1d) 1306 ENDIF 1307 CALL iom_swap( TRIM(cxios_context) ) 1308 #else 1309 istop = istop + 1 1310 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1311 #endif 1312 ENDIF 1313 !some final adjustments 1314 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1315 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 1316 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 1317 1318 !--- Apply scale_factor and offset 1319 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 1320 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1321 IF( PRESENT(pv_r1d) ) THEN 1322 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1323 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1324 ELSEIF( PRESENT(pv_r2d) ) THEN 1325 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1326 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1327 ELSEIF( PRESENT(pv_r3d) ) THEN 1328 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1329 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 920 1330 ENDIF 921 1331 ! … … 1119 1529 !! INTERFACE iom_rstput 1120 1530 !!---------------------------------------------------------------------- 1121 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )1531 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1122 1532 INTEGER , INTENT(in) :: kt ! ocean time-step 1123 1533 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1126 1536 REAL(wp) , INTENT(in) :: pvar ! written field 1127 1537 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1538 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1539 LOGICAL :: llx ! local xios write flag 1128 1540 INTEGER :: ivid ! variable id 1129 IF( kiomid > 0 ) THEN 1130 IF( iom_file(kiomid)%nfid > 0 ) THEN 1131 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1132 SELECT CASE (iom_file(kiomid)%iolib) 1133 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1134 CASE DEFAULT 1135 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1136 END SELECT 1541 1542 llx = .FALSE. 1543 IF(PRESENT(ldxios)) llx = ldxios 1544 IF( llx ) THEN 1545 #ifdef key_iomput 1546 IF( kt == kwrite ) THEN 1547 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1548 CALL xios_send_field(trim(cdvar), pvar) 1549 ENDIF 1550 #endif 1551 ELSE 1552 IF( kiomid > 0 ) THEN 1553 IF( iom_file(kiomid)%nfid > 0 ) THEN 1554 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1555 SELECT CASE (iom_file(kiomid)%iolib) 1556 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1557 CASE DEFAULT 1558 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1559 END SELECT 1560 ENDIF 1137 1561 ENDIF 1138 1562 ENDIF 1139 1563 END SUBROUTINE iom_rp0d 1140 1564 1141 1142 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1565 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1143 1566 INTEGER , INTENT(in) :: kt ! ocean time-step 1144 1567 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1147 1570 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1148 1571 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1572 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1573 LOGICAL :: llx ! local xios write flag 1149 1574 INTEGER :: ivid ! variable id 1150 IF( kiomid > 0 ) THEN 1151 IF( iom_file(kiomid)%nfid > 0 ) THEN 1152 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1153 SELECT CASE (iom_file(kiomid)%iolib) 1154 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1155 CASE DEFAULT 1156 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1157 END SELECT 1575 1576 llx = .FALSE. 1577 IF(PRESENT(ldxios)) llx = ldxios 1578 IF( llx ) THEN 1579 #ifdef key_iomput 1580 IF( kt == kwrite ) THEN 1581 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1582 CALL xios_send_field(trim(cdvar), pvar) 1583 ENDIF 1584 #endif 1585 ELSE 1586 IF( kiomid > 0 ) THEN 1587 IF( iom_file(kiomid)%nfid > 0 ) THEN 1588 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1589 SELECT CASE (iom_file(kiomid)%iolib) 1590 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1591 CASE DEFAULT 1592 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1593 END SELECT 1594 ENDIF 1158 1595 ENDIF 1159 1596 ENDIF 1160 1597 END SUBROUTINE iom_rp1d 1161 1598 1162 1163 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1599 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1164 1600 INTEGER , INTENT(in) :: kt ! ocean time-step 1165 1601 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1168 1604 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1169 1605 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1606 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1607 LOGICAL :: llx 1170 1608 INTEGER :: ivid ! variable id 1171 IF( kiomid > 0 ) THEN 1172 IF( iom_file(kiomid)%nfid > 0 ) THEN 1173 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1174 SELECT CASE (iom_file(kiomid)%iolib) 1175 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1176 CASE DEFAULT 1177 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1178 END SELECT 1609 1610 llx = .FALSE. 1611 IF(PRESENT(ldxios)) llx = ldxios 1612 IF( llx ) THEN 1613 #ifdef key_iomput 1614 IF( kt == kwrite ) THEN 1615 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1616 CALL xios_send_field(trim(cdvar), pvar) 1617 ENDIF 1618 #endif 1619 ELSE 1620 IF( kiomid > 0 ) THEN 1621 IF( iom_file(kiomid)%nfid > 0 ) THEN 1622 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1623 SELECT CASE (iom_file(kiomid)%iolib) 1624 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1625 CASE DEFAULT 1626 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1627 END SELECT 1628 ENDIF 1179 1629 ENDIF 1180 1630 ENDIF 1181 1631 END SUBROUTINE iom_rp2d 1182 1632 1183 1184 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1633 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1185 1634 INTEGER , INTENT(in) :: kt ! ocean time-step 1186 1635 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1189 1638 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1190 1639 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1640 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1641 LOGICAL :: llx ! local xios write flag 1191 1642 INTEGER :: ivid ! variable id 1192 IF( kiomid > 0 ) THEN 1193 IF( iom_file(kiomid)%nfid > 0 ) THEN 1194 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1195 SELECT CASE (iom_file(kiomid)%iolib) 1196 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1197 CASE DEFAULT 1198 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1199 END SELECT 1643 1644 llx = .FALSE. 1645 IF(PRESENT(ldxios)) llx = ldxios 1646 IF( llx ) THEN 1647 #ifdef key_iomput 1648 IF( kt == kwrite ) THEN 1649 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1650 CALL xios_send_field(trim(cdvar), pvar) 1651 ENDIF 1652 #endif 1653 ELSE 1654 IF( kiomid > 0 ) THEN 1655 IF( iom_file(kiomid)%nfid > 0 ) THEN 1656 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1657 SELECT CASE (iom_file(kiomid)%iolib) 1658 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1659 CASE DEFAULT 1660 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1661 END SELECT 1662 ENDIF 1200 1663 ENDIF 1201 1664 ENDIF … … 1273 1736 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1274 1737 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1275 ENDIF1738 ENDIF 1276 1739 IF( xios_is_valid_domaingroup(cdid) ) THEN 1277 1740 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1392 1855 !!---------------------------------------------------------------------- 1393 1856 CHARACTER(LEN=*), INTENT(in) :: cdname 1394 !!---------------------------------------------------------------------- 1395 IF( xios_is_valid_context(cdname) ) THEN 1857 CHARACTER(LEN=120) :: clname 1858 !!---------------------------------------------------------------------- 1859 clname = cdname 1860 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 1861 IF( xios_is_valid_context(clname) ) THEN 1396 1862 CALL iom_swap( cdname ) ! swap to cdname context 1397 1863 CALL xios_context_finalize() ! finalize the context 1398 1864 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1399 1865 ENDIF 1866 ! 1400 1867 END SUBROUTINE iom_context_finalize 1401 1868 1402 1869 1403 SUBROUTINE set_grid( cdgrd, plon, plat )1870 SUBROUTINE set_grid( cdgrd, plon, plat, ldxios ) 1404 1871 !!---------------------------------------------------------------------- 1405 1872 !! *** ROUTINE set_grid *** … … 1413 1880 INTEGER :: ni, nj 1414 1881 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1882 LOGICAL, INTENT(IN) :: ldxios 1415 1883 !!---------------------------------------------------------------------- 1416 1884 ! … … 1423 1891 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1424 1892 ! 1425 IF ( ln_mskland ) THEN1893 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 1426 1894 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1427 1895 SELECT CASE ( cdgrd ) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r9019 r9367 39 39 INTEGER, PARAMETER, PUBLIC :: jpmax_digits = 5 !: maximum number of digits for the cpu number in the file name 40 40 41 41 42 !$AGRIF_DO_NOT_TREAT 42 43 INTEGER, PUBLIC :: iom_open_init = 0 !: used to initialize iom_file(:)%nfid to 0 44 !XIOS write restart 45 LOGICAL, PUBLIC :: lwxios !: write single file restart using XIOS 46 INTEGER, PUBLIC :: nxioso !: type of restart file when writing using XIOS 1 - single, 2 - multiple 47 !XIOS read restart 48 LOGICAL, PUBLIC :: lrxios !: read single file restart using XIOS 49 LOGICAL, PUBLIC :: lxios_sini = .FALSE. ! is restart in a single file 50 LOGICAL, PUBLIC :: lxios_set = .FALSE. 51 52 43 53 44 54 TYPE, PUBLIC :: file_descriptor … … 62 72 END TYPE file_descriptor 63 73 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files 74 INTEGER, PARAMETER, PUBLIC :: max_rst_fields = 95 !: maximum number of restart variables defined in iom_set_rst_vars 75 TYPE, PUBLIC :: RST_FIELD 76 CHARACTER(len=30) :: vname = "NO_NAME" ! names of variables in restart file 77 CHARACTER(len=30) :: grid = "NO_GRID" 78 LOGICAL :: active =.FALSE. ! for restart write only: true - write field, false do not write field 79 END TYPE RST_FIELD 64 80 !$AGRIF_END_DO_NOT_TREAT 65 81 ! 82 TYPE(RST_FIELD), PUBLIC :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields) 83 ! 66 84 !!---------------------------------------------------------------------- 67 85 !! NEMO/OPA 3.3 , NEMO Consortium (2010) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r9019 r9367 131 131 CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy ), clinfo) 132 132 ! define dimensions 133 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x' , kdompar(1,1) , idmy ), clinfo)134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y' , kdompar(2,1) , idmy ), clinfo)135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, ' z', ilevels, idmy ), clinfo)136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't ', NF90_UNLIMITED, idmy ), clinfo)133 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x' , kdompar(1,1) , idmy ), clinfo) 134 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y' , kdompar(2,1) , idmy ), clinfo) 135 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk , idmy ), clinfo) 136 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 137 137 ! global attributes 138 138 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r6140 r9367 28 28 USE iom ! I/O module 29 29 USE diurnal_bulk 30 30 31 31 IMPLICIT NONE 32 32 PRIVATE … … 61 61 CHARACTER(LEN=50) :: clname ! ocean output restart file name 62 62 CHARACTER(lc) :: clpath ! full path to ocean output restart file 63 CHARACTER(LEN=52) :: clpname ! ocean output restart file name including prefix for AGRIF 63 64 !!---------------------------------------------------------------------- 64 65 ! … … 94 95 IF(lwp) THEN 95 96 WRITE(numout,*) 96 SELECT CASE ( jprstlib ) 97 CASE DEFAULT ; WRITE(numout,*) & 98 ' open ocean restart NetCDF file: ',TRIM(clpath)//clname 99 END SELECT 100 IF ( snc4set%luse ) WRITE(numout,*) ' opened for NetCDF4 chunking and compression' 101 IF( kt == nitrst - 1 ) THEN ; WRITE(numout,*) ' kt = nitrst - 1 = ', kt 102 ELSE ; WRITE(numout,*) ' kt = ' , kt 97 IF(.NOT.lwxios) THEN 98 SELECT CASE ( jprstlib ) 99 CASE DEFAULT ; WRITE(numout,*) & 100 ' open ocean restart NetCDF file: ',TRIM(clpath)//TRIM(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 103 106 ENDIF 104 107 ENDIF 105 108 ! 106 CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 109 IF(.NOT.lwxios) THEN 110 CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 111 ELSE 112 cwxios_context = "rstw_"//TRIM(ADJUSTL(clkt)) 113 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 114 clpname = clname 115 ELSE 116 clpname = TRIM(Agrif_CFixed())//"_"//clname 117 ENDIF 118 CALL iom_init( cwxios_context, TRIM(clpath)//TRIM(clpname)) 119 CALL xios_update_calendar(nitrst) 120 CALL iom_swap( cxios_context ) 121 ENDIF 107 122 lrst_oce = .TRUE. 108 123 ENDIF … … 123 138 INTEGER, INTENT(in) :: kt ! ocean time-step 124 139 !!---------------------------------------------------------------------- 125 126 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics and tracertime step140 IF(lwxios) CALL iom_swap( cwxios_context ) 141 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt , ldxios = lwxios) ! dynamics time step 127 142 128 143 IF ( .NOT. ln_diurnal_only ) THEN 129 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub ) ! before fields130 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb )131 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem) )132 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal) )133 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb )144 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub, ldxios = lwxios ) ! before fields 145 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb, ldxios = lwxios ) 146 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem), ldxios = lwxios ) 147 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal), ldxios = lwxios ) 148 CALL iom_rstput( kt, nitrst, numrow, 'sshb' , sshb, ldxios = lwxios ) 134 149 ! 135 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields 136 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn ) 137 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem) ) 138 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal) ) 139 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn ) 140 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop ) 141 150 CALL iom_rstput( kt, nitrst, numrow, 'un' , un, ldxios = lwxios ) ! now fields 151 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn, ldxios = lwxios ) 152 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem), ldxios = lwxios ) 153 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal), ldxios = lwxios ) 154 CALL iom_rstput( kt, nitrst, numrow, 'sshn' , sshn, ldxios = lwxios ) 155 CALL iom_rstput( kt, nitrst, numrow, 'rhop' , rhop, ldxios = lwxios ) 142 156 ! extra variable needed for the ice sheet coupling 143 157 IF ( ln_iscpl ) THEN 144 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask 145 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask 146 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask 147 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask 148 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) ) ! need to compute temperature correction149 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:) ) ! need to compute bt conservation150 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:) ) ! need to compute bt conservation151 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:) ) ! need to compute extrapolation if vvl158 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask, ldxios = lwxios ) ! need to extrapolate T/S 159 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask, ldxios = lwxios ) ! need to correct barotropic velocity 160 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask, ldxios = lwxios ) ! need to correct barotropic velocity 161 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask, ldxios = lwxios) ! need to correct barotropic velocity 162 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios ) ! need to compute temperature correction 163 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation 164 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios ) ! need to compute bt conservation 165 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl 152 166 END IF 153 167 ENDIF 154 168 155 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst 156 169 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst, ldxios = lwxios ) 170 IF(lwxios) CALL iom_swap( cxios_context ) 157 171 IF( kt == nitrst ) THEN 158 CALL iom_close( numrow ) ! close the restart file (only at last time step) 172 IF(.NOT.lwxios) THEN 173 CALL iom_close( numrow ) ! close the restart file (only at last time step) 174 ELSE 175 CALL iom_context_finalize( cwxios_context ) 176 ENDIF 159 177 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 160 178 !!gm not sure what to do here ===>>> ask to Sebastian … … 164 182 nitrst = nstocklist( nrst_lst ) 165 183 ENDIF 166 lrst_oce = .FALSE.167 184 ENDIF 168 185 ! … … 193 210 WRITE(numout,*) '~~~~~~~~' 194 211 ENDIF 195 212 lxios_sini = .FALSE. 196 213 clpath = TRIM(cn_ocerst_indir) 197 214 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 198 215 CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 199 ENDIF 216 ! are we using XIOS to read the data? Part above will have to modified once XIOS 217 ! can handle checking if variable is in the restart file (there will be no need to open 218 ! restart) 219 IF(.NOT.lxios_set) lrxios = lrxios.AND.lxios_sini 220 IF( lrxios) THEN 221 crxios_context = 'nemo_rst' 222 IF( .NOT.lxios_set ) THEN 223 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 224 CALL iom_init( crxios_context ) 225 lxios_set = .TRUE. 226 ENDIF 227 ENDIF 228 IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 229 CALL iom_init( crxios_context ) 230 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 231 lxios_set = .TRUE. 232 ENDIF 233 ENDIF 234 200 235 END SUBROUTINE rst_read_open 201 236 … … 211 246 REAL(wp) :: zrdt 212 247 INTEGER :: jk 248 REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d 213 249 !!---------------------------------------------------------------------- 214 250 … … 217 253 ! Check dynamics and tracer time-step consistency and force Euler restart if changed 218 254 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 219 CALL iom_get( numror, 'rdt', zrdt )255 CALL iom_get( numror, 'rdt', zrdt, ldxios = lrxios ) 220 256 IF( zrdt /= rdt ) neuler = 0 221 257 ENDIF 222 258 223 259 ! Diurnal DSST 224 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst 260 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios ) 225 261 IF ( ln_diurnal_only ) THEN 226 262 IF(lwp) WRITE( numout, * ) & 227 263 & "rst_read:- ln_diurnal_only set, setting rhop=rau0" 228 264 rhop = rau0 229 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,1,jp_tem) ) 265 CALL iom_get( numror, jpdom_autoglo, 'tn' , w3d, ldxios = lrxios ) 266 tsn(:,:,1,jp_tem) = w3d(:,:,1) 230 267 RETURN 231 268 ENDIF 232 269 233 270 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 234 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub ) ! before fields235 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb )236 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) )237 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) )238 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb )271 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub, ldxios = lrxios ) ! before fields 272 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb, ldxios = lrxios ) 273 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem), ldxios = lrxios ) 274 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal), ldxios = lrxios ) 275 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb, ldxios = lrxios ) 239 276 ELSE 240 277 neuler = 0 241 278 ENDIF 242 279 ! 243 CALL iom_get( numror, jpdom_autoglo, 'un' , un 244 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn 245 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem) )246 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) )247 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn 280 CALL iom_get( numror, jpdom_autoglo, 'un' , un, ldxios = lrxios ) ! now fields 281 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn, ldxios = lrxios ) 282 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem), ldxios = lrxios ) 283 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal), ldxios = lrxios ) 284 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, ldxios = lrxios ) 248 285 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 249 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop 286 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop, ldxios = lrxios ) ! now potential density 250 287 ELSE 251 288 CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) ) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r9168 r9367 65 65 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 66 66 TYPE(FLD_N) :: sn_apr ! informations about the fields to be read 67 LOGICAL :: lrxios ! read restart using XIOS? 67 68 !! 68 69 NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc … … 109 110 CALL ctl_warn( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 110 111 ! 112 IF( lwxios ) THEN 113 CALL iom_set_rstw_var_active('ssh_ibb') 114 ENDIF 111 115 END SUBROUTINE sbc_apr_init 112 116 … … 152 156 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 153 157 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 154 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh158 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, ldxios = lrxios ) ! before inv. barometer ssh 155 159 ! 156 160 ELSE !* no restart: set from nit000 values … … 165 169 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 166 170 IF(lwp) WRITE(numout,*) '~~~~' 167 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 171 IF( lwxios ) CALL iom_swap( cwxios_context ) 172 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib, ldxios = lwxios ) 173 IF( lwxios ) CALL iom_swap( cxios_context ) 168 174 ENDIF 169 175 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r9168 r9367 207 207 & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 208 208 IF(lwp) WRITE(numout,*) ' nit000-1 isf tracer content forcing fields read in the restart file' 209 CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) ) ! before salt content isf_tsc trend210 CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b' , risf_tsc_b(:,:,jp_sal)) ! before salt content isf_tsc trend211 CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b' , risf_tsc_b(:,:,jp_tem)) ! before salt content isf_tsc trend209 CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) , ldxios = lrxios ) ! before salt content isf_tsc trend 210 CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b' , risf_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content isf_tsc trend 211 CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b' , risf_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before salt content isf_tsc trend 212 212 ELSE 213 213 fwfisf_b(:,:) = fwfisf(:,:) … … 221 221 & 'at it= ', kt,' date= ', ndastp 222 222 IF(lwp) WRITE(numout,*) '~~~~' 223 CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) ) 224 CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 225 CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 223 IF( lwxios ) CALL iom_swap( cwxios_context ) 224 CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) , ldxios = lwxios ) 225 CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem), ldxios = lwxios ) 226 CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal), ldxios = lwxios ) 227 IF( lwxios ) CALL iom_swap( cxios_context ) 226 228 ENDIF 227 229 ! … … 399 401 END DO 400 402 403 IF( lwxios ) THEN 404 CALL iom_set_rstw_var_active('fwf_isf_b') 405 CALL iom_set_rstw_var_active('isf_hc_b') 406 CALL iom_set_rstw_var_active('isf_sc_b') 407 ENDIF 408 409 401 410 END SUBROUTINE sbc_isf_init 402 411 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r9190 r9367 57 57 USE lib_mpp ! MPP library 58 58 USE timing ! Timing 59 60 59 USE diurnal_bulk, ONLY: ln_diurnal_only ! diurnal SST diagnostic 61 60 … … 339 338 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 340 339 ! 340 IF( lwxios ) THEN 341 CALL iom_set_rstw_var_active('utau_b') 342 CALL iom_set_rstw_var_active('vtau_b') 343 CALL iom_set_rstw_var_active('qns_b') 344 ! The 3D heat content due to qsr forcing is treated in traqsr 345 ! CALL iom_set_rstw_var_active('qsr_b') 346 CALL iom_set_rstw_var_active('emp_b') 347 CALL iom_set_rstw_var_active('sfx_b') 348 ENDIF 349 341 350 END SUBROUTINE sbc_init 342 351 … … 446 455 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 447 456 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 448 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point)449 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b ) ! before j-stress (V-point)450 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point)457 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios ) ! before i-stress (U-point) 458 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios ) ! before j-stress (V-point) 459 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios ) ! before non solar heat flux (T-point) 451 460 ! The 3D heat content due to qsr forcing is treated in traqsr 452 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point)453 CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b ) ! before freshwater flux (T-point)461 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios ) ! before solar heat flux (T-point) 462 CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b, ldxios = lrxios ) ! before freshwater flux (T-point) 454 463 ! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6 455 464 IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 456 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point)465 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b, ldxios = lrxios ) ! before salt flux (T-point) 457 466 ELSE 458 467 sfx_b (:,:) = sfx(:,:) … … 474 483 & 'at it= ', kt,' date= ', ndastp 475 484 IF(lwp) WRITE(numout,*) '~~~~' 476 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) 477 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau ) 478 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns ) 485 IF( lwxios ) CALL iom_swap( cwxios_context ) 486 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau, ldxios = lwxios ) 487 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau, ldxios = lwxios ) 488 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns, ldxios = lwxios ) 479 489 ! The 3D heat content due to qsr forcing is treated in traqsr 480 490 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 481 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 482 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 491 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp, ldxios = lwxios ) 492 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx, ldxios = lwxios ) 493 IF( lwxios ) CALL iom_swap( cxios_context ) 483 494 ENDIF 484 495 ! ! ---------------------------------------- ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r9169 r9367 146 146 IF( ln_rstart .AND. & !* Restart: read in restart file 147 147 & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 148 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file' 149 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b ) ! before runoff150 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) ) ! before heat content of runoff151 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) ) ! before salinity content of runoff148 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file', lrxios 149 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b, ldxios = lrxios ) ! before runoff 150 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content of runoff 151 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salinity content of runoff 152 152 ELSE !* no restart: set from nit000 values 153 153 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' … … 163 163 & 'at it= ', kt,' date= ', ndastp 164 164 IF(lwp) WRITE(numout,*) '~~~~' 165 CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf ) 166 CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) ) 167 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 165 IF( lwxios ) CALL iom_swap( cwxios_context ) 166 CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf, ldxios = lwxios ) 167 CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem), ldxios = lwxios ) 168 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal), ldxios = lwxios ) 169 IF( lwxios ) CALL iom_swap( cxios_context ) 168 170 ENDIF 169 171 ! … … 469 471 ENDIF 470 472 ! 473 IF( lwxios ) THEN 474 CALL iom_set_rstw_var_active('rnf_b') 475 CALL iom_set_rstw_var_active('rnf_hc_b') 476 CALL iom_set_rstw_var_active('rnf_sc_b') 477 ENDIF 478 471 479 END SUBROUTINE sbc_rnf_init 472 480 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r9019 r9367 155 155 IF(lwp) WRITE(numout,*) '~~~~~~~' 156 156 zf_sbc = REAL( nn_fsbc, wp ) 157 CALL iom_rstput( kt, nitrst, numrow, 'nn_fsbc', zf_sbc ) ! sbc frequency 158 CALL iom_rstput( kt, nitrst, numrow, 'ssu_m' , ssu_m ) ! sea surface mean fields 159 CALL iom_rstput( kt, nitrst, numrow, 'ssv_m' , ssv_m ) 160 CALL iom_rstput( kt, nitrst, numrow, 'sst_m' , sst_m ) 161 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m ) 162 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m ) 163 CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m ) 164 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m ) 165 ! 157 IF( lwxios ) CALL iom_swap( cwxios_context ) 158 CALL iom_rstput( kt, nitrst, numrow, 'nn_fsbc', zf_sbc, ldxios = lwxios ) ! sbc frequency 159 CALL iom_rstput( kt, nitrst, numrow, 'ssu_m' , ssu_m, ldxios = lwxios ) ! sea surface mean fields 160 CALL iom_rstput( kt, nitrst, numrow, 'ssv_m' , ssv_m, ldxios = lwxios ) 161 CALL iom_rstput( kt, nitrst, numrow, 'sst_m' , sst_m, ldxios = lwxios ) 162 CALL iom_rstput( kt, nitrst, numrow, 'sss_m' , sss_m, ldxios = lwxios ) 163 CALL iom_rstput( kt, nitrst, numrow, 'ssh_m' , ssh_m, ldxios = lwxios ) 164 CALL iom_rstput( kt, nitrst, numrow, 'e3t_m' , e3t_m, ldxios = lwxios ) 165 CALL iom_rstput( kt, nitrst, numrow, 'frq_m' , frq_m, ldxios = lwxios ) 166 ! 167 IF( lwxios ) CALL iom_swap( cxios_context ) 166 168 ENDIF 167 169 ! … … 206 208 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 207 209 l_ssm_mean = .TRUE. 208 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run209 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (U-point)210 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point)211 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point)212 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point)213 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point)214 CALL iom_get( numror, jpdom_autoglo, 'e3t_m' , e3t_m ) ! 1st level thickness (T-point)210 CALL iom_get( numror , 'nn_fsbc', zf_sbc, ldxios = lrxios ) ! sbc frequency of previous run 211 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m, ldxios = lrxios ) ! sea surface mean velocity (U-point) 212 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m, ldxios = lrxios ) ! " " velocity (V-point) 213 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m, ldxios = lrxios ) ! " " temperature (T-point) 214 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m, ldxios = lrxios ) ! " " salinity (T-point) 215 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m, ldxios = lrxios ) ! " " height (T-point) 216 CALL iom_get( numror, jpdom_autoglo, 'e3t_m' , e3t_m, ldxios = lrxios ) ! 1st level thickness (T-point) 215 217 ! fraction of solar net radiation absorbed in 1st T level 216 218 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 217 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m )219 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m, ldxios = lrxios ) 218 220 ELSE 219 221 frq_m(:,:) = 1._wp ! default definition … … 251 253 ENDIF 252 254 ! 255 IF( lwxios.AND.nn_fsbc > 1 ) THEN 256 CALL iom_set_rstw_var_active('nn_fsbc') 257 CALL iom_set_rstw_var_active('ssu_m') 258 CALL iom_set_rstw_var_active('ssv_m') 259 CALL iom_set_rstw_var_active('sst_m') 260 CALL iom_set_rstw_var_active('sss_m') 261 CALL iom_set_rstw_var_active('ssh_m') 262 CALL iom_set_rstw_var_active('e3t_m') 263 CALL iom_set_rstw_var_active('frq_m') 264 ENDIF 265 253 266 END SUBROUTINE sbc_ssm_init 254 267 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r9169 r9367 137 137 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file' 138 138 z1_2 = 0.5_wp 139 CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b ) ! before heat content trend due to Qsr flux139 CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios ) ! before heat content trend due to Qsr flux 140 140 ELSE ! No restart or restart not found: Euler forward time stepping 141 141 z1_2 = 1._wp … … 288 288 ! 289 289 IF( lrst_oce ) THEN ! write in the ocean restart file 290 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc ) 291 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) 290 IF( lwxios ) CALL iom_swap( cwxios_context ) 291 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc , ldxios = lwxios ) 292 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 293 IF( lwxios ) CALL iom_swap( cxios_context ) 292 294 ENDIF 293 295 ! … … 421 423 ! 1st ocean level attenuation coefficient (used in sbcssm) 422 424 IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 423 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )425 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev, ldxios = lrxios ) 424 426 ELSE 425 427 fraqsr_1lev(:,:) = 1._wp ! default : no penetration 426 428 ENDIF 427 429 ! 430 IF( lwxios ) THEN 431 CALL iom_set_rstw_var_active('qsr_hc_b') 432 CALL iom_set_rstw_var_active('fraqsr_1lev') 433 ENDIF 434 ! 428 435 END SUBROUTINE tra_qsr_init 429 436 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r9124 r9367 111 111 zfact = 0.5_wp 112 112 sbc_tsc(:,:,:) = 0._wp 113 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend114 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend113 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios ) ! before heat content sbc trend 114 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios ) ! before salt content sbc trend 115 115 ELSE ! No restart or restart not found: Euler forward time stepping 116 116 zfact = 1._wp … … 161 161 ! 162 162 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==! 163 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 164 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) ) 163 IF( lwxios ) CALL iom_swap( cwxios_context ) 164 CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), ldxios = lwxios ) 165 CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), ldxios = lwxios ) 166 IF( lwxios ) CALL iom_swap( cxios_context ) 165 167 ENDIF 166 168 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r9124 r9367 1123 1123 CALL gls_rst( nit000, 'READ' ) ! (en, avt_k, avm_k, hmxl_n) 1124 1124 ! 1125 IF( lwxios ) THEN 1126 CALL iom_set_rstw_var_active('en') 1127 CALL iom_set_rstw_var_active('avt_k') 1128 CALL iom_set_rstw_var_active('avm_k') 1129 CALL iom_set_rstw_var_active('hmxl_n') 1130 ENDIF 1131 ! 1125 1132 END SUBROUTINE zdf_gls_init 1126 1133 … … 1156 1163 ! 1157 1164 IF( MIN( id1, id2, id3, id4 ) > 0 ) THEN ! all required arrays exist 1158 CALL iom_get( numror, jpdom_autoglo, 'en' , en )1159 CALL iom_get( numror, jpdom_autoglo, 'avt_k' , avt_k )1160 CALL iom_get( numror, jpdom_autoglo, 'avm_k' , avm_k )1161 CALL iom_get( numror, jpdom_autoglo, 'hmxl_n', hmxl_n )1165 CALL iom_get( numror, jpdom_autoglo, 'en' , en , ldxios = lrxios ) 1166 CALL iom_get( numror, jpdom_autoglo, 'avt_k' , avt_k , ldxios = lrxios ) 1167 CALL iom_get( numror, jpdom_autoglo, 'avm_k' , avm_k , ldxios = lrxios ) 1168 CALL iom_get( numror, jpdom_autoglo, 'hmxl_n', hmxl_n, ldxios = lrxios ) 1162 1169 ELSE 1163 1170 IF(lwp) WRITE(numout,*) … … 1178 1185 ! ! ------------------- 1179 1186 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1180 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1181 CALL iom_rstput( kt, nitrst, numrow, 'avt_k' , avt_k ) 1182 CALL iom_rstput( kt, nitrst, numrow, 'avm_k' , avm_k ) 1183 CALL iom_rstput( kt, nitrst, numrow, 'hmxl_n', hmxl_n ) 1187 IF( lwxios ) CALL iom_swap( cwxios_context ) 1188 CALL iom_rstput( kt, nitrst, numrow, 'en' , en , ldxios = lwxios ) 1189 CALL iom_rstput( kt, nitrst, numrow, 'avt_k' , avt_k , ldxios = lwxios ) 1190 CALL iom_rstput( kt, nitrst, numrow, 'avm_k' , avm_k , ldxios = lwxios ) 1191 CALL iom_rstput( kt, nitrst, numrow, 'hmxl_n', hmxl_n, ldxios = lwxios ) 1192 IF( lwxios ) CALL iom_swap( cxios_context ) 1184 1193 ! 1185 1194 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfosm.F90
r9190 r9367 1509 1509 ghamv(:,:,:) = 0. 1510 1510 ! 1511 IF( lwxios ) THEN 1512 CALL iom_set_rstw_var_active('wn') 1513 CALL iom_set_rstw_var_active('hbl') 1514 CALL iom_set_rstw_var_active('hbli') 1515 ENDIF 1511 1516 END SUBROUTINE zdf_osm_init 1512 1517 … … 1540 1545 id1 = iom_varid( numror, 'wn' , ldstop = .FALSE. ) 1541 1546 IF( id1 > 0 ) THEN ! 'wn' exists; read 1542 CALL iom_get( numror, jpdom_autoglo, 'wn', wn )1547 CALL iom_get( numror, jpdom_autoglo, 'wn', wn, ldxios = lrxios ) 1543 1548 WRITE(numout,*) ' ===>>>> : wn read from restart file' 1544 1549 ELSE … … 1549 1554 id2 = iom_varid( numror, 'hbli' , ldstop = .FALSE. ) 1550 1555 IF( id1 > 0 .AND. id2 > 0) THEN ! 'hbl' exists; read and return 1551 CALL iom_get( numror, jpdom_autoglo, 'hbl' , hbl)1552 CALL iom_get( numror, jpdom_autoglo, 'hbli', hbli )1556 CALL iom_get( numror, jpdom_autoglo, 'hbl' , hbl , ldxios = lrxios ) 1557 CALL iom_get( numror, jpdom_autoglo, 'hbli', hbli, ldxios = lrxios ) 1553 1558 WRITE(numout,*) ' ===>>>> : hbl & hbli read from restart file' 1554 1559 RETURN … … 1563 1568 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbli into the restart file, then return 1564 1569 IF(lwp) WRITE(numout,*) '---- osm-rst ----' 1565 CALL iom_rstput( kt, nitrst, numrow, 'wn' , wn)1566 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl)1567 CALL iom_rstput( kt, nitrst, numrow, 'hbli' , hbli 1570 CALL iom_rstput( kt, nitrst, numrow, 'wn' , wn , ldxios = lwxios ) 1571 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl , ldxios = lwxios ) 1572 CALL iom_rstput( kt, nitrst, numrow, 'hbli' , hbli, ldxios = lwxios ) 1568 1573 RETURN 1569 1574 END IF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90
r9104 r9367 105 105 CALL ric_rst( nit000, 'READ' ) !* read or initialize all required files 106 106 ! 107 IF( lwxios ) THEN 108 CALL iom_set_rstw_var_active('avt_k') 109 CALL iom_set_rstw_var_active('avm_k') 110 ENDIF 107 111 END SUBROUTINE zdf_ric_init 108 112 … … 222 226 ! 223 227 IF( MIN( id1, id2 ) > 0 ) THEN ! restart exists => read it 224 CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k )225 CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k )228 CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k, ldxios = lrxios ) 229 CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k, ldxios = lrxios ) 226 230 ENDIF 227 231 ENDIF … … 231 235 ! ! ------------------- 232 236 IF(lwp) WRITE(numout,*) '---- ric-rst ----' 233 CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k ) 234 CALL iom_rstput( kt, nitrst, numrow, 'avm_k', avm_k ) 237 IF( lwxios ) CALL iom_swap( cwxios_context ) 238 CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k, ldxios = lwxios ) 239 CALL iom_rstput( kt, nitrst, numrow, 'avm_k', avm_k, ldxios = lwxios) 240 IF( lwxios ) CALL iom_swap( cxios_context ) 235 241 ! 236 242 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r9190 r9367 732 732 CALL tke_rst( nit000, 'READ' ) ! (en, avt_k, avm_k, dissl) 733 733 ! 734 IF( lwxios ) THEN 735 CALL iom_set_rstw_var_active('en') 736 CALL iom_set_rstw_var_active('avt_k') 737 CALL iom_set_rstw_var_active('avm_k') 738 CALL iom_set_rstw_var_active('dissl') 739 ENDIF 734 740 END SUBROUTINE zdf_tke_init 735 741 … … 763 769 ! 764 770 IF( MIN( id1, id2, id3, id4 ) > 0 ) THEN ! fields exist 765 CALL iom_get( numror, jpdom_autoglo, 'en' , en )766 CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k )767 CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k )768 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl )771 CALL iom_get( numror, jpdom_autoglo, 'en' , en , ldxios = lrxios ) 772 CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k, ldxios = lrxios ) 773 CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k, ldxios = lrxios ) 774 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl, ldxios = lrxios ) 769 775 ELSE ! start TKE from rest 770 776 IF(lwp) WRITE(numout,*) … … 785 791 ! ! ------------------- 786 792 IF(lwp) WRITE(numout,*) '---- tke_rst ----' 787 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 788 CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k ) 789 CALL iom_rstput( kt, nitrst, numrow, 'avm_k', avm_k ) 790 CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl ) 793 IF( lwxios ) CALL iom_swap( cwxios_context ) 794 CALL iom_rstput( kt, nitrst, numrow, 'en' , en , ldxios = lwxios ) 795 CALL iom_rstput( kt, nitrst, numrow, 'avt_k', avt_k, ldxios = lwxios ) 796 CALL iom_rstput( kt, nitrst, numrow, 'avm_k', avm_k, ldxios = lwxios ) 797 CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl, ldxios = lwxios ) 798 IF( lwxios ) CALL iom_swap( cxios_context ) 791 799 ! 792 800 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r9213 r9367 431 431 IF( ln_timing ) CALL timing_start( 'nemo_init') 432 432 ! 433 CALL phy_cst ! Physical constants434 CALL eos_init ! Equation of state435 IF( lk_c1d ) CALL c1d_init ! 1D column configuration436 CALL wad_init ! Wetting and drying options437 CALL dom_init 438 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization439 IF( ln_ctl ) CALL prt_ctl_init ! Print control433 CALL phy_cst ! Physical constants 434 CALL eos_init ! Equation of state 435 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 436 CALL wad_init ! Wetting and drying options 437 CALL dom_init("OPA") ! Domain 438 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 439 IF( ln_ctl ) CALL prt_ctl_init ! Print control 440 440 441 441 CALL diurnal_sst_bulk_init ! diurnal sst -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/step.F90
r9250 r9367 327 327 IF( kstp == nitend .OR. indic < 0 ) THEN 328 328 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 329 IF(lrxios) CALL iom_context_finalize( crxios_context ) 329 330 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 330 331 ENDIF -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90
r9169 r9367 300 300 CALL phy_cst ! Physical constants 301 301 CALL eos_init ! Equation of state 302 CALL dom_init 302 CALL dom_init('SAO') ! Domain 303 303 304 304 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r9124 r9367 30 30 USE in_out_manager ! I/O manager 31 31 USE prtctl ! Print control 32 USE iom ! 32 USE iom ! I/O manager 33 33 USE timing ! Timing 34 34 USE restart ! restart … … 142 142 ! call day to set the calendar parameters at the begining of the current simulaton. needed by iom_init 143 143 CALL day( nit000 ) 144 IF( lwxios ) THEN 145 CALL iom_set_rstw_var_active('kt') 146 CALL iom_set_rstw_var_active('ndastp') 147 CALL iom_set_rstw_var_active('adatrj') 148 CALL iom_set_rstw_var_active('ntime') 149 ENDIF 144 150 ! 145 151 END SUBROUTINE day_init … … 318 324 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 319 325 ! Get Calendar informations 320 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run326 CALL iom_get( numror, 'kt', zkt, ldxios = lrxios ) ! last time-step of previous run 321 327 IF(lwp) THEN 322 328 WRITE(numout,*) ' *** Info read in restart : ' … … 337 343 IF ( nrstdt == 2 ) THEN 338 344 ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 339 CALL iom_get( numror, 'ndastp', zndastp )345 CALL iom_get( numror, 'ndastp', zndastp, ldxios = lrxios ) 340 346 ndastp = NINT( zndastp ) 341 CALL iom_get( numror, 'adatrj', adatrj )342 CALL iom_get( numror, 'ntime' , ktime)347 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios ) 348 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios ) 343 349 nn_time0=INT(ktime) 344 350 ! calculate start time in hours and minutes … … 399 405 ENDIF 400 406 ! calendar control 401 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 402 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 403 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since 407 IF( lwxios ) CALL iom_swap( cwxios_context ) 408 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) , ldxios = lwxios ) ! time-step 409 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) , ldxios = lwxios ) ! date 410 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj , ldxios = lwxios ) ! number of elapsed days since 404 411 ! ! the begining of the run [s] 405 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp) ) ! time 412 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp), ldxios = lwxios ) ! time 413 IF( lwxios ) CALL iom_swap( cxios_context ) 406 414 ENDIF 407 415 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r9267 r9367 381 381 CALL phy_cst ! Physical constants 382 382 CALL eos_init ! Equation of seawater 383 CALL dom_init 383 CALL dom_init('SAS') ! Domain 384 384 IF( ln_ctl ) CALL prt_ctl_init ! Print control 385 385 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/SAS_SRC/step.F90
r9019 r9367 122 122 123 123 #if defined key_iomput 124 IF( kstp == nitend .OR. indic < 0 ) THEN 124 IF( kstp == nitrst ) THEN 125 IF(.NOT.lwxios) THEN 126 CALL iom_close( numrow ) 127 ELSE 128 CALL iom_context_finalize( cwxios_context ) 129 ENDIF 130 lrst_oce = .FALSE. 131 ENDIF 132 IF( kstp == nitend .OR. indic < 0 ) THEN 125 133 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 126 134 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.