Changeset 14815
- Timestamp:
- 2021-05-07T18:21:45+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU
- Files:
-
- 3 edited
-
DIA_GPU.fcm (modified) (1 diff)
-
MY_SRC/diahsb.F90 (modified) (1 diff)
-
MY_SRC/diahsb_gpu.h90 (modified) (18 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU/DIA_GPU.fcm
r14091 r14815 1 bld::tool::fppkeys key_si3 key_top key_ iomputkey_mpp_mpi key_gpu1 bld::tool::fppkeys key_si3 key_top key_xios key_mpp_mpi key_gpu -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU/MY_SRC/diahsb.F90
r14792 r14815 333 333 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 334 334 ENDIF 335 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini ) 335 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini ) ! ice sheet coupling 336 336 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini ) 337 337 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini ) -
NEMO/branches/2021/dev_r13747_HPC-11_mcastril_HPDAonline_DiagGPU/tests/DIA_GPU/MY_SRC/diahsb_gpu.h90
r14091 r14815 1 1 MODULE diahsb 2 2 !!====================================================================== 3 !! *** MODULE diahsb***3 !! *** MODULE diahsb *** 4 4 !! Ocean diagnostics: Heat, salt and volume budgets 5 5 !!====================================================================== 6 !! History : 3.3 ! 2010-09 (M. Leclair)Original code7 !! ! 2012-10 (C. Rousset)add iom_put6 !! History : 3.3 ! 2010-09 (M. Leclair) Original code 7 !! ! 2012-10 (C. Rousset) add iom_put 8 8 !!---------------------------------------------------------------------- 9 9 10 10 !!---------------------------------------------------------------------- 11 !! dia_hsb: Diagnose the conservation of ocean heat and salt contents, and volume12 !! dia_hsb_rst: Read or write DIA file in restart file13 !! dia_hsb_init: Initialization of the conservation diagnostic11 !! dia_hsb : Diagnose the conservation of ocean heat and salt contents, and volume 12 !! dia_hsb_rst : Read or write DIA file in restart file 13 !! dia_hsb_init : Initialization of the conservation diagnostic 14 14 !!---------------------------------------------------------------------- 15 USE oce ! ocean dynamics and tracers16 USE dom_oce ! ocean space and time domain17 USE phycst ! physical constants18 USE sbc_oce ! surface thermohaline fluxes19 USE isf_oce ! ice shelf fluxes20 USE sbcrnf ! river runoff21 USE domvvl ! vertical scale factors22 USE traqsr ! penetrative solar radiation23 USE trabbc ! bottom boundary condition24 USE trabbc ! bottom boundary condition25 USE restart ! ocean restart15 USE oce ! ocean dynamics and tracers 16 USE dom_oce ! ocean space and time domain 17 USE phycst ! physical constants 18 USE sbc_oce ! surface thermohaline fluxes 19 USE isf_oce ! ice shelf fluxes 20 USE sbcrnf ! river runoff 21 USE domvvl ! vertical scale factors 22 USE traqsr ! penetrative solar radiation 23 USE trabbc ! bottom boundary condition 24 USE trabbc ! bottom boundary condition 25 USE restart ! ocean restart 26 26 USE bdy_oce , ONLY : ln_bdy 27 27 ! 28 USE iom ! I/O manager28 USE iom ! I/O manager 29 29 USE in_out_manager ! I/O manager 30 31 USE gpu_manager ! GPU manager 32 USE cudafor ! CUDA toolkit libs 33 USE cuda_fortran ! CUDA routines 34 !USE nvtx ! CUDA profiling/DEGUG tools 35 36 USE lib_fortran ! glob_sum 37 USE lib_mpp ! distributed memory computing library 38 USE timing ! preformance summary 30 USE gpu_manager ! GPU manager 31 USE cudafor ! CUDA toolkit libs 32 USE cuda_fortran ! CUDA routines 33 !USE nvtx ! CUDA profiling/DEGUG tools 34 USE lib_fortran ! glob_sum 35 USE lib_mpp ! distributed memory computing library 36 USE timing ! preformance summary 39 37 40 38 IMPLICIT NONE 41 39 PRIVATE 42 40 43 PUBLIC dia_hsb ! routine called by step.F90 44 PUBLIC dia_hsb_init ! routine called by nemogcm.F90 45 46 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets 47 48 REAL(wp) :: surf_tot ! ocean surface 49 50 51 52 41 PUBLIC dia_hsb ! routine called by step.F90 42 PUBLIC dia_hsb_init ! routine called by nemogcm.F90 43 44 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets 45 46 REAL(wp) :: surf_tot ! ocean surface 53 47 REAL(wp) , DIMENSION(2), SAVE :: frc_t, frc_s, frc_v ! global forcing trends 54 48 REAL(wp) , DIMENSION(2), SAVE :: frc_wn_t, frc_wn_s ! global forcing trends 55 56 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 57 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini ! 58 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini ! 59 60 61 49 ! 50 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf 51 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: surf_ini , ssh_ini ! 52 REAL(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini ! 62 53 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, PINNED :: hc_loc_ini, sc_loc_ini ! 63 54 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: e3t_ini ! 64 55 REAL(wp), DIMENSION(:) , ALLOCATABLE, PINNED, SAVE :: h_ztmpv, h_ztmph, h_ztmps, h_ztmp ! 65 66 56 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_ini 67 57 68 58 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 59 !Device data associate to PUBLIC arrays 60 REAL(8), DIMENSION(:,:,:,:) , ALLOCATABLE, DEVICE :: d_e3t ! 61 REAL(8), DIMENSION(:,:,:) , ALLOCATABLE, DEVICE :: d_tmask ! 62 REAL(8), DIMENSION(:,:) , ALLOCATABLE, DEVICE :: d_tmask_h ! 63 REAL(8), DIMENSION(:,:,:) , ALLOCATABLE, DEVICE :: d_tmask_ini ! 64 REAL(8), DIMENSION(:,:,:,:,:), ALLOCATABLE, DEVICE :: d_ts ! 65 !Device data associate to LOCAL/DEVICE arrays 66 REAL(8), DEVICE , DIMENSION(:,:) , ALLOCATABLE :: d_surf ! 67 REAL(8), DEVICE , DIMENSION(:,:) , ALLOCATABLE :: d_surf_ini ! 68 REAL(8), DEVICE , DIMENSION(:,:,:) , ALLOCATABLE :: d_hc_loc_ini ! 69 REAL(8), DEVICE , DIMENSION(:,:,:) , ALLOCATABLE :: d_sc_loc_ini ! 70 REAL(8), DEVICE , DIMENSION(:,:,:) , ALLOCATABLE :: d_e3t_ini ! 71 REAL(8), DEVICE , DIMENSION(:,:,:) , ALLOCATABLE :: d_zwrkv, d_zwrkh, d_zwrks, d_zwrk ! 3D GPU workspace 72 REAL(8), DEVICE :: ztmpv, ztmph, ztmps, ztmp ! Device Reduction 73 ! 74 INTEGER :: globsize ! 3D workspace size 75 type(dim3) :: dimGrid, dimBlock ! cuda parameters 76 INTEGER, parameter :: nstreams = 3 ! Streams Number 77 INTEGER(kind=cuda_stream_kind) :: stream(nstreams), str ! Stream ID 78 !DEBUG 79 !REAL(8) , save , DIMENSION(:,:,:) , ALLOCATABLE :: prev_3d 80 !REAL(8) :: accum 91 81 92 82 … … 94 84 95 85 !! * Substitutions 96 !#include "domzgr_substitute.h90"86 # include "domzgr_substitute.h90" 97 87 !!---------------------------------------------------------------------- 98 88 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 104 94 SUBROUTINE dia_hsb( kt, Kbb, Kmm ) 105 95 !!--------------------------------------------------------------------------- 106 !! *** ROUTINE dia_hsb***96 !! *** ROUTINE dia_hsb *** 107 97 !! 108 98 !! ** Purpose: Compute the ocean global heat content, salt content and volume conservation 109 99 !! 110 100 !! ** Method : - Compute the deviation of heat content, salt content and volume 111 !! at the current time step from their values at nit000112 !! - Compute the contribution of forcing and remove it from these deviations101 !! at the current time step from their values at nit000 102 !! - Compute the contribution of forcing and remove it from these deviations 113 103 !! 114 104 !!--------------------------------------------------------------------------- 115 INTEGER, INTENT(in) :: kt ! ocean time-step index 116 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 117 ! 118 119 INTEGER, VALUE :: ji, jj, jk, kts ! dummy loop indice 120 INTEGER, VALUE :: localsize ! jpi * jpj * jpk 121 INTEGER :: istat ! CUDA error check 122 COMPLEX :: ctmp ! dummy complex number 105 INTEGER, INTENT(in) :: kt ! ocean time-step index 106 INTEGER, INTENT(in) :: Kbb, Kmm ! ocean time level indices 107 ! 108 INTEGER, VALUE :: ji, jj, jk, kts ! dummy loop indice 109 INTEGER, VALUE :: localsize ! jpi * jpj * jpk 110 INTEGER :: istat ! CUDA error check 111 COMPLEX :: ctmp ! dummy complex number 123 112 INTEGER(kind=cuda_stream_kind) :: str ! dummy kernel stream 124 INTEGER :: tile_n, tile_b ! tile indexe. _n now, _b before125 REAL(wp) , DIMENSION(2), SAVE :: zdiff_hc1, zdiff_sc1 ! heat and salt content variations126 REAL(wp) , DIMENSION(2), SAVE :: zdiff_hc, zdiff_sc ! - - - -127 REAL(wp) , DIMENSION(2), SAVE :: zdiff_v2 ! volume variation128 REAL(wp) , DIMENSION(2), SAVE :: zdiff_v1 ! volume variation129 REAL(wp) , DIMENSION(2), SAVE :: zerr_hc1, zerr_sc1 ! heat and salt content misfit130 REAL(wp) , DIMENSION(2), SAVE :: zvol_tot ! volume131 REAL(wp) , DIMENSION(2), SAVE :: z_frc_trd_t, z_frc_trd_s ! - -132 REAL(wp) , DIMENSION(2), SAVE :: z_frc_trd_v ! - -133 REAL(wp) , DIMENSION(2), SAVE :: z_wn_trd_t, z_wn_trd_s ! - -134 REAL(wp) , DIMENSION(2), SAVE :: z_ssh_hc, z_ssh_sc ! - -113 INTEGER :: tile_n, tile_b ! tile indexe. _n now, _b before 114 REAL(wp) , DIMENSION(2), SAVE :: zdiff_hc1, zdiff_sc1 ! heat and salt content variations 115 REAL(wp) , DIMENSION(2), SAVE :: zdiff_hc, zdiff_sc ! - - - - 116 REAL(wp) , DIMENSION(2), SAVE :: zdiff_v2 ! volume variation 117 REAL(wp) , DIMENSION(2), SAVE :: zdiff_v1 ! volume variation 118 REAL(wp) , DIMENSION(2), SAVE :: zerr_hc1, zerr_sc1 ! heat and salt content misfit 119 REAL(wp) , DIMENSION(2), SAVE :: zvol_tot ! volume 120 REAL(wp) , DIMENSION(2), SAVE :: z_frc_trd_t, z_frc_trd_s ! - - 121 REAL(wp) , DIMENSION(2), SAVE :: z_frc_trd_v ! - - 122 REAL(wp) , DIMENSION(2), SAVE :: z_wn_trd_t, z_wn_trd_s ! - - 123 REAL(wp) , DIMENSION(2), SAVE :: z_ssh_hc, z_ssh_sc ! - - 135 124 # 147 "diahsb_new.F90" 136 125 REAL(wp), DIMENSION(jpi,jpj) :: z2d0, z2d1 ! 2D workspace 137 126 REAL(wp), DIMENSION(jpi,jpj,jpkm1) :: zwrk ! 3D workspace 138 127 !!--------------------------------------------------------------------------- 139 IF( ln_timing ) CALL timing_start('dia_hsb')128 IF( ln_timing ) CALL timing_start('dia_hsb') 140 129 141 130 localsize = jpi * jpj * jpk … … 160 149 ! 1 - Trends due to forcing ! 161 150 ! ------------------------- ! 162 163 151 z_frc_trd_v(tile_n) = r1_rho0 * glob_sum( 'diahsb', - ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) * surf(:,:) )! volume fluxes 164 152 z_frc_trd_t(tile_n) = glob_sum( 'diahsb', sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 165 153 z_frc_trd_s(tile_n) = glob_sum( 'diahsb', sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 166 ! ! Add runoff heat & salt input 167 IF( ln_rnf ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) + glob_sum( 'diahsb', rnf_tsc(:,:,jp_tem) * surf(:,:) ) 168 IF( ln_rnf_sal) z_frc_trd_s(tile_n) = z_frc_trd_s(tile_n) + glob_sum( 'diahsb', rnf_tsc(:,:,jp_sal) * surf(:,:) ) ! Add ice shelf heat & salt input 169 IF( ln_isf ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) & 170 & + glob_sum( 'diahsb', ( risf_cav_tsc(:,:,jp_tem) + risf_par_tsc(:,:,jp_tem) ) * surf(:,:) ) ! Add penetrative solar radiation 171 IF( ln_traqsr ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) + r1_rho0_rcp * glob_sum( 'diahsb', qsr (:,:) * surf(:,:) ) ! Add geothermal heat flux 172 IF( ln_trabbc ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) + glob_sum( 'diahsb', qgh_trd0(:,:) * surf(:,:) ) 154 ! ! Add runoff heat & salt input 155 IF( ln_rnf ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) + glob_sum( 'diahsb', rnf_tsc(:,:,jp_tem) * surf(:,:) ) 156 IF( ln_rnf_sal) z_frc_trd_s(tile_n) = z_frc_trd_s(tile_n) + glob_sum( 'diahsb', rnf_tsc(:,:,jp_sal) * surf(:,:) ) ! Add ice shelf heat & salt input 157 ! ! Add ice shelf heat & salt input 158 IF( ln_isf ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) & 159 & + glob_sum( 'diahsb', ( risf_cav_tsc(:,:,jp_tem) + risf_par_tsc(:,:,jp_tem) ) * surf(:,:) ) ! Add penetrative solar radiation 160 ! ! Add penetrative solar radiation 161 IF( ln_traqsr ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) + r1_rho0_rcp * glob_sum( 'diahsb', qsr (:,:) * surf(:,:) ) ! Add geothermal heat flux 162 ! ! Add geothermal heat flux 163 IF( ln_trabbc ) z_frc_trd_t(tile_n) = z_frc_trd_t(tile_n) + glob_sum( 'diahsb', qgh_trd0(:,:) * surf(:,:) ) 173 164 ! 174 165 IF( ln_linssh ) THEN … … 184 175 z2d1(:,:) = surf(:,:) * ww(:,:,1) * ts(:,:,1,jp_sal,Kbb) 185 176 END IF 186 187 177 z_wn_trd_t(tile_n) = - glob_sum( 'diahsb', z2d0 ) 188 178 z_wn_trd_s(tile_n) = - glob_sum( 'diahsb', z2d1 ) 189 190 191 192 193 179 ENDIF 194 180 … … 205 191 ! ! Advection flux through fixed surface (z=0) 206 192 IF( ln_linssh ) THEN 207 frc_wn_t(tile_n) = frc_wn_t(tile_n) + z_wn_trd_t(tile_n) * rn_Dt 208 frc_wn_s(tile_n) = frc_wn_s(tile_n) + z_wn_trd_s(tile_n) * rn_Dt 209 ENDIF 193 frc_wn_t(tile_n) = frc_wn_t(tile_n) + z_wn_trd_t(tile_n) * rn_Dt 194 frc_wn_s(tile_n) = frc_wn_s(tile_n) + z_wn_trd_s(tile_n) * rn_Dt 195 ENDIF 196 210 197 ! ------------------------ ! 211 ! 2 - Content variations!198 ! 2 - Content variations ! 212 199 ! ------------------------ ! 213 200 ! glob_sum_full is needed because you keep the full interior domain to compute the sum (iscpl) 214 201 215 ! ! volume variation (calculated with ssh)202 ! ! volume variation (calculated with ssh) 216 203 217 204 zdiff_v1(tile_n) = glob_sum_full( 'diahsb', surf(:,:)*ssh(:,:,Kmm) - surf_ini(:,:)*ssh_ini(:,:) ) 218 205 219 220 221 ! ! heat & salt content variation (associated with ssh) 222 IF( ln_linssh ) THEN ! linear free surface case 223 IF( ln_isfcav ) THEN ! ISF case 206 ! ! heat & salt content variation (associated with ssh) 207 IF( ln_linssh ) THEN ! linear free surface case 208 IF( ln_isfcav ) THEN ! ISF case 224 209 DO ji = 1, jpi 225 210 DO jj = 1, jpj … … 228 213 END DO 229 214 END DO 230 ELSE ! no under ice-shelf seas215 ELSE ! no under ice-shelf seas 231 216 z2d0(:,:) = surf(:,:) * ( ts(:,:,1,jp_tem,Kmm) * ssh(:,:,Kmm) - ssh_hc_loc_ini(:,:) ) 232 217 z2d1(:,:) = surf(:,:) * ( ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) - ssh_sc_loc_ini(:,:) ) 233 218 END IF 234 235 219 z_ssh_hc(tile_n) = glob_sum_full( 'diahsb', z2d0 ) 236 220 z_ssh_sc(tile_n) = glob_sum_full( 'diahsb', z2d1 ) 237 238 239 240 241 221 ENDIF 242 222 … … 466 446 467 447 SUBROUTINE dia_hsb_rst( kt, Kmm, tile, cdrw ) 468 469 470 471 448 !!--------------------------------------------------------------------- 472 !! *** ROUTINE dia_hsb_rst***449 !! *** ROUTINE dia_hsb_rst *** 473 450 !! 474 451 !! ** Purpose : Read or write DIA file in restart file 475 452 !! 476 !! ** Method : use of IOM library453 !! ** Method : use of IOM library 477 454 !!---------------------------------------------------------------------- 478 INTEGER , INTENT(in) :: kt ! ocean time-step 479 INTEGER , INTENT(in) :: Kmm ! ocean time level index 480 481 INTEGER , INTENT(in) :: tile ! host tile 482 483 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 484 ! 485 INTEGER :: ji, jj, jk ! dummy loop indices 455 INTEGER , INTENT(in) :: kt ! ocean time-step 456 INTEGER , INTENT(in) :: Kmm ! ocean time level index 457 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 458 INTEGER , INTENT(in) :: tile ! host tile 459 ! 460 INTEGER :: ji, jj, jk ! dummy loop indices 486 461 !!---------------------------------------------------------------------- 487 462 ! 488 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise489 IF( ln_rstart ) THEN !* Read the restart file463 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 464 IF( ln_rstart ) THEN !* Read the restart file 490 465 ! 491 466 IF(lwp) WRITE(numout,*) 492 467 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : read hsb restart at it= ', kt,' date= ', ndastp 493 468 IF(lwp) WRITE(numout,*) 494 495 CALL iom_get( numror, 'frc_v', frc_v(tile), ldxios = lrxios ) 496 CALL iom_get( numror, 'frc_t', frc_t(tile), ldxios = lrxios ) 497 CALL iom_get( numror, 'frc_s', frc_s(tile), ldxios = lrxios ) 469 CALL iom_get( numror, 'frc_v', frc_v(tile) ) 470 CALL iom_get( numror, 'frc_t', frc_t(tile) ) 471 CALL iom_get( numror, 'frc_s', frc_s(tile) ) 498 472 IF( ln_linssh ) THEN 499 CALL iom_get( numror, 'frc_wn_t', frc_wn_t(tile) , ldxios = lrxios)500 CALL iom_get( numror, 'frc_wn_s', frc_wn_s(tile) , ldxios = lrxios)473 CALL iom_get( numror, 'frc_wn_t', frc_wn_t(tile) ) 474 CALL iom_get( numror, 'frc_wn_s', frc_wn_s(tile) ) 501 475 ENDIF 502 CALL iom_get( numror, jpdom_auto, 'surf_ini' , surf_ini , ldxios = lrxios) ! ice sheet coupling503 CALL iom_get( numror, jpdom_auto, 'ssh_ini' , ssh_ini , ldxios = lrxios)504 CALL iom_get( numror, jpdom_auto, 'e3t_ini' , e3t_ini , ldxios = lrxios)505 CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini , ldxios = lrxios)506 CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini , ldxios = lrxios)507 CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini , ldxios = lrxios)476 CALL iom_get( numror, jpdom_auto, 'surf_ini' , surf_ini ) ! ice sheet coupling 477 CALL iom_get( numror, jpdom_auto, 'ssh_ini' , ssh_ini ) 478 CALL iom_get( numror, jpdom_auto, 'e3t_ini' , e3t_ini ) 479 CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini ) 480 CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini ) 481 CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini ) 508 482 IF( ln_linssh ) THEN 509 CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini , ldxios = lrxios)510 CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini , ldxios = lrxios)483 CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 484 CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 511 485 ENDIF 512 486 ELSE … … 514 488 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : initialise hsb at initial state ' 515 489 IF(lwp) WRITE(numout,*) 516 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface517 ssh_ini(:,:) = ssh(:,:,Kmm) ! initial ssh490 surf_ini(:,:) = e1e2t(:,:) * tmask_i(:,:) ! initial ocean surface 491 ssh_ini(:,:) = ssh(:,:,Kmm) ! initial ssh 518 492 DO jk = 1, jpk 519 493 ! if ice sheet/oceqn coupling, need to mask ini variables here (mask could change at the next NEMO instance). 520 e3t_ini (:,:,jk) = e3t(:,:,jk,Kmm) * tmask(:,:,jk)! initial vertical scale factors521 tmask_ini (:,:,jk) = tmask(:,:,jk) ! initial mask522 hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial heat content523 sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial salt content494 e3t_ini (:,:,jk) = e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial vertical scale factors 495 tmask_ini (:,:,jk) = tmask(:,:,jk) ! initial mask 496 hc_loc_ini(:,:,jk) = ts(:,:,jk,jp_tem,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial heat content 497 sc_loc_ini(:,:,jk) = ts(:,:,jk,jp_sal,Kmm) * e3t(:,:,jk,Kmm) * tmask(:,:,jk) ! initial salt content 524 498 END DO 525 526 499 d_surf_ini = surf_ini 527 500 d_e3t_ini = e3t_ini … … 529 502 d_hc_loc_ini = hc_loc_ini 530 503 d_sc_loc_ini = sc_loc_ini 531 frc_v(tile) = 0._wp ! volume trend due to forcing 532 frc_t(tile) = 0._wp ! heat content - - - - 533 frc_s(tile) = 0._wp ! salt content - - - - 534 535 536 537 538 504 frc_v(tile) = 0._wp ! volume trend due to forcing 505 frc_t(tile) = 0._wp ! heat content - - - - 506 frc_s(tile) = 0._wp ! salt content - - - - 539 507 IF( ln_linssh ) THEN 540 508 IF( ln_isfcav ) THEN … … 549 517 ssh_sc_loc_ini(:,:) = ts(:,:,1,jp_sal,Kmm) * ssh(:,:,Kmm) ! initial salt content in ssh 550 518 END IF 551 552 519 frc_wn_t(tile) = 0._wp ! initial heat content misfit due to free surface 553 520 frc_wn_s(tile) = 0._wp ! initial salt content misfit due to free surface 554 555 556 557 558 521 ENDIF 559 522 ENDIF 560 523 ! 561 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file562 ! ! -------------------524 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file 525 ! ! ------------------- 563 526 IF(lwp) WRITE(numout,*) 564 527 IF(lwp) WRITE(numout,*) ' dia_hsb_rst : write restart at it= ', kt,' date= ', ndastp 565 528 IF(lwp) WRITE(numout,*) 566 529 ! 567 568 IF( lwxios ) CALL iom_swap( cwxios_context ) 569 CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v(tile), ldxios = lwxios ) 570 CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t(tile), ldxios = lwxios ) 571 CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s(tile), ldxios = lwxios ) 530 CALL iom_rstput( kt, nitrst, numrow, 'frc_v', frc_v(tile) ) 531 CALL iom_rstput( kt, nitrst, numrow, 'frc_t', frc_t(tile) ) 532 CALL iom_rstput( kt, nitrst, numrow, 'frc_s', frc_s(tile) ) 572 533 IF( ln_linssh ) THEN 573 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t(tile) , ldxios = lwxios)574 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s(tile) , ldxios = lwxios)534 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t(tile) ) 535 CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s(tile) ) 575 536 ENDIF 576 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini , ldxios = lwxios) ! ice sheet coupling577 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini , ldxios = lwxios)578 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini , ldxios = lwxios)579 CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini , ldxios = lwxios)580 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini , ldxios = lwxios)581 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini , ldxios = lwxios)537 CALL iom_rstput( kt, nitrst, numrow, 'surf_ini' , surf_ini ) ! ice sheet coupling 538 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini' , ssh_ini ) 539 CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini' , e3t_ini ) 540 CALL iom_rstput( kt, nitrst, numrow, 'tmask_ini' , tmask_ini ) 541 CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 542 CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 582 543 IF( ln_linssh ) THEN 583 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini , ldxios = lwxios)584 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini , ldxios = lwxios)544 CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 545 CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 585 546 ENDIF 586 IF( lwxios ) CALL iom_swap( cxios_context )587 547 ! 588 548 ENDIF … … 593 553 SUBROUTINE dia_hsb_init( Kmm ) 594 554 !!--------------------------------------------------------------------------- 595 !! *** ROUTINE dia_hsb***555 !! *** ROUTINE dia_hsb *** 596 556 !! 597 557 !! ** Purpose: Initialization for the heat salt volume budgets … … 600 560 !! 601 561 !! ** Action : - Compute initial heat content, salt content and volume 602 !! - Initialize forcing trends603 !! - Compute coefficients for conversion562 !! - Initialize forcing trends 563 !! - Compute coefficients for conversion 604 564 !!--------------------------------------------------------------------------- 605 565 INTEGER, INTENT(in) :: Kmm ! time level index 606 566 ! 607 INTEGER :: ierror, ios ! local integer 608 609 INTEGER :: i, istat ! local integer 610 567 INTEGER :: ierror, ios ! local integer 568 INTEGER :: i, istat ! local integer 611 569 !! 612 570 NAMELIST/namhsb/ ln_diahsb … … 618 576 WRITE(numout,*) '~~~~~~~~~~~~ ' 619 577 ENDIF 620 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 621 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist' ) 622 READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 623 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist' ) 624 578 READ ( numnam_ref, namhsb, IOSTAT = ios, ERR = 901) 579 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namhsb in reference namelist' ) 580 READ ( numnam_cfg, namhsb, IOSTAT = ios, ERR = 902 ) 581 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namhsb in configuration namelist' ) 625 582 IF(lwm) WRITE( numond, namhsb ) 626 583 … … 630 587 ENDIF 631 588 ! 632 IF( .NOT. ln_diahsb ) RETURN 633 634 IF(lwxios) THEN 635 ! define variables in restart file when writing with XIOS 636 CALL iom_set_rstw_var_active('frc_v') 637 CALL iom_set_rstw_var_active('frc_t') 638 CALL iom_set_rstw_var_active('frc_s') 639 CALL iom_set_rstw_var_active('surf_ini') 640 CALL iom_set_rstw_var_active('ssh_ini') 641 CALL iom_set_rstw_var_active('e3t_ini') 642 CALL iom_set_rstw_var_active('hc_loc_ini') 643 CALL iom_set_rstw_var_active('sc_loc_ini') 644 IF( ln_linssh ) THEN 645 CALL iom_set_rstw_var_active('ssh_hc_loc_ini') 646 CALL iom_set_rstw_var_active('ssh_sc_loc_ini') 647 CALL iom_set_rstw_var_active('frc_wn_t') 648 CALL iom_set_rstw_var_active('frc_wn_s') 649 ENDIF 650 ENDIF 589 IF( .NOT. ln_diahsb ) RETURN 590 651 591 ! ------------------- ! 652 592 ! 1 - Allocate memory ! … … 687 627 688 628 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), surf_ini(jpi,jpj), & 689 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), tmask_ini(jpi,jpj,jpk),STAT=ierror ) 690 629 & e3t_ini(jpi,jpj,jpk), surf(jpi,jpj), ssh_ini(jpi,jpj), tmask_ini(jpi,jpj,jpk),STAT=ierror ) 691 630 IF( ierror > 0 ) THEN 692 CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ;RETURN693 ENDIF 694 695 IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror )631 CALL ctl_stop( 'dia_hsb_init: unable to allocate hc_loc_ini' ) ; RETURN 632 ENDIF 633 634 IF( ln_linssh ) ALLOCATE( ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj),STAT=ierror ) 696 635 IF( ierror > 0 ) THEN 697 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' ) ;RETURN636 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_hc_loc_ini' ) ; RETURN 698 637 ENDIF 699 638 … … 701 640 ! 2 - Time independant variables and file opening ! 702 641 ! ----------------------------------------------- ! 703 surf(:,:) = e1e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area704 surf_tot = glob_sum( 'diahsb', surf(:,:) )! total ocean surface area642 surf(:,:) = e1e2t(:,:) * tmask_i(:,:) ! masked surface grid cell area 643 surf_tot = glob_sum( 'diahsb', surf(:,:) ) ! total ocean surface area 705 644 706 645 d_surf = surf … … 717 656 ! 4 - initial conservation variables ! 718 657 ! ---------------------------------- ! 719 720 658 CALL dia_hsb_rst( nit000, Kmm, 1, 'READ' ) !* read or initialize all required files 721 659
Note: See TracChangeset
for help on using the changeset viewer.
