Changeset 8988
- Timestamp:
- 2017-12-12T13:11:44+01:00 (5 years ago)
- Location:
- branches/2017/dev_METO_2017/NEMOGCM
- Files:
-
- 28 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_METO_2017/NEMOGCM/CONFIG/SHARED/namelist_ref
r8987 r8988 53 53 ln_clobber = .true. ! clobber (overwrite) an existing file 54 54 nn_chunksz = 0 ! chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 55 ln_xios_read = .FALSE. ! use XIOS to read restart file (only for a single file restart)56 nn_wxios = 0 ! use XIOS to write restart file 0 - no, 1 - single file output, 2 - multiple file output57 55 / 58 56 ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r8987 r8988 255 255 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 256 256 IF(lwp) WRITE(numout,*) '~~~~~~~' 257 CALL iom_get( numror, 'frc_v', frc_v, ldxios = lrxios ) 258 CALL iom_get( numror, 'frc_t', frc_t, ldxios = lrxios ) 259 CALL iom_get( numror, 'frc_s', frc_s, ldxios = lrxios ) 260 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini, ldxios = lrxios ) ! ice sheet coupling 261 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:), ldxios = lrxios ) 262 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:), ldxios = lrxios ) 263 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:), ldxios = lrxios ) 264 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:), ldxios = lrxios ) 257 CALL iom_get( numror, 'frc_v', frc_v ) 258 CALL iom_get( numror, 'frc_t', frc_t ) 259 CALL iom_get( numror, 'frc_s', frc_s ) 265 260 IF( ln_linssh ) THEN 266 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:), ldxios = lrxios ) 267 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:), ldxios = lrxios ) 268 CALL iom_get( numror, 'frc_wn_t', frc_wn_t, ldxios = lrxios ) 269 CALL iom_get( numror, 'frc_wn_s', frc_wn_s, ldxios = lrxios ) 261 CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 262 CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 263 ENDIF 264 CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 265 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 266 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 267 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 268 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 269 IF( ln_linssh ) THEN 270 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 271 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 270 272 ENDIF 271 273 ELSE … … 306 308 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 307 309 IF(lwp) WRITE(numout,*) '~~~~~~~' 308 IF( lwxios ) CALL iom_swap( cwxios_context ) 309 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v, ldxios = lwxios) 310 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t, ldxios = lwxios) 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s, ldxios = lwxios) 312 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini, ldxios = lwxios ) ! ice sheet coupling 313 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:), ldxios = lwxios ) 314 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:), ldxios = lwxios ) 315 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:), ldxios = lwxios ) 316 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:), ldxios = lwxios ) 310 311 CALL iom_rstput( kt, nitrst, numrow, 'frc_v' , frc_v ) 312 CALL iom_rstput( kt, nitrst, numrow, 'frc_t' , frc_t ) 313 CALL iom_rstput( kt, nitrst, numrow, 'frc_s' , frc_s ) 317 314 IF( ln_linssh ) THEN 318 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:), ldxios = lwxios ) 319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:), ldxios = lwxios ) 320 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t, ldxios = lwxios) 321 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s, ldxios = lwxios ) 315 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 316 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 317 ENDIF 318 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini', surf_ini ) ! ice sheet coupling 319 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini(:,:) ) 320 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini(:,:,:) ) 321 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 322 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 323 IF( ln_linssh ) THEN 324 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 325 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 322 326 ENDIF 323 327 ! 324 IF( lwxios ) CALL iom_swap( cxios_context )325 328 ENDIF 326 329 ! … … 364 367 IF( .NOT. ln_diahsb ) RETURN 365 368 366 IF(lwxios) THEN367 ! define variables in restart file when writing with XIOS368 CALL iom_set_rstw_var_active('frc_v')369 CALL iom_set_rstw_var_active('frc_t')370 CALL iom_set_rstw_var_active('frc_s')371 CALL iom_set_rstw_var_active('surf_ini')372 CALL iom_set_rstw_var_active('ssh_ini')373 CALL iom_set_rstw_var_active('e3t_ini')374 CALL iom_set_rstw_var_active('hc_loc_ini')375 CALL iom_set_rstw_var_active('sc_loc_ini')376 IF( ln_linssh ) THEN377 CALL iom_set_rstw_var_active('ssh_hc_loc_ini')378 CALL iom_set_rstw_var_active('ssh_sc_loc_ini')379 CALL iom_set_rstw_var_active('frc_wn_t')380 CALL iom_set_rstw_var_active('frc_wn_s')381 ENDIF382 ENDIF383 369 ! ------------------- ! 384 370 ! 1 - Allocate memory ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r8987 r8988 143 143 CALL day( nit000 ) 144 144 ! 145 IF( lwxios ) THEN146 ! define variables in restart file when writing with XIOS147 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 ENDIF152 153 145 END SUBROUTINE day_init 154 146 … … 326 318 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 327 319 ! Get Calendar informations 328 CALL iom_get( numror, 'kt', zkt , ldxios = lrxios) ! last time-step of previous run320 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run 329 321 IF(lwp) THEN 330 322 WRITE(numout,*) ' *** Info read in restart : ' … … 345 337 IF ( nrstdt == 2 ) THEN 346 338 ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 347 CALL iom_get( numror, 'ndastp', zndastp , ldxios = lrxios)339 CALL iom_get( numror, 'ndastp', zndastp ) 348 340 ndastp = NINT( zndastp ) 349 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios)350 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios)341 CALL iom_get( numror, 'adatrj', adatrj ) 342 CALL iom_get( numror, 'ntime', ktime ) 351 343 nn_time0=INT(ktime) 352 344 ! calculate start time in hours and minutes … … 407 399 ENDIF 408 400 ! calendar control 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 ) 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 416 406 ENDIF 417 407 ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r8987 r8988 61 61 CONTAINS 62 62 63 SUBROUTINE dom_init (cdstr)63 SUBROUTINE dom_init 64 64 !!---------------------------------------------------------------------- 65 65 !! *** ROUTINE dom_init *** … … 79 79 INTEGER :: iconf = 0 ! local integers 80 80 CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))" 81 CHARACTER (len=*), INTENT(IN) :: cdstr ! model: NEMO or SAS. Determines core restart variables82 81 INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level 83 82 REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0 … … 129 128 CALL dom_glo ! global domain versus local domain 130 129 CALL dom_nam ! read namelist ( namrun, namdom ) 131 !132 IF( lwxios ) THEN133 !define names for restart write and set core output (restart.F90)134 CALL iom_set_rst_vars(rst_wfields)135 CALL iom_set_rstw_core(cdstr)136 ENDIF137 !reset namelist for SAS138 IF(cdstr == 'SAS') THEN139 IF(lrxios) THEN140 IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'141 lrxios = .FALSE.142 ENDIF143 ENDIF144 !145 130 CALL dom_clo( cn_cfg, nn_cfg ) ! Closed seas and lake 146 131 CALL dom_hgr ! Horizontal mesh … … 300 285 & nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , & 301 286 & nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , & 302 & ln_cfmeta, ln_iscpl , ln_xios_read, nn_wxios287 & ln_cfmeta, ln_iscpl 303 288 NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs 304 289 #if defined key_netcdf4 … … 308 293 !!---------------------------------------------------------------------- 309 294 ! 310 ln_xios_read = .false. ! set in case ln_xios_read is not in namelist311 nn_wxios = 0312 295 REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run 313 296 READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) … … 350 333 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 351 334 WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl 352 IF( TRIM(Agrif_CFixed()) == '0' ) THEN353 WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read354 WRITE(numout,*) ' Write restart using XIOS nn_wxios = ', nn_wxios355 ELSE356 WRITE(numout,*) " AGRIF: nn_wxios will be ingored. See setting for parent"357 WRITE(numout,*) " AGRIF: ln_xios_read will be ingored. See setting for parent"358 ENDIF359 335 ENDIF 360 336 … … 437 413 rdt = rn_rdt 438 414 439 IF( TRIM(Agrif_CFixed()) == '0' ) THEN440 lrxios = ln_xios_read.AND.ln_rstart441 !set output file type for XIOS based on NEMO namelist442 IF (nn_wxios > 0) lwxios = .TRUE.443 nxioso = nn_wxios444 ENDIF445 446 415 #if defined key_netcdf4 447 416 ! ! NetCDF 4 case ("key_netcdf4" defined) -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r8987 r8988 242 242 ENDIF 243 243 ! 244 IF(lwxios) THEN245 ! define variables in restart file when writing with XIOS246 CALL iom_set_rstw_var_active('e3t_b')247 CALL iom_set_rstw_var_active('e3t_n')248 ! ! ----------------------- !249 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases !250 ! ! ----------------------- !251 CALL iom_set_rstw_var_active('tilde_e3t_b')252 CALL iom_set_rstw_var_active('tilde_e3t_n')253 END IF254 ! ! -------------!255 IF( ln_vvl_ztilde ) THEN ! z_tilde case !256 ! ! ------------ !257 CALL iom_set_rstw_var_active('hdiv_lf')258 ENDIF259 !260 ENDIF261 262 244 IF( nn_timing == 1 ) CALL timing_stop('dom_vvl_init') 263 245 ! … … 817 799 IF( ln_rstart ) THEN !* Read the restart file 818 800 CALL rst_read_open ! open the restart file if necessary 819 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn , ldxios = lrxios)801 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn ) 820 802 ! 821 803 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) … … 828 810 ! ! --------- ! 829 811 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 830 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) , ldxios = lrxios)831 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) , ldxios = lrxios)812 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 813 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 832 814 ! needed to restart if land processor not computed 833 815 IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' … … 843 825 IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 844 826 IF(lwp) write(numout,*) 'neuler is forced to 0' 845 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) , ldxios = lrxios)827 CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 846 828 e3t_n(:,:,:) = e3t_b(:,:,:) 847 829 neuler = 0 … … 850 832 IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 851 833 IF(lwp) write(numout,*) 'neuler is forced to 0' 852 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) , ldxios = lrxios)834 CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 853 835 e3t_b(:,:,:) = e3t_n(:,:,:) 854 836 neuler = 0 … … 875 857 ! ! ----------------------- ! 876 858 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 877 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lrxios)878 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lrxios)859 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 860 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 879 861 ELSE ! one at least array is missing 880 862 tilde_e3t_b(:,:,:) = 0.0_wp … … 885 867 ! ! ------------ ! 886 868 IF( id5 > 0 ) THEN ! required array exists 887 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lrxios)869 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) ) 888 870 ELSE ! array is missing 889 871 hdiv_lf(:,:,:) = 0.0_wp … … 956 938 ! ! =================== 957 939 IF(lwp) WRITE(numout,*) '---- dom_vvl_rst ----' 958 IF( lwxios ) CALL iom_swap( cwxios_context )959 940 ! ! --------- ! 960 941 ! ! all cases ! 961 942 ! ! --------- ! 962 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) , ldxios = lwxios)963 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) , ldxios = lwxios)943 CALL iom_rstput( kt, nitrst, numrow, 'e3t_b', e3t_b(:,:,:) ) 944 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) ) 964 945 ! ! ----------------------- ! 965 946 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases ! 966 947 ! ! ----------------------- ! 967 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) , ldxios = lwxios)968 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) , ldxios = lwxios)948 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 949 CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 969 950 END IF 970 951 ! ! -------------! 971 952 IF( ln_vvl_ztilde ) THEN ! z_tilde case ! 972 953 ! ! ------------ ! 973 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) , ldxios = lwxios)954 CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) ) 974 955 ENDIF 975 956 ! 976 IF( lwxios ) CALL iom_swap( cxios_context )977 957 ENDIF 978 958 ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r8987 r8988 64 64 65 65 !! get restart variable 66 CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b , ldxios = lrxios) ! need to extrapolate T/S67 CALL iom_get( numror, jpdom_autoglo, 'umask' , zumask_b , ldxios = lrxios) ! need to correct barotropic velocity68 CALL iom_get( numror, jpdom_autoglo, 'vmask' , zvmask_b , ldxios = lrxios) ! need to correct barotropic velocity69 CALL iom_get( numror, jpdom_autoglo, 'smask' , zsmask_b , ldxios = lrxios) ! need to correct barotropic velocity70 CALL iom_get( numror, jpdom_autoglo, 'e3t_n' , ze3t_b(:,:,:) , ldxios = lrxios) ! need to compute temperature correction71 CALL iom_get( numror, jpdom_autoglo, 'e3u_n' , ze3u_b(:,:,:) , ldxios = lrxios) ! need to correct barotropic velocity72 CALL iom_get( numror, jpdom_autoglo, 'e3v_n' , ze3v_b(:,:,:) , ldxios = lrxios) ! need to correct barotropic velocity73 CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) , ldxios = lrxios) ! need to interpol vertical profile (vvl)66 CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b ) ! need to extrapolate T/S 67 CALL iom_get( numror, jpdom_autoglo, 'umask' , zumask_b ) ! need to correct barotropic velocity 68 CALL iom_get( numror, jpdom_autoglo, 'vmask' , zvmask_b ) ! need to correct barotropic velocity 69 CALL iom_get( numror, jpdom_autoglo, 'smask' , zsmask_b ) ! need to correct barotropic velocity 70 CALL iom_get( numror, jpdom_autoglo, 'e3t_n' , ze3t_b(:,:,:) ) ! need to compute temperature correction 71 CALL iom_get( numror, jpdom_autoglo, 'e3u_n' , ze3u_b(:,:,:) ) ! need to correct barotropic velocity 72 CALL iom_get( numror, jpdom_autoglo, 'e3v_n' , ze3v_b(:,:,:) ) ! need to correct barotropic velocity 73 CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 74 74 75 75 !! read namelist -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r8987 r8988 59 59 USE asminc ! Assimilation increment 60 60 #endif 61 61 62 62 63 IMPLICIT NONE … … 1309 1310 ! 1310 1311 IF( TRIM(cdrw) == 'READ' ) THEN 1311 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) , ldxios = lrxios)1312 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) , ldxios = lrxios)1312 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) ) 1313 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) ) 1313 1314 IF( .NOT.ln_bt_av ) THEN 1314 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) , ldxios = lrxios)1315 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:) , ldxios = lrxios)1316 CALL iom_get( numror, jpdom_autoglo, 'vbb_e' , vbb_e(:,:) , ldxios = lrxios)1317 CALL iom_get( numror, jpdom_autoglo, 'sshb_e' , sshb_e(:,:) , ldxios = lrxios)1318 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:) , ldxios = lrxios)1319 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:) , ldxios = lrxios)1315 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) ) 1316 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:) ) 1317 CALL iom_get( numror, jpdom_autoglo, 'vbb_e' , vbb_e(:,:) ) 1318 CALL iom_get( numror, jpdom_autoglo, 'sshb_e' , sshb_e(:,:) ) 1319 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:) ) 1320 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:) ) 1320 1321 ENDIF 1321 1322 #if defined key_agrif 1322 1323 ! Read time integrated fluxes 1323 1324 IF ( .NOT.Agrif_Root() ) THEN 1324 CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b' , ub2_i_b(:,:) , ldxios = lrxios)1325 CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b' , vb2_i_b(:,:) , ldxios = lrxios)1325 CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b' , ub2_i_b(:,:) ) 1326 CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b' , vb2_i_b(:,:) ) 1326 1327 ENDIF 1327 1328 #endif 1328 1329 ! 1329 1330 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 1330 IF( lwxios ) CALL iom_swap( cwxios_context ) 1331 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:), ldxios = lwxios ) 1332 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:), ldxios = lwxios ) 1331 CALL iom_rstput( kt, nitrst, numrow, 'ub2_b' , ub2_b (:,:) ) 1332 CALL iom_rstput( kt, nitrst, numrow, 'vb2_b' , vb2_b (:,:) ) 1333 1333 ! 1334 1334 IF (.NOT.ln_bt_av) THEN 1335 CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e' , sshbb_e(:,:) , ldxios = lwxios)1336 CALL iom_rstput( kt, nitrst, numrow, 'ubb_e' , ubb_e(:,:) , ldxios = lwxios)1337 CALL iom_rstput( kt, nitrst, numrow, 'vbb_e' , vbb_e(:,:) , ldxios = lwxios)1338 CALL iom_rstput( kt, nitrst, numrow, 'sshb_e' , sshb_e(:,:) , ldxios = lwxios)1339 CALL iom_rstput( kt, nitrst, numrow, 'ub_e' , ub_e(:,:) , ldxios = lwxios)1340 CALL iom_rstput( kt, nitrst, numrow, 'vb_e' , vb_e(:,:) , ldxios = lwxios)1335 CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e' , sshbb_e(:,:) ) 1336 CALL iom_rstput( kt, nitrst, numrow, 'ubb_e' , ubb_e(:,:) ) 1337 CALL iom_rstput( kt, nitrst, numrow, 'vbb_e' , vbb_e(:,:) ) 1338 CALL iom_rstput( kt, nitrst, numrow, 'sshb_e' , sshb_e(:,:) ) 1339 CALL iom_rstput( kt, nitrst, numrow, 'ub_e' , ub_e(:,:) ) 1340 CALL iom_rstput( kt, nitrst, numrow, 'vb_e' , vb_e(:,:) ) 1341 1341 ENDIF 1342 1342 #if defined key_agrif 1343 1343 ! Save time integrated fluxes 1344 1344 IF ( .NOT.Agrif_Root() ) THEN 1345 CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b' , ub2_i_b(:,:) , ldxios = lwxios)1346 CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b' , vb2_i_b(:,:) , ldxios = lwxios)1345 CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b' , ub2_i_b(:,:) ) 1346 CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b' , vb2_i_b(:,:) ) 1347 1347 ENDIF 1348 1348 #endif 1349 IF( lwxios ) CALL iom_swap( cxios_context )1350 1349 ENDIF 1351 1350 ! … … 1435 1434 CALL wrk_dealloc( jpi,jpj, zcu ) 1436 1435 ! 1437 IF( lwxios ) THEN1438 ! define variables in restart file when writing with XIOS1439 CALL iom_set_rstw_var_active('ub2_b')1440 CALL iom_set_rstw_var_active('vb2_b')1441 !1442 IF (.NOT.ln_bt_av) THEN1443 CALL iom_set_rstw_var_active('sshbb_e')1444 CALL iom_set_rstw_var_active('ubb_e')1445 CALL iom_set_rstw_var_active('vbb_e')1446 CALL iom_set_rstw_var_active('sshb_e')1447 CALL iom_set_rstw_var_active('ub_e')1448 CALL iom_set_rstw_var_active('vb_e')1449 ENDIF1450 #if defined key_agrif1451 ! Save time integrated fluxes1452 IF ( .NOT.Agrif_Root() ) THEN1453 CALL iom_set_rstw_var_active('ub2_i_b')1454 CALL iom_set_rstw_var_active('vb2_i_b')1455 ENDIF1456 #endif1457 ENDIF1458 1459 1436 END SUBROUTINE dyn_spg_ts_init 1460 1437 -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r8987 r8988 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 restart47 INTEGER :: nn_wxios !: write resart using xios 0 - no, 1 - single, 2 - multiple file output48 46 49 47 #if defined key_netcdf4 … … 152 150 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 153 151 CHARACTER(lc) :: cxios_context !: context name used in xios 154 CHARACTER(lc) :: crxios_context !: context name used in xios to read restart155 CHARACTER(lc) :: cwxios_context !: context name used in xios to write restart file156 152 157 153 !!---------------------------------------------------------------------- -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8987 r8988 44 44 USE ioipsl, ONLY : ju2ymds ! for calendar 45 45 USE crs ! Grid coarsening 46 USE lib_fortran47 USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal48 46 49 47 IMPLICIT NONE … … 65 63 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 66 64 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 67 PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active68 PUBLIC iom_set_rstw_var_active, iom_set_rst_vars69 65 # endif 70 66 … … 93 89 CONTAINS 94 90 95 SUBROUTINE iom_init( cdname , fname)91 SUBROUTINE iom_init( cdname ) 96 92 !!---------------------------------------------------------------------- 97 93 !! *** ROUTINE *** … … 101 97 !!---------------------------------------------------------------------- 102 98 CHARACTER(len=*), INTENT(in) :: cdname 103 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname104 99 #if defined key_iomput 105 100 106 101 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 107 102 TYPE(xios_date) :: start_date 108 CHARACTER(len= lc) :: clname103 CHARACTER(len=10) :: clname 109 104 INTEGER :: ji, jkmin 110 LOGICAL :: llrst_context ! is context related to restart111 105 ! 112 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds … … 119 113 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 120 114 CALL iom_swap( cdname ) 121 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 115 122 116 123 117 ! Calendar type is now defined in xml file … … 132 126 133 127 ! horizontal grid definition 134 IF(.NOT.llrst_context)CALL set_scalar128 CALL set_scalar 135 129 136 130 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 137 CALL set_grid( "T", glamt, gphit , .FALSE.)138 CALL set_grid( "U", glamu, gphiu , .FALSE.)139 CALL set_grid( "V", glamv, gphiv , .FALSE.)140 CALL set_grid( "W", glamt, gphit , .FALSE.)131 CALL set_grid( "T", glamt, gphit ) 132 CALL set_grid( "U", glamu, gphiu ) 133 CALL set_grid( "V", glamv, gphiv ) 134 CALL set_grid( "W", glamt, gphit ) 141 135 CALL set_grid_znl( gphit ) 142 136 ! … … 156 150 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 157 151 ! 158 CALL set_grid( "T", glamt_crs, gphit_crs , .FALSE.)159 CALL set_grid( "U", glamu_crs, gphiu_crs , .FALSE.)160 CALL set_grid( "V", glamv_crs, gphiv_crs , .FALSE.)161 CALL set_grid( "W", glamt_crs, gphit_crs , .FALSE.)152 CALL set_grid( "T", glamt_crs, gphit_crs ) 153 CALL set_grid( "U", glamu_crs, gphiu_crs ) 154 CALL set_grid( "V", glamv_crs, gphiv_crs ) 155 CALL set_grid( "W", glamt_crs, gphit_crs ) 162 156 CALL set_grid_znl( gphit_crs ) 163 157 ! 164 158 CALL dom_grid_glo ! Return to parent grid domain 165 159 ! 166 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata160 IF( ln_cfmeta ) THEN ! Add additional grid metadata 167 161 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 168 162 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) … … 177 171 178 172 ! vertical grid definition 179 IF(.NOT.llrst_context) THEN 180 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 181 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 182 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 183 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 184 185 ! Add vertical grid bounds 186 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 187 zt_bnds(2,: ) = gdept_1d(:) 188 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 189 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 190 zw_bnds(1,: ) = gdepw_1d(:) 191 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 192 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 193 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 194 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 195 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 196 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 173 CALL iom_set_axis_attr( "deptht", gdept_1d ) 174 CALL iom_set_axis_attr( "depthu", gdept_1d ) 175 CALL iom_set_axis_attr( "depthv", gdept_1d ) 176 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 177 178 ! Add vertical grid bounds 179 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 180 zt_bnds(2,: ) = gdept_1d(:) 181 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 182 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 183 zw_bnds(1,: ) = gdepw_1d(:) 184 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 185 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 186 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 187 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 188 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 189 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 197 190 198 191 199 192 # if defined key_floats 200 193 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 201 194 # endif 202 195 #if defined key_lim3 || defined key_lim2 203 196 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 204 197 #endif 205 206 207 208 ENDIF198 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 209 202 ! automatic definitions of some of the xml attributs 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 read from restart file 221 CALL iom_set_rstw_active(fname) 222 ELSE 223 CALL set_xmlatt 224 ENDIF 203 CALL set_xmlatt 225 204 226 205 ! end file definition … … 234 213 235 214 #endif 236 215 237 216 END SUBROUTINE iom_init 238 217 239 SUBROUTINE iom_set_rstw_var_active(field)240 !!---------------------------------------------------------------------241 !! *** SUBROUTINE iom_set_rstw_var_active ***242 !!243 !! ** Purpose : enable variable in restart file when writing with XIOS244 !!---------------------------------------------------------------------245 CHARACTER(len = *), INTENT(IN) :: field246 INTEGER :: i247 LOGICAL :: llis_set248 249 llis_set = .FALSE.250 251 DO i = 1, max_rst_fields252 IF(TRIM(rst_wfields(i)%vname) == field) THEN253 rst_wfields(i)%active = .TRUE.254 llis_set = .TRUE.255 EXIT256 ENDIF257 ENDDO258 !Warn if variable is not in defined in rst_wfields259 IF(.NOT.llis_set) THEN260 IF(lwp) THEN261 write(numout,cform_err)262 write(numout,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined'263 ENDIF264 nstop = nstop + 1265 ENDIF266 267 END SUBROUTINE iom_set_rstw_var_active268 269 SUBROUTINE iom_set_rstr_active()270 !!---------------------------------------------------------------------271 !! *** SUBROUTINE iom_set_rstr_active ***272 !!273 !! ** Purpose : define file name in XIOS context for reading restart file,274 !! enable variables present in restart file for reading with XIOS275 !!---------------------------------------------------------------------276 277 !sets enabled = .TRUE. for each field in restart file278 CHARACTER(len=256) :: rst_file279 TYPE(xios_field) :: field_hdl280 TYPE(xios_file) :: file_hdl281 TYPE(xios_filegroup) :: filegroup_hdl282 INTEGER :: i283 CHARACTER(lc) :: clpath284 285 clpath = TRIM(cn_ocerst_indir)286 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/'287 IF( TRIM(Agrif_CFixed()) == '0' ) THEN288 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in)289 ELSE290 rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in)291 ENDIF292 !set name of the restart file and enable available fields293 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file294 CALL xios_get_handle("file_definition", filegroup_hdl )295 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart')296 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", &297 par_access="collective", enabled=.TRUE., mode="read", &298 output_freq=xios_timestep)299 !define variables for restart context300 DO i = 1, max_rst_fields301 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN302 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN303 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname))304 SELECT CASE (TRIM(rst_rfields(i)%grid))305 CASE ("grid_N_3D")306 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &307 domain_ref="grid_N", axis_ref="deptht", operation = "instant")308 CASE ("grid_N")309 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &310 domain_ref="grid_N", operation = "instant")311 CASE ("grid_vector")312 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &313 axis_ref="deptht", operation = "instant")314 CASE ("grid_scalar")315 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), &316 scalar_ref = "grid_scalar", operation = "instant")317 END SELECT318 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file)319 ENDIF320 ENDIF321 END DO322 END SUBROUTINE iom_set_rstr_active323 324 SUBROUTINE iom_set_rstw_core(cdmdl)325 !!---------------------------------------------------------------------326 !! *** SUBROUTINE iom_set_rstw_core ***327 !!328 !! ** Purpose : set variables which are always in restart file329 !!---------------------------------------------------------------------330 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS331 332 IF(cdmdl == "OPA") THEN333 !from restart.F90334 CALL iom_set_rstw_var_active("rdt")335 IF ( .NOT. ln_diurnal_only ) THEN336 CALL iom_set_rstw_var_active('ub' )337 CALL iom_set_rstw_var_active('vb' )338 CALL iom_set_rstw_var_active('tb' )339 CALL iom_set_rstw_var_active('sb' )340 CALL iom_set_rstw_var_active('sshb')341 !342 CALL iom_set_rstw_var_active('un' )343 CALL iom_set_rstw_var_active('vn' )344 CALL iom_set_rstw_var_active('tn' )345 CALL iom_set_rstw_var_active('sn' )346 CALL iom_set_rstw_var_active('sshn')347 CALL iom_set_rstw_var_active('rhop')348 ! extra variable needed for the ice sheet coupling349 IF ( ln_iscpl ) THEN350 CALL iom_set_rstw_var_active('tmask')351 CALL iom_set_rstw_var_active('umask')352 CALL iom_set_rstw_var_active('vmask')353 CALL iom_set_rstw_var_active('smask')354 CALL iom_set_rstw_var_active('e3t_n')355 CALL iom_set_rstw_var_active('e3u_n')356 CALL iom_set_rstw_var_active('e3v_n')357 CALL iom_set_rstw_var_active('gdepw_n')358 END IF359 ENDIF360 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst')361 !from trasbc.F90362 CALL iom_set_rstw_var_active('sbc_hc_b')363 CALL iom_set_rstw_var_active('sbc_sc_b')364 ENDIF365 END SUBROUTINE iom_set_rstw_core366 367 SUBROUTINE iom_set_rst_vars(fields)368 !!---------------------------------------------------------------------369 !! *** SUBROUTINE iom_set_rstr_active ***370 !!371 !! ** Purpose : Fill array fields with the information about all372 !! possible variables and corresponding grids definition373 !! for reading/writing restart with XIOS374 !!---------------------------------------------------------------------375 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields)376 377 INTEGER :: i378 i = 0379 i = i + 1; fields(i)%vname="rdt"; fields(i)%grid="grid_scalar"380 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D"381 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D"382 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D"383 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D"384 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D"385 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D"386 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D"387 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D"388 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N"389 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N"390 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D"391 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar"392 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar"393 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar"394 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N"395 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N"396 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N"397 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N"398 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N"399 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D"400 i = i + 1; fields(i)%vname="avt"; fields(i)%grid="grid_N_3D"401 i = i + 1; fields(i)%vname="avm"; fields(i)%grid="grid_N_3D"402 i = i + 1; fields(i)%vname="avmu"; fields(i)%grid="grid_N_3D"403 i = i + 1; fields(i)%vname="avmv"; fields(i)%grid="grid_N_3D"404 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D"405 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N"406 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N"407 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D"408 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N"409 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar"410 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar"411 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar"412 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar"413 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar"414 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N"415 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D"416 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D"417 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D"418 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N"419 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N"420 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N"421 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N"422 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N"423 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N"424 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N"425 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N"426 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N"427 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N"428 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N"429 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N"430 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N"431 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N"432 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N"433 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N"434 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N"435 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N"436 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N"437 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N"438 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar"439 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N"440 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N"441 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N"442 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N"443 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N"444 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N"445 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N"446 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector"447 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector"448 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N"449 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N"450 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar"451 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar"452 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D"453 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D"454 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D"455 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D"456 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D"457 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D"458 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D"459 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D"460 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N"461 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D"462 i = i + 1; fields(i)%vname="mxln"; fields(i)%grid="grid_N_3D"463 464 IF( i-1 > max_rst_fields) THEN465 IF(lwp) write(numout,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small'466 nstop = nstop + 1467 ENDIF468 469 END SUBROUTINE iom_set_rst_vars470 471 472 SUBROUTINE iom_set_rstw_active(cdrst_file)473 !!---------------------------------------------------------------------474 !! *** SUBROUTINE iom_set_rstr_active ***475 !!476 !! ** Purpose : define file name in XIOS context for writing restart477 !! enable variables present in restart file for writing478 !!---------------------------------------------------------------------479 !sets enabled = .TRUE. for each field in restart file480 CHARACTER(len=*) :: cdrst_file481 #if defined key_iomput482 TYPE(xios_field) :: field_hdl483 TYPE(xios_file) :: file_hdl484 TYPE(xios_filegroup) :: filegroup_hdl485 INTEGER :: i486 CHARACTER(lc) :: clpath487 488 !set name of the restart file and enable available fields489 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file490 CALL xios_get_handle("file_definition", filegroup_hdl )491 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart')492 IF(nxioso.eq.1) THEN493 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,&494 mode="write", output_freq=xios_timestep)495 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode'496 ELSE497 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,&498 mode="write", output_freq=xios_timestep)499 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode'500 ENDIF501 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file))502 !defin files for restart context503 DO i = 1, max_rst_fields504 IF( rst_wfields(i)%active ) THEN505 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname))506 SELECT CASE (TRIM(rst_wfields(i)%grid))507 CASE ("grid_N_3D")508 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &509 domain_ref="grid_N", axis_ref="deptht", prec = 8, operation = "instant")510 CASE ("grid_N")511 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &512 domain_ref="grid_N", prec = 8, operation = "instant")513 CASE ("grid_vector")514 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &515 axis_ref="deptht", prec = 8, operation = "instant")516 CASE ("grid_scalar")517 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), &518 scalar_ref = "grid_scalar", prec = 8, operation = "instant")519 END SELECT520 ENDIF521 END DO522 #endif523 END SUBROUTINE iom_set_rstw_active524 525 SUBROUTINE iom_set_rst_context( )526 !!---------------------------------------------------------------------527 !! *** SUBROUTINE iom_set_rstr_active ***528 !!529 !! ** Purpose : Define domain, axis and grid for restart (read/write)530 !! context531 !!532 !!---------------------------------------------------------------------533 #if defined key_iomput534 TYPE(xios_domaingroup) :: domaingroup_hdl535 TYPE(xios_domain) :: domain_hdl536 TYPE(xios_axisgroup) :: axisgroup_hdl537 TYPE(xios_axis) :: axis_hdl538 TYPE(xios_scalar) :: scalar_hdl539 TYPE(xios_scalargroup) :: scalargroup_hdl540 541 CALL xios_get_handle("domain_definition",domaingroup_hdl)542 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N")543 CALL set_grid("N", glamt, gphit, .TRUE.)544 545 CALL xios_get_handle("axis_definition",axisgroup_hdl)546 CALL xios_add_child(axisgroup_hdl, axis_hdl, "deptht")547 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr548 ! CALL xios_set_axis_attr( "deptht", long_name="Vertical levels", unit="m", positive="down")549 CALL xios_set_axis_attr( "deptht", long_name="Vertical levels in meters", positive="down")550 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d )551 552 CALL xios_get_handle("scalar_definition", scalargroup_hdl)553 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar")554 #endif555 END SUBROUTINE iom_set_rst_context556 218 557 219 SUBROUTINE iom_swap( cdname ) … … 564 226 #if defined key_iomput 565 227 TYPE(xios_context) :: nemo_hdl 228 566 229 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 567 230 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 684 347 icnt = icnt + 1 685 348 END DO 686 ELSE687 lxios_sini = .TRUE.688 349 ENDIF 689 350 IF( llwrt ) THEN … … 869 530 !! INTERFACE iom_get 870 531 !!---------------------------------------------------------------------- 871 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime , ldxios)532 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime ) 872 533 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 873 534 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 874 535 REAL(wp) , INTENT( out) :: pvar ! read field 875 536 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 876 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart877 537 ! 878 538 INTEGER :: idvar ! variable id … … 882 542 CHARACTER(LEN=100) :: clname ! file name 883 543 CHARACTER(LEN=1) :: cldmspc ! 884 LOGICAL :: llxios 885 ! 886 llxios = .FALSE. 887 IF( PRESENT(ldxios) ) llxios = ldxios 888 889 IF(.NOT.llxios) THEN ! read data using default library 890 itime = 1 891 IF( PRESENT(ktime) ) itime = ktime 892 ! 893 clname = iom_file(kiomid)%name 894 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 895 ! 896 IF( kiomid > 0 ) THEN 897 idvar = iom_varid( kiomid, cdvar ) 898 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 899 idmspc = iom_file ( kiomid )%ndims( idvar ) 900 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 901 WRITE(cldmspc , fmt='(i1)') idmspc 902 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 903 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 904 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 905 SELECT CASE (iom_file(kiomid)%iolib) 906 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 907 CASE DEFAULT 908 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 909 END SELECT 910 ENDIF 911 ENDIF 912 ELSE 913 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 914 CALL iom_swap( TRIM(crxios_context) ) 915 CALL xios_recv_field( trim(cdvar), pvar) 916 CALL iom_swap( TRIM(cxios_context) ) 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 917 566 ENDIF 918 567 END SUBROUTINE iom_g0d 919 568 920 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount , ldxios)569 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 921 570 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 922 571 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 926 575 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 927 576 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 928 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS929 577 ! 930 578 IF( kiomid > 0 ) THEN 931 579 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 932 & ktime=ktime, kstart=kstart, kcount=kcount, & 933 & ldxios=ldxios ) 580 & ktime=ktime, kstart=kstart, kcount=kcount ) 934 581 ENDIF 935 582 END SUBROUTINE iom_g1d 936 583 937 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr , ldxios)584 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 938 585 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 939 586 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 947 594 ! called open_ocean_jstart to set the start 948 595 ! value for the 2nd dimension (netcdf only) 949 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS950 596 ! 951 597 IF( kiomid > 0 ) THEN 952 598 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 953 599 & ktime=ktime, kstart=kstart, kcount=kcount, & 954 & lrowattr=lrowattr , ldxios=ldxios)600 & lrowattr=lrowattr ) 955 601 ENDIF 956 602 END SUBROUTINE iom_g2d 957 603 958 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr , ldxios)604 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr ) 959 605 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 960 606 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 968 614 ! called open_ocean_jstart to set the start 969 615 ! value for the 2nd dimension (netcdf only) 970 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS971 616 ! 972 617 IF( kiomid > 0 ) THEN 973 618 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 974 619 & ktime=ktime, kstart=kstart, kcount=kcount, & 975 & lrowattr=lrowattr , ldxios=ldxios)620 & lrowattr=lrowattr ) 976 621 ENDIF 977 622 END SUBROUTINE iom_g3d … … 981 626 & pv_r1d, pv_r2d, pv_r3d, & 982 627 & ktime , kstart, kcount, & 983 & lrowattr , ldxios)628 & lrowattr ) 984 629 !!----------------------------------------------------------------------- 985 630 !! *** ROUTINE iom_get_123d *** … … 1002 647 ! called open_ocean_jstart to set the start 1003 648 ! value for the 2nd dimension (netcdf only) 1004 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1005 ! 1006 LOGICAL :: llxios ! local definition for XIOS read 649 ! 1007 650 LOGICAL :: llnoov ! local definition to read overlap 1008 651 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 1031 674 !--------------------------------------------------------------------- 1032 675 ! 1033 REAL(wp) :: gma, gmi 1034 llxios = .FALSE. 1035 if(PRESENT(ldxios)) llxios = ldxios 1036 idvar = iom_varid( kiomid, cdvar ) 676 clname = iom_file(kiomid)%name ! esier to read 677 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 678 ! local definition of the domain ? 1037 679 idom = kdom 1038 1039 IF(.NOT.llxios) THEN 1040 clname = iom_file(kiomid)%name ! esier to read 1041 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 1042 ! local definition of the domain ? 1043 ! do we read the overlap 1044 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 1045 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 1046 ! check kcount and kstart optionals parameters... 1047 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1048 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1049 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 680 ! do we read the overlap 681 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 682 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 683 ! check kcount and kstart optionals parameters... 684 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 685 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 686 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 1050 687 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 1051 688 … … 1064 701 ENDIF 1065 702 1066 ! Search for the variable in the data base (eventually actualize data) 1067 istop = nstop 1068 ! 1069 IF( idvar > 0 ) THEN 1070 ! to write iom_file(kiomid)%dimsz in a shorter way ! 1071 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 1072 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 1073 idmspc = inbdim ! number of spatial dimensions in the file 1074 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 1075 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1076 ! 1077 ! update idom definition... 1078 ! Identify the domain in case of jpdom_auto(glo/dta) definition 1079 IF( idom == jpdom_autoglo_xy ) THEN 1080 ll_depth_spec = .TRUE. 1081 idom = jpdom_autoglo 1082 ELSE 1083 ll_depth_spec = .FALSE. 1084 ENDIF 1085 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 1086 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 1087 ELSE ; idom = jpdom_data 1088 ENDIF 1089 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 1090 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 1091 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 1092 ENDIF 1093 ! Identify the domain in case of jpdom_local definition 1094 IF( idom == jpdom_local ) THEN 1095 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 1096 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 1097 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 1098 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 1099 ENDIF 1100 ENDIF 1101 ! 1102 ! check the consistency between input array and data rank in the file 1103 ! 1104 ! initializations 1105 itime = 1 1106 IF( PRESENT(ktime) ) itime = ktime 1107 1108 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 1109 WRITE(clrankpv, fmt='(i1)') irankpv 1110 WRITE(cldmspc , fmt='(i1)') idmspc 1111 ! 1112 IF( idmspc < irankpv ) THEN 1113 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 703 ! Search for the variable in the data base (eventually actualize data) 704 istop = nstop 705 idvar = iom_varid( kiomid, cdvar ) 706 ! 707 IF( idvar > 0 ) THEN 708 ! to write iom_file(kiomid)%dimsz in a shorter way ! 709 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 710 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 711 idmspc = inbdim ! number of spatial dimensions in the file 712 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 713 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 714 ! 715 ! update idom definition... 716 ! Identify the domain in case of jpdom_auto(glo/dta) definition 717 IF( idom == jpdom_autoglo_xy ) THEN 718 ll_depth_spec = .TRUE. 719 idom = jpdom_autoglo 720 ELSE 721 ll_depth_spec = .FALSE. 722 ENDIF 723 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 724 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 725 ELSE ; idom = jpdom_data 726 ENDIF 727 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 728 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 729 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 730 ENDIF 731 ! Identify the domain in case of jpdom_local definition 732 IF( idom == jpdom_local ) THEN 733 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 734 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 735 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 736 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 737 ENDIF 738 ENDIF 739 ! 740 ! check the consistency between input array and data rank in the file 741 ! 742 ! initializations 743 itime = 1 744 IF( PRESENT(ktime) ) itime = ktime 745 746 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 747 WRITE(clrankpv, fmt='(i1)') irankpv 748 WRITE(cldmspc , fmt='(i1)') idmspc 749 ! 750 IF( idmspc < irankpv ) THEN 751 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1114 752 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1115 1116 753 ELSEIF( idmspc == irankpv ) THEN 754 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 1117 755 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 1118 1119 1120 756 ELSEIF( idmspc > irankpv ) THEN 757 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 758 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 1121 759 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1122 760 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1123 1124 1125 761 idmspc = idmspc - 1 762 ELSE 763 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 1126 764 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 1127 765 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1128 1129 1130 1131 1132 1133 1134 1135 1136 766 ENDIF 767 ENDIF 768 769 ! 770 ! definition of istart and icnt 771 ! 772 icnt (:) = 1 773 istart(:) = 1 774 istart(idmspc+1) = itime 1137 775 1138 776 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN … … 1155 793 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1156 794 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1157 795 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 1158 796 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 1159 797 ! JMM + SM: ugly patch before getting the new version of lib_mpp) … … 1172 810 ENDIF 1173 811 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186 1187 1188 1189 1190 1191 1192 1193 812 ! check that istart and icnt can be used with this file 813 !- 814 DO jl = 1, jpmax_dims 815 itmp = istart(jl)+icnt(jl)-1 816 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 817 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 818 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 819 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 820 ENDIF 821 END DO 822 823 ! check that icnt matches the input array 824 !- 825 IF( idom == jpdom_unknown ) THEN 826 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 827 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 828 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 829 ctmp1 = 'd' 830 ELSE 831 IF( irankpv == 2 ) THEN 1194 832 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1195 833 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 1196 1197 1198 1199 1200 834 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 835 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 836 ENDIF 837 ENDIF 838 IF( irankpv == 3 ) THEN 1201 839 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1202 840 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 1203 1204 1205 1206 1207 841 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 842 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 843 ENDIF 844 ENDIF 845 ENDIF 1208 846 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 847 DO jl = 1, irankpv 848 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 849 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 850 END DO 851 852 ENDIF 853 854 ! read the data 855 !- 856 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 857 ! 858 ! find the right index of the array to be read 1221 859 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1222 860 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1223 861 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1224 862 ! ENDIF 1225 1226 1227 1228 1229 1230 1231 1232 1233 863 IF( llnoov ) THEN 864 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 865 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 866 ENDIF 867 ELSE 868 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 869 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 870 ENDIF 871 ENDIF 1234 872 1235 873 SELECT CASE (iom_file(kiomid)%iolib) … … 1240 878 END SELECT 1241 879 1242 1243 880 IF( istop == nstop ) THEN ! no additional errors until this point... 881 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 1244 882 1245 !--- overlap areas and extra hallows (mpp) 1246 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1247 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1248 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1249 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1250 IF( icnt(3) == jpk ) THEN 1251 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1252 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1253 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1254 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1255 ENDIF 1256 ENDIF 1257 ! 1258 ELSE 1259 ! return if istop == nstop is false 1260 RETURN 1261 ENDIF 1262 ELSE 1263 ! return if statment idvar > 0 .AND. istop == nstop is false 1264 RETURN 1265 ENDIF 1266 ! 1267 ELSE ! read using XIOS. Only if KEY_IOMPUT is defined 1268 #if defined key_iomput 1269 !would be good to be able to check which context is active and swap only if current is not restart 1270 CALL iom_swap( TRIM(crxios_context) ) 1271 IF( PRESENT(pv_r3d) ) THEN 1272 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1273 CALL xios_recv_field( trim(cdvar), pv_r3d) 1274 IF(idom /= jpdom_unknown ) then 1275 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1276 ENDIF 1277 ELSEIF( PRESENT(pv_r2d) ) THEN 1278 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1279 CALL xios_recv_field( trim(cdvar), pv_r2d) 1280 IF(idom /= jpdom_unknown ) THEN 1281 CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 1282 ENDIF 1283 ELSEIF( PRESENT(pv_r1d) ) THEN 1284 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1285 CALL xios_recv_field( trim(cdvar), pv_r1d) 1286 ENDIF 1287 CALL iom_swap( TRIM(cxios_context) ) 1288 #else 1289 istop = istop + 1 1290 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1291 #endif 1292 ENDIF 1293 !some final adjustments 1294 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1295 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 1296 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 1297 1298 !--- Apply scale_factor and offset 1299 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 1300 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1301 IF( PRESENT(pv_r1d) ) THEN 1302 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1303 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1304 ELSEIF( PRESENT(pv_r2d) ) THEN 1305 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1306 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1307 ELSEIF( PRESENT(pv_r3d) ) THEN 1308 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1309 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1310 ENDIF 883 !--- overlap areas and extra hallows (mpp) 884 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 885 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 886 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 887 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 888 IF( icnt(3) == jpk ) THEN 889 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 890 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 891 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 892 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 893 ENDIF 894 ENDIF 895 896 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 897 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 898 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 899 900 !--- Apply scale_factor and offset 901 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 902 zofs = iom_file(kiomid)%ofs(idvar) ! offset 903 IF( PRESENT(pv_r1d) ) THEN 904 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 905 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 906 ELSEIF( PRESENT(pv_r2d) ) THEN 907 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 908 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 909 ELSEIF( PRESENT(pv_r3d) ) THEN 910 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 911 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 912 ENDIF 913 ! 914 ENDIF 915 ! 916 ENDIF 917 ! 1311 918 END SUBROUTINE iom_get_123d 1312 919 … … 1508 1115 !! INTERFACE iom_rstput 1509 1116 !!---------------------------------------------------------------------- 1510 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1117 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1511 1118 INTEGER , INTENT(in) :: kt ! ocean time-step 1512 1119 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1515 1122 REAL(wp) , INTENT(in) :: pvar ! written field 1516 1123 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1517 LOGICAL, OPTIONAL :: ldxios ! xios write flag1518 LOGICAL :: llx ! local xios write flag1519 1124 INTEGER :: ivid ! variable id 1520 1521 llx = .FALSE. 1522 IF(PRESENT(ldxios)) llx = ldxios 1523 IF( llx ) THEN 1524 #ifdef key_iomput 1525 IF( kt == kwrite ) THEN 1526 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1527 CALL xios_send_field(trim(cdvar), pvar) 1528 ENDIF 1529 #endif 1530 ELSE 1531 IF( kiomid > 0 ) THEN 1532 IF( iom_file(kiomid)%nfid > 0 ) THEN 1533 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1534 SELECT CASE (iom_file(kiomid)%iolib) 1535 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1536 CASE DEFAULT 1537 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1538 END SELECT 1539 ENDIF 1125 IF( kiomid > 0 ) THEN 1126 IF( iom_file(kiomid)%nfid > 0 ) THEN 1127 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1128 SELECT CASE (iom_file(kiomid)%iolib) 1129 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1130 CASE DEFAULT 1131 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1132 END SELECT 1540 1133 ENDIF 1541 1134 ENDIF 1542 1135 END SUBROUTINE iom_rp0d 1543 1136 1544 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1137 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1545 1138 INTEGER , INTENT(in) :: kt ! ocean time-step 1546 1139 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1549 1142 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1550 1143 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1551 LOGICAL, OPTIONAL :: ldxios ! xios write flag1552 LOGICAL :: llx ! local xios write flag1553 1144 INTEGER :: ivid ! variable id 1554 1555 llx = .FALSE. 1556 IF(PRESENT(ldxios)) llx = ldxios 1557 IF( llx ) THEN 1558 #ifdef key_iomput 1559 IF( kt == kwrite ) THEN 1560 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1561 CALL xios_send_field(trim(cdvar), pvar) 1562 ENDIF 1563 #endif 1564 ELSE 1565 IF( kiomid > 0 ) THEN 1566 IF( iom_file(kiomid)%nfid > 0 ) THEN 1567 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1568 SELECT CASE (iom_file(kiomid)%iolib) 1569 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1570 CASE DEFAULT 1571 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1572 END SELECT 1573 ENDIF 1145 IF( kiomid > 0 ) THEN 1146 IF( iom_file(kiomid)%nfid > 0 ) THEN 1147 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1148 SELECT CASE (iom_file(kiomid)%iolib) 1149 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1150 CASE DEFAULT 1151 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1152 END SELECT 1574 1153 ENDIF 1575 1154 ENDIF 1576 1155 END SUBROUTINE iom_rp1d 1577 1156 1578 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1157 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1579 1158 INTEGER , INTENT(in) :: kt ! ocean time-step 1580 1159 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1583 1162 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1584 1163 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1585 LOGICAL, OPTIONAL :: ldxios ! xios write flag1586 LOGICAL :: llx1587 1164 INTEGER :: ivid ! variable id 1588 1589 llx = .FALSE. 1590 IF(PRESENT(ldxios)) llx = ldxios 1591 IF( llx ) THEN 1592 #ifdef key_iomput 1593 IF( kt == kwrite ) THEN 1594 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1595 CALL xios_send_field(trim(cdvar), pvar) 1596 ENDIF 1597 #endif 1598 ELSE 1599 IF( kiomid > 0 ) THEN 1600 IF( iom_file(kiomid)%nfid > 0 ) THEN 1601 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1602 SELECT CASE (iom_file(kiomid)%iolib) 1603 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1604 CASE DEFAULT 1605 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1606 END SELECT 1607 ENDIF 1165 IF( kiomid > 0 ) THEN 1166 IF( iom_file(kiomid)%nfid > 0 ) THEN 1167 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1168 SELECT CASE (iom_file(kiomid)%iolib) 1169 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1170 CASE DEFAULT 1171 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1172 END SELECT 1608 1173 ENDIF 1609 1174 ENDIF 1610 1175 END SUBROUTINE iom_rp2d 1611 1176 1612 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype , ldxios)1177 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1613 1178 INTEGER , INTENT(in) :: kt ! ocean time-step 1614 1179 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1617 1182 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1618 1183 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1619 LOGICAL, OPTIONAL :: ldxios ! xios write flag1620 LOGICAL :: llx ! local xios write flag1621 1184 INTEGER :: ivid ! variable id 1622 1623 llx = .FALSE. 1624 IF(PRESENT(ldxios)) llx = ldxios 1625 IF( llx ) THEN 1626 #ifdef key_iomput 1627 IF( kt == kwrite ) THEN 1628 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1629 CALL xios_send_field(trim(cdvar), pvar) 1630 ENDIF 1631 #endif 1632 ELSE 1633 IF( kiomid > 0 ) THEN 1634 IF( iom_file(kiomid)%nfid > 0 ) THEN 1635 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1636 SELECT CASE (iom_file(kiomid)%iolib) 1637 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1638 CASE DEFAULT 1639 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1640 END SELECT 1641 ENDIF 1185 IF( kiomid > 0 ) THEN 1186 IF( iom_file(kiomid)%nfid > 0 ) THEN 1187 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1188 SELECT CASE (iom_file(kiomid)%iolib) 1189 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1190 CASE DEFAULT 1191 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1192 END SELECT 1642 1193 ENDIF 1643 1194 ENDIF … … 1711 1262 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1712 1263 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1713 1264 ENDIF 1714 1265 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1715 1266 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1817 1368 SUBROUTINE iom_context_finalize( cdname ) 1818 1369 CHARACTER(LEN=*), INTENT(in) :: cdname 1819 CHARACTER(LEN=120) :: clname 1820 ! 1821 clname = cdname 1822 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 1823 1824 IF( xios_is_valid_context(clname) ) THEN 1370 ! 1371 IF( xios_is_valid_context(cdname) ) THEN 1825 1372 CALL iom_swap( cdname ) ! swap to cdname context 1826 1373 CALL xios_context_finalize() ! finalize the context … … 1831 1378 1832 1379 1833 SUBROUTINE set_grid( cdgrd, plon, plat , ldxios)1380 SUBROUTINE set_grid( cdgrd, plon, plat ) 1834 1381 !!---------------------------------------------------------------------- 1835 1382 !! *** ROUTINE set_grid *** … … 1844 1391 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1845 1392 INTEGER :: ni,nj 1846 LOGICAL, INTENT(IN) :: ldxios1847 1393 1848 1394 ni=nlei-nldi+1 ; nj=nlej-nldj+1 … … 1850 1396 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1851 1397 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1852 if(.NOT.ldxios)CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &1398 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & 1853 1399 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1854 1400 1855 IF ( ln_mskland .AND.(.NOT.ldxios)) THEN1401 IF ( ln_mskland ) THEN 1856 1402 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1857 1403 SELECT CASE ( cdgrd ) … … 1893 1439 ! Offset of coordinate representing bottom-left corner 1894 1440 SELECT CASE ( TRIM(cdgrd) ) 1895 CASE ('T', 'W' , 'N')1441 CASE ('T', 'W') 1896 1442 icnr = -1 ; jcnr = -1 1897 1443 CASE ('U') -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r8987 r8988 44 44 INTEGER, PARAMETER, PUBLIC :: jpmax_digits = 5 !: maximum number of digits for the cpu number in the file name 45 45 46 47 46 !$AGRIF_DO_NOT_TREAT 48 47 INTEGER, PUBLIC :: iom_open_init = 0 !: used to initialize iom_file(:)%nfid to 0 49 !XIOS write restart50 LOGICAL, PUBLIC :: lwxios !: write single file restart using XIOS51 INTEGER, PUBLIC :: nxioso !: type of restart file when writing using XIOS 1 - single, 2 - multiple52 !XIOS read restart53 LOGICAL, PUBLIC :: lrxios !: read single file restart using XIOS54 LOGICAL, PUBLIC :: lxios_sini = .FALSE. ! is restart in a single file55 LOGICAL, PUBLIC :: lxios_set = .FALSE.56 57 58 48 59 49 TYPE, PUBLIC :: file_descriptor … … 76 66 END TYPE file_descriptor 77 67 TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC :: iom_file !: array containing the info for all opened files 78 INTEGER, PARAMETER, PUBLIC :: max_rst_fields = 95 !: maximum number of restart variables defined in iom_set_rst_vars79 TYPE, PUBLIC :: RST_FIELD80 CHARACTER(len=30) :: vname = "NO_NAME" ! names of variables in restart file81 CHARACTER(len=30) :: grid = "NO_GRID"82 LOGICAL :: active =.FALSE. ! for restart write only: true - write field, false do not write field83 END TYPE RST_FIELD84 68 !$AGRIF_END_DO_NOT_TREAT 85 86 TYPE(RST_FIELD), PUBLIC :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields)87 69 88 70 !!===================================================================== -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r8987 r8988 126 126 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1) , idmy ), clinfo) 127 127 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1) , idmy ), clinfo) 128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, ' nav_lev', jpk , idmy ), clinfo)129 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't ime_counter', NF90_UNLIMITED, idmy ), clinfo)128 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk , idmy ), clinfo) 129 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo) 130 130 ! global attributes 131 131 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r8987 r8988 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 AGRIF64 63 !!---------------------------------------------------------------------- 65 64 ! … … 95 94 IF(lwp) THEN 96 95 WRITE(numout,*) 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 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 106 103 ENDIF 107 104 ENDIF 108 105 ! 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 106 CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 122 107 lrst_oce = .TRUE. 123 108 ENDIF … … 138 123 INTEGER, INTENT(in) :: kt ! ocean time-step 139 124 !!---------------------------------------------------------------------- 140 IF(lwxios) CALL iom_swap( cwxios_context ) 141 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt , ldxios = lwxios) ! dynamicstime step125 126 CALL iom_rstput( kt, nitrst, numrow, 'rdt' , rdt ) ! dynamics and tracer time step 142 127 143 128 IF ( .NOT. ln_diurnal_only ) THEN 144 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub , ldxios = lwxios) ! before fields145 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)129 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub ) ! before fields 130 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 ) 149 134 ! 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 ) 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 156 142 ! extra variable needed for the ice sheet coupling 157 143 IF ( ln_iscpl ) THEN 158 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask , ldxios = lwxios) ! need to extrapolate T/S159 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask , ldxios = lwxios) ! need to correct barotropic velocity160 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask , ldxios = lwxios) ! need to correct barotropic velocity161 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask , ldxios = lwxios) ! need to correct barotropic velocity162 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) , ldxios = lwxios) ! need to compute temperature correction163 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:) , ldxios = lwxios) ! need to compute bt conservation164 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:) , ldxios = lwxios) ! need to compute bt conservation165 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:) , ldxios = lwxios) ! need to compute extrapolation if vvl144 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask ) ! need to extrapolate T/S 145 CALL iom_rstput( kt, nitrst, numrow, 'umask' , umask ) ! need to correct barotropic velocity 146 CALL iom_rstput( kt, nitrst, numrow, 'vmask' , vmask ) ! need to correct barotropic velocity 147 CALL iom_rstput( kt, nitrst, numrow, 'smask' , ssmask ) ! need to correct barotropic velocity 148 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:) ) ! need to compute temperature correction 149 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:) ) ! need to compute bt conservation 150 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:) ) ! need to compute bt conservation 151 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:) ) ! need to compute extrapolation if vvl 166 152 END IF 167 153 ENDIF 168 154 169 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst , ldxios = lwxios)170 IF(lwxios) CALL iom_swap( cxios_context ) 155 IF (ln_diurnal) CALL iom_rstput( kt, nitrst, numrow, 'Dsst', x_dsst ) 156 171 157 IF( kt == nitrst ) THEN 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 158 CALL iom_close( numrow ) ! close the restart file (only at last time step) 177 159 !!gm IF( .NOT. lk_trdmld ) lrst_oce = .FALSE. 178 160 !!gm not sure what to do here ===>>> ask to Sebastian … … 182 164 nitrst = nstocklist( nrst_lst ) 183 165 ENDIF 166 lrst_oce = .FALSE. 184 167 ENDIF 185 168 ! … … 210 193 WRITE(numout,*) '~~~~~~~~' 211 194 ENDIF 212 lxios_sini = .FALSE. 195 213 196 clpath = TRIM(cn_ocerst_indir) 214 197 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 215 198 CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 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 199 ENDIF 235 200 END SUBROUTINE rst_read_open 236 201 … … 246 211 REAL(wp) :: zrdt 247 212 INTEGER :: jk 248 REAL(wp), DIMENSION(jpi, jpj, jpk) :: w3d249 213 !!---------------------------------------------------------------------- 250 214 … … 253 217 ! Check dynamics and tracer time-step consistency and force Euler restart if changed 254 218 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 255 CALL iom_get( numror, 'rdt', zrdt , ldxios = lrxios)219 CALL iom_get( numror, 'rdt', zrdt ) 256 220 IF( zrdt /= rdt ) neuler = 0 257 221 ENDIF 258 222 259 223 ! Diurnal DSST 260 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst , ldxios = lrxios)224 IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst ) 261 225 IF ( ln_diurnal_only ) THEN 262 226 IF(lwp) WRITE( numout, * ) & 263 227 & "rst_read:- ln_diurnal_only set, setting rhop=rau0" 264 228 rhop = rau0 265 CALL iom_get( numror, jpdom_autoglo, 'tn' , w3d, ldxios = lrxios ) 266 tsn(:,:,1,jp_tem) = w3d(:,:,1) 229 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,1,jp_tem) ) 267 230 RETURN 268 231 ENDIF 269 232 270 233 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 271 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub , ldxios = lrxios) ! before fields272 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)234 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub ) ! before fields 235 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 ) 276 239 ELSE 277 240 neuler = 0 278 241 ENDIF 279 242 ! 280 CALL iom_get( numror, jpdom_autoglo, 'un' , un , ldxios = lrxios) ! now fields281 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)243 CALL iom_get( numror, jpdom_autoglo, 'un' , un ) ! now fields 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 ) 285 248 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 286 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop , ldxios = lrxios) ! now potential density249 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop ) ! now potential density 287 250 ELSE 288 251 CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) ) -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r8987 r8988 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?68 67 !! 69 68 NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc … … 110 109 CALL ctl_warn( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 111 110 ! 112 IF( lwxios ) THEN113 CALL iom_set_rstw_var_active('ssh_ibb')114 ENDIF115 111 END SUBROUTINE sbc_apr_init 116 112 … … 156 152 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 157 153 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 158 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb , ldxios = lrxios) ! before inv. barometer ssh154 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 159 155 ! 160 156 ELSE !* no restart: set from nit000 values … … 169 165 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 170 166 IF(lwp) WRITE(numout,*) '~~~~' 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 ) 167 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 174 168 ENDIF 175 169 ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r8987 r8988 218 218 & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 219 219 IF(lwp) WRITE(numout,*) ' nit000-1 isf tracer content forcing fields read in the restart file' 220 CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) , ldxios = lrxios) ! before salt content isf_tsc trend221 CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) , ldxios = lrxios) ! before salt content isf_tsc trend222 CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) , ldxios = lrxios) ! before salt content isf_tsc trend220 CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) ) ! before salt content isf_tsc trend 221 CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) ) ! before salt content isf_tsc trend 222 CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) ) ! before salt content isf_tsc trend 223 223 ELSE 224 224 fwfisf_b(:,:) = fwfisf(:,:) … … 232 232 & 'at it= ', kt,' date= ', ndastp 233 233 IF(lwp) WRITE(numout,*) '~~~~' 234 IF( lwxios ) CALL iom_swap( cwxios_context ) 235 CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:), ldxios = lwxios ) 236 CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem), ldxios = lwxios ) 237 CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal), ldxios = lwxios ) 238 IF( lwxios ) CALL iom_swap( cxios_context ) 234 CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:) ) 235 CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 236 CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 239 237 ENDIF 240 238 ! … … 395 393 END DO 396 394 397 IF( lwxios ) THEN398 CALL iom_set_rstw_var_active('fwf_isf_b')399 CALL iom_set_rstw_var_active('isf_hc_b')400 CALL iom_set_rstw_var_active('isf_sc_b')401 ENDIF402 403 404 395 END SUBROUTINE sbc_isf_init 405 396 -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r8987 r8988 56 56 USE lib_mpp ! MPP library 57 57 USE timing ! Timing 58 58 59 USE diurnal_bulk, ONLY: ln_diurnal_only ! diurnal SST diagnostic 59 60 … … 355 356 IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation 356 357 ! 357 IF( lwxios ) THEN358 CALL iom_set_rstw_var_active('utau_b')359 CALL iom_set_rstw_var_active('vtau_b')360 CALL iom_set_rstw_var_active('qns_b')361 ! The 3D heat content due to qsr forcing is treated in traqsr362 ! CALL iom_set_rstw_var_active('qsr_b')363 CALL iom_set_rstw_var_active('emp_b')364 CALL iom_set_rstw_var_active('sfx_b')365 ENDIF366 367 358 END SUBROUTINE sbc_init 368 359 … … 471 462 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 472 463 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 473 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b , ldxios = lrxios) ! before i-stress (U-point)474 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b , ldxios = lrxios) ! before j-stress (V-point)475 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b , ldxios = lrxios) ! before non solar heat flux (T-point)464 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point) 465 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b ) ! before j-stress (V-point) 466 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point) 476 467 ! The 3D heat content due to qsr forcing is treated in traqsr 477 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b , ldxios = lrxios) ! before solar heat flux (T-point)478 CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b , ldxios = lrxios) ! before freshwater flux (T-point)468 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point) 469 CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b ) ! before freshwater flux (T-point) 479 470 ! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6 480 471 IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 481 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b , ldxios = lrxios) ! before salt flux (T-point)472 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point) 482 473 ELSE 483 474 sfx_b (:,:) = sfx(:,:) … … 499 490 & 'at it= ', kt,' date= ', ndastp 500 491 IF(lwp) WRITE(numout,*) '~~~~' 501 IF( lwxios ) CALL iom_swap( cwxios_context ) 502 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau, ldxios = lwxios ) 503 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau, ldxios = lwxios ) 504 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns, ldxios = lwxios ) 492 CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) 493 CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau ) 494 CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns ) 505 495 ! The 3D heat content due to qsr forcing is treated in traqsr 506 496 ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr ) 507 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp, ldxios = lwxios ) 508 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx, ldxios = lwxios ) 509 IF( lwxios ) CALL iom_swap( cxios_context ) 497 CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp ) 498 CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx ) 510 499 ENDIF 511 500 ! ! ---------------------------------------- ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r8987 r8988 148 148 IF( ln_rstart .AND. & !* Restart: read in restart file 149 149 & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 150 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file' , lrxios151 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b , ldxios = lrxios) ! before runoff152 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) , ldxios = lrxios) ! before heat content of runoff153 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) , ldxios = lrxios) ! before salinity content of runoff150 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file' 151 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b ) ! before runoff 152 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) ) ! before heat content of runoff 153 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) ) ! before salinity content of runoff 154 154 ELSE !* no restart: set from nit000 values 155 155 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' … … 165 165 & 'at it= ', kt,' date= ', ndastp 166 166 IF(lwp) WRITE(numout,*) '~~~~' 167 IF( lwxios ) CALL iom_swap( cwxios_context ) 168 CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf, ldxios = lwxios ) 169 CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem), ldxios = lwxios ) 170 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal), ldxios = lwxios ) 171 IF( lwxios ) CALL iom_swap( cxios_context ) 167 CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf ) 168 CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) ) 169 CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 172 170 ENDIF 173 171 ! … … 475 473 ENDIF 476 474 ! 477 IF( lwxios ) THEN478 CALL iom_set_rstw_var_active('rnf_b')479 CALL iom_set_rstw_var_active('rnf_hc_b')480 CALL iom_set_rstw_var_active('rnf_sc_b')481 ENDIF482 483 475 END SUBROUTINE sbc_rnf_init 484 476 -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r8987 r8988 155 155 IF(lwp) WRITE(numout,*) '~~~~~~~' 156 156 zf_sbc = REAL( nn_fsbc, wp ) 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 ) 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 ! 168 166 ENDIF 169 167 ! … … 208 206 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 209 207 l_ssm_mean = .TRUE. 210 CALL iom_get( numror , 'nn_fsbc', zf_sbc , ldxios = lrxios) ! sbc frequency of previous run211 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)208 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run 209 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) 217 215 ! fraction of solar net radiation absorbed in 1st T level 218 216 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 219 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m , ldxios = lrxios)217 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m ) 220 218 ELSE 221 219 frq_m(:,:) = 1._wp ! default definition … … 253 251 ENDIF 254 252 ! 255 IF( lwxios.AND.nn_fsbc > 1 ) THEN256 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 ENDIF265 266 253 END SUBROUTINE sbc_ssm_init 267 254 -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r8987 r8988 139 139 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field read in the restart file' 140 140 z1_2 = 0.5_wp 141 CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b , ldxios = lrxios) ! before heat content trend due to Qsr flux141 CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b ) ! before heat content trend due to Qsr flux 142 142 ELSE ! No restart or restart not found: Euler forward time stepping 143 143 z1_2 = 1._wp … … 294 294 ! 295 295 IF( lrst_oce ) THEN ! write in the ocean restart file 296 IF( lwxios ) CALL iom_swap( cwxios_context ) 297 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc, ldxios = lwxios ) 298 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, ldxios = lwxios ) 299 IF( lwxios ) CALL iom_swap( cxios_context ) 296 CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b' , qsr_hc ) 297 CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev ) 300 298 ENDIF 301 299 ! … … 432 430 ! 1st ocean level attenuation coefficient (used in sbcssm) 433 431 IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 434 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev , ldxios = lrxios)432 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev ) 435 433 ELSE 436 434 fraqsr_1lev(:,:) = 1._wp ! default : no penetration 437 435 ENDIF 438 436 ! 439 IF( lwxios ) THEN440 CALL iom_set_rstw_var_active('qsr_hc_b')441 CALL iom_set_rstw_var_active('fraqsr_1lev')442 ENDIF443 437 IF( nn_timing == 1 ) CALL timing_stop('tra_qsr_init') 444 438 ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r8987 r8988 112 112 zfact = 0.5_wp 113 113 sbc_tsc(:,:,:) = 0._wp 114 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) , ldxios = lrxios) ! before heat content sbc trend115 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) , ldxios = lrxios) ! before salt content sbc trend114 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend 115 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend 116 116 ELSE ! No restart or restart not found: Euler forward time stepping 117 117 zfact = 1._wp … … 161 161 ! 162 162 IF( lrst_oce ) THEN !== write sbc_tsc in the ocean restart file ==! 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 ) 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) ) 167 165 ENDIF 168 166 ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r8987 r8988 1140 1140 CALL gls_rst( nit000, 'READ' ) !* read or initialize all required files 1141 1141 ! 1142 IF( lwxios ) THEN1143 CALL iom_set_rstw_var_active('en')1144 CALL iom_set_rstw_var_active('avt')1145 CALL iom_set_rstw_var_active('avm')1146 CALL iom_set_rstw_var_active('avmu')1147 CALL iom_set_rstw_var_active('avmv')1148 CALL iom_set_rstw_var_active('mxln')1149 ENDIF1150 1151 1142 IF( nn_timing == 1 ) CALL timing_stop('zdf_gls_init') 1152 1143 ! … … 1184 1175 ! 1185 1176 IF( MIN( id1, id2, id3, id4, id5, id6 ) > 0 ) THEN ! all required arrays exist 1186 CALL iom_get( numror, jpdom_autoglo, 'en' , en , ldxios = lrxios)1187 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt , ldxios = lrxios)1188 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm , ldxios = lrxios)1189 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu , ldxios = lrxios)1190 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv , ldxios = lrxios)1191 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln , ldxios = lrxios)1177 CALL iom_get( numror, jpdom_autoglo, 'en' , en ) 1178 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) 1179 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm ) 1180 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu ) 1181 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 1182 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln ) 1192 1183 ELSE 1193 1184 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' … … 1209 1200 ! ! ------------------- 1210 1201 IF(lwp) WRITE(numout,*) '---- gls-rst ----' 1211 IF( lwxios ) CALL iom_swap( cwxios_context ) 1212 CALL iom_rstput( kt, nitrst, numrow, 'en' , en, ldxios = lwxios ) 1213 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k, ldxios = lwxios ) 1214 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm_k, ldxios = lwxios ) 1215 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k, ldxios = lwxios ) 1216 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k, ldxios = lwxios ) 1217 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln, ldxios = lwxios ) 1218 IF( lwxios ) CALL iom_swap( cxios_context ) 1202 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 1203 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k ) 1204 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm_k ) 1205 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 1206 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 1207 CALL iom_rstput( kt, nitrst, numrow, 'mxln' , mxln ) 1219 1208 ! 1220 1209 ENDIF -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r8987 r8988 159 159 ! file in traadv_cen2 end read here. 160 160 IF( iom_varid( numror, 'avmb', ldstop = .FALSE. ) > 0 ) THEN 161 CALL iom_get( numror, jpdom_unknown, 'avmb', avmb , ldxios = lrxios)162 CALL iom_get( numror, jpdom_unknown, 'avtb', avtb , ldxios = lrxios)161 CALL iom_get( numror, jpdom_unknown, 'avmb', avmb ) 162 CALL iom_get( numror, jpdom_unknown, 'avtb', avtb ) 163 163 ENDIF 164 164 ENDIF -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r8987 r8988 814 814 CALL tke_rst( nit000, 'READ' ) !* read or initialize all required files 815 815 ! 816 IF( lwxios ) THEN817 CALL iom_set_rstw_var_active('en')818 CALL iom_set_rstw_var_active('avt')819 CALL iom_set_rstw_var_active('avm')820 CALL iom_set_rstw_var_active('avmu')821 CALL iom_set_rstw_var_active('avmv')822 CALL iom_set_rstw_var_active('dissl')823 ENDIF824 825 816 END SUBROUTINE zdf_tke_init 826 817 … … 854 845 ! 855 846 IF( id1 > 0 ) THEN ! 'en' exists 856 CALL iom_get( numror, jpdom_autoglo, 'en', en , ldxios = lrxios)847 CALL iom_get( numror, jpdom_autoglo, 'en', en ) 857 848 IF( MIN( id2, id3, id4, id5, id6 ) > 0 ) THEN ! all required arrays exist 858 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt , ldxios = lrxios)859 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm , ldxios = lrxios)860 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu , ldxios = lrxios)861 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv , ldxios = lrxios)862 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl , ldxios = lrxios)849 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt ) 850 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm ) 851 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu ) 852 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv ) 853 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl ) 863 854 ELSE ! one at least array is missing 864 855 CALL tke_avn ! compute avt, avm, avmu, avmv and dissl (approximation) … … 889 880 ! ! ------------------- 890 881 IF(lwp) WRITE(numout,*) '---- tke-rst ----' 891 IF( lwxios ) CALL iom_swap( cwxios_context ) 892 CALL iom_rstput( kt, nitrst, numrow, 'en' , en , ldxios = lwxios ) 893 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k , ldxios = lwxios ) 894 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm_k , ldxios = lwxios ) 895 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k, ldxios = lwxios ) 896 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k, ldxios = lwxios ) 897 CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl , ldxios = lwxios ) 898 IF( lwxios ) CALL iom_swap( cxios_context ) 882 CALL iom_rstput( kt, nitrst, numrow, 'en' , en ) 883 CALL iom_rstput( kt, nitrst, numrow, 'avt' , avt_k ) 884 CALL iom_rstput( kt, nitrst, numrow, 'avm' , avm_k ) 885 CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 886 CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 887 CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl ) 899 888 ! 900 889 ENDIF -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r8987 r8988 422 422 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 423 423 CALL wad_init ! Wetting and drying options 424 CALL dom_init ("OPA")! Domain424 CALL dom_init ! Domain 425 425 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 426 426 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined) -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/step.F90
r8987 r8988 345 345 IF( kstp == nitend .OR. indic < 0 ) THEN 346 346 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 347 IF(lrxios) CALL iom_context_finalize( crxios_context )348 347 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 349 348 ENDIF -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/SAO_SRC/nemogcm.F90
r8987 r8988 271 271 CALL phy_cst ! Physical constants 272 272 CALL eos_init ! Equation of state 273 CALL dom_init ('SAO')! Domain273 CALL dom_init ! Domain 274 274 275 275 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r8987 r8988 30 30 USE in_out_manager ! I/O manager 31 31 USE prtctl ! Print control 32 USE iom ! I/O manager32 USE iom ! 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 ) THEN145 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 ENDIF150 144 ! 151 145 END SUBROUTINE day_init … … 324 318 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 325 319 ! Get Calendar informations 326 CALL iom_get( numror, 'kt', zkt , ldxios = lrxios) ! last time-step of previous run320 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run 327 321 IF(lwp) THEN 328 322 WRITE(numout,*) ' *** Info read in restart : ' … … 343 337 IF ( nrstdt == 2 ) THEN 344 338 ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 345 CALL iom_get( numror, 'ndastp', zndastp , ldxios = lrxios)339 CALL iom_get( numror, 'ndastp', zndastp ) 346 340 ndastp = NINT( zndastp ) 347 CALL iom_get( numror, 'adatrj', adatrj , ldxios = lrxios)348 CALL iom_get( numror, 'ntime' , ktime , ldxios = lrxios)341 CALL iom_get( numror, 'adatrj', adatrj ) 342 CALL iom_get( numror, 'ntime', ktime ) 349 343 nn_time0=INT(ktime) 350 344 ! calculate start time in hours and minutes … … 405 399 ENDIF 406 400 ! calendar control 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 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 411 404 ! ! the begining of the run [s] 412 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp), ldxios = lwxios ) ! time 413 IF( lwxios ) CALL iom_swap( cxios_context ) 405 CALL iom_rstput( kt, nitrst, numrow, 'ntime' , REAL( nn_time0, wp) ) ! time 414 406 ENDIF 415 407 ! -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r8987 r8988 359 359 CALL phy_cst ! Physical constants 360 360 CALL eos_init ! Equation of state 361 CALL dom_init('SAS') ! Domain 361 CALL dom_init ! Domain 362 362 363 IF( ln_nnogather ) CALL nemo_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 363 364 -
branches/2017/dev_METO_2017/NEMOGCM/NEMO/SAS_SRC/step.F90
r8987 r8988 122 122 123 123 #if defined key_iomput 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 124 IF( kstp == nitend .OR. indic < 0 ) THEN 133 125 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 134 126 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.