- Timestamp:
- 2011-02-25T11:43:45+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/LIM_SRC_3/limthd_sal.F90
r2528 r2612 6 6 !! History : - ! 2003-05 (M. Vancoppenolle) UCL-ASTR first coding for LIM3-1D 7 7 !! 3.0 ! 2005-12 (M. Vancoppenolle) adapted to the 3-D version 8 !! 4.0 ! 2011-02 (G. Madec) dynamical allocation 8 9 !!--------------------------------------------------------------------- 9 10 #if defined key_lim3 … … 16 17 USE phycst ! physical constants (ocean directory) 17 18 USE sbc_oce ! Surface boundary condition: ocean fields 18 USE ice ! LIM: sea-ice variables 19 USE par_ice ! LIM: sea-ice parameters 20 USE thd_ice ! LIM: sea-ice thermodynamics 21 USE limvar ! LIM: sea-ice variables 19 USE ice ! LIM variables 20 USE par_ice ! LIM parameters 21 USE thd_ice ! LIM thermodynamics 22 USE limvar ! LIM variables 23 USE wrk_nemo ! workspace manager 22 24 USE in_out_manager ! I/O manager 23 25 … … 29 31 30 32 !!---------------------------------------------------------------------- 31 !! NEMO/LIM3 3.3 , UCL - NEMO Consortium (2010)33 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011) 32 34 !! $Id$ 33 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 51 53 INTEGER :: ji, jk ! dummy loop indices 52 54 INTEGER :: zji, zjj ! local integers 53 REAL(wp) :: zsold, zeps,iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars55 REAL(wp) :: zsold, iflush, iaccrbo, igravdr, isnowic, i_ice_switch, ztmelts ! local scalars 54 56 REAL(wp) :: zaaa, zbbb, zccc, zdiscrim ! local scalars 55 REAL(wp), DIMENSION(jpij) :: ze_init, zhiold, zsiold ! 1D workspace 57 ! 58 REAL(wp), POINTER, DIMENSION(:) :: ze_init, zhiold, zsiold 56 59 !!--------------------------------------------------------------------- 57 60 58 zeps=1.0e-06_wp 61 IF( .NOT. wrk_use(1, 1,2,3) ) THEN 62 CALL ctl_stop('lim_thd_dh : requestead workspace arrays unavailable.') ; RETURN 63 END IF 64 ! Set-up pointers to sub-arrays of workspace arrays 65 ze_init => wrk_1d_1 (1:jpij) 66 zhiold => wrk_1d_2 (1:jpij) 67 zsiold => wrk_1d_3 (1:jpij) 59 68 60 69 !------------------------------------------------------------------------------| 61 70 ! 1) Constant salinity, constant in time | 62 71 !------------------------------------------------------------------------------| 63 72 !!gm comment: if num_sal = 1 s_i_b and sm_i_b can be set to bulk_sal one for all in the initialisation phase !! 64 73 IF( num_sal == 1 ) THEN 74 ! 65 75 DO jk = 1, nlay_i 66 76 DO ji = kideb, kiut … … 79 89 !------------------------------------------------------------------------------| 80 90 81 IF ( ( num_sal .EQ. 2 ) .OR. ( num_sal .EQ. 4 ) ) THEN 82 83 ! WRITE(numout,*) 84 ! WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 85 ! num_sal 86 ! WRITE(numout,*) '~~~~~~~~~~~' 87 ! WRITE(numout,*) 91 IF( num_sal == 2 .OR. num_sal == 4 ) THEN 88 92 89 93 !--------------------------------- … … 91 95 !--------------------------------- 92 96 DO ji = kideb, kiut 93 zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - & 94 dh_i_surf(ji) 95 END DO ! ji 97 zhiold(ji) = ht_i_b(ji) - dh_i_bott(ji) - dh_snowice(ji) - dh_i_surf(ji) 98 END DO 96 99 97 100 !--------------------- 98 101 ! Global heat content 99 102 !--------------------- 100 101 ze_init(:) = 0.0 103 ze_init(:) = 0._wp 102 104 DO jk = 1, nlay_i 103 105 DO ji = kideb, kiut 104 106 ze_init(ji) = ze_init(ji) + q_i_b(ji,jk) * ht_i_b(ji) / nlay_i 105 END DO ! ji 106 END DO ! jk 107 108 DO ji = kideb, kiut 109 110 !---------- 107 END DO 108 END DO 109 110 DO ji = kideb, kiut 111 ! 111 112 ! Switches 112 113 !---------- 113 114 ! iflush : 1 if summer 115 iflush = MAX( 0.0 , SIGN ( 1.0 , t_su_b(ji) - rtt ) ) 116 ! igravdr : 1 if t_su lt t_bo 117 igravdr = MAX( 0.0 , SIGN ( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) 118 ! iaccrbo : 1 if bottom accretion 119 iaccrbo = MAX( 0.0 , SIGN ( 1.0 , dh_i_bott(ji) ) ) 120 ! isnowic : 1 if snow ice formation 121 i_ice_switch = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - ht_i_b(ji) + 1.0e-2 ) ) 122 isnowic = 1.0 - MAX ( 0.0 , SIGN ( 1.0 , - dh_snowice(ji) ) ) * i_ice_switch 114 iflush = MAX( 0._wp , SIGN( 1.0 , t_su_b(ji) - rtt ) ) ! =1 if summer 115 igravdr = MAX( 0._wp , SIGN( 1.0 , t_bo_b(ji) - t_su_b(ji) ) ) ! =1 if t_su < t_bo 116 iaccrbo = MAX( 0._wp , SIGN( 1.0 , dh_i_bott(ji) ) ) ! =1 if bottom accretion 117 i_ice_switch = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - ht_i_b(ji) + 1.e-2 ) ) 118 isnowic = 1._wp - MAX ( 0._wp , SIGN( 1._wp , - dh_snowice(ji) ) ) * i_ice_switch ! =1 if snow ice formation 123 119 124 120 !--------------------- 125 121 ! Salinity tendencies 126 122 !--------------------- 127 128 ! drainage by gravity drainage 123 ! ! drainage by gravity drainage 129 124 dsm_i_gd_1d(ji) = - igravdr * MAX( sm_i_b(ji) - sal_G , 0._wp ) / time_G * rdt_ice 130 131 ! drainage by flushing 132 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 125 ! ! drainage by flushing 126 dsm_i_fl_1d(ji) = - iflush * MAX( sm_i_b(ji) - sal_F , 0._wp ) / time_F * rdt_ice 133 127 134 128 !----------------- 135 129 ! Update salinity 136 130 !----------------- 137 138 131 ! only drainage terms ( gravity drainage and flushing ) 139 ! snow ice / bottom sources are added in lim_thd_ent 140 ! to conserve energy 132 ! snow ice / bottom sources are added in lim_thd_ent to conserve energy 141 133 zsiold(ji) = sm_i_b(ji) 142 134 sm_i_b(ji) = sm_i_b(ji) + dsm_i_fl_1d(ji) + dsm_i_gd_1d(ji) 143 135 144 ! if no ice, salinity eq0.1136 ! if no ice, salinity = 0.1 145 137 i_ice_switch = 1._wp - MAX ( 0._wp, SIGN( 1._wp , - ht_i_b(ji) ) ) 146 sm_i_b(ji) = i_ice_switch *sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch )138 sm_i_b(ji) = i_ice_switch * sm_i_b(ji) + s_i_min * ( 1._wp - i_ice_switch ) 147 139 END DO ! ji 148 140 … … 155 147 156 148 DO ji = kideb, kiut 149 !!gm useless 157 150 ! iflush : 1 if summer 158 151 iflush = MAX( 0._wp , SIGN ( 1._wp , t_su_b(ji) - rtt ) ) … … 161 154 ! iaccrbo : 1 if bottom accretion 162 155 iaccrbo = MAX( 0._wp , SIGN ( 1._wp , dh_i_bott(ji) ) ) 156 !!gm end useless 163 157 ! 164 158 fhbri_1d(ji) = 0._wp … … 186 180 zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + q_i_b(ji,jk) / rhoic - lfus 187 181 zccc = lfus * ( ztmelts - rtt ) 188 zdiscrim = SQRT( MAX(zbbb*zbbb - 4.0*zaaa*zccc,0.0))182 zdiscrim = SQRT( MAX( zbbb*zbbb - 4.0*zaaa*zccc, 0._wp ) ) 189 183 t_i_b(ji,jk) = rtt - ( zbbb + zdiscrim ) / ( 2.0 *zaaa ) 190 END DO !ji191 END DO !jk184 END DO 185 END DO 192 186 ! 193 187 ENDIF ! num_sal .EQ. 2 … … 197 191 !------------------------------------------------------------------------------| 198 192 199 IF( num_sal .EQ. 3 ) THEN 200 201 WRITE(numout,*) 202 WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 203 num_sal 204 WRITE(numout,*) '~~~~~~~~~~~~' 205 206 CALL lim_var_salprof1d(kideb,kiut) 207 208 ENDIF ! num_sal .EQ. 3 193 IF( num_sal == 3 ) CALL lim_var_salprof1d( kideb, kiut ) 209 194 210 195 !------------------------------------------------------------------------------| … … 212 197 !------------------------------------------------------------------------------| 213 198 214 ! Cox and Weeks, 1974 215 IF (num_sal.eq.5) THEN 216 217 WRITE(numout,*) 218 WRITE(numout,*) 'lim_thd_sal : Ice salinity computation module ', & 219 num_sal 220 WRITE(numout,*) '~~~~~~~~~~~~' 221 222 DO ji = kideb, kiut 223 199 IF( num_sal == 5 ) THEN ! Cox and Weeks, 1974 200 ! 201 DO ji = kideb, kiut 224 202 zsold = sm_i_b(ji) 225 226 IF (ht_i_b(ji).lt.0.4) THEN 227 sm_i_b(ji) = 14.24 - 19.39*ht_i_b(ji) 203 IF( ht_i_b(ji) < 0.4 ) THEN 204 sm_i_b(ji) = 14.24 - 19.39 * ht_i_b(ji) 228 205 ELSE 229 sm_i_b(ji) = 7.88 - 1.59*ht_i_b(ji)230 sm_i_b(ji) = MIN(sm_i_b(ji),zsold)206 sm_i_b(ji) = 7.88 - 1.59 * ht_i_b(ji) 207 sm_i_b(ji) = MIN( sm_i_b(ji) , zsold ) 231 208 ENDIF 232 233 IF ( ht_i_b(ji) .GT. 3.06918239 ) THEN 234 sm_i_b(ji) = 3.0 209 IF( ht_i_b(ji) > 3.06918239 ) THEN 210 sm_i_b(ji) = 3._wp 235 211 ENDIF 236 237 212 DO jk = 1, nlay_i 238 213 s_i_b(ji,jk) = sm_i_b(ji) 239 214 END DO 240 241 END DO ! ji 242 215 END DO 216 ! 243 217 ENDIF ! num_sal 244 218 … … 247 221 !------------------------------------------------------------------------------| 248 222 249 IF ( num_sal .EQ.4 ) THEN250 DO ji = kideb, kiut 251 zji = MOD( npb(ji) - 1, jpi ) + 1252 zjj =( npb(ji) - 1 ) / jpi + 1223 IF ( num_sal == 4 ) THEN 224 DO ji = kideb, kiut 225 zji = MOD( npb(ji) - 1 , jpi ) + 1 226 zjj = ( npb(ji) - 1 ) / jpi + 1 253 227 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - bulk_sal ) & 254 228 & * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice … … 256 230 ELSE 257 231 DO ji = kideb, kiut 258 zji = MOD( npb(ji) - 1, jpi ) + 1259 zjj =( npb(ji) - 1 ) / jpi + 1232 zji = MOD( npb(ji) - 1 , jpi ) + 1 233 zjj = ( npb(ji) - 1 ) / jpi + 1 260 234 fseqv_1d(ji) = fseqv_1d(ji) + ( sss_m(zji,zjj) - s_i_new(ji) ) & 261 235 & * rhoic * a_i_b(ji) * MAX( dh_i_bott(ji) , 0.0 ) / rdt_ice 262 END DO ! ji236 END DO 263 237 ENDIF 238 ! 239 IF( .NOT. wrk_release(1, 1,2,3) ) CALL ctl_stop( 'lim_thd_lac : failed to release workspace arrays.' ) 264 240 ! 265 241 END SUBROUTINE lim_thd_sal
Note: See TracChangeset
for help on using the changeset viewer.
