Changeset 2528 for trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_2/limdyn_2.F90
- Property svn:eol-style deleted
r1694 r2528 4 4 !! Sea-Ice dynamics : 5 5 !!====================================================================== 6 !! History : 1.0 ! 01-04 (LIM) Original code 7 !! 2.0 ! 02-08 (C. Ethe, G. Madec) F90, mpp 8 !! 2.0 ! 03-08 (C. Ethe) add lim_dyn_init 9 !! 2.0 ! 06-07 (G. Madec) Surface module 6 !! History : 1.0 ! 2001-04 (LIM) Original code 7 !! 2.0 ! 2002-08 (C. Ethe, G. Madec) F90, mpp 8 !! 2.0 ! 2003-08 (C. Ethe) add lim_dyn_init 9 !! 2.0 ! 2006-07 (G. Madec) Surface module 10 !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case 10 11 !!--------------------------------------------------------------------- 11 12 #if defined key_lim2 … … 16 17 !! lim_dyn_init_2 : initialization and namelist read 17 18 !!---------------------------------------------------------------------- 18 USE dom_oce ! ocean space and time domain 19 USE sbc_oce ! 20 USE phycst ! 21 USE ice_2 ! 22 USE dom_ice_2 ! 23 USE limistate_2 ! 24 USE limrhg_2 ! ice rheology 25 26 USE lbclnk ! 27 USE lib_mpp ! 28 USE in_out_manager ! I/O manager 29 USE prtctl ! Print control 19 USE dom_oce ! ocean space and time domain 20 USE sbc_oce ! ocean surface boundary condition 21 USE phycst ! physical constant 22 USE ice_2 ! LIM-2: ice variables 23 USE sbc_ice ! Surface boundary condition: sea-ice fields 24 USE dom_ice_2 ! LIM-2: ice domain 25 USE limistate_2 ! LIM-2: initial state 26 USE limrhg_2 ! LIM-2: VP ice rheology 27 USE limrhg ! LIM : EVP ice rheology 28 USE lbclnk ! lateral boundary condition - MPP link 29 USE lib_mpp ! MPP library 30 USE in_out_manager ! I/O manager 31 USE prtctl ! Print control 30 32 31 33 IMPLICIT NONE 32 34 PRIVATE 33 35 34 PUBLIC lim_dyn_2 ! routine called by sbc_ice_lim 35 36 !! * Module variables 37 REAL(wp) :: rone = 1.e0 ! constant value 38 36 PUBLIC lim_dyn_2 ! routine called by sbc_ice_lim 37 38 !! * Substitutions 39 39 # include "vectopt_loop_substitute.h90" 40 40 !!---------------------------------------------------------------------- 41 !! LIM 2.0, UCL-LOCEAN-IPSL (2006)41 !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010) 42 42 !! $Id$ 43 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 44 !!---------------------------------------------------------------------- 45 43 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 44 !!---------------------------------------------------------------------- 46 45 CONTAINS 47 46 … … 83 82 ! --------------------------------------------------- 84 83 85 IF( lk_mpp .OR. nbit_cmp == 1) THEN ! mpp: compute over the whole domain84 IF( lk_mpp .OR. lk_mpp_rep ) THEN ! mpp: compute over the whole domain 86 85 i_j1 = 1 87 86 i_jpj = jpj 88 87 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 89 CALL lim_rhg_2( i_j1, i_jpj ) 88 IF( lk_lim2_vp ) THEN ; CALL lim_rhg_2( i_j1, i_jpj ) ! VP rheology 89 ELSE ; CALL lim_rhg ( i_j1, i_jpj ) ! EVP rheology 90 ENDIF 90 91 ! 91 92 ELSE ! optimization of the computational area … … 105 106 i_j1 = i_j1 + 1 106 107 END DO 107 i_j1 = MAX( 1, i_j1-1 ) 108 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 109 ! 110 CALL lim_rhg_2( i_j1, i_jpj ) 111 ! 108 IF( lk_lim2_vp ) THEN ! VP rheology 109 i_j1 = MAX( 1, i_j1-1 ) 110 CALL lim_rhg_2( i_j1, i_jpj ) 111 ELSE ! EVP rheology 112 i_j1 = MAX( 1, i_j1-2 ) 113 CALL lim_rhg( i_j1, i_jpj ) 114 ENDIF 115 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj 116 ! 112 117 ! Southern hemisphere 113 118 i_j1 = 1 … … 116 121 i_jpj = i_jpj - 1 117 122 END DO 118 i_jpj = MIN( jpj, i_jpj+2 ) 119 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 120 ! 121 CALL lim_rhg_2( i_j1, i_jpj ) 122 ! 123 IF( lk_lim2_vp ) THEN ! VP rheology 124 i_jpj = MIN( jpj, i_jpj+2 ) 125 CALL lim_rhg_2( i_j1, i_jpj ) 126 ELSE ! EVP rheology 127 i_jpj = MIN( jpj, i_jpj+1 ) 128 CALL lim_rhg( i_j1, i_jpj ) 129 ENDIF 130 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, 'ij_jpj = ', i_jpj 131 ! 123 132 ELSE ! local domain extends over one hemisphere only 124 133 ! ! Rheology is computed only over the ice cover … … 134 143 i_jpj = i_jpj - 1 135 144 END DO 136 i_jpj = MIN( jpj, i_jpj+2) 137 145 i_jpj = MIN( jpj, i_jpj+2 ) 146 ! 147 IF( lk_lim2_vp ) THEN ! VP rheology 148 i_jpj = MIN( jpj, i_jpj+2 ) 149 CALL lim_rhg_2( i_j1, i_jpj ) ! VP rheology 150 ELSE ! EVP rheology 151 i_j1 = MAX( 1 , i_j1-2 ) 152 i_jpj = MIN( jpj, i_jpj+1 ) 153 CALL lim_rhg ( i_j1, i_jpj ) ! EVP rheology 154 ENDIF 138 155 IF(ln_ctl) WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 139 !140 CALL lim_rhg_2( i_j1, i_jpj )141 156 ! 142 157 ENDIF … … 148 163 ! computation of friction velocity 149 164 ! -------------------------------- 150 ! ice-ocean velocity at U & V-points (u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points) 151 152 DO jj = 1, jpjm1 153 DO ji = 1, jpim1 ! NO vector opt. 154 zu_io(ji,jj) = 0.5 * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) ) - ssu_m(ji,jj) 155 zv_io(ji,jj) = 0.5 * ( v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) ) - ssv_m(ji,jj) 156 END DO 157 END DO 165 SELECT CASE( cp_ice_msh ) ! ice-ocean relative velocity at u- & v-pts 166 CASE( 'C' ) ! EVP : C-grid ice dynamics 167 zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) ! ice-ocean & ice velocity at ocean velocity points 168 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 169 CASE( 'I' ) ! VP : B-grid ice dynamics (I-point) 170 DO jj = 1, jpjm1 ! u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points 171 DO ji = 1, jpim1 ! NO vector opt. ! 172 zu_io(ji,jj) = 0.5_wp * ( u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) ) - ssu_m(ji,jj) 173 zv_io(ji,jj) = 0.5_wp * ( v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) ) - ssv_m(ji,jj) 174 END DO 175 END DO 176 END SELECT 177 158 178 ! frictional velocity at T-point 179 zcoef = 0.5_wp * cw 159 180 DO jj = 2, jpjm1 160 181 DO ji = 2, jpim1 ! NO vector opt. because of zu_io 161 ust2s(ji,jj) = 0.5 * cw & 162 & * ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 163 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tms(ji,jj) 182 ust2s(ji,jj) = zcoef * ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) & 183 & + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) * tms(ji,jj) 164 184 END DO 165 185 END DO … … 170 190 DO jj = 2, jpjm1 171 191 DO ji = fs_2, fs_jpim1 ! vector opt. 172 ust2s(ji,jj) = zcoef * tms(ji,jj) *SQRT( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) &173 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1))192 ust2s(ji,jj) = zcoef * SQRT( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) & 193 & + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) * tms(ji,jj) 174 194 END DO 175 195 END DO … … 180 200 ! 181 201 IF(ln_ctl) CALL prt_ctl(tab2d_1=ust2s , clinfo1=' lim_dyn : ust2s :') 182 202 ! 183 203 END SUBROUTINE lim_dyn_2 184 204 … … 198 218 NAMELIST/namicedyn/ epsd, alpha, & 199 219 & dm, nbiter, nbitdr, om, resl, cw, angvg, pstar, & 200 & c_rhg, etamn, creepl, ecc, ahi0 220 & c_rhg, etamn, creepl, ecc, ahi0, & 221 & nevp, telast,alphaevp 201 222 !!------------------------------------------------------------------- 202 223 … … 223 244 WRITE(numout,*) ' eccentricity of the elliptical yield curve ecc = ', ecc 224 245 WRITE(numout,*) ' horizontal diffusivity coeff. for sea-ice ahi0 = ', ahi0 246 WRITE(numout,*) ' number of iterations for subcycling nevp = ', nevp 247 WRITE(numout,*) ' timescale for elastic waves telast = ', telast 248 WRITE(numout,*) ' coefficient for the solution of int. stresses alphaevp = ', alphaevp 249 ENDIF 250 ! 251 IF( angvg /= 0._wp .AND. .NOT.lk_lim2_vp ) THEN 252 CALL ctl_warn( 'lim_dyn_init_2: turning angle for oceanic stress not properly coded for EVP ', & 253 & '(see limsbc_2 module). We force angvg = 0._wp' ) 254 angvg = 0._wp 225 255 ENDIF 226 256
Note: See TracChangeset
for help on using the changeset viewer.