Changeset 6789
- Timestamp:
- 2016-07-05T11:51:54+02:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r6763 r6789 112 112 CHARACTER (len=50) :: charout 113 113 114 REAL(wp) :: dtevp, z1_dtevp ! time step for subcycling115 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity116 REAL(wp) :: zbeta, zalph1, z1_alph1, zalph2, z1_alph2 ! alpha and beta from Bouillon 2009 and 2013117 REAL(wp) :: zm1, zm2, zm3 ! ice/snow mass118 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 119 REAL(wp) :: zTauO, zTauA, zTauB, ZCor, zmt, zu_ice2, zv_ice1, zvel ! temporary scalars120 121 REAL(wp) :: zsig1, zsig2 ! internal ice stress122 REAL(wp) :: zresm ! Maximal error on ice velocity123 REAL(wp) :: zintb, zintn ! dummy argument124 125 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength126 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors127 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points128 !129 REAL(wp), POINTER, DIMENSION(:,:) :: za1 , za2 ! ice fraction on U/V points130 REAL(wp), POINTER, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points131 REAL(wp), POINTER, DIMENSION(:,:) :: zcor1 , zcor2 ! coriolis parameter on U/V points132 REAL(wp), POINTER, DIMENSION(:,:) :: zspgu , zspgv ! surface pressure gradient at U/V points114 REAL(wp) :: dtevp, z1_dtevp ! time step for subcycling 115 REAL(wp) :: ecc2, z1_ecc2 ! square of yield ellipse eccenticity 116 REAL(wp) :: zbeta, zalph1, z1_alph1, zalph2, z1_alph2 ! alpha and beta from Bouillon 2009 and 2013 117 REAL(wp) :: zm1, zm2, zm3 ! ice/snow mass 118 REAL(wp) :: zdelta, zp_delf, zds2, zdt, zdt2, zdiv, zdiv2 ! temporary scalars 119 REAL(wp) :: zTauO, zTauA, zTauB, ZCor, zmt, zu_ice2, zv_ice1, zvel ! temporary scalars 120 121 REAL(wp) :: zsig1, zsig2 ! internal ice stress 122 REAL(wp) :: zresm ! Maximal error on ice velocity 123 REAL(wp) :: zintb, zintn ! dummy argument 124 125 REAL(wp), POINTER, DIMENSION(:,:) :: zpresh ! temporary array for ice strength 126 REAL(wp), POINTER, DIMENSION(:,:) :: z1_e1t0, z1_e2t0 ! scale factors 127 REAL(wp), POINTER, DIMENSION(:,:) :: zp_delt ! P/delta at T points 128 ! 129 REAL(wp), POINTER, DIMENSION(:,:) :: za1 , za2 ! ice fraction on U/V points 130 REAL(wp), POINTER, DIMENSION(:,:) :: zmass1, zmass2 ! ice/snow mass on U/V points 131 REAL(wp), POINTER, DIMENSION(:,:) :: zcor1 , zcor2 ! coriolis parameter on U/V points 132 REAL(wp), POINTER, DIMENSION(:,:) :: zspgu , zspgv ! surface pressure gradient at U/V points 133 133 REAL(wp), POINTER, DIMENSION(:,:) :: v_oce1, u_oce2, v_ice1, u_ice2 ! ocean/ice u/v component on V/U points 134 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! internal stresses134 REAL(wp), POINTER, DIMENSION(:,:) :: zf1 , zf2 ! internal stresses 135 135 136 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear 137 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components 138 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence 139 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 140 ! ocean surface (ssh_m) if ice is not embedded 141 ! ice top surface if ice is embedded 142 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch1, zswitch2 ! dummy arrays 143 144 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 145 REAL(wp), PARAMETER :: zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 136 REAL(wp), POINTER, DIMENSION(:,:) :: zds ! shear 137 REAL(wp), POINTER, DIMENSION(:,:) :: zs1, zs2, zs12 ! stress tensor components 138 REAL(wp), POINTER, DIMENSION(:,:) :: zu_ice, zv_ice, zresr ! check convergence 139 REAL(wp), POINTER, DIMENSION(:,:) :: zpice ! array used for the calculation of ice surface slope: 140 ! ocean surface (ssh_m) if ice is not embedded 141 ! ice top surface if ice is embedded 142 REAL(wp), POINTER, DIMENSION(:,:) :: zswitch1, zswitch2 ! dummy arrays 143 REAL(wp), POINTER, DIMENSION(:,:) :: zfmask, zwf ! mask at F points for the ice 144 145 REAL(wp), PARAMETER :: zepsi = 1.0e-20_wp ! tolerance parameter 146 REAL(wp), PARAMETER :: zvmin = 1.0e-03_wp ! ice volume below which ice velocity equals ocean velocity 147 REAL(wp), PARAMETER :: zshlat = 2._wp ! boundary condition for sea-ice velocity (2=no slip ; 0=free slip) 146 148 !!------------------------------------------------------------------- 147 149 … … 150 152 CALL wrk_alloc( jpi,jpj, zspgu, zspgv, v_oce1, u_oce2, v_ice1, u_ice2, zf1, zf2 ) 151 153 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 152 CALL wrk_alloc( jpi,jpj, zswitch1, zswitch2 )154 CALL wrk_alloc( jpi,jpj, zswitch1, zswitch2, zfmask, zwf ) 153 155 154 156 #if defined key_agrif … … 158 160 ! 159 161 !------------------------------------------------------------------------------! 160 ! 0) define some variables 162 ! 0) mask at F points for the ice 163 !------------------------------------------------------------------------------! 164 ! ocean/land mask 165 DO jj = 1, jpjm1 166 DO ji = 1, jpim1 ! NO vector opt. 167 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 168 END DO 169 END DO 170 CALL lbc_lnk( zfmask, 'F', 1._wp ) 171 172 ! Lateral boundary conditions on velocity (modify zfmask) 173 zwf(:,:) = zfmask(:,:) 174 DO jj = 2, jpjm1 175 DO ji = fs_2, fs_jpim1 ! vector opt. 176 IF( zfmask(ji,jj) == 0._wp ) THEN 177 zfmask(ji,jj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1), zwf(ji-1,jj), zwf(ji,jj-1) ) ) 178 ENDIF 179 END DO 180 END DO 181 DO jj = 2, jpjm1 182 IF( zfmask(1,jj) == 0._wp ) THEN 183 zfmask(1 ,jj) = zshlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 184 ENDIF 185 IF( zfmask(jpi,jj) == 0._wp ) THEN 186 zfmask(jpi,jj) = zshlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 187 ENDIF 188 END DO 189 DO ji = 2, jpim1 190 IF( zfmask(ji,1) == 0._wp ) THEN 191 zfmask(ji,1 ) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 192 ENDIF 193 IF( zfmask(ji,jpj) == 0._wp ) THEN 194 zfmask(ji,jpj) = zshlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 195 ENDIF 196 END DO 197 CALL lbc_lnk( zfmask, 'F', 1._wp ) 198 199 !------------------------------------------------------------------------------! 200 ! 1) define some variables and initialize arrays 161 201 !------------------------------------------------------------------------------! 162 202 ! ecc2: square of yield ellipse eccenticrity … … 181 221 z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 182 222 183 !------------------------------------------------------------------------------!184 ! 1) initialize arrays185 !------------------------------------------------------------------------------!186 223 ! Initialise stress tensor 187 224 zs1 (:,:) = stress1_i (:,:) … … 279 316 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 280 317 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 281 & ) * r1_e12f(ji,jj) 318 & ) * r1_e12f(ji,jj) * zfmask(ji,jj) 282 319 283 320 END DO … … 547 584 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 548 585 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 549 & ) * r1_e12f(ji,jj) 586 & ) * r1_e12f(ji,jj) * zfmask(ji,jj) 550 587 551 588 END DO … … 629 666 CALL wrk_dealloc( jpi,jpj, zspgu, zspgv, v_oce1, u_oce2, v_ice1, u_ice2, zf1, zf2 ) 630 667 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 631 CALL wrk_dealloc( jpi,jpj, zswitch1, zswitch2 )668 CALL wrk_dealloc( jpi,jpj, zswitch1, zswitch2, zfmask, zwf ) 632 669 633 670 END SUBROUTINE lim_rhg
Note: See TracChangeset
for help on using the changeset viewer.
