- Timestamp:
- 2020-07-22T16:20:32+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src
- Files:
-
- 9 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/ICE/iceistate.F90
r13295 r13334 33 33 USE fldread ! read input fields 34 34 35 # if defined key_agrif 36 USE agrif_oce 37 USE agrif_ice 38 USE agrif_ice_interp 39 # endif 35 USE agrif_oce ! initial state interpolation 36 USE agrif_ice_interp 40 37 41 38 IMPLICIT NONE … … 177 174 178 175 IF( ln_iceini ) THEN 179 ! !---------------! 180 181 IF( Agrif_Root() ) THEN 182 176 177 #if defined key_agrif 178 IF ( ( Agrif_Root() ).OR.(.NOT.ln_init_chfrpar ) ) THEN 179 #endif 180 ! !---------------! 183 181 IF( ln_iceini_file )THEN ! Read a file ! 184 182 ! !---------------! … … 376 374 t1_ice(:,:,:) = t_i (:,:,1,:) 377 375 ! 378 379 #if defined key_agrif 376 #if defined key_agrif 380 377 ELSE 381 382 Agrif_SpecialValue = -9999. 383 Agrif_UseSpecialValue = .TRUE. 384 CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 385 use_sign_north = .TRUE. 386 sign_north = -1. 387 CALL Agrif_init_variable(u_iceini_id ,procname=interp_u_ice) 388 CALL Agrif_init_variable(v_iceini_id ,procname=interp_v_ice) 389 Agrif_SpecialValue = 0._wp 390 use_sign_north = .FALSE. 391 Agrif_UseSpecialValue = .FALSE. 392 ! lbc ???? 393 ! Here we know : a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i 394 CALL ice_var_glo2eqv 395 CALL ice_var_zapsmall 396 CALL ice_var_agg(2) 397 398 ! Melt ponds 399 WHERE( a_i > epsi10 ) 400 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 401 ELSEWHERE 402 a_ip_frac(:,:,:) = 0._wp 403 END WHERE 404 WHERE( a_ip > 0._wp ) ! ??????? 405 h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 406 ELSEWHERE 407 h_ip(:,:,:) = 0._wp 408 END WHERE 409 410 tn_ice(:,:,:) = t_su(:,:,:) 411 t1_ice(:,:,:) = t_i (:,:,1,:) 378 CALL agrif_istate_ice 379 ENDIF 412 380 #endif 413 ENDIF ! Agrif_Root414 381 ENDIF ! ln_iceini 415 382 ! -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/ICE/icerst.F90
r13286 r13334 25 25 USE lib_mpp ! MPP library 26 26 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 27 28 USE agrif_oce ! initial state interpolation 29 USE agrif_ice_interp 27 30 28 31 IMPLICIT NONE … … 185 188 ENDIF 186 189 187 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 188 189 ! test if v_i exists 190 id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. ) 191 192 ! ! ------------------------------ ! 193 IF( id0 > 0 ) THEN ! == case of a normal restart == ! 194 ! ! ------------------------------ ! 190 #if defined key_agrif 191 IF( (.NOT.Agrif_Root()).AND.ln_init_chfrpar ) THEN 192 ! ! -------------------------------- ! 193 ! ! == set ice fields from parent == ! 194 ! ! -------------------------------- ! 195 ! 196 CALL agrif_istate_ice 197 ! 198 ELSE 199 #endif 200 201 CALL iom_open ( TRIM(cn_icerst_indir)//'/'//cn_icerst_in, numrir ) 202 203 ! test if v_i exists 204 id0 = iom_varid( numrir, 'v_i' , ldstop = .FALSE. ) 205 206 ! ! ------------------------------ ! 207 IF( id0 > 0 ) THEN ! == case of a normal restart == ! 208 ! ! ------------------------------ ! 195 209 196 ! Time info 197 CALL iom_get( numrir, 'nn_fsbc', zfice ) 198 CALL iom_get( numrir, 'kt_ice' , ziter ) 199 IF(lwp) WRITE(numout,*) ' read ice restart file at time step : ', ziter 200 IF(lwp) WRITE(numout,*) ' in any case we force it to nit000 - 1 : ', nit000 - 1 201 202 ! Control of date 203 IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 ) & 204 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart', & 205 & ' verify the file or rerun with the value 0 for the', & 206 & ' control of time parameter nrstdt' ) 207 IF( NINT(zfice) /= nn_fsbc .AND. ABS( nrstdt ) == 1 ) & 208 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart', & 209 & ' verify the file or rerun with the value 0 for the', & 210 & ' control of time parameter nrstdt' ) 211 212 ! --- mandatory fields --- ! 213 CALL iom_get( numrir, jpdom_auto, 'v_i' , v_i ) 214 CALL iom_get( numrir, jpdom_auto, 'v_s' , v_s ) 215 CALL iom_get( numrir, jpdom_auto, 'sv_i' , sv_i ) 216 CALL iom_get( numrir, jpdom_auto, 'a_i' , a_i ) 217 CALL iom_get( numrir, jpdom_auto, 't_su' , t_su ) 218 CALL iom_get( numrir, jpdom_auto, 'u_ice', u_ice, cd_type = 'U', psgn = -1._wp ) 219 CALL iom_get( numrir, jpdom_auto, 'v_ice', v_ice, cd_type = 'V', psgn = -1._wp ) 220 ! Snow enthalpy 221 DO jk = 1, nlay_s 222 WRITE(zchar1,'(I2.2)') jk 223 znam = 'e_s'//'_l'//zchar1 224 CALL iom_get( numrir, jpdom_auto, znam , z3d ) 225 e_s(:,:,jk,:) = z3d(:,:,:) 226 END DO 227 ! Ice enthalpy 228 DO jk = 1, nlay_i 229 WRITE(zchar1,'(I2.2)') jk 230 znam = 'e_i'//'_l'//zchar1 231 CALL iom_get( numrir, jpdom_auto, znam , z3d ) 232 e_i(:,:,jk,:) = z3d(:,:,:) 233 END DO 234 ! -- optional fields -- ! 235 ! ice age 236 id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 237 IF( id1 > 0 ) THEN ! fields exist 238 CALL iom_get( numrir, jpdom_auto, 'oa_i', oa_i ) 239 ELSE ! start from rest 240 IF(lwp) WRITE(numout,*) ' ==>> previous run without ice age output then set it to zero' 241 oa_i(:,:,:) = 0._wp 210 ! Time info 211 CALL iom_get( numrir, 'nn_fsbc', zfice ) 212 CALL iom_get( numrir, 'kt_ice' , ziter ) 213 IF(lwp) WRITE(numout,*) ' read ice restart file at time step : ', ziter 214 IF(lwp) WRITE(numout,*) ' in any case we force it to nit000 - 1 : ', nit000 - 1 215 216 ! Control of date 217 IF( ( nit000 - NINT(ziter) ) /= 1 .AND. ABS( nrstdt ) == 1 ) & 218 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nit000 in ice restart', & 219 & ' verify the file or rerun with the value 0 for the', & 220 & ' control of time parameter nrstdt' ) 221 IF( NINT(zfice) /= nn_fsbc .AND. ABS( nrstdt ) == 1 ) & 222 & CALL ctl_stop( 'ice_rst_read ===>>>> : problem with nn_fsbc in ice restart', & 223 & ' verify the file or rerun with the value 0 for the', & 224 & ' control of time parameter nrstdt' ) 225 226 ! --- mandatory fields --- ! 227 CALL iom_get( numrir, jpdom_auto, 'v_i' , v_i ) 228 CALL iom_get( numrir, jpdom_auto, 'v_s' , v_s ) 229 CALL iom_get( numrir, jpdom_auto, 'sv_i' , sv_i ) 230 CALL iom_get( numrir, jpdom_auto, 'a_i' , a_i ) 231 CALL iom_get( numrir, jpdom_auto, 't_su' , t_su ) 232 CALL iom_get( numrir, jpdom_auto, 'u_ice', u_ice, cd_type = 'U', psgn = -1._wp ) 233 CALL iom_get( numrir, jpdom_auto, 'v_ice', v_ice, cd_type = 'V', psgn = -1._wp ) 234 ! Snow enthalpy 235 DO jk = 1, nlay_s 236 WRITE(zchar1,'(I2.2)') jk 237 znam = 'e_s'//'_l'//zchar1 238 CALL iom_get( numrir, jpdom_auto, znam , z3d ) 239 e_s(:,:,jk,:) = z3d(:,:,:) 240 END DO 241 ! Ice enthalpy 242 DO jk = 1, nlay_i 243 WRITE(zchar1,'(I2.2)') jk 244 znam = 'e_i'//'_l'//zchar1 245 CALL iom_get( numrir, jpdom_auto, znam , z3d ) 246 e_i(:,:,jk,:) = z3d(:,:,:) 247 END DO 248 ! -- optional fields -- ! 249 ! ice age 250 id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 251 IF( id1 > 0 ) THEN ! fields exist 252 CALL iom_get( numrir, jpdom_auto, 'oa_i', oa_i ) 253 ELSE ! start from rest 254 IF(lwp) WRITE(numout,*) ' ==>> previous run without ice age output then set it to zero' 255 oa_i(:,:,:) = 0._wp 256 ENDIF 257 ! melt ponds 258 id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 259 IF( id2 > 0 ) THEN ! fields exist 260 CALL iom_get( numrir, jpdom_auto, 'a_ip' , a_ip ) 261 CALL iom_get( numrir, jpdom_auto, 'v_ip' , v_ip ) 262 ELSE ! start from rest 263 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it to zero' 264 a_ip(:,:,:) = 0._wp 265 v_ip(:,:,:) = 0._wp 266 ENDIF 267 ! fields needed for Met Office (Jules) coupling 268 IF( ln_cpl ) THEN 269 id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 270 id4 = iom_varid( numrir, 't1_ice' , ldstop = .FALSE. ) 271 IF( id3 > 0 .AND. id4 > 0 ) THEN ! fields exist 272 CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice ) 273 CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice ) 274 ELSE ! start from rest 275 IF(lwp) WRITE(numout,*) ' ==>> previous run without conductivity output then set it to zero' 276 cnd_ice(:,:,:) = 0._wp 277 t1_ice (:,:,:) = rt0 278 ENDIF 279 ENDIF 280 281 CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 282 283 ! ! ---------------------------------- ! 284 ELSE ! == case of a simplified restart == ! 285 ! ! ---------------------------------- ! 286 CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 287 ! 288 CALL ice_istate_init 289 CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 290 ! 291 IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 292 & CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 293 ! 242 294 ENDIF 243 ! melt ponds 244 id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 245 IF( id2 > 0 ) THEN ! fields exist 246 CALL iom_get( numrir, jpdom_auto, 'a_ip' , a_ip ) 247 CALL iom_get( numrir, jpdom_auto, 'v_ip' , v_ip ) 248 ELSE ! start from rest 249 IF(lwp) WRITE(numout,*) ' ==>> previous run without melt ponds output then set it to zero' 250 a_ip(:,:,:) = 0._wp 251 v_ip(:,:,:) = 0._wp 252 ENDIF 253 ! fields needed for Met Office (Jules) coupling 254 IF( ln_cpl ) THEN 255 id3 = iom_varid( numrir, 'cnd_ice' , ldstop = .FALSE. ) 256 id4 = iom_varid( numrir, 't1_ice' , ldstop = .FALSE. ) 257 IF( id3 > 0 .AND. id4 > 0 ) THEN ! fields exist 258 CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice ) 259 CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice ) 260 ELSE ! start from rest 261 IF(lwp) WRITE(numout,*) ' ==>> previous run without conductivity output then set it to zero' 262 cnd_ice(:,:,:) = 0._wp 263 t1_ice (:,:,:) = rt0 264 ENDIF 265 ENDIF 266 267 CALL iom_delay_rst( 'READ', 'ICE', numrir ) ! read only ice delayed global communication variables 268 269 ! ! ---------------------------------- ! 270 ELSE ! == case of a simplified restart == ! 271 ! ! ---------------------------------- ! 272 CALL ctl_warn('ice_rst_read: you are using a simplified ice restart') 273 ! 274 CALL ice_istate_init 275 CALL ice_istate( nit000, Kbb, Kmm, Kaa ) 276 ! 277 IF( .NOT.ln_iceini .OR. .NOT.ln_iceini_file ) & 278 & CALL ctl_stop('STOP', 'ice_rst_read: you need ln_ice_ini=T and ln_iceini_file=T') 279 ! 280 ENDIF 295 #if defined key_agrif 296 ENDIF 297 #endif 281 298 282 299 END SUBROUTINE ice_rst_read -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_ice_interp.F90
r13286 r13334 25 25 USE agrif_oce 26 26 USE phycst , ONLY: rt0 27 USE icevar 28 USE sbc_ice, ONLY : tn_ice 27 29 28 30 IMPLICIT NONE … … 30 32 31 33 PUBLIC agrif_interp_ice ! called by agrif_user.F90 32 PUBLIC interp_tra_ice, interp_u_ice, interp_v_ice ! called by iceistate.F9034 PUBLIC agrif_istate_ice ! called by icerst.F90 33 35 34 36 !!---------------------------------------------------------------------- … … 39 41 40 42 CONTAINS 43 44 SUBROUTINE agrif_istate_ice 45 !!----------------------------------------------------------------------- 46 !! *** ROUTINE agrif_istate_ice *** 47 !! 48 !! ** Method : Set initial ice fields from parent grid 49 !! 50 !!----------------------------------------------------------------------- 51 IF(lwp) WRITE(numout,*) ' ' 52 IF(lwp) WRITE(numout,*) 'Agrif_istate_ice : interp child ice initial state from parent' 53 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 54 IF(lwp) WRITE(numout,*) ' ' 55 56 ! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i: 57 Agrif_SpecialValue = -9999. 58 Agrif_UseSpecialValue = .TRUE. 59 CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice) 60 ! 61 ! Set u_ice, v_ice: 62 use_sign_north = .TRUE. 63 sign_north = -1. 64 Agrif_UseSpecialValue = .TRUE. 65 CALL Agrif_init_variable(u_iceini_id ,procname=interp_u_ice) 66 CALL Agrif_init_variable(v_iceini_id ,procname=interp_v_ice) 67 Agrif_SpecialValue = 0._wp 68 use_sign_north = .FALSE. 69 Agrif_UseSpecialValue = .FALSE. 70 ! lbc ???? 71 ! JC: do we really need the 3 lines below ? 72 CALL ice_var_glo2eqv 73 CALL ice_var_zapsmall 74 CALL ice_var_agg(2) 75 76 ! Melt ponds 77 WHERE( a_i > epsi10 ) 78 a_ip_frac(:,:,:) = a_ip(:,:,:) / a_i(:,:,:) 79 ELSEWHERE 80 a_ip_frac(:,:,:) = 0._wp 81 END WHERE 82 WHERE( a_ip > 0._wp ) ! ??????? 83 h_ip(:,:,:) = v_ip(:,:,:) / a_ip(:,:,:) 84 ELSEWHERE 85 h_ip(:,:,:) = 0._wp 86 END WHERE 87 88 tn_ice(:,:,:) = t_su(:,:,:) 89 t1_ice(:,:,:) = t_i (:,:,1,:) 90 91 END SUBROUTINE agrif_istate_ice 41 92 42 93 SUBROUTINE agrif_interp_ice( cd_type, kiter, kitermax ) -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce.F90
r13286 r13334 116 116 ! 117 117 END FUNCTION agrif_oce_alloc 118 119 118 #endif 120 119 !!====================================================================== -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_oce_interp.F90
r13286 r13334 46 46 PUBLIC interpe3t, interpglamt, interpgphit 47 47 PUBLIC interpht0, interpmbkt 48 PUBLIC agrif_i nitts, agrif_initssh48 PUBLIC agrif_istate_oce, agrif_istate_ssh ! called by icestate.F90 and domvvl.F90 49 49 50 50 INTEGER :: bdy_tinterp = 0 … … 56 56 !!---------------------------------------------------------------------- 57 57 CONTAINS 58 59 SUBROUTINE Agrif_istate_oce( Kbb, Kmm, Kaa ) 60 !!---------------------------------------------------------------------- 61 !! *** ROUTINE agrif_istate_oce *** 62 !! 63 !! set initial t, s, u, v, ssh from parent 64 !!---------------------------------------------------------------------- 65 ! 66 IMPLICIT NONE 67 ! 68 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa 69 INTEGER :: jn 70 !!---------------------------------------------------------------------- 71 IF(lwp) WRITE(numout,*) ' ' 72 IF(lwp) WRITE(numout,*) 'Agrif_istate_oce : interp child initial state from parent' 73 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 74 IF(lwp) WRITE(numout,*) ' ' 75 76 IF ( ln_rstart ) & 77 & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 78 79 IF ( .NOT.Agrif_Parent(ln_1st_euler) ) & 80 & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 81 82 l_ini_child = .TRUE. 83 Agrif_SpecialValue = 0.0_wp 84 Agrif_UseSpecialValue = .TRUE. 85 86 ts(:,:,:,:,:) = 0.0_wp 87 uu(:,:,:,:) = 0.0_wp 88 vv(:,:,:,:) = 0.0_wp 89 ssh(:,:,:) = 0._wp 90 91 Krhs_a = Kbb ; Kmm_a = Kbb 92 93 CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 94 CALL Agrif_Init_Variable(sshini_id, procname=interpsshn) 95 96 Agrif_UseSpecialValue = ln_spc_dyn 97 use_sign_north = .TRUE. 98 sign_north = -1._wp 99 CALL Agrif_Init_Variable(uini_id , procname=interpun ) 100 CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 101 use_sign_north = .FALSE. 102 103 Agrif_UseSpecialValue = .FALSE. 104 l_ini_child = .FALSE. 105 106 Krhs_a = Kaa ; Kmm_a = Kmm 107 108 ssh(:,:,Kbb) = ssh(:,:,Kbb) * tmask(:,:,1) 109 110 DO jn = 1, jpts 111 ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb) * tmask(:,:,:) 112 END DO 113 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:) 114 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:) 115 116 CALL lbc_lnk_multi( 'agrif_istate_oce', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 117 CALL lbc_lnk( 'agrif_istate_oce', ts(:,:,:,:,Kbb), 'T', 1.0_wp ) 118 CALL lbc_lnk( 'agrif_istate_oce', ssh(:,:,Kbb), 'T', 1.0_wp ) 119 120 END SUBROUTINE Agrif_istate_oce 121 122 SUBROUTINE Agrif_istate_ssh( Kbb, Kmm ) 123 !!---------------------------------------------------------------------- 124 !! *** ROUTINE agrif_istate_ssh *** 125 !! 126 !! set initial ssh from parent 127 !!---------------------------------------------------------------------- 128 ! 129 IMPLICIT NONE 130 ! 131 INTEGER, INTENT(in) :: Kbb, Kmm 132 !!---------------------------------------------------------------------- 133 IF(lwp) WRITE(numout,*) ' ' 134 IF(lwp) WRITE(numout,*) 'Agrif_istate_ssh : interp child ssh from parent' 135 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~' 136 IF(lwp) WRITE(numout,*) ' ' 137 138 IF ( ln_rstart ) & 139 & CALL ctl_stop('AGRIF hot start should be desactivated in restarting mode') 140 141 IF ( .NOT.Agrif_Parent(ln_1st_euler) ) & 142 & CALL ctl_stop('AGRIF hot start requires to force Euler first step on parent') 143 144 Kmm_a = Kmm 145 ssh(:,:,Kmm) = 0._wp 146 l_ini_child = .TRUE. 147 Agrif_SpecialValue = 0._wp 148 Agrif_UseSpecialValue = .TRUE. 149 CALL Agrif_Init_Variable(sshini_id, procname=interpsshn) 150 Agrif_UseSpecialValue = .FALSE. 151 l_ini_child = .FALSE. 152 CALL lbc_lnk( 'dom_vvl_rst', ssh(:,:,Kmm), 'T', 1._wp ) 153 154 END SUBROUTINE Agrif_istate_ssh 155 58 156 59 157 SUBROUTINE Agrif_tra … … 828 926 ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a) 829 927 ELSE 830 hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 928 IF( l_ini_child ) THEN 929 ssh(i1:i2,j1:j2,Kmm_a) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 930 ELSE 931 hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 932 ENDIF 831 933 ENDIF 832 934 ! … … 869 971 END DO 870 972 871 IF( l_vremap .OR. l_ini_child ) THEN973 IF( l_vremap .OR. l_ini_child ) THEN 872 974 ! Extrapolate thicknesses in partial bottom cells: 873 975 ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on … … 1462 1564 ! 1463 1565 END SUBROUTINE interpht0 1464 1465 1466 SUBROUTINE agrif_initts(tabres,i1,i2,j1,j2,k1,k2,m1,m2,before)1467 INTEGER :: i1, i2, j1, j2, k1, k2, m1, m21468 REAL(wp):: tabres(i1:i2,j1:j2,k1:k2,m1:m2)1469 LOGICAL :: before1470 1471 INTEGER :: jm1472 1473 IF (before) THEN1474 DO jm=1,jpts1475 tabres(i1:i2,j1:j2,k1:k2,jm) = ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a)1476 END DO1477 ELSE1478 DO jm=1,jpts1479 ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a)=tabres(i1:i2,j1:j2,k1:k2,jm)1480 END DO1481 ENDIF1482 END SUBROUTINE agrif_initts1483 1484 1485 SUBROUTINE agrif_initssh( ptab, i1, i2, j1, j2, before )1486 !!----------------------------------------------------------------------1487 !! *** ROUTINE interpsshn ***1488 !!----------------------------------------------------------------------1489 INTEGER , INTENT(in ) :: i1, i2, j1, j21490 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab1491 LOGICAL , INTENT(in ) :: before1492 !1493 !!----------------------------------------------------------------------1494 !1495 IF( before) THEN1496 ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kbb_a)1497 ELSE1498 ssh(i1:i2,j1:j2,Kbb_a) = ptab(i1:i2,j1:j2)*tmask(i1:i2,j1:j2,1)1499 ENDIF1500 !1501 END SUBROUTINE agrif_initssh1502 1566 1503 1567 #else -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/NST/agrif_user.F90
r13295 r13334 40 40 ! 41 41 END SUBROUTINE Agrif_initvalues 42 43 44 SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa )45 !!----------------------------------------------------------------------46 !! *** ROUTINE agrif_istate ***47 !!----------------------------------------------------------------------48 USE domvvl49 USE domain50 USE par_oce51 USE agrif_oce52 USE agrif_oce_interp53 USE oce54 USE lib_mpp55 USE lbclnk56 !57 IMPLICIT NONE58 !59 INTEGER, INTENT(in) :: Kbb, Kmm, Kaa60 INTEGER :: jn61 !!----------------------------------------------------------------------62 IF(lwp) WRITE(numout,*) ' '63 IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent'64 IF(lwp) WRITE(numout,*) ' '65 66 l_ini_child = .TRUE.67 Agrif_SpecialValue = 0.0_wp68 Agrif_UseSpecialValue = .TRUE.69 uu(:,:,:,:) = 0.0_wp ; vv(:,:,:,:) = 0.0_wp ; ts(:,:,:,:,:) = 0.0_wp70 71 Krhs_a = Kbb ; Kmm_a = Kbb72 73 ! Brutal fix to pas 1x1 refinment.74 ! IF(Agrif_Irhox() == 1) THEN75 ! CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts)76 ! ELSE77 CALL Agrif_Init_Variable(tsini_id, procname=interptsn)78 79 ! ENDIF80 ! just for VORTEX because Parent velocities can actually be exactly zero81 ! Agrif_UseSpecialValue = .FALSE.82 Agrif_UseSpecialValue = ln_spc_dyn83 use_sign_north = .TRUE.84 sign_north = -1.85 CALL Agrif_Init_Variable(uini_id , procname=interpun )86 CALL Agrif_Init_Variable(vini_id , procname=interpvn )87 use_sign_north = .FALSE.88 89 Agrif_UseSpecialValue = .FALSE.90 l_ini_child = .FALSE.91 92 Krhs_a = Kaa ; Kmm_a = Kmm93 94 DO jn = 1, jpts95 ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:)96 END DO97 uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)98 vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)99 100 101 CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,: ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp )102 CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1.0_wp )103 104 END SUBROUTINE Agrif_Istate105 42 106 43 … … 285 222 mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 286 223 287 IF ( ln_init_chfrpar ) THEN288 CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh)289 CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. )290 DO jk = 1, jpk291 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) &292 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) &293 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) )294 END DO295 ENDIF296 224 297 225 ! check if masks and bathymetries match … … 904 832 & 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 905 833 IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 834 ! 906 835 ! 907 836 END SUBROUTINE agrif_nemo_init -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/domain.F90
r13286 r13334 329 329 nn_it000 = (Agrif_Parent(nn_it000)-1)*Agrif_IRhot() + 1 330 330 nn_itend = Agrif_Parent(nn_itend) *Agrif_IRhot() 331 nn_date0 = Agrif_Parent(ndastp) 332 nn_time0 = Agrif_Parent(nn_time0) 331 333 ENDIF 332 334 #endif -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/domvvl.F90
r13295 r13334 25 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 26 USE timing ! Timing 27 28 USE agrif_oce ! initial state interpolation 29 USE agrif_oce_interp 27 30 28 31 IMPLICIT NONE … … 803 806 IF( TRIM(cdrw) == 'READ' ) THEN ! Read/initialise 804 807 ! ! =============== 805 IF( ln_rstart ) THEN !* Read the restart file 806 CALL rst_read_open ! open the restart file if necessary 807 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 808 ! 809 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 810 id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 811 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 812 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 813 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 814 ! 808 IF( ln_rstart ) THEN 809 !* Read the restart file 810 #if defined key_agrif 811 IF ( (.NOT.Agrif_root()).AND.(ln_init_chfrpar) ) THEN 812 ! skip reading restart if initialized from parent: 813 id1 = -1 ; id2 = -1 ; id3 = -1 ; id4 = -1 ; id5 = -1 814 ELSE 815 #endif 816 CALL rst_read_open ! open the restart file if necessary 817 CALL iom_get( numror, jpdom_auto, 'sshn' , ssh(:,:,Kmm), ldxios = lrxios ) 818 ! 819 id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 820 id2 = iom_varid( numror, 'e3t_n', ldstop = .FALSE. ) 821 id3 = iom_varid( numror, 'tilde_e3t_b', ldstop = .FALSE. ) 822 id4 = iom_varid( numror, 'tilde_e3t_n', ldstop = .FALSE. ) 823 id5 = iom_varid( numror, 'hdiv_lf', ldstop = .FALSE. ) 824 #if defined key_agrif 825 ENDIF 826 #endif 815 827 ! ! --------- ! 816 828 ! ! all cases ! … … 926 938 ! is set up: 927 939 ! CALL usr_def_istate( gdept_0, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 928 !!940 ! 929 941 ! DO jk=1,jpk 930 942 ! e3t(:,:,jk,Kbb) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb) ) & 931 ! & / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) 943 ! & / ( ht_0(:,:) + 1._wp -ssmask(:,:) ) * tmask(:,:,jk) & 944 ! & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 932 945 ! END DO 933 946 ! e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 934 935 936 947 ssh(:,:,Kmm)=0._wp 948 e3t(:,:,:,Kmm)=e3t_0(:,:,:) 949 e3t(:,:,:,Kbb)=e3t_0(:,:,:) 937 950 ! 938 951 END IF ! end of ll_wd edits … … 944 957 END IF 945 958 ENDIF 959 960 #if defined key_agrif 961 IF ( .NOT.Agrif_root().AND.(ln_init_chfrpar) ) THEN 962 ! Interpolate initial ssh from parent: 963 CALL Agrif_istate_ssh( Kbb, Kmm ) 964 ! 965 DO jk = 1, jpk 966 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & 967 & / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk) & 968 & + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 969 END DO 970 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 971 ENDIF 972 #endif 946 973 ! 947 974 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN ! Create restart file -
NEMO/branches/2020/dev_r13312_AGRIF-03-04_jchanut_vinterp_tstep/src/OCE/DOM/istate.F90
r13295 r13334 34 34 USE lib_mpp ! MPP library 35 35 USE restart ! restart 36 #if defined key_agrif 37 USE agrif_oce_interp 38 USE agrif_oce 39 #endif 36 37 USE agrif_oce ! initial state interpolation 38 USE agrif_oce_interp 40 39 41 40 IMPLICIT NONE … … 89 88 #endif 90 89 90 IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN 91 91 #if defined key_agrif 92 IF ( (.NOT.Agrif_root()).AND.ln_init_chfrpar ) THEN93 92 numror = 0 ! define numror = 0 -> no restart file to read 94 93 ln_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 95 94 CALL day_init 96 CALL agrif_istate ( Kbb, Kmm, Kaa ) ! Interp from parent95 CALL agrif_istate_oce( Kbb, Kmm, Kaa ) ! Interp from parent 97 96 ! 98 ts 99 ssh 100 uu (:,:,:,Kmm) = uu(:,:,:,Kbb)101 vv (:,:,:,Kmm) = vv(:,:,:,Kbb)97 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) 98 ssh(:,:,Kmm) = ssh(:,:,Kbb) 99 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 100 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 102 101 ELSE 103 102 #endif 104 IF( ln_rstart ) THEN ! Restart from a file 105 ! ! ------------------- 106 CALL rst_read( Kbb, Kmm ) ! Read the restart file 107 CALL day_init ! model calendar (using both namelist and restart infos) 108 ! 109 ELSE ! Start from rest 110 ! ! --------------- 111 numror = 0 ! define numror = 0 -> no restart file to read 112 l_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 113 CALL day_init ! model calendar (using both namelist and restart infos) 114 ! ! Initialization of ocean to zero 115 ! 116 IF( ln_tsd_init ) THEN 117 CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 103 IF( ln_rstart ) THEN ! Restart from a file 104 ! ! ------------------- 105 CALL rst_read( Kbb, Kmm ) ! Read the restart file 106 CALL day_init ! model calendar (using both namelist and restart infos) 118 107 ! 119 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 120 uu (:,:,:,Kbb) = 0._wp 121 vv (:,:,:,Kbb) = 0._wp 108 ELSE ! Start from rest 109 ! ! --------------- 110 numror = 0 ! define numror = 0 -> no restart file to read 111 l_1st_euler = .true. ! Set time-step indicator at nit000 (euler forward) 112 CALL day_init ! model calendar (using both namelist and restart infos) 113 ! ! Initialization of ocean to zero 122 114 ! 123 IF( l l_wd ) THEN124 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD115 IF( ln_tsd_init ) THEN 116 CALL dta_tsd( nit000, ts(:,:,:,:,Kbb) ) ! read 3D T and S data at nit000 125 117 ! 126 ! Apply minimum wetdepth criterion 118 ssh(:,:,Kbb) = 0._wp ! set the ocean at rest 119 uu (:,:,:,Kbb) = 0._wp 120 vv (:,:,:,Kbb) = 0._wp 127 121 ! 128 DO_2D( 1, 1, 1, 1 ) 129 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 130 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 131 ENDIF 132 END_2D 133 ENDIF 134 ! 135 ELSE ! user defined initial T and S 136 DO jk = 1, jpk 137 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 138 END DO 139 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 140 ENDIF 141 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 142 ssh (:,:,Kmm) = ssh(:,:,Kbb) 143 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 144 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 122 IF( ll_wd ) THEN 123 ssh(:,:,Kbb) = -ssh_ref ! Added in 30 here for bathy that adds 30 as Iterative test CEOD 124 ! 125 ! Apply minimum wetdepth criterion 126 ! 127 DO_2D( 1, 1, 1, 1 ) 128 IF( ht_0(ji,jj) + ssh(ji,jj,Kbb) < rn_wdmin1 ) THEN 129 ssh(ji,jj,Kbb) = tmask(ji,jj,1)*( rn_wdmin1 - (ht_0(ji,jj)) ) 130 ENDIF 131 END_2D 132 ENDIF 133 ! 134 ELSE ! user defined initial T and S 135 DO jk = 1, jpk 136 zgdept(:,:,jk) = gdept(:,:,jk,Kbb) 137 END DO 138 CALL usr_def_istate( zgdept, tmask, ts(:,:,:,:,Kbb), uu(:,:,:,Kbb), vv(:,:,:,Kbb), ssh(:,:,Kbb) ) 139 ENDIF 140 ts (:,:,:,:,Kmm) = ts (:,:,:,:,Kbb) ! set now values from to before ones 141 ssh (:,:,Kmm) = ssh(:,:,Kbb) 142 uu (:,:,:,Kmm) = uu (:,:,:,Kbb) 143 vv (:,:,:,Kmm) = vv (:,:,:,Kbb) 145 144 146 145 !!gm POTENTIAL BUG : … … 169 168 !!gm 170 169 ! 171 ENDIF172 #if defined key_agrif 170 ENDIF 171 173 172 ENDIF 174 #endif175 173 ! 176 174 ! Initialize "now" and "before" barotropic velocities:
Note: See TracChangeset
for help on using the changeset viewer.