Changeset 14062 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isfcpl.F90
- Timestamp:
- 2020-12-03T17:39:30+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/ISF/isfcpl.F90
r14037 r14062 10 10 11 11 !!---------------------------------------------------------------------- 12 !! isfrst : read/write iceshelf variables in/from restart12 !! isfrst : read/write iceshelf variables in/from restart 13 13 !!---------------------------------------------------------------------- 14 USE isf_oce ! ice shelf variable 14 USE oce ! ocean dynamics and tracers 15 #if defined key_qco 16 USE domqco , ONLY : dom_qco_zgr ! vertical scale factor interpolation 17 #else 18 USE domvvl , ONLY : dom_vvl_zgr ! vertical scale factor interpolation 19 #endif 20 USE domutl , ONLY : dom_ngb ! find the closest grid point from a given lon/lat position 21 USE isf_oce ! ice shelf variable 15 22 USE isfutils, ONLY : debug 16 USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine17 #if ! defined key_qco18 USE domvvl , ONLY: dom_vvl_zgr ! vertical scale factor interpolation19 #else20 USE domqco , ONLY: dom_qco_zgr ! vertical scale factor interpolation21 #endif22 USE domutl , ONLY: dom_ngb ! find the closest grid point from a given lon/lat position23 23 ! 24 USE oce ! ocean dynamics and tracers25 24 USE in_out_manager ! I/O manager 26 25 USE iom ! I/O library 26 USE lib_mpp , ONLY : mpp_sum, mpp_max ! mpp routine 27 27 ! 28 28 IMPLICIT NONE … … 34 34 35 35 TYPE isfcons 36 INTEGER :: ii ! i global37 INTEGER :: jj ! j global38 INTEGER :: kk ! k level39 REAL(wp):: dvol ! volume increment40 REAL(wp):: dsal ! salt increment41 REAL(wp):: dtem ! heat increment42 REAL(wp):: lon ! lon43 REAL(wp):: lat ! lat44 INTEGER :: ngb ! 0/1 (valid location or not (ie on halo or no neigbourg))36 INTEGER :: ii ! i global 37 INTEGER :: jj ! j global 38 INTEGER :: kk ! k level 39 REAL(wp):: dvol ! volume increment 40 REAL(wp):: dsal ! salt increment 41 REAL(wp):: dtem ! heat increment 42 REAL(wp):: lon ! lon 43 REAL(wp):: lat ! lat 44 INTEGER :: ngb ! 0/1 (valid location or not (ie on halo or no neigbourg)) 45 45 END TYPE 46 46 ! … … 121 121 #endif 122 122 END SUBROUTINE isfcpl_init 123 ! 124 SUBROUTINE isfcpl_rst_write(kt, Kmm) 123 124 125 SUBROUTINE isfcpl_rst_write( kt, Kmm ) 125 126 !!--------------------------------------------------------------------- 126 127 !! *** ROUTINE iscpl_rst_write *** … … 133 134 !!---------------------------------------------------------------------- 134 135 INTEGER :: jk ! loop index 135 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw ! e3t , e3u, e3v !!st patch to usesubstitution136 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v, zgdepw ! for qco substitution 136 137 !!---------------------------------------------------------------------- 137 138 ! … … 153 154 END SUBROUTINE isfcpl_rst_write 154 155 156 155 157 SUBROUTINE isfcpl_ssh(Kbb, Kmm, Kaa) 156 158 !!---------------------------------------------------------------------- … … 184 186 zdssmask(:,:) = ssmask(:,:) - zssmask0(:,:) 185 187 DO_2D( 0, 0, 0, 0 ) 186 jip1=ji+1 ; jim1=ji-1;187 jjp1=jj+1 ; jjm1=jj-1;188 jip1=ji+1 ; jim1=ji-1 189 jjp1=jj+1 ; jjm1=jj-1 188 190 ! 189 191 zsummsk = zssmask0(jip1,jj) + zssmask0(jim1,jj) + zssmask0(ji,jjp1) + zssmask0(ji,jjm1) … … 191 193 IF (zdssmask(ji,jj) == 1._wp .AND. zsummsk /= 0._wp) THEN 192 194 ssh(ji,jj,Kmm)=( zssh(jip1,jj)*zssmask0(jip1,jj) & 193 & + zssh(jim1,jj)*zssmask0(jim1,jj) &194 & + zssh(ji,jjp1)*zssmask0(ji,jjp1) &195 & + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk195 & + zssh(jim1,jj)*zssmask0(jim1,jj) & 196 & + zssh(ji,jjp1)*zssmask0(ji,jjp1) & 197 & + zssh(ji,jjm1)*zssmask0(ji,jjm1)) / zsummsk 196 198 zssmask_b(ji,jj) = 1._wp 197 199 ENDIF … … 222 224 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 223 225 #else 224 CALL dom_qco_zgr(Kbb, Kmm , Kaa)226 CALL dom_qco_zgr(Kbb, Kmm) 225 227 #endif 226 228 ! 227 229 END SUBROUTINE isfcpl_ssh 228 230 231 229 232 SUBROUTINE isfcpl_tra(Kmm) 230 233 !!---------------------------------------------------------------------- … … 375 378 ! 376 379 END SUBROUTINE isfcpl_tra 380 377 381 378 382 SUBROUTINE isfcpl_vol(Kmm) … … 466 470 risfcpl_ssh(:,:) = risfcpl_ssh(:,:) + risfcpl_vol(:,:,jk) * r1_e1e2t(:,:) 467 471 END DO 468 472 ! 469 473 END SUBROUTINE isfcpl_vol 470 474 475 471 476 SUBROUTINE isfcpl_cons(Kmm) 472 477 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.