Changeset 2715 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r2528 r2715 4 4 !! Sea-Ice dynamics : 5 5 !!====================================================================== 6 !! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code 7 !! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid 6 !! history : 1.0 ! 2002-08 (C. Ethe, G. Madec) original VP code 7 !! 3.0 ! 2007-03 (MA Morales Maqueda, S. Bouillon, M. Vancoppenolle) LIM3: EVP-Cgrid 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_lim3 … … 14 15 !! lim_dyn_init : initialization and namelist read 15 16 !!---------------------------------------------------------------------- 16 USE phycst 17 USE in_out_manager ! I/O manager18 USE dom_ice19 USE dom_oce ! ocean space and time domain20 USE ice 21 USE par_ice 22 USE sbc_oce ! Surface boundary condition: ocean fields23 USE sbc_ice ! Surface boundary condition: ice fields24 USE l imrhg ! ice rheology25 USE l bclnk26 USE lib_mpp27 USE prtctl ! Print control17 USE phycst ! physical constants 18 USE dom_oce ! ocean space and time domain 19 USE sbc_oce ! Surface boundary condition: ocean fields 20 USE sbc_ice ! Surface boundary condition: ice fields 21 USE ice ! LIM-3 variables 22 USE par_ice ! LIM-3 parameters 23 USE dom_ice ! LIM-3 domain 24 USE limrhg ! LIM-3 rheology 25 USE lbclnk ! lateral boundary conditions - MPP exchanges 26 USE lib_mpp ! MPP library 27 USE in_out_manager ! I/O manager 28 USE prtctl ! Print control 28 29 29 30 IMPLICIT NONE … … 35 36 # include "vectopt_loop_substitute.h90" 36 37 !!---------------------------------------------------------------------- 37 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)38 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 38 39 !! $Id$ 39 40 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 54 55 !! - treatment of the case if no ice dynamic 55 56 !!------------------------------------------------------------------------------------ 57 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 58 USE wrk_nemo, ONLY: wrk_1d_1, wrk_1d_2 59 USE wrk_nemo, ONLY: zu_io => wrk_2d_1, zv_io => wrk_2d_2 ! ice-ocean velocity 60 ! 56 61 INTEGER, INTENT(in) :: kt ! number of iteration 57 62 !! … … 59 64 INTEGER :: i_j1, i_jpj ! Starting/ending j-indices for rheology 60 65 REAL(wp) :: zcoef ! local scalar 61 REAL(wp), DIMENSION(jpj) :: zind ! i-averaged indicator of sea-ice 62 REAL(wp), DIMENSION(jpj) :: zmsk ! i-averaged of tmask 63 REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io ! ice-ocean velocity 66 REAL(wp), POINTER, DIMENSION(:) :: zind ! i-averaged indicator of sea-ice 67 REAL(wp), POINTER, DIMENSION(:) :: zmsk ! i-averaged of tmask 64 68 !!--------------------------------------------------------------------- 65 69 66 IF( kt == nit000 .AND. lwp ) THEN 67 WRITE(numout,*) ' lim_dyn : Ice dynamics ' 68 WRITE(numout,*) ' ~~~~~~~ ' 69 ENDIF 70 71 IF( numit == nstart ) CALL lim_dyn_init ! Initialization (first time-step only) 72 73 IF ( ln_limdyn ) THEN 74 70 IF( wrk_in_use(1, 1,2) .OR. wrk_in_use(2, 1,2) ) THEN 71 CALL ctl_stop('lim_dyn : requested workspace arrays unavailable') ; RETURN 72 ENDIF 73 zind => wrk_1d_1(1:jpj) ! Set-up pointers to sub-arrays of workspaces 74 zmsk => wrk_1d_2(1:jpj) 75 76 IF( kt == nit000 ) CALL lim_dyn_init ! Initialization (first time-step only) 77 78 IF( ln_limdyn ) THEN 79 ! 75 80 old_u_ice(:,:) = u_ice(:,:) * tmu(:,:) 76 81 old_v_ice(:,:) = v_ice(:,:) * tmv(:,:) … … 88 93 CALL lim_rhg( i_j1, i_jpj ) 89 94 ELSE ! optimization of the computational area 90 95 ! 91 96 DO jj = 1, jpj 92 zind(jj) = SUM( 1.0 - at_i (:,jj ) ) ! = FLOAT(jpj) if ocean everywhere on a j-line93 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0if land everywhere on a j-line97 zind(jj) = SUM( 1.0 - at_i(:,jj) ) ! = REAL(jpj) if ocean everywhere on a j-line 98 zmsk(jj) = SUM( tmask(:,jj,1) ) ! = 0 if land everywhere on a j-line 94 99 END DO 95 100 … … 106 111 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : NH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 107 112 CALL lim_rhg( i_j1, i_jpj ) 108 113 ! 109 114 ! Southern hemisphere 110 115 i_j1 = 1 … … 115 120 i_jpj = MIN( jpj, i_jpj+1 ) 116 121 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : SH i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 117 118 CALL lim_rhg( i_j1, i_jpj )119 120 ELSE ! local domain extends over one hemisphere only121 ! ! Rheology is computed only over the ice cover122 ! ! latitude strip123 i_j1 = 1122 ! 123 CALL lim_rhg( i_j1, i_jpj ) 124 ! 125 ELSE ! local domain extends over one hemisphere only 126 ! ! Rheology is computed only over the ice cover 127 ! ! latitude strip 128 i_j1 = 1 124 129 DO WHILE ( i_j1 <= jpj .AND. zind(i_j1) == FLOAT(jpi) .AND. zmsk(i_j1) /=0 ) 125 130 i_j1 = i_j1 + 1 … … 132 137 END DO 133 138 i_jpj = MIN( jpj, i_jpj+1) 134 139 ! 135 140 IF(ln_ctl) CALL prt_ctl_info( 'lim_dyn : one hemisphere: i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 136 141 ! 137 142 CALL lim_rhg( i_j1, i_jpj ) 138 143 ! 139 144 ENDIF 140 145 ! 141 146 ENDIF 142 147 … … 147 152 zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 148 153 ! frictional velocity at T-point 149 zcoef = 0.5 * cw154 zcoef = 0.5_wp * cw 150 155 DO jj = 2, jpjm1 151 156 DO ji = fs_2, fs_jpim1 ! vector opt. … … 157 162 ELSE ! no ice dynamics : transmit directly the atmospheric stress to the ocean 158 163 ! 159 zcoef = SQRT( 0.5 ) / rau0164 zcoef = SQRT( 0.5_wp ) / rau0 160 165 DO jj = 2, jpjm1 161 166 DO ji = fs_2, fs_jpim1 ! vector opt. … … 207 212 ENDIF 208 213 ! 214 IF( wrk_not_released(1, 1,2) .OR. & 215 wrk_not_released(2, 1,2) ) CALL ctl_stop('lim_dyn : failed to release workspace arrays' ) 216 ! 209 217 END SUBROUTINE lim_dyn 210 218 … … 271 279 ahiu(:,:) = ahi0 * umask(:,:,1) 272 280 ahiv(:,:) = ahi0 * vmask(:,:,1) 273 281 ! 274 282 END SUBROUTINE lim_dyn_init 275 283
Note: See TracChangeset
for help on using the changeset viewer.
