- Timestamp:
- 2017-12-01T18:44:09+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90
r8329 r8882 11 11 !! iscpl_rst_interpol : restart interpolation in case of coupling with ice sheet 12 12 !!---------------------------------------------------------------------- 13 USE oce ! global tra/dyn variable 13 14 USE dom_oce ! ocean space and time domain 14 15 USE domwri ! ocean space and time domain 15 USE domvvl , ONLY : dom_vvl_interpol16 USE domvvl , ONLY : dom_vvl_interpol 16 17 USE phycst ! physical constants 17 18 USE sbc_oce ! surface boundary condition variables 18 USE oce ! global tra/dyn variable 19 USE iscplini ! ice sheet coupling: initialisation 20 USE iscplhsb ! ice sheet coupling: conservation 21 ! 19 22 USE in_out_manager ! I/O manager 20 23 USE iom ! I/O module 21 24 USE lib_mpp ! MPP library 22 25 USE lib_fortran ! MPP library 23 USE wrk_nemo ! Memory allocation24 26 USE lbclnk ! communication 25 USE iscplini ! ice sheet coupling: initialisation26 USE iscplhsb ! ice sheet coupling: conservation27 27 28 28 IMPLICIT NONE … … 50 50 !!---------------------------------------------------------------------- 51 51 INTEGER :: inum0 52 REAL(wp), DIMENSION( :,: ), POINTER:: zsmask_b53 REAL(wp), DIMENSION( :,:,:), POINTER:: ztmask_b, zumask_b, zvmask_b54 REAL(wp), DIMENSION( :,:,:), POINTER:: ze3t_b , ze3u_b , ze3v_b55 REAL(wp), DIMENSION( :,:,:), POINTER:: zdepw_b52 REAL(wp), DIMENSION(jpi,jpj) :: zsmask_b 53 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask_b, zumask_b, zvmask_b 54 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t_b , ze3u_b , ze3v_b 55 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdepw_b 56 56 CHARACTER(20) :: cfile 57 57 !!---------------------------------------------------------------------- 58 59 CALL wrk_alloc(jpi,jpj,jpk, ztmask_b, zumask_b, zvmask_b) ! mask before 60 CALL wrk_alloc(jpi,jpj,jpk, ze3t_b , ze3u_b , ze3v_b ) ! e3 before 61 CALL wrk_alloc(jpi,jpj,jpk, zdepw_b ) 62 CALL wrk_alloc(jpi,jpj, zsmask_b ) 63 64 65 !! get restart variable 58 ! 59 ! ! get restart variable 66 60 CALL iom_get( numror, jpdom_autoglo, 'tmask' , ztmask_b ) ! need to extrapolate T/S 67 61 CALL iom_get( numror, jpdom_autoglo, 'umask' , zumask_b ) ! need to correct barotropic velocity … … 72 66 CALL iom_get( numror, jpdom_autoglo, 'e3v_n' , ze3v_b(:,:,:) ) ! need to correct barotropic velocity 73 67 CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 74 75 !! read namelist 76 CALL iscpl_init() 77 78 !! ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 68 ! 69 CALL iscpl_init() ! read namelist 70 ! ! Extrapolation/interpolation of modify cell and new cells ... (maybe do it later after domvvl) 79 71 CALL iscpl_rst_interpol( ztmask_b, zumask_b, zvmask_b, zsmask_b, ze3t_b, ze3u_b, ze3v_b, zdepw_b ) 80 81 !! compute correction if conservation needed 82 IF ( ln_hsb ) THEN 72 ! 73 IF ( ln_hsb ) THEN ! compute correction if conservation needed 83 74 IF( iscpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'rst_iscpl : unable to allocate rst_iscpl arrays' ) 84 75 CALL iscpl_cons(ztmask_b, zsmask_b, ze3t_b, htsc_iscpl, hdiv_iscpl, rdt_iscpl) 85 76 END IF 86 77 87 ! ! print mesh/mask88 IF( nn_msh /= 0 .AND. ln_iscpl ) CALL dom_wri ! Create a domain file89 78 ! ! create a domain file 79 IF( nn_msh /= 0 .AND. ln_iscpl ) CALL dom_wri 80 ! 90 81 IF ( ln_hsb ) THEN 91 82 cfile='correction' … … 97 88 CALL iom_close ( inum0 ) 98 89 END IF 99 100 CALL wrk_dealloc(jpi,jpj,jpk, ztmask_b,zumask_b,zvmask_b ) 101 CALL wrk_dealloc(jpi,jpj,jpk, ze3t_b ,ze3u_b ,ze3v_b ) 102 CALL wrk_dealloc(jpi,jpj,jpk, zdepw_b ) 103 CALL wrk_dealloc(jpi,jpj, zsmask_b ) 104 105 !! next step is an euler time step 106 neuler = 0 107 108 !! set _b and _n variables equal 90 ! 91 neuler = 0 ! next step is an euler time step 92 ! 93 ! ! set _b and _n variables equal 109 94 tsb (:,:,:,:) = tsn (:,:,:,:) 110 95 ub (:,:,:) = un (:,:,:) 111 96 vb (:,:,:) = vn (:,:,:) 112 97 sshb(:,:) = sshn(:,:) 113 114 ! ! set _b and _n vertical scale factor equal98 ! 99 ! ! set _b and _n vertical scale factor equal 115 100 e3t_b (:,:,:) = e3t_n (:,:,:) 116 101 e3u_b (:,:,:) = e3u_n (:,:,:) 117 102 e3v_b (:,:,:) = e3v_n (:,:,:) 118 103 ! 119 104 e3uw_b (:,:,:) = e3uw_n (:,:,:) 120 105 e3vw_b (:,:,:) = e3vw_n (:,:,:) … … 150 135 REAL(wp):: zdz, zdzm1, zdzp1 151 136 !! 152 REAL(wp), DIMENSION(:,: ), POINTER :: zdmask , zdsmask, zvcorr, zucorr, zde3t 153 REAL(wp), DIMENSION(:,: ), POINTER :: zbub , zbvb , zbun , zbvn 154 REAL(wp), DIMENSION(:,: ), POINTER :: zssh0 , zssh1, zhu1, zhv1 155 REAL(wp), DIMENSION(:,: ), POINTER :: zsmask0, zsmask1 156 REAL(wp), DIMENSION(:,:,: ), POINTER :: ztmask0, ztmask1, ztrp 157 REAL(wp), DIMENSION(:,:,: ), POINTER :: zwmaskn, zwmaskb, ztmp3d 158 REAL(wp), DIMENSION(:,:,:,:), POINTER :: zts0 137 REAL(wp), DIMENSION(jpi,jpj) :: zdmask , zsmask0, zucorr, zbub, zbun, zssh0, zhu1, zde3t 138 REAL(wp), DIMENSION(jpi,jpj) :: zdsmask, zsmask1, zvcorr, zbvb, zbvn, zssh1, zhv1 139 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask0, zwmaskn, ztrp 140 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztmask1, zwmaskb, ztmp3d 141 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts0 159 142 !!---------------------------------------------------------------------- 160 161 !! allocate variables 162 CALL wrk_alloc(jpi,jpj,jpk,2, zts0 ) 163 CALL wrk_alloc(jpi,jpj,jpk, ztmask0, ztmask1 , ztrp, ztmp3d ) 164 CALL wrk_alloc(jpi,jpj,jpk, zwmaskn, zwmaskb ) 165 CALL wrk_alloc(jpi,jpj, zsmask0, zsmask1 ) 166 CALL wrk_alloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t) 167 CALL wrk_alloc(jpi,jpj, zbub , zbvb , zbun , zbvn ) 168 CALL wrk_alloc(jpi,jpj, zssh0 , zssh1, zhu1, zhv1 ) 169 170 !! mask value to be sure 143 ! 144 ! ! mask value to be sure 171 145 tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * ptmask_b(:,:,:) 172 146 tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * ptmask_b(:,:,:) 173 174 ! compute wmask147 ! 148 ! ! compute wmask 175 149 zwmaskn(:,:,1) = tmask (:,:,1) 176 150 zwmaskb(:,:,1) = ptmask_b(:,:,1) … … 179 153 zwmaskb(:,:,jk) = ptmask_b(:,:,jk) * ptmask_b(:,:,jk-1) 180 154 END DO 181 182 ! compute new ssh if we open a full water column (average of the closest neigbourgs)155 ! 156 ! ! compute new ssh if we open a full water column (average of the closest neigbourgs) 183 157 sshb (:,:)=sshn(:,:) 184 158 zssh0(:,:)=sshn(:,:) 185 159 zsmask0(:,:) = psmask_b(:,:) 186 160 zsmask1(:,:) = psmask_b(:,:) 187 DO iz = 1, 10! need to be tuned (configuration dependent) (OK for ISOMIP+)161 DO iz = 1, 10 ! need to be tuned (configuration dependent) (OK for ISOMIP+) 188 162 zdsmask(:,:) = ssmask(:,:)-zsmask0(:,:) 189 163 DO jj = 2,jpj-1 … … 198 172 & + zssh0(ji,jjm1)*zsmask0(ji,jjm1))/summsk 199 173 zsmask1(ji,jj)=1._wp 200 END 174 ENDIF 201 175 END DO 202 176 END DO 203 CALL lbc_lnk( sshn,'T',1._wp)204 CALL lbc_lnk( zsmask1,'T',1._wp)177 CALL lbc_lnk( sshn , 'T', 1._wp ) 178 CALL lbc_lnk( zsmask1, 'T', 1._wp ) 205 179 zssh0 = sshn 206 180 zsmask0 = zsmask1 … … 210 184 !============================================================================= 211 185 !PM: Is this needed since introduction of VVL by default? 212 IF ( .NOT.ln_linssh) THEN186 IF ( .NOT.ln_linssh ) THEN 213 187 ! Reconstruction of all vertical scale factors at now time steps 214 188 ! ============================================================================= … … 225 199 END DO 226 200 END DO 227 201 ! 228 202 CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:), 'U' ) 229 203 CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:), 'V' ) 230 204 CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:), 'F' ) 231 205 232 ! Vertical scale factor interpolations233 ! ------------------------------------206 ! Vertical scale factor interpolations 207 ! ------------------------------------ 234 208 CALL dom_vvl_interpol( e3t_n(:,:,:), e3w_n (:,:,:), 'W' ) 235 209 CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 236 210 CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 237 238 ! t- and w- points depth239 ! ----------------------211 212 ! t- and w- points depth 213 ! ---------------------- 240 214 gdept_n(:,:,1) = 0.5_wp * e3w_n(:,:,1) 241 215 gdepw_n(:,:,1) = 0.0_wp … … 431 405 ! nothing to do 432 406 ! 433 ! deallocation tmp arrays434 CALL wrk_dealloc(jpi,jpj,jpk,2, zts0 )435 CALL wrk_dealloc(jpi,jpj,jpk, ztmask0, ztmask1 , ztrp )436 CALL wrk_dealloc(jpi,jpj,jpk, zwmaskn, zwmaskb , ztmp3d )437 CALL wrk_dealloc(jpi,jpj, zsmask0, zsmask1 )438 CALL wrk_dealloc(jpi,jpj, zdmask , zdsmask, zvcorr, zucorr, zde3t)439 CALL wrk_dealloc(jpi,jpj, zbub , zbvb , zbun , zbvn )440 CALL wrk_dealloc(jpi,jpj, zssh0 , zssh1 , zhu1 , zhv1 )441 !442 407 END SUBROUTINE iscpl_rst_interpol 443 408
Note: See TracChangeset
for help on using the changeset viewer.
