Changeset 5737
- Timestamp:
- 2015-09-13T09:42:41+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO
- Files:
-
- 59 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limadv.F90
r5429 r5737 97 97 98 98 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 99 psm (:,:) = MAX( pcrh * e1 2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )99 psm (:,:) = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 100 100 101 101 ! Calculate fluxes and moments between boxes i<-->i+1 … … 282 282 283 283 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) 284 psm(:,:) = MAX( pcrh * e1 2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 )284 psm(:,:) = MAX( pcrh * e1e2t(:,:) + ( 1.0 - pcrh ) * psm(:,:) , epsi20 ) 285 285 286 286 ! Calculate fluxes and moments between boxes j<-->j+1 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limcons.F90
r5183 r5737 185 185 zfs_b = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 186 186 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 187 & ) * e1 2t(:,:) * tmask(:,:,1) * zconv )187 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 188 188 189 189 ! water flux 190 190 zfw_b = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 191 191 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 192 & ) * e1 2t(:,:) * tmask(:,:,1) * zconv )192 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 193 193 194 194 ! heat flux 195 195 zft_b = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 196 196 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 197 & ) * e1 2t(:,:) * tmask(:,:,1) * zconv )198 199 zvi_b = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1 2t * tmask(:,:,1) * zconv )200 201 zsmv_b = glob_sum( SUM( smv_i * rhoic , dim=3 ) * e1 2t * tmask(:,:,1) * zconv )197 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) 198 199 zvi_b = glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 200 201 zsmv_b = glob_sum( SUM( smv_i * rhoic , dim=3 ) * e1e2t * tmask(:,:,1) * zconv ) 202 202 203 203 zei_b = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + & 204 204 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) & 205 ) * e1 2t * tmask(:,:,1) * zconv )205 ) * e1e2t * tmask(:,:,1) * zconv ) 206 206 207 207 ELSEIF( icount == 1 ) THEN … … 210 210 zfs = glob_sum( ( sfx_bri(:,:) + sfx_bog(:,:) + sfx_bom(:,:) + sfx_sum(:,:) + sfx_sni(:,:) + & 211 211 & sfx_opw(:,:) + sfx_res(:,:) + sfx_dyn(:,:) & 212 & ) * e1 2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b212 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfs_b 213 213 214 214 ! water flux 215 215 zfw = glob_sum( -( wfx_bog(:,:) + wfx_bom(:,:) + wfx_sum(:,:) + wfx_sni(:,:) + wfx_opw(:,:) + & 216 216 & wfx_res(:,:) + wfx_dyn(:,:) + wfx_snw(:,:) + wfx_sub(:,:) + wfx_spr(:,:) & 217 & ) * e1 2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b217 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zfw_b 218 218 219 219 ! heat flux 220 220 zft = glob_sum( ( hfx_sum(:,:) + hfx_bom(:,:) + hfx_bog(:,:) + hfx_dif(:,:) + hfx_opw(:,:) + hfx_snw(:,:) & 221 221 & - hfx_thd(:,:) - hfx_dyn(:,:) - hfx_res(:,:) - hfx_sub(:,:) - hfx_spr(:,:) & 222 & ) * e1 2t(:,:) * tmask(:,:,1) * zconv ) - zft_b222 & ) * e1e2t(:,:) * tmask(:,:,1) * zconv ) - zft_b 223 223 224 224 ! outputs 225 225 zvi = ( ( glob_sum( SUM( v_i * rhoic + v_s * rhosn, dim=3 ) & 226 & * e1 2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday226 & * e1e2t * tmask(:,:,1) * zconv ) - zvi_b ) * r1_rdtice - zfw ) * rday 227 227 228 228 zsmv = ( ( glob_sum( SUM( smv_i * rhoic , dim=3 ) & 229 & * e1 2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday229 & * e1e2t * tmask(:,:,1) * zconv ) - zsmv_b ) * r1_rdtice + zfs ) * rday 230 230 231 231 zei = glob_sum( ( SUM( SUM( e_i(:,:,1:nlay_i,:), dim=4 ), dim=3 ) + & 232 232 & SUM( SUM( e_s(:,:,1:nlay_s,:), dim=4 ), dim=3 ) & 233 & ) * e1 2t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft233 & ) * e1e2t * tmask(:,:,1) * zconv ) * r1_rdtice - zei_b * r1_rdtice + zft 234 234 235 235 ! zvtrp and zetrp must be close to 0 if the advection scheme is conservative 236 zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1 2t * tmask(:,:,1) * zconv ) * rday237 zetrp = glob_sum( ( diag_trp_ei + diag_trp_es ) * e1 2t * tmask(:,:,1) * zconv )236 zvtrp = glob_sum( ( diag_trp_vi * rhoic + diag_trp_vs * rhosn ) * e1e2t * tmask(:,:,1) * zconv ) * rday 237 zetrp = glob_sum( ( diag_trp_ei + diag_trp_es ) * e1e2t * tmask(:,:,1) * zconv ) 238 238 239 239 zvmin = glob_min( v_i ) … … 242 242 243 243 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 244 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1 2t * zconv ) ! in 1.e9 m2244 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2 245 245 zv_sill = zarea * 2.5e-5 246 246 zs_sill = zarea * 25.e-5 … … 286 286 #if ! defined key_bdy 287 287 ! heat flux 288 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e1 2t * tmask(:,:,1) * zconv )288 zhfx = glob_sum( ( hfx_in - hfx_out - diag_heat - diag_trp_ei - diag_trp_es - hfx_sub ) * e1e2t * tmask(:,:,1) * zconv ) 289 289 ! salt flux 290 zsfx = glob_sum( ( sfx + diag_smvi ) * e1 2t * tmask(:,:,1) * zconv ) * rday290 zsfx = glob_sum( ( sfx + diag_smvi ) * e1e2t * tmask(:,:,1) * zconv ) * rday 291 291 ! water flux 292 zvfx = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1 2t * tmask(:,:,1) * zconv ) * rday292 zvfx = glob_sum( ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + diag_vice + diag_vsnw ) * e1e2t * tmask(:,:,1) * zconv ) * rday 293 293 294 294 ! set threshold values and calculate the ice area (+epsi10 to set a threshold > 0 when there is no ice) 295 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1 2t * zconv ) ! in 1.e9 m2295 zarea = glob_sum( SUM( a_i + epsi10, dim=3 ) * e1e2t * zconv ) ! in 1.e9 m2 296 296 zv_sill = zarea * 2.5e-5 297 297 zs_sill = zarea * 25.e-5 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limctl.F90
r5167 r5737 306 306 WRITE(numout,*) ' - Cell values ' 307 307 WRITE(numout,*) ' ~~~~~~~~~~~ ' 308 WRITE(numout,*) ' cell area : ', e1 2t(ji,jj)308 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj) 309 309 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 310 310 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) … … 350 350 WRITE(numout,*) ' - Cell values ' 351 351 WRITE(numout,*) ' ~~~~~~~~~~~ ' 352 WRITE(numout,*) ' cell area : ', e1 2t(ji,jj)352 WRITE(numout,*) ' cell area : ', e1e2t(ji,jj) 353 353 WRITE(numout,*) ' at_i : ', at_i(ji,jj) 354 354 WRITE(numout,*) ' vt_i : ', vt_i(ji,jj) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r5215 r5737 71 71 72 72 ! 1/area 73 z1_area = 1._wp / MAX( glob_sum( e1 2t(:,:) * tmask(:,:,1) ), epsi06 )74 75 rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1 2t(:,:) * tmask(:,:,1) ) - epsi06 ) )73 z1_area = 1._wp / MAX( glob_sum( e1e2t(:,:) * tmask(:,:,1) ), epsi06 ) 74 75 rswitch = MAX( 0._wp , SIGN( 1._wp , glob_sum( e1e2t(:,:) * tmask(:,:,1) ) - epsi06 ) ) 76 76 ! ----------------------- ! 77 77 ! 1 - Content variations ! 78 78 ! ----------------------- ! 79 zbg_ivo = glob_sum( vt_i(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! volume ice80 zbg_svo = glob_sum( vt_s(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! volume snow81 zbg_are = glob_sum( at_i(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! area82 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1 2t(:,:) * tmask(:,:,1) ) ! mean salt content83 zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! mean temp content84 85 !zbg_ihc = glob_sum( et_i(:,:) * e1 2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content86 !zbg_shc = glob_sum( et_s(:,:) * e1 2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content79 zbg_ivo = glob_sum( vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume ice 80 zbg_svo = glob_sum( vt_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume snow 81 zbg_are = glob_sum( at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! area 82 zbg_sal = glob_sum( SUM( smv_i(:,:,:), dim=3 ) * e1e2t(:,:) * tmask(:,:,1) ) ! mean salt content 83 zbg_tem = glob_sum( ( tm_i(:,:) - rt0 ) * vt_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! mean temp content 84 85 !zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_ivo,epsi06 ) ! ice heat content 86 !zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) * tmask(:,:,1) ) / MAX( zbg_svo,epsi06 ) ! snow heat content 87 87 88 88 ! Volume 89 89 ztmp = rswitch * z1_area * r1_rau0 * rday 90 zbg_vfx = ztmp * glob_sum( emp(:,:) * e1 2t(:,:) * tmask(:,:,1) )91 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1 2t(:,:) * tmask(:,:,1) )92 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1 2t(:,:) * tmask(:,:,1) )93 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1 2t(:,:) * tmask(:,:,1) )94 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1 2t(:,:) * tmask(:,:,1) )95 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1 2t(:,:) * tmask(:,:,1) )96 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1 2t(:,:) * tmask(:,:,1) )97 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1 2t(:,:) * tmask(:,:,1) )98 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1 2t(:,:) * tmask(:,:,1) )99 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1 2t(:,:) * tmask(:,:,1) )100 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1 2t(:,:) * tmask(:,:,1) )90 zbg_vfx = ztmp * glob_sum( emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 91 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 92 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 93 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 94 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 95 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 96 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 97 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 98 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 99 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 100 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 101 101 102 102 ! Salt 103 zbg_sfx = ztmp * glob_sum( sfx(:,:) * e1 2t(:,:) * tmask(:,:,1) )104 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1 2t(:,:) * tmask(:,:,1) )105 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1 2t(:,:) * tmask(:,:,1) )106 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1 2t(:,:) * tmask(:,:,1) )107 108 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1 2t(:,:) * tmask(:,:,1) )109 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1 2t(:,:) * tmask(:,:,1) )110 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1 2t(:,:) * tmask(:,:,1) )111 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1 2t(:,:) * tmask(:,:,1) )112 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1 2t(:,:) * tmask(:,:,1) )103 zbg_sfx = ztmp * glob_sum( sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 104 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 105 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 106 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 107 108 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 109 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 110 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 111 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 112 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 113 113 114 114 ! Heat budget 115 zbg_ihc = glob_sum( et_i(:,:) * e1 2t(:,:) * 1.e-20 )! ice heat content [1.e20 J]116 zbg_shc = glob_sum( et_s(:,:) * e1 2t(:,:) * 1.e-20 )! snow heat content [1.e20 J]117 zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]118 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]119 120 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]121 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]122 zbg_hfx_res = glob_sum( hfx_res(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]123 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]124 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]125 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]126 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]127 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]128 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]129 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]130 zbg_hfx_out = glob_sum( hfx_out(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]131 zbg_hfx_in = glob_sum( hfx_in(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! [in W]115 zbg_ihc = glob_sum( et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! ice heat content [1.e20 J] 116 zbg_shc = glob_sum( et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! snow heat content [1.e20 J] 117 zbg_hfx_dhc = glob_sum( diag_heat(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 118 zbg_hfx_spr = glob_sum( hfx_spr(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 119 120 zbg_hfx_thd = glob_sum( hfx_thd(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 121 zbg_hfx_dyn = glob_sum( hfx_dyn(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 122 zbg_hfx_res = glob_sum( hfx_res(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 123 zbg_hfx_sub = glob_sum( hfx_sub(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 124 zbg_hfx_snw = glob_sum( hfx_snw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 125 zbg_hfx_sum = glob_sum( hfx_sum(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 126 zbg_hfx_bom = glob_sum( hfx_bom(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 127 zbg_hfx_bog = glob_sum( hfx_bog(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 128 zbg_hfx_dif = glob_sum( hfx_dif(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 129 zbg_hfx_opw = glob_sum( hfx_opw(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 130 zbg_hfx_out = glob_sum( hfx_out(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 131 zbg_hfx_in = glob_sum( hfx_in(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! [in W] 132 132 133 133 ! --------------------------------------------- ! 134 134 ! 2 - Trends due to forcing and ice growth/melt ! 135 135 ! --------------------------------------------- ! 136 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! volume fluxes137 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * e1 2t(:,:) * tmask(:,:,1) ) ! salt fluxes136 z_frc_vol = r1_rau0 * glob_sum( - emp(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 137 z_frc_sal = r1_rau0 * glob_sum( sfx(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! salt fluxes 138 138 z_bg_grme = glob_sum( - ( wfx_bog(:,:) + wfx_opw(:,:) + wfx_sni(:,:) + wfx_dyn(:,:) + & 139 139 & wfx_bom(:,:) + wfx_sum(:,:) + wfx_res(:,:) + wfx_snw(:,:) + & 140 & wfx_sub(:,:) ) * e1 2t(:,:) * tmask(:,:,1) ) ! volume fluxes140 & wfx_sub(:,:) ) * e1e2t(:,:) * tmask(:,:,1) ) ! volume fluxes 141 141 ! 142 142 frc_vol = frc_vol + z_frc_vol * rdt_ice -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limdyn.F90
r5123 r5737 191 191 CALL prt_ctl(tab2d_1=delta_i , clinfo1=' lim_dyn : delta_i :') 192 192 CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_dyn : strength :') 193 CALL prt_ctl(tab2d_1=e1 2t, clinfo1=' lim_dyn : cell area :')193 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_dyn : cell area :') 194 194 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_dyn : at_i :') 195 195 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_dyn : vt_i :') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r5429 r5737 76 76 DO jj = 2, jpjm1 77 77 DO ji = fs_2 , fs_jpim1 ! vector opt. 78 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1 2t(ji,jj)78 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e1e2t(ji,jj) 79 79 END DO 80 80 END DO … … 107 107 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 108 108 DO ji = fs_2 , fs_jpim1 ! vector opt. 109 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1 2t(ji,jj)109 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) 110 110 END DO 111 111 END DO … … 149 149 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes 150 150 DO ji = fs_2 , fs_jpim1 ! vector opt. 151 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1 2t(ji,jj)151 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e1e2t(ji,jj) 152 152 ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) ) 153 153 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limitd_me.F90
r5202 r5737 377 377 CALL prt_ctl_info(' - Cell values : ') 378 378 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 379 CALL prt_ctl(tab2d_1=e1 2t, clinfo1=' lim_itd_me : cell area :')379 CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_me : cell area :') 380 380 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_me : at_i :') 381 381 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_me : vt_i :') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r5429 r5737 355 355 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 356 356 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 357 & ) * r1_e1 2t(ji,jj)357 & ) * r1_e1e2t(ji,jj) 358 358 359 359 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 360 360 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 361 & ) * r1_e1 2t(ji,jj)361 & ) * r1_e1e2t(ji,jj) 362 362 363 363 ! 364 364 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) & 365 365 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 366 & ) * r1_e1 2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) &366 & ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) & 367 367 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 368 368 … … 386 386 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 387 387 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) & 388 & ) * r1_e1 2t(ji,jj)388 & ) * r1_e1e2t(ji,jj) 389 389 390 390 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) … … 394 394 zddc = ( ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 395 395 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 396 & ) * r1_e1 2f(ji,jj)396 & ) * r1_e1e2f(ji,jj) 397 397 398 398 zdtc = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 399 399 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 400 & ) * r1_e1 2f(ji,jj)400 & ) * r1_e1e2f(ji,jj) 401 401 402 402 zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl … … 423 423 & + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj) & 424 424 & + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 425 & ) * r1_e1 2u(ji,jj)425 & ) * r1_e1e2u(ji,jj) 426 426 ! contribution of zs1, zs2 and zs12 to zf2 427 427 zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 428 428 & - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj) & 429 429 & + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj) & 430 & ) * r1_e1 2v(ji,jj)430 & ) * r1_e1e2v(ji,jj) 431 431 END DO 432 432 END DO … … 607 607 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj ) * u_ice(ji-1,jj ) & 608 608 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji ,jj-1) * v_ice(ji ,jj-1) & 609 & ) * r1_e1 2t(ji,jj)609 & ) * r1_e1e2t(ji,jj) 610 610 611 611 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 612 612 & -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 613 & ) * r1_e1 2t(ji,jj)613 & ) * r1_e1e2t(ji,jj) 614 614 ! 615 615 ! SB modif because ocean has no slip boundary condition 616 616 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) & 617 617 & +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 618 & ) * r1_e1 2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) &618 & ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) & 619 619 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 620 620 621 621 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e1 2t(ji,jj)622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e1e2t(ji,jj) 623 623 624 624 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) … … 637 637 DO ji = fs_2, fs_jpim1 638 638 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj ) * v_ice1(ji-1,jj) & 639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1 2t(ji,jj)639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj) 640 640 shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 641 641 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5407 r5737 325 325 CALL prt_ctl_info(' - Cell values : ') 326 326 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 327 CALL prt_ctl(tab2d_1=e1 2t, clinfo1=' lim_thd : cell area :')327 CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_thd : cell area :') 328 328 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_thd : at_i :') 329 329 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_thd : vt_i :') … … 382 382 CALL prt_ctl_info(' - Cell values : ') 383 383 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 384 CALL prt_ctl(tab2d_1=e1 2t, clinfo1=' lim_itd_th : cell area :')384 CALL prt_ctl(tab2d_1=e1e2t, clinfo1=' lim_itd_th : cell area :') 385 385 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :') 386 386 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r5202 r5737 95 95 ENDIF 96 96 97 zsm(:,:) = e1 2t(:,:)97 zsm(:,:) = e1e2t(:,:) 98 98 99 99 ! !-------------------------------------! … … 162 162 ! transported fields 163 163 !------------------------- 164 z0opw(:,:,1) = ato_i(:,:) * e1 2t(:,:) ! Open water area165 DO jl = 1, jpl 166 z0snw (:,:,jl) = v_s (:,:, jl) * e12t(:,:)! Snow volume167 z0ice(:,:,jl) = v_i (:,:, jl) * e12t(:,:)! Ice volume168 z0ai (:,:,jl) = a_i (:,:, jl) * e12t(:,:)! Ice area169 z0smi (:,:,jl) = smv_i(:,:, jl) * e12t(:,:)! Salt content170 z0oi (:,:,jl) = oa_i (:,:, jl) * e12t(:,:)! Age content171 z0es (:,:,jl) = e_s (:,:,1,jl) * e1 2t(:,:) ! Snow heat content164 z0opw(:,:,1) = ato_i(:,:) * e1e2t(:,:) ! Open water area 165 DO jl = 1, jpl 166 z0snw (:,:,jl) = v_s (:,:, jl) * e1e2t(:,:) ! Snow volume 167 z0ice(:,:,jl) = v_i (:,:, jl) * e1e2t(:,:) ! Ice volume 168 z0ai (:,:,jl) = a_i (:,:, jl) * e1e2t(:,:) ! Ice area 169 z0smi (:,:,jl) = smv_i(:,:, jl) * e1e2t(:,:) ! Salt content 170 z0oi (:,:,jl) = oa_i (:,:, jl) * e1e2t(:,:) ! Age content 171 z0es (:,:,jl) = e_s (:,:,1,jl) * e1e2t(:,:) ! Snow heat content 172 172 DO jk = 1, nlay_i 173 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1 2t(:,:) ! Ice heat content173 z0ei (:,:,jk,jl) = e_i (:,:,jk,jl) * e1e2t(:,:) ! Ice heat content 174 174 END DO 175 175 END DO … … 263 263 ! Recover the properties from their contents 264 264 !------------------------------------------- 265 ato_i(:,:) = z0opw(:,:,1) * r1_e1 2t(:,:)266 DO jl = 1, jpl 267 v_i (:,:, jl) = z0ice(:,:,jl) * r1_e12t(:,:)268 v_s (:,:, jl) = z0snw(:,:,jl) * r1_e12t(:,:)269 smv_i(:,:, jl) = z0smi(:,:,jl) * r1_e12t(:,:)270 oa_i (:,:, jl) = z0oi (:,:,jl) * r1_e12t(:,:)271 a_i (:,:, jl) = z0ai (:,:,jl) * r1_e12t(:,:)272 e_s (:,:,1,jl) = z0es (:,:,jl) * r1_e1 2t(:,:)265 ato_i(:,:) = z0opw(:,:,1) * r1_e1e2t(:,:) 266 DO jl = 1, jpl 267 v_i (:,:, jl) = z0ice(:,:,jl) * r1_e1e2t(:,:) 268 v_s (:,:, jl) = z0snw(:,:,jl) * r1_e1e2t(:,:) 269 smv_i(:,:, jl) = z0smi(:,:,jl) * r1_e1e2t(:,:) 270 oa_i (:,:, jl) = z0oi (:,:,jl) * r1_e1e2t(:,:) 271 a_i (:,:, jl) = z0ai (:,:,jl) * r1_e1e2t(:,:) 272 e_s (:,:,1,jl) = z0es (:,:,jl) * r1_e1e2t(:,:) 273 273 DO jk = 1, nlay_i 274 e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1 2t(:,:)274 e_i(:,:,jk,jl) = z0ei(:,:,jk,jl) * r1_e1e2t(:,:) 275 275 END DO 276 276 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limupdate1.F90
r5215 r5737 146 146 CALL prt_ctl_info(' - Cell values : ') 147 147 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 148 CALL prt_ctl(tab2d_1=e1 2t, clinfo1=' lim_update1 : cell area :')148 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_update1 : cell area :') 149 149 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update1 : at_i :') 150 150 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update1 : vt_i :') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90
r5410 r5737 191 191 CALL prt_ctl_info(' - Cell values : ') 192 192 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 193 CALL prt_ctl(tab2d_1=e1 2t, clinfo1=' lim_update2 : cell area :')193 CALL prt_ctl(tab2d_1=e1e2t , clinfo1=' lim_update2 : cell area :') 194 194 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update2 : at_i :') 195 195 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update2 : vt_i :') -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r5656 r5737 210 210 DO jj = j1,j2-1 211 211 DO ji = i1,i2-1 212 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)213 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)212 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 213 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 214 214 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 215 215 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) … … 239 239 240 240 IF (.NOT. tabspongedone_tsn(ji,jj)) THEN 241 zbtr = r1_e1 2t(ji,jj) / fse3t_n(ji,jj,jk)241 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) 242 242 ! horizontal diffusive trends 243 243 ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) … … 290 290 DO jj = j1,j2 291 291 DO ji = i1+1,i2 ! vector opt. 292 zbtr = r1_e1 2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)292 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 293 293 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)*fse3u_n(ji ,jj,jk) * ubdiff(ji ,jj,jk) & 294 294 & -e2u(ji-1,jj)*fse3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr … … 298 298 DO jj = j1,j2-1 299 299 DO ji = i1,i2 ! vector opt. 300 zbtr = r1_e1 2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)300 zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 301 301 rotdiff(ji,jj,jk) = (-e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 302 302 +e1u(ji,jj ) * ubdiff(ji,jj ,jk) & … … 396 396 DO jj = j1+1,j2 397 397 DO ji = i1,i2 ! vector opt. 398 zbtr = r1_e1 2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj)398 zbtr = r1_e1e2t(ji,jj) / fse3t_n(ji,jj,jk) * fsahm_spt(ji,jj) 399 399 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * fse3v(ji,jj ,jk) * vbdiff(ji,jj ,jk) & 400 400 & -e1v(ji,jj-1) * fse3v(ji,jj-1,jk) * vbdiff(ji,jj-1,jk) ) * zbtr … … 403 403 DO jj = j1,j2 404 404 DO ji = i1,i2-1 ! vector opt. 405 zbtr = r1_e1 2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj)405 zbtr = r1_e1e2f(ji,jj) * fse3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 406 406 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 407 407 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) & -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/NST_SRC/agrif_top_sponge.F90
r5656 r5737 74 74 DO jj = j1,j2-1 75 75 DO ji = i1,i2-1 76 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)77 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)76 zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 77 zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 78 78 ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 79 79 ztv(ji,jj) = zabe2 * ( trbdiff(ji ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) … … 85 85 86 86 IF (.NOT. tabspongedone_trn(ji,jj)) THEN 87 zbtr = r1_e1 2t(ji,jj) / fse3t(ji,jj,jk)87 zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,jk) 88 88 ! horizontal diffusive trends 89 89 ztra = zbtr * ( ztu(ji,jj) - ztu(ji-1,jj ) + ztv(ji,jj) - ztv(ji ,jj-1) ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OFF_SRC/domrea.F90
r5504 r5737 4 4 !! Ocean initialization : domain initialization 5 5 !!============================================================================== 6 !! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code 7 !! ! 1992-01 (M. Imbard) insert time step initialization 8 !! ! 1996-06 (G. Madec) generalized vertical coordinate 9 !! ! 1997-02 (G. Madec) creation of domwri.F 10 !! ! 2001-05 (E.Durand - G. Madec) insert closed sea 11 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 12 !!---------------------------------------------------------------------- 6 13 7 14 !!---------------------------------------------------------------------- … … 10 17 !! dom_ctl : control print for the ocean domain 11 18 !!---------------------------------------------------------------------- 12 !! * Modules used13 19 USE oce ! 20 USE trc_oce ! shared ocean/biogeochemical variables 14 21 USE dom_oce ! ocean space and time domain 15 22 USE phycst ! physical constants 23 USE domstp ! domain: set the time-step 24 ! 16 25 USE in_out_manager ! I/O manager 17 26 USE lib_mpp ! distributed memory computing library 18 19 USE domstp ! domain: set the time-step20 21 27 USE lbclnk ! lateral boundary condition - MPP exchanges 22 USE trc_oce ! shared ocean/biogeochemical variables23 28 USE wrk_nemo 24 29 … … 26 31 PRIVATE 27 32 28 !! * Routine accessibility 29 PUBLIC dom_rea ! called by opa.F90 33 PUBLIC dom_rea ! called by nemogcm.F90 30 34 31 35 !! * Substitutions … … 33 37 # include "vectopt_loop_substitute.h90" 34 38 !!---------------------------------------------------------------------- 35 !! NEMO/OFF 3. 3 , NEMO Consortium (2010)39 !! NEMO/OFF 3.7 , NEMO Consortium (2015) 36 40 !! $Id$ 37 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 42 !!---------------------------------------------------------------------- 39 40 43 CONTAINS 41 44 … … 51 54 !! - dom_stp: defined the model time step 52 55 !! - dom_rea: read the meshmask file if nmsh=1 53 !! 54 !! History : 55 !! ! 90-10 (C. Levy - G. Madec) Original code 56 !! ! 91-11 (G. Madec) 57 !! ! 92-01 (M. Imbard) insert time step initialization 58 !! ! 96-06 (G. Madec) generalized vertical coordinate 59 !! ! 97-02 (G. Madec) creation of domwri.F 60 !! ! 01-05 (E.Durand - G. Madec) insert closed sea 61 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 62 !!---------------------------------------------------------------------- 63 !! * Local declarations 64 INTEGER :: jk ! dummy loop argument 65 INTEGER :: iconf = 0 ! temporary integers 66 !!---------------------------------------------------------------------- 67 56 !!---------------------------------------------------------------------- 57 INTEGER :: jk ! dummy loop index 58 INTEGER :: iconf = 0 ! local integers 59 !!---------------------------------------------------------------------- 60 ! 68 61 IF(lwp) THEN 69 62 WRITE(numout,*) … … 71 64 WRITE(numout,*) '~~~~~~~~' 72 65 ENDIF 73 66 ! 74 67 CALL dom_nam ! read namelist ( namrun, namdom, namcla ) 75 68 CALL dom_zgr ! Vertical mesh and bathymetry option 76 69 CALL dom_grd ! Create a domain file 77 78 !79 ! - ML - Used in dom_vvl_sf_nxt and lateral diffusion routines80 ! but could be usefull in many other routines81 e12t (:,:) = e1t(:,:) * e2t(:,:)82 e1e2t (:,:) = e1t(:,:) * e2t(:,:)83 e12u (:,:) = e1u(:,:) * e2u(:,:)84 e12v (:,:) = e1v(:,:) * e2v(:,:)85 e1 2f (:,:) = e1f(:,:) * e2f(:,:)86 r1_e12t (:,:) = 1._wp / e12t(:,:)87 r1_e12u (:,:) = 1._wp / e12u(:,:)88 r1_e12v (:,:) = 1._wp / e12v(:,:)89 r1_e12f (:,:) = 1._wp / e12f(:,:)90 re2u_e1u(:,:) = e2u(:,:) / e1u(:,:)91 re1v_e2v(:,:) = e1v(:,:) / e2v(:,:)92 ! 93 hu(:,:) = 0._wp 70 ! 71 ! ! associated horizontal metrics 72 ! 73 r1_e1t(:,:) = 1._wp / e1t(:,:) ; r1_e2t (:,:) = 1._wp / e2t(:,:) 74 r1_e1u(:,:) = 1._wp / e1u(:,:) ; r1_e2u (:,:) = 1._wp / e2u(:,:) 75 r1_e1v(:,:) = 1._wp / e1v(:,:) ; r1_e2v (:,:) = 1._wp / e2v(:,:) 76 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 77 ! 78 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 79 e1e2u (:,:) = e1u(:,:) * e2u(:,:) ; r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) 80 e1e2v (:,:) = e1v(:,:) * e2v(:,:) ; r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 81 e1e2f (:,:) = e1f(:,:) * e2f(:,:) ; r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 82 ! 83 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 84 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 85 ! 86 hu(:,:) = 0._wp ! Ocean depth at U- and V-points 94 87 hv(:,:) = 0._wp 95 88 DO jk = 1, jpk … … 100 93 hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask(:,:,1) ) * umask(:,:,1) 101 94 hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask(:,:,1) ) * vmask(:,:,1) 102 95 ! 103 96 CALL dom_stp ! Time step 104 97 CALL dom_msk ! Masks 105 98 CALL dom_ctl ! Domain control 106 99 ! 107 100 END SUBROUTINE dom_rea 101 108 102 109 103 SUBROUTINE dom_nam … … 118 112 !!---------------------------------------------------------------------- 119 113 USE ioipsl 120 INTEGER :: ios ! Local integer output status for namelist read 114 INTEGER :: ios ! Local integer output status for namelist read 115 ! 121 116 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 122 117 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, & … … 178 173 nstocklist = nn_stocklist 179 174 nwrite = nn_write 180 181 175 ! 182 176 ! ! control of output frequency 183 177 IF ( nstock == 0 .OR. nstock > nitend ) THEN … … 321 315 END SUBROUTINE dom_nam 322 316 317 323 318 SUBROUTINE dom_zgr 324 319 !!---------------------------------------------------------------------- … … 374 369 END SUBROUTINE dom_zgr 375 370 371 376 372 SUBROUTINE dom_ctl 377 373 !!---------------------------------------------------------------------- … … 382 378 !! ** Method : compute and print extrema of masked scale factors 383 379 !! 384 !! History : 385 !! 8.5 ! 02-08 (G. Madec) Original code 386 !!---------------------------------------------------------------------- 387 !! * Local declarations 380 !!---------------------------------------------------------------------- 388 381 INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2 389 382 INTEGER, DIMENSION(2) :: iloc ! … … 421 414 ijma2 = iloc(2) + njmpp - 1 422 415 ENDIF 423 416 ! 424 417 IF(lwp) THEN 425 418 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1 … … 428 421 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2 429 422 ENDIF 430 423 ! 431 424 END SUBROUTINE dom_ctl 425 432 426 433 427 SUBROUTINE dom_grd … … 538 532 CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 539 533 #endif 540 541 534 ! ! horizontal mesh (inum3) 542 535 CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) … … 756 749 !! (min value = 1 over land) 757 750 !!---------------------------------------------------------------------- 758 !759 751 INTEGER :: ji, jj ! dummy loop indices 760 752 REAL(wp), POINTER, DIMENSION(:,:) :: zmbk … … 785 777 END SUBROUTINE zgr_bot_level 786 778 779 787 780 SUBROUTINE dom_msk 788 781 !!--------------------------------------------------------------------- … … 799 792 !! tpol : ??? 800 793 !!---------------------------------------------------------------------- 801 ! 802 INTEGER :: ji, jj, jk ! dummy loop indices 803 INTEGER :: iif, iil, ijf, ijl ! local integers 794 INTEGER :: ji, jj, jk ! dummy loop indices 795 INTEGER :: iif, iil, ijf, ijl ! local integers 804 796 INTEGER, POINTER, DIMENSION(:,:) :: imsk 805 !806 797 !!--------------------------------------------------------------------- 807 798 … … 853 844 ! 3. Ocean/land mask at wu-, wv- and w points 854 845 !---------------------------------------------- 855 wmask (:,:,1) = tmask(:,:,1) ! ????????856 wumask(:,:,1) = umask(:,:,1) ! ????????857 wvmask(:,:,1) = vmask(:,:,1) ! ????????858 DO jk =2,jpk859 wmask (:,:,jk) =tmask(:,:,jk) * tmask(:,:,jk-1)860 wumask(:,:,jk) =umask(:,:,jk) * umask(:,:,jk-1)861 wvmask(:,:,jk) =vmask(:,:,jk) * vmask(:,:,jk-1)846 wmask (:,:,1) = tmask(:,:,1) ! surface value 847 wumask(:,:,1) = umask(:,:,1) 848 wvmask(:,:,1) = vmask(:,:,1) 849 DO jk = 2, jpk ! deeper value 850 wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 851 wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1) 852 wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 862 853 END DO 863 854 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90
r5385 r5737 510 510 zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * fse3v(ji ,jj ,jk) 511 511 zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) 512 zet = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )512 zet = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 513 513 zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet 514 514 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r5541 r5737 444 444 + e1v(ji ,jj ) * fse3v(ji ,jj ,jk) * v_bkginc(ji ,jj ,jk) & 445 445 - e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk) * v_bkginc(ji ,jj-1,jk) ) & 446 / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )446 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 447 447 END DO 448 448 END DO … … 452 452 DO jj = 2, jpjm1 453 453 DO ji = fs_2, fs_jpim1 ! vector opt. 454 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1 t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj) &455 - e1 t(ji ,jj)*e2t(ji ,jj) * hdiv(ji ,jj) ) &456 /e1u(ji,jj) * umask(ji,jj,jk)457 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1 t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1) &458 - e1 t(ji,jj )*e2t(ji,jj ) * hdiv(ji,jj ) ) &459 /e2v(ji,jj) * vmask(ji,jj,jk)454 u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji+1,jj) * hdiv(ji+1,jj) & 455 - e1e2t(ji ,jj) * hdiv(ji ,jj) ) & 456 * r1_e1u(ji,jj) * umask(ji,jj,jk) 457 v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2_wp * ( e1e2t(ji,jj+1) * hdiv(ji,jj+1) & 458 - e1e2t(ji,jj ) * hdiv(ji,jj ) ) & 459 * r1_e2v(ji,jj) * vmask(ji,jj,jk) 460 460 END DO 461 461 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90
r5643 r5737 91 91 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 92 92 ! ----------------------------------------------------------------------- 93 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1 t(:,:) *e2t(:,:) ) / rau093 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 94 94 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 95 95 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r5253 r5737 237 237 IF( dia_ar5_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_ar5_init : unable to allocate arrays' ) 238 238 239 area(:,:) = e1 t(:,:) *e2t(:,:) * tmask_i(:,:)239 area(:,:) = e1e2t(:,:) * tmask_i(:,:) 240 240 241 241 area_tot = SUM( area(:,:) ) ; IF( lk_mpp ) CALL mpp_sum( area_tot ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90
r5506 r5737 74 74 a_salb = 0.e0 ! valeur de sal au debut de la simulation 75 75 ! sshb used because diafwb called after tranxt (i.e. after the swap) 76 a_sshb = SUM( e1 t(:,:) *e2t(:,:) * sshb(:,:) * tmask_i(:,:) )76 a_sshb = SUM( e1e2t(:,:) * sshb(:,:) * tmask_i(:,:) ) 77 77 IF( lk_mpp ) CALL mpp_sum( a_sshb ) ! sum over the global domain 78 78 … … 80 80 DO jj = 2, jpjm1 81 81 DO ji = fs_2, fs_jpim1 ! vector opt. 82 zwei = e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)82 zwei = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 83 83 a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 84 84 END DO … … 88 88 ENDIF 89 89 90 a_fwf = SUM( e1 t(:,:) *e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) )90 a_fwf = SUM( e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) ) 91 91 IF( lk_mpp ) CALL mpp_sum( a_fwf ) ! sum over the global domain 92 92 … … 98 98 zfwfnew = 0.e0 99 99 ! Mean sea level at nitend 100 a_sshn = SUM( e1 t(:,:) *e2t(:,:) * sshn(:,:) * tmask_i(:,:) )100 a_sshn = SUM( e1e2t(:,:) * sshn(:,:) * tmask_i(:,:) ) 101 101 IF( lk_mpp ) CALL mpp_sum( a_sshn ) ! sum over the global domain 102 zarea = SUM( e1 t(:,:) *e2t(:,:) * tmask_i(:,:) )102 zarea = SUM( e1e2t(:,:) * tmask_i(:,:) ) 103 103 IF( lk_mpp ) CALL mpp_sum( zarea ) ! sum over the global domain 104 104 … … 106 106 DO jj = 2, jpjm1 107 107 DO ji = fs_2, fs_jpim1 ! vector opt. 108 zwei = e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)108 zwei = e1e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 109 109 a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 110 110 zvol = zvol + zwei -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r5566 r5737 232 232 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 233 233 ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 234 z2d(:,:) = rau0 * e1 2t(:,:)234 z2d(:,:) = rau0 * e1e2t(:,:) 235 235 DO jk = 1, jpk 236 236 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) … … 247 247 DO jj = 2, jpjm1 ! sst gradient 248 248 DO ji = fs_2, fs_jpim1 ! vector opt. 249 zztmp 250 zztmpx = ( tsn(ji+1,jj ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) /e1u(ji-1,jj )251 zztmpy = ( tsn(ji ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) /e2v(ji ,jj-1)249 zztmp = tsn(ji,jj,1,jp_tem) 250 zztmpx = ( tsn(ji+1,jj ,1,jp_tem) - zztmp ) * r1_e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) * r1_e1u(ji-1,jj ) 251 zztmpy = ( tsn(ji ,jj+1,1,jp_tem) - zztmp ) * r1_e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) * r1_e2v(ji ,jj-1) 252 252 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 253 253 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) … … 657 657 658 658 clmx ="l_max(only(x))" ! max index on a period 659 CALL histdef( nid_T, "sobowlin", "Bowl Index" , "W-point", & ! bowl INDEX660 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clmx, zsto, zout )659 ! CALL histdef( nid_T, "sobowlin", "Bowl Index" , "W-point", & ! bowl INDEX 660 ! & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clmx, zsto, zout ) 661 661 #if defined key_diahth 662 662 CALL histdef( nid_T, "sothedep", "Thermocline Depth" , "m" , & ! hth … … 892 892 DO jj = 2, jpjm1 893 893 DO ji = fs_2, fs_jpim1 ! vector opt. 894 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk)) /e2v(ji,jj) + &895 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk)) /e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx894 zw3d(ji,jj,jk) = (psiy_eiv(ji,jj,jk) - psiy_eiv(ji,jj-1,jk))*r1_e2v(ji,jj) + & 895 & (psix_eiv(ji,jj,jk) - psix_eiv(ji-1,jj,jk))*r1_e1u(ji,jj) ! w_eiv = dpsiy/dy + dpsiy/dx 896 896 END DO 897 897 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r5123 r5737 7 7 !! History : 1.0 ! 2005-10 (A. Beckmann, G. Madec) reactivate s-coordinate 8 8 !! 3.3 ! 2010-11 (G. Madec) add mbk. arrays associated to the deepest ocean level 9 !! 4.0! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation9 !! 3.4 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 10 10 !! 3.5 ! 2012 (S. Mocavero, I. Epicoco) Add arrays associated 11 11 !! to the optimization of BDY communications 12 !! 3.7 ! 2015-11 (G. Madec) introduce surface and scale factor ratio 12 13 !!---------------------------------------------------------------------- 13 14 … … 158 159 !! horizontal curvilinear coordinate and scale factors 159 160 !! --------------------------------------------------------------------- 160 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamt, glamu !: longitude of t-, u-, v- and f-points (degre) 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamv, glamf !: 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit, gphiu !: latitude of t-, u-, v- and f-points (degre) 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphiv, gphif !: 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1t, e2t, r1_e1t, r1_e2t !: horizontal scale factors and inverse at t-point (m) 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1u, e2u, r1_e1u, r1_e2u !: horizontal scale factors and inverse at u-point (m) 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1v, e2v, r1_e1v, r1_e2v !: horizontal scale factors and inverse at v-point (m) 167 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) :: e1f, e2f, r1_e1f, r1_e2f !: horizontal scale factors and inverse at f-point (m) 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t !: surface at t-point (m2) 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 161 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: glamt , glamu, glamv , glamf !: longitude at t, u, v, f-points [degree] 162 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: gphit , gphiu, gphiv , gphif !: latitude at t, u, v, f-points [degree] 163 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1t , e2t , r1_e1t, r1_e2t !: t-point horizontal scale factors [m] 164 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1u , e2u , r1_e1u, r1_e2u !: horizontal scale factors at u-point [m] 165 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1v , e2v , r1_e1v, r1_e2v !: horizontal scale factors at v-point [m] 166 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1f , e2f , r1_e1f, r1_e2f !: horizontal scale factors at f-point [m] 167 ! 168 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2t , r1_e1e2t !: associated metrics at t-point 169 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2u , r1_e1e2u , e2_e1u !: associated metrics at u-point 170 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2v , r1_e1e2v , e1_e2v !: associated metrics at v-point 171 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e1e2f , r1_e1e2f !: associated metrics at f-point 172 ! 173 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ff !: coriolis factor [1/s] 170 174 171 175 !!---------------------------------------------------------------------- … … 216 220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_0 !: reference depth at t- points (meters) 217 221 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hu_0 , hv_0 !: reference depth at u- and v-points (meters) 218 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re2u_e1u !: scale factor coeffs at u points (e2u/e1u)219 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: re1v_e2v !: scale factor coeffs at v points (e1v/e2v)220 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12t , r1_e12t !: horizontal cell surface and inverse at t points221 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12u , r1_e12u !: horizontal cell surface and inverse at u points222 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12v , r1_e12v !: horizontal cell surface and inverse at v points223 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: e12f , r1_e12f !: horizontal cell surface and inverse at f points224 222 225 223 INTEGER, PUBLIC :: nla10 !: deepest W level Above ~10m (nlb10 - 1) … … 333 331 INTEGER FUNCTION dom_oce_alloc() 334 332 !!---------------------------------------------------------------------- 335 INTEGER, DIMENSION(1 2) :: ierr333 INTEGER, DIMENSION(13) :: ierr 336 334 !!---------------------------------------------------------------------- 337 335 ierr(:) = 0 … … 346 344 & tpol(jpiglo) , fpol(jpiglo) , STAT=ierr(2) ) 347 345 ! 348 ALLOCATE( glamt(jpi,jpj) , gphit(jpi,jpj) , e1t(jpi,jpj) , e2t(jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) , & 349 & glamu(jpi,jpj) , gphiu(jpi,jpj) , e1u(jpi,jpj) , e2u(jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) , & 350 & glamv(jpi,jpj) , gphiv(jpi,jpj) , e1v(jpi,jpj) , e2v(jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) , & 351 & glamf(jpi,jpj) , gphif(jpi,jpj) , e1f(jpi,jpj) , e2f(jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) , & 352 & e1e2t(jpi,jpj) , ff (jpi,jpj) , STAT=ierr(3) ) 346 ALLOCATE( glamt(jpi,jpj) , glamu(jpi,jpj) , glamv(jpi,jpj) , glamf(jpi,jpj) , & 347 & gphit(jpi,jpj) , gphiu(jpi,jpj) , gphiv(jpi,jpj) , gphif(jpi,jpj) , & 348 & e1t (jpi,jpj) , e2t (jpi,jpj) , r1_e1t(jpi,jpj) , r1_e2t(jpi,jpj) , & 349 & e1u (jpi,jpj) , e2u (jpi,jpj) , r1_e1u(jpi,jpj) , r1_e2u(jpi,jpj) , & 350 & e1v (jpi,jpj) , e2v (jpi,jpj) , r1_e1v(jpi,jpj) , r1_e2v(jpi,jpj) , & 351 & e1f (jpi,jpj) , e2f (jpi,jpj) , r1_e1f(jpi,jpj) , r1_e2f(jpi,jpj) , & 352 & e1e2t(jpi,jpj) , r1_e1e2t(jpi,jpj) , & 353 & e1e2u(jpi,jpj) , r1_e1e2u(jpi,jpj) , e2_e1u(jpi,jpj) , & 354 & e1e2v(jpi,jpj) , r1_e1e2v(jpi,jpj) , e1_e2v(jpi,jpj) , & 355 & e1e2f(jpi,jpj) , r1_e1e2f(jpi,jpj) , & 356 & ff (jpi,jpj) , STAT=ierr(3) ) 353 357 ! 354 358 ALLOCATE( gdep3w_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0 (jpi,jpj,jpk) , & … … 364 368 & gdept_b (jpi,jpj,jpk) ,gdepw_b(jpi,jpj,jpk) , e3w_b (jpi,jpj,jpk) , & 365 369 & e3t_a (jpi,jpj,jpk) , e3u_a (jpi,jpj,jpk) , e3v_a (jpi,jpj,jpk) , & 366 & ehu_a (jpi,jpj) , ehv_a (jpi,jpj), & 367 & ehur_a (jpi,jpj) , ehvr_a (jpi,jpj), & 368 & ehu_b (jpi,jpj) , ehv_b (jpi,jpj), & 369 & ehur_b (jpi,jpj) , ehvr_b (jpi,jpj), STAT=ierr(5) ) 370 #endif 371 ! 372 ALLOCATE( hu (jpi,jpj) , hur (jpi,jpj) , hu_0(jpi,jpj) , ht_0 (jpi,jpj) , & 373 & hv (jpi,jpj) , hvr (jpi,jpj) , hv_0(jpi,jpj) , ht (jpi,jpj) , & 374 & re2u_e1u(jpi,jpj) , re1v_e2v(jpi,jpj) , & 375 & e12t (jpi,jpj) , r1_e12t (jpi,jpj) , & 376 & e12u (jpi,jpj) , r1_e12u (jpi,jpj) , & 377 & e12v (jpi,jpj) , r1_e12v (jpi,jpj) , & 378 & e12f (jpi,jpj) , r1_e12f (jpi,jpj) , STAT=ierr(6) ) 370 & ehu_a (jpi,jpj) , ehv_a (jpi,jpj), & 371 & ehur_a (jpi,jpj) , ehvr_a(jpi,jpj), & 372 & ehu_b (jpi,jpj) , ehv_b (jpi,jpj), & 373 & ehur_b (jpi,jpj) , ehvr_b(jpi,jpj), STAT=ierr(5) ) 374 #endif 375 ! 376 ALLOCATE( hu(jpi,jpj) , hur(jpi,jpj) , hu_0(jpi,jpj) , ht_0(jpi,jpj) , & 377 & hv(jpi,jpj) , hvr(jpi,jpj) , hv_0(jpi,jpj) , ht (jpi,jpj) , STAT=ierr(6) ) 379 378 ! 380 379 ALLOCATE( gdept_1d(jpk) , gdepw_1d(jpk) , & … … 387 386 & scosrf(jpi,jpj) , scobot(jpi,jpj) , & 388 387 & hifv (jpi,jpj) , hiff (jpi,jpj) , & 389 & hift (jpi,jpj) , hifu (jpi,jpj) , rx1 388 & hift (jpi,jpj) , hifu (jpi,jpj) , rx1(jpi,jpj) , STAT=ierr(8) ) 390 389 391 390 ALLOCATE( mbathy(jpi,jpj) , bathy(jpi,jpj) , & 392 391 & tmask_i(jpi,jpj) , umask_i(jpi,jpj), vmask_i(jpi,jpj), fmask_i(jpi,jpj), & 393 & bmask (jpi,jpj), &392 & bmask (jpi,jpj) , & 394 393 & mbkt (jpi,jpj) , mbku (jpi,jpj) , mbkv(jpi,jpj) , STAT=ierr(9) ) 395 394 396 395 ! (ISF) Allocation of basic array 397 ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj), &398 & mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) , &399 & mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) )396 ALLOCATE( misfdep(jpi,jpj) , risfdep(jpi,jpj), & 397 & mikt(jpi,jpj), miku(jpi,jpj), mikv(jpi,jpj) , & 398 & mikf(jpi,jpj), ssmask(jpi,jpj), STAT=ierr(10) ) 400 399 401 400 ALLOCATE( tmask(jpi,jpj,jpk) , umask(jpi,jpj,jpk), & … … 405 404 406 405 #if defined key_noslip_accurate 407 ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(1 2) )406 ALLOCATE( npcoa(4,jpk), nicoa(2*(jpi+jpj),4,jpk), njcoa(2*(jpi+jpj),4,jpk), STAT=ierr(13) ) 408 407 #endif 409 408 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90
r5656 r5737 14 14 !! use of parameters in par_CONFIG-Rxx.h90, not in namelist 15 15 !! - ! 2004-05 (A. Koch-Larrouy) Add Gyre configuration 16 !! 4.0 ! 2011-02 (G. Madec) add cell surface (e1e2t) 16 !! 3.7 ! 2015-09 (G. Madec) add cell surface and their inverse 17 !! add optional read of e1e2u & e1e2v 17 18 !!---------------------------------------------------------------------- 18 19 … … 23 24 USE dom_oce ! ocean space and time domain 24 25 USE phycst ! physical constants 26 USE domwri ! write 'meshmask.nc' & 'coordinate_e1e2u_v.nc' files 27 ! 25 28 USE in_out_manager ! I/O manager 26 29 USE lib_mpp ! MPP library … … 35 38 36 39 !!---------------------------------------------------------------------- 37 !! NEMO/OPA 4.0 , NEMO Consortium (2011)40 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 38 41 !! $Id$ 39 42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 106 109 REAL(wp) :: zphi1, zsin_alpha, zim05, zjm05 107 110 INTEGER :: isrow ! index for ORCA1 starting row 108 111 INTEGER :: ie1e2u_v ! fag for u- & v-surface read in coordinate file or not 109 112 !!---------------------------------------------------------------------- 110 113 ! … … 122 125 WRITE(numout,*) ' meridional grid-spacing (meters) ppe2_m = ', ppe2_m 123 126 ENDIF 124 125 126 SELECT CASE( jphgr_msh ) ! type of horizontal mesh 127 128 CASE ( 0 ) ! curvilinear coordinate on the sphere read in coordinate.nc file 129 127 ! 128 ie1e2u_v = 0 ! set to unread e1e2u and e1e2v 129 ! 130 SELECT CASE( jphgr_msh ) ! type of horizontal mesh 131 ! 132 CASE ( 0 ) !== read in coordinate.nc file ==! 133 ! 130 134 IF(lwp) WRITE(numout,*) 131 135 IF(lwp) WRITE(numout,*) ' curvilinear coordinate on the sphere read in "coordinate" file' 132 133 CALL hgr_read ! Defaultl option : NetCDF file 134 136 ! 137 CALL hgr_read( ie1e2u_v ) 138 ! 139 IF( ie1e2u_v == 0 ) THEN ! e1e2u and e1e2v have not been read: compute them 140 ! ! e2u and e1v does not include a reduction in some strait: apply reduction 141 e1e2u (:,:) = e1u(:,:) * e2u(:,:) 142 e1e2v (:,:) = e1v(:,:) * e2v(:,:) 143 144 ! 135 145 ! ! ===================== 136 146 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration … … 157 167 ! 158 168 ENDIF 159 160 !! =====================169 ! 170 ! ! ===================== 161 171 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration 162 172 ! ! ===================== 163 173 ! This dirty section will be suppressed by simplification process: all this will come back in input files 164 174 ! Currently these hard-wired indices relate to configuration with 165 ! extend grid (jpjglo=332) 166 ! which had a grid-size of 362x292. 175 ! extend grid (jpjglo=332) which had a grid-size of 362x292. 167 176 ! 168 177 isrow = 332 - jpjglo … … 208 217 IF(lwp) WRITE(numout,*) ' orca_r1: E Halmahera : e1v reduced to 50 km' 209 218 ! 210 ! 211 ENDIF 212 219 ENDIF 220 ! 213 221 ! ! ====================== 214 222 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration … … 251 259 ! 252 260 ENDIF 253 254 261 262 ! ! create 'coordinate_e1e2u_v.nc' file that contains 263 ! ! reduced scale factor in some strait but full e1e2u and e1e2v surfaces 264 IF( ie1e2u_v == 0 ) CALL dom_wri_coordinate 265 ! 266 ! 267 ENDIF 268 269 270 ! 255 271 ! N.B. : General case, lat and long function of both i and j indices: 256 272 ! e1t(ji,jj) = ra * rad * SQRT( ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2 & … … 271 287 ! e2f(ji,jj) = ra * rad * SQRT( ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2 & 272 288 ! + ( fsdjph( zfi, zfj ) )**2 ) 273 274 275 CASE ( 1 ) ! geographical mesh on the sphere with regular grid-spacing276 289 ! 290 ! 291 CASE ( 1 ) !== geographical mesh on the sphere with regular (in degree) grid-spacing ==! 292 ! 277 293 IF(lwp) WRITE(numout,*) 278 294 IF(lwp) WRITE(numout,*) ' geographical mesh on the sphere with regular grid-spacing' 279 295 IF(lwp) WRITE(numout,*) ' given by ppe1_deg and ppe2_deg' 280 296 ! 281 297 DO jj = 1, jpj 282 298 DO ji = 1, jpi 283 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - 1 + njmpp - 1 )284 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = FLOAT( jj - 1 + njmpp - 1 )285 zvi = FLOAT( ji - 1 + nimpp - 1 ) ; zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5286 zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5299 zti = REAL( ji - 1 + nimpp - 1 ) ; ztj = REAL( jj - 1 + njmpp - 1 ) 300 zui = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = REAL( jj - 1 + njmpp - 1 ) 301 zvi = REAL( ji - 1 + nimpp - 1 ) ; zvj = REAL( jj - 1 + njmpp - 1 ) + 0.5 302 zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = REAL( jj - 1 + njmpp - 1 ) + 0.5 287 303 ! Longitude 288 304 glamt(ji,jj) = ppglam0 + ppe1_deg * zti … … 307 323 END DO 308 324 END DO 309 310 311 CASE ( 2:3 ) ! f- or beta-plane with regular grid-spacing 312 325 ! 326 CASE ( 2:3 ) !== f- or beta-plane with regular grid-spacing ==! 327 ! 313 328 IF(lwp) WRITE(numout,*) 314 329 IF(lwp) WRITE(numout,*) ' f- or beta-plane with regular grid-spacing' 315 330 IF(lwp) WRITE(numout,*) ' given by ppe1_m and ppe2_m' 316 331 ! 317 332 ! Position coordinates (in kilometers) 318 333 ! ========== 319 334 glam0 = 0.e0 320 335 gphi0 = - ppe2_m * 1.e-3 321 336 ! 322 337 #if defined key_agrif 323 338 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only … … 332 347 DO jj = 1, jpj 333 348 DO ji = 1, jpi 334 glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) )335 glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 )349 glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) ) 350 glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( REAL( ji - 1 + nimpp - 1 ) + 0.5 ) 336 351 glamv(ji,jj) = glamt(ji,jj) 337 352 glamf(ji,jj) = glamu(ji,jj) 338 339 gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) )353 ! 354 gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) ) 340 355 gphiu(ji,jj) = gphit(ji,jj) 341 gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 )356 gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( REAL( jj - 1 + njmpp - 1 ) + 0.5 ) 342 357 gphif(ji,jj) = gphiv(ji,jj) 343 358 END DO 344 359 END DO 345 360 ! 346 361 ! Horizontal scale factors (in meters) 347 362 ! ====== … … 350 365 e1v(:,:) = ppe1_m ; e2v(:,:) = ppe2_m 351 366 e1f(:,:) = ppe1_m ; e2f(:,:) = ppe2_m 352 353 CASE ( 4 ) ! geographical mesh on the sphere, isotropic MERCATOR type354 367 ! 368 CASE ( 4 ) !== geographical mesh on the sphere, isotropic MERCATOR type ==! 369 ! 355 370 IF(lwp) WRITE(numout,*) 356 371 IF(lwp) WRITE(numout,*) ' geographical mesh on the sphere, MERCATOR type' 357 372 IF(lwp) WRITE(numout,*) ' longitudinal/latitudinal spacing given by ppe1_deg' 358 373 IF ( ppgphi0 == -90 ) CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' ) 359 374 ! 360 375 ! Find index corresponding to the equator, given the grid spacing e1_deg 361 376 ! and the (approximate) southern latitude ppgphi0. … … 365 380 ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg ) 366 381 IF( ppgphi0 > 0 ) ijeq = -ijeq 367 382 ! 368 383 IF(lwp) WRITE(numout,*) ' Index of the equator on the MERCATOR grid:', ijeq 369 384 ! 370 385 DO jj = 1, jpj 371 386 DO ji = 1, jpi 372 zti = FLOAT( ji - 1 + nimpp - 1 ) ; ztj = FLOAT( jj - ijeq + njmpp - 1 )373 zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = FLOAT( jj - ijeq + njmpp - 1 )374 zvi = FLOAT( ji - 1 + nimpp - 1 ) ; zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5375 zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5387 zti = REAL( ji - 1 + nimpp - 1 ) ; ztj = REAL( jj - ijeq + njmpp - 1 ) 388 zui = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zuj = REAL( jj - ijeq + njmpp - 1 ) 389 zvi = REAL( ji - 1 + nimpp - 1 ) ; zvj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 390 zfi = REAL( ji - 1 + nimpp - 1 ) + 0.5 ; zfj = REAL( jj - ijeq + njmpp - 1 ) + 0.5 376 391 ! Longitude 377 392 glamt(ji,jj) = ppglam0 + ppe1_deg * zti … … 396 411 END DO 397 412 END DO 398 399 CASE ( 5 ) ! beta-plane with regular grid-spacing and rotated domain(GYRE configuration)400 413 ! 414 CASE ( 5 ) !== beta-plane with regular grid-spacing and rotated domain ==! (GYRE configuration) 415 ! 401 416 IF(lwp) WRITE(numout,*) 402 417 IF(lwp) WRITE(numout,*) ' beta-plane with regular grid-spacing and rotated domain (GYRE configuration)' 403 418 IF(lwp) WRITE(numout,*) ' given by ppe1_m and ppe2_m' 404 419 ! 405 420 ! Position coordinates (in kilometers) 406 421 ! ========== 407 422 ! 408 423 ! angle 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN 409 zlam1 = -85 410 zphi1 = 29424 zlam1 = -85._wp 425 zphi1 = 29._wp 411 426 ! resolution in meters 412 ze1 = 106000. / FLOAT(jp_cfg)427 ze1 = 106000. / REAL( jp_cfg , wp ) 413 428 ! benchmark: forced the resolution to be about 100 km 414 429 IF( nbench /= 0 ) ze1 = 106000.e0 415 zsin_alpha = - SQRT( 2. ) / 2.416 zcos_alpha = SQRT( 2. ) / 2.430 zsin_alpha = - SQRT( 2._wp ) * 0.5_wp 431 zcos_alpha = SQRT( 2._wp ) * 0.5_wp 417 432 ze1deg = ze1 / (ra * rad) 418 IF( nbench /= 0 ) ze1deg = ze1deg / FLOAT(jp_cfg)! benchmark: keep the lat/+lon419 ! ! at the right jp_cfg resolution420 glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2)421 gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2)422 433 IF( nbench /= 0 ) ze1deg = ze1deg / REAL( jp_cfg , wp ) ! benchmark: keep the lat/+lon 434 ! ! at the right jp_cfg resolution 435 glam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 436 gphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 437 ! 423 438 IF( nprint==1 .AND. lwp ) THEN 424 439 WRITE(numout,*) ' ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 425 440 WRITE(numout,*) ' ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0 426 441 ENDIF 427 442 ! 428 443 DO jj = 1, jpj 429 DO ji = 1, jpi430 zim1 = FLOAT( ji + nimpp - 1 ) - 1. ; zim05 = FLOAT( ji + nimpp - 1 ) - 1.5431 zjm1 = FLOAT( jj + njmpp - 1 ) - 1. ; zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5432 433 glamf(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha434 gphif(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha435 436 glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha437 gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha438 439 glamu(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha440 gphiu(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha441 442 glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha443 gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha444 END DO445 446 444 DO ji = 1, jpi 445 zim1 = REAL( ji + nimpp - 1 ) - 1. ; zim05 = REAL( ji + nimpp - 1 ) - 1.5 446 zjm1 = REAL( jj + njmpp - 1 ) - 1. ; zjm05 = REAL( jj + njmpp - 1 ) - 1.5 447 ! 448 glamf(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha 449 gphif(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha 450 ! 451 glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 452 gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 453 ! 454 glamu(ji,jj) = glam0 + zim1 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha 455 gphiu(ji,jj) = gphi0 - zim1 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha 456 ! 457 glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1 * ze1deg * zsin_alpha 458 gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1 * ze1deg * zcos_alpha 459 END DO 460 END DO 461 ! 447 462 ! Horizontal scale factors (in meters) 448 463 ! ====== … … 451 466 e1v(:,:) = ze1 ; e2v(:,:) = ze1 452 467 e1f(:,:) = ze1 ; e2f(:,:) = ze1 453 468 ! 454 469 CASE DEFAULT 455 470 WRITE(ctmp1,*) ' bad flag value for jphgr_msh = ', jphgr_msh 456 471 CALL ctl_stop( ctmp1 ) 457 472 ! 458 473 END SELECT 459 474 460 ! T-cell surface 461 ! -------------- 462 e1e2t(:,:) = e1t(:,:) * e2t(:,:) 463 464 ! Useful shortcuts (JC: note the duplicated e2e2t array ! Need some cleaning) 465 ! --------------------------------------------------------------------------- 466 e12t (:,:) = e1t(:,:) * e2t(:,:) 467 e12u (:,:) = e1u(:,:) * e2u(:,:) 468 e12v (:,:) = e1v(:,:) * e2v(:,:) 469 e12f (:,:) = e1f(:,:) * e2f(:,:) 470 r1_e12t (:,:) = 1._wp / e12t(:,:) 471 r1_e12u (:,:) = 1._wp / e12u(:,:) 472 r1_e12v (:,:) = 1._wp / e12v(:,:) 473 r1_e12f (:,:) = 1._wp / e12f(:,:) 474 re2u_e1u(:,:) = e2u(:,:) / e1u(:,:) 475 re1v_e2v(:,:) = e1v(:,:) / e2v(:,:) 476 r1_e1t (:,:) = 1._wp / e1t(:,:) 477 r1_e1u (:,:) = 1._wp / e1u(:,:) 478 r1_e1v (:,:) = 1._wp / e1v(:,:) 479 r1_e1f (:,:) = 1._wp / e1f(:,:) 480 r1_e2t (:,:) = 1._wp / e2t(:,:) 481 r1_e2u (:,:) = 1._wp / e2u(:,:) 482 r1_e2v (:,:) = 1._wp / e2v(:,:) 483 r1_e2f (:,:) = 1._wp / e2f(:,:) 484 485 ! Control printing : Grid informations (if not restart) 486 ! ---------------- 487 488 IF( lwp .AND. .NOT.ln_rstart ) THEN 475 ! associated horizontal metrics 476 ! ----------------------------- 477 ! 478 r1_e1t(:,:) = 1._wp / e1t(:,:) ; r1_e2t (:,:) = 1._wp / e2t(:,:) 479 r1_e1u(:,:) = 1._wp / e1u(:,:) ; r1_e2u (:,:) = 1._wp / e2u(:,:) 480 r1_e1v(:,:) = 1._wp / e1v(:,:) ; r1_e2v (:,:) = 1._wp / e2v(:,:) 481 r1_e1f(:,:) = 1._wp / e1f(:,:) ; r1_e2f (:,:) = 1._wp / e2f(:,:) 482 ! 483 e1e2t (:,:) = e1t(:,:) * e2t(:,:) ; r1_e1e2t(:,:) = 1._wp / e1e2t(:,:) 484 e1e2f (:,:) = e1f(:,:) * e2f(:,:) ; r1_e1e2f(:,:) = 1._wp / e1e2f(:,:) 485 IF( jphgr_msh /= 0 ) THEN ! e1e2u and e1e2v have not been set: compute them 486 e1e2u (:,:) = e1u(:,:) * e2u(:,:) 487 e1e2v (:,:) = e1v(:,:) * e2v(:,:) 488 ENDIF 489 r1_e1e2u(:,:) = 1._wp / e1e2u(:,:) ! compute their invert in both cases 490 r1_e1e2v(:,:) = 1._wp / e1e2v(:,:) 491 ! 492 e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 493 e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 494 495 IF( lwp .AND. .NOT.ln_rstart ) THEN ! Control print : Grid informations (if not restart) 489 496 WRITE(numout,*) 490 497 WRITE(numout,*) ' longitude and e1 scale factors' … … 496 503 9300 FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x, & 497 504 f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 ) 498 505 ! 499 506 WRITE(numout,*) 500 507 WRITE(numout,*) ' latitude and e2 scale factors' … … 506 513 ENDIF 507 514 508 509 IF( nprint == 1 .AND. lwp ) THEN510 WRITE(numout,*) ' e1u e2u '511 CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )512 CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )513 WRITE(numout,*) ' e1v e2v '514 CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )515 CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )516 WRITE(numout,*) ' e1f e2f '517 CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )518 CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )519 ENDIF520 521 515 522 516 ! ================= ! … … 525 519 526 520 SELECT CASE( jphgr_msh ) ! type of horizontal mesh 527 521 ! 528 522 CASE ( 0, 1, 4 ) ! mesh on the sphere 529 523 ! 530 524 ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 531 525 ! 532 526 CASE ( 2 ) ! f-plane at ppgphi0 533 527 ! 534 528 ff(:,:) = 2. * omega * SIN( rad * ppgphi0 ) 535 529 ! 536 530 IF(lwp) WRITE(numout,*) ' f-plane: Coriolis parameter = constant = ', ff(1,1) 537 531 ! 538 532 CASE ( 3 ) ! beta-plane 539 533 ! 540 534 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 541 zphi0 = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad ) ! latitude of the first row F-points542 535 zphi0 = ppgphi0 - REAL( jpjglo/2) * ppe2_m / ( ra * rad ) ! latitude of the first row F-points 536 ! 543 537 #if defined key_agrif 544 538 IF ( cp_cfg == 'eel' .AND. jp_cfg == 6 ) THEN ! for EEL6 configuration only 545 539 IF( .NOT. Agrif_Root() ) THEN 546 zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) & 547 & / (ra * rad) 540 zphi0 = ppgphi0 - REAL( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 548 541 ENDIF 549 542 ENDIF 550 543 #endif 551 544 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 552 545 ! 553 546 ff(:,:) = ( zf0 + zbeta * gphif(:,:) * 1.e+3 ) ! f = f0 +beta* y ( y=0 at south) 554 547 ! 555 548 IF(lwp) THEN 556 549 WRITE(numout,*) … … 565 558 IF(lwp) WRITE(numout,*) ' Coriolis parameter varies globally from ', zminff,' to ', zmaxff 566 559 END IF 567 560 ! 568 561 CASE ( 5 ) ! beta-plane and rotated domain (gyre configuration) 569 562 ! 570 563 zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra ! beta at latitude ppgphi0 571 564 zphi0 = 15.e0 ! latitude of the first row F-points 572 565 zf0 = 2. * omega * SIN( rad * zphi0 ) ! compute f0 1st point south 573 566 ! 574 567 ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra ) ! f = f0 +beta* y ( y=0 at south) 575 568 ! 576 569 IF(lwp) THEN 577 570 WRITE(numout,*) … … 579 572 WRITE(numout,*) ' Coriolis parameter varies in this processor from ', ff(nldi,nldj),' to ', ff(nldi,nlej) 580 573 ENDIF 581 574 ! 582 575 IF( lk_mpp ) THEN 583 576 zminff=ff(nldi,nldj) … … 587 580 IF(lwp) WRITE(numout,*) ' Coriolis parameter varies globally from ', zminff,' to ', zmaxff 588 581 END IF 589 582 ! 590 583 END SELECT 591 584 … … 596 589 597 590 IF( nperio == 2 ) THEN 598 znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi )591 znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / REAL( jpi ) 599 592 IF( znorme > 1.e-13 ) CALL ctl_stop( ' ===>>>> : symmetrical condition: rerun with good equator line' ) 600 593 ENDIF … … 605 598 606 599 607 SUBROUTINE hgr_read 600 SUBROUTINE hgr_read( ke1e2u_v ) 608 601 !!--------------------------------------------------------------------- 609 602 !! *** ROUTINE hgr_read *** 610 603 !! 611 !! ** Purpose : Read a coordinate file in NetCDF format 612 !! 613 !! ** Method : The mesh file has been defined trough a analytical 614 !! or semi-analytical method. It is read in a NetCDF file. 615 !! 604 !! ** Purpose : Read a coordinate file in NetCDF format using IOM 605 !! 616 606 !!---------------------------------------------------------------------- 617 607 USE iom 618 608 !! 609 INTEGER, INTENT( inout ) :: ke1e2u_v ! fag: e1e2u & e1e2v read in coordinate file (=1) or not (=0) 610 ! 619 611 INTEGER :: inum ! temporary logical unit 620 612 !!---------------------------------------------------------------------- 621 613 ! 622 614 IF(lwp) THEN 623 615 WRITE(numout,*) … … 625 617 WRITE(numout,*) '~~~~~~~~ jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk 626 618 ENDIF 627 619 ! 628 620 CALL iom_open( 'coordinates', inum ) 629 621 ! 630 622 CALL iom_get( inum, jpdom_data, 'glamt', glamt, lrowattr=ln_use_jattr ) 631 623 CALL iom_get( inum, jpdom_data, 'glamu', glamu, lrowattr=ln_use_jattr ) 632 624 CALL iom_get( inum, jpdom_data, 'glamv', glamv, lrowattr=ln_use_jattr ) 633 625 CALL iom_get( inum, jpdom_data, 'glamf', glamf, lrowattr=ln_use_jattr ) 634 626 ! 635 627 CALL iom_get( inum, jpdom_data, 'gphit', gphit, lrowattr=ln_use_jattr ) 636 628 CALL iom_get( inum, jpdom_data, 'gphiu', gphiu, lrowattr=ln_use_jattr ) 637 629 CALL iom_get( inum, jpdom_data, 'gphiv', gphiv, lrowattr=ln_use_jattr ) 638 630 CALL iom_get( inum, jpdom_data, 'gphif', gphif, lrowattr=ln_use_jattr ) 639 640 CALL iom_get( inum, jpdom_data, 'e1t', e1t, lrowattr=ln_use_jattr ) 641 CALL iom_get( inum, jpdom_data, 'e1u', e1u, lrowattr=ln_use_jattr ) 642 CALL iom_get( inum, jpdom_data, 'e1v', e1v, lrowattr=ln_use_jattr ) 643 CALL iom_get( inum, jpdom_data, 'e1f', e1f, lrowattr=ln_use_jattr ) 644 645 CALL iom_get( inum, jpdom_data, 'e2t', e2t, lrowattr=ln_use_jattr ) 646 CALL iom_get( inum, jpdom_data, 'e2u', e2u, lrowattr=ln_use_jattr ) 647 CALL iom_get( inum, jpdom_data, 'e2v', e2v, lrowattr=ln_use_jattr ) 648 CALL iom_get( inum, jpdom_data, 'e2f', e2f, lrowattr=ln_use_jattr ) 649 631 ! 632 CALL iom_get( inum, jpdom_data, 'e1t' , e1t , lrowattr=ln_use_jattr ) 633 CALL iom_get( inum, jpdom_data, 'e1u' , e1u , lrowattr=ln_use_jattr ) 634 CALL iom_get( inum, jpdom_data, 'e1v' , e1v , lrowattr=ln_use_jattr ) 635 CALL iom_get( inum, jpdom_data, 'e1f' , e1f , lrowattr=ln_use_jattr ) 636 ! 637 CALL iom_get( inum, jpdom_data, 'e2t' , e2t , lrowattr=ln_use_jattr ) 638 CALL iom_get( inum, jpdom_data, 'e2u' , e2u , lrowattr=ln_use_jattr ) 639 CALL iom_get( inum, jpdom_data, 'e2v' , e2v , lrowattr=ln_use_jattr ) 640 CALL iom_get( inum, jpdom_data, 'e2f' , e2f , lrowattr=ln_use_jattr ) 641 ! 642 IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 643 IF(lwp) WRITE(numout,*) 'hgr_read : e1e2u & e1e2v read in coordinates file' 644 CALL iom_get( inum, jpdom_data, 'e1e2u' , e1e2u , lrowattr=ln_use_jattr ) 645 CALL iom_get( inum, jpdom_data, 'e1e2v' , e1e2v , lrowattr=ln_use_jattr ) 646 ke1e2u_v = 1 647 ELSE 648 ke1e2u_v = 0 649 ENDIF 650 ! 650 651 CALL iom_close( inum ) 651 652 653 !!gm THIS is TO BE REMOVED !!!!!!! 654 652 655 ! need to be define for the extended grid south of -80S 653 656 ! some point are undefined but you need to have e1 and e2 .NE. 0 … … 676 679 e2f=1.0e2 677 680 END WHERE 681 !!gm end 678 682 679 683 END SUBROUTINE hgr_read -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5506 r5737 10 10 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 11 11 !!---------------------------------------------------------------------- 12 !! 'key_vvl' variable volume 13 !!---------------------------------------------------------------------- 12 14 13 !!---------------------------------------------------------------------- 15 14 !! dom_vvl_init : define initial vertical scale factors, depths and column thickness … … 19 18 !! dom_vvl_rst : read/write restart file 20 19 !! dom_vvl_ctl : Check the vvl options 21 !! dom_vvl_orca_fix : Recompute some area-weighted interpolations of vertical scale factors22 !! : to account for manual changes to e[1,2][u,v] in some Straits23 20 !!---------------------------------------------------------------------- 24 !! * Modules used25 21 USE oce ! ocean dynamics and tracers 26 22 USE dom_oce ! ocean space and time domain … … 37 33 PRIVATE 38 34 39 !! * Routine accessibility40 35 PUBLIC dom_vvl_init ! called by domain.F90 41 36 PUBLIC dom_vvl_sf_nxt ! called by step.F90 42 37 PUBLIC dom_vvl_sf_swp ! called by step.F90 43 38 PUBLIC dom_vvl_interpol ! called by dynnxt.F90 44 PRIVATE dom_vvl_orca_fix ! called by dom_vvl_interpol 45 46 !!* Namelist nam_vvl 47 LOGICAL , PUBLIC :: ln_vvl_zstar = .FALSE. ! zstar vertical coordinate 48 LOGICAL , PUBLIC :: ln_vvl_ztilde = .FALSE. ! ztilde vertical coordinate 49 LOGICAL , PUBLIC :: ln_vvl_layer = .FALSE. ! level vertical coordinate 50 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE. ! ztilde vertical coordinate 51 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor = .FALSE. ! ztilde vertical coordinate 52 LOGICAL , PUBLIC :: ln_vvl_kepe = .FALSE. ! kinetic/potential energy transfer 53 ! ! conservation: not used yet 54 REAL(wp) :: rn_ahe3 ! thickness diffusion coefficient 55 REAL(wp) :: rn_rst_e3t ! ztilde to zstar restoration timescale [days] 56 REAL(wp) :: rn_lf_cutoff ! cutoff frequency for low-pass filter [days] 57 REAL(wp) :: rn_zdef_max ! maximum fractional e3t deformation 58 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 59 60 !! * Module variables 61 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 62 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 63 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors 64 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors 65 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 66 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 39 40 ! !!* Namelist nam_vvl 41 LOGICAL , PUBLIC :: ln_vvl_zstar = .FALSE. ! zstar vertical coordinate 42 LOGICAL , PUBLIC :: ln_vvl_ztilde = .FALSE. ! ztilde vertical coordinate 43 LOGICAL , PUBLIC :: ln_vvl_layer = .FALSE. ! level vertical coordinate 44 LOGICAL , PUBLIC :: ln_vvl_ztilde_as_zstar = .FALSE. ! ztilde vertical coordinate 45 LOGICAL , PUBLIC :: ln_vvl_zstar_at_eqtor = .FALSE. ! ztilde vertical coordinate 46 LOGICAL , PUBLIC :: ln_vvl_kepe = .FALSE. ! kinetic/potential energy transfer 47 ! ! conservation: not used yet 48 REAL(wp) :: rn_ahe3 ! thickness diffusion coefficient 49 REAL(wp) :: rn_rst_e3t ! ztilde to zstar restoration timescale [days] 50 REAL(wp) :: rn_lf_cutoff ! cutoff frequency for low-pass filter [days] 51 REAL(wp) :: rn_zdef_max ! maximum fractional e3t deformation 52 LOGICAL , PUBLIC :: ln_vvl_dbg = .FALSE. ! debug control prints 53 54 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: un_td, vn_td ! thickness diffusion transport 55 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hdiv_lf ! low frequency part of hz divergence 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_b, tilde_e3t_n ! baroclinic scale factors 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tilde_e3t_a, dtilde_e3t_a ! baroclinic scale factors 58 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_e3t ! retoring period for scale factors 59 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: frq_rst_hdv ! retoring period for low freq. divergence 67 60 68 61 !! * Substitutions … … 372 365 DO jj = 1, jpjm1 373 366 DO ji = 1, fs_jpim1 ! vector opt. 374 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * re2u_e1u(ji,jj)&375 &* ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) )376 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * re1v_e2v(ji,jj)&377 &* ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) )367 un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj) & 368 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj ,jk) ) 369 vn_td(ji,jj,jk) = rn_ahe3 * vmask(ji,jj,jk) * e1_e2v(ji,jj) & 370 & * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji ,jj+1,jk) ) 378 371 zwu(ji,jj) = zwu(ji,jj) + un_td(ji,jj,jk) 379 372 zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) … … 394 387 tilde_e3t_a(ji,jj,jk) = tilde_e3t_a(ji,jj,jk) + ( un_td(ji-1,jj ,jk) - un_td(ji,jj,jk) & 395 388 & + vn_td(ji ,jj-1,jk) - vn_td(ji,jj,jk) & 396 & ) * r1_e1 2t(ji,jj)389 & ) * r1_e1e2t(ji,jj) 397 390 END DO 398 391 END DO … … 695 688 !! - vertical interpolation: simple averaging 696 689 !!---------------------------------------------------------------------- 697 !! * Arguments698 690 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in ! input e3 to be interpolated 699 691 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out ! output interpolated e3 700 692 CHARACTER(LEN=*), INTENT( in ) :: pout ! grid point of out scale factors 701 693 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 702 ! ! * Local declarations694 ! 703 695 INTEGER :: ji, jj, jk ! dummy loop indices 704 696 LOGICAL :: l_is_orca ! local logical … … 717 709 DO jj = 1, jpjm1 718 710 DO ji = 1, fs_jpim1 ! vector opt. 719 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1 2u(ji,jj) &720 & * ( e1 2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &721 & + e1 2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) )711 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e1e2u(ji,jj) & 712 & * ( e1e2t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 713 & + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 722 714 END DO 723 715 END DO 724 716 END DO 725 717 ! 726 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )727 718 ! boundary conditions 728 719 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp ) … … 735 726 DO jj = 1, jpjm1 736 727 DO ji = 1, fs_jpim1 ! vector opt. 737 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1 2v(ji,jj) &738 & * ( e1 2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &739 & + e1 2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) )728 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e1e2v(ji,jj) & 729 & * ( e1e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 730 & + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 740 731 END DO 741 732 END DO 742 733 END DO 743 734 ! 744 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )745 735 ! boundary conditions 746 736 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp ) … … 753 743 DO jj = 1, jpjm1 754 744 DO ji = 1, fs_jpim1 ! vector opt. 755 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1 2f(ji,jj) &756 & * ( e1 2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) &757 & + e1 2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) )745 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e1e2f(ji,jj) & 746 & * ( e1e2u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 747 & + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 758 748 END DO 759 749 END DO 760 750 END DO 761 751 ! 762 IF( l_is_orca ) CALL dom_vvl_orca_fix( pe3_in, pe3_out, pout )763 752 ! boundary conditions 764 753 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp ) … … 1021 1010 END SUBROUTINE dom_vvl_ctl 1022 1011 1023 SUBROUTINE dom_vvl_orca_fix( pe3_in, pe3_out, pout )1024 !!---------------------------------------------------------------------1025 !! *** ROUTINE dom_vvl_orca_fix ***1026 !!1027 !! ** Purpose : Correct surface weighted, horizontally interpolated,1028 !! scale factors at locations that have been individually1029 !! modified in domhgr. Such modifications break the1030 !! relationship between e12t and e1u*e2u etc.1031 !! Recompute some scale factors ignoring the modified metric.1032 !!----------------------------------------------------------------------1033 !! * Arguments1034 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: pe3_in ! input e3 to be interpolated1035 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: pe3_out ! output interpolated e31036 CHARACTER(LEN=*), INTENT( in ) :: pout ! grid point of out scale factors1037 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW'1038 !! * Local declarations1039 INTEGER :: ji, jj, jk ! dummy loop indices1040 INTEGER :: ij0, ij1, ii0, ii1 ! dummy loop indices1041 INTEGER :: isrow ! index for ORCA1 starting row1042 !! acc1043 !! Hmm with the time splitting these "fixes" seem to do more harm than good. Temporarily disabled for1044 !! the ORCA2 tests (by changing jp_cfg test from 2 to 3) pending further investigations1045 !!1046 ! ! =====================1047 IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN ! ORCA R2 configuration1048 ! ! =====================1049 !! acc1050 IF( nn_cla == 0 ) THEN1051 !1052 ii0 = 139 ; ii1 = 140 ! Gibraltar Strait (e2u was modified)1053 ij0 = 102 ; ij1 = 1021054 DO jk = 1, jpkm11055 DO jj = mj0(ij0), mj1(ij1)1056 DO ji = mi0(ii0), mi1(ii1)1057 SELECT CASE ( pout )1058 CASE( 'U' )1059 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1060 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1061 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1062 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1063 CASE( 'F' )1064 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1065 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1066 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1067 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1068 END SELECT1069 END DO1070 END DO1071 END DO1072 !1073 ii0 = 160 ; ii1 = 160 ! Bab el Mandeb (e2u and e1v were modified)1074 ij0 = 88 ; ij1 = 881075 DO jk = 1, jpkm11076 DO jj = mj0(ij0), mj1(ij1)1077 DO ji = mi0(ii0), mi1(ii1)1078 SELECT CASE ( pout )1079 CASE( 'U' )1080 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1081 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1082 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1083 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1084 CASE( 'V' )1085 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1086 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1087 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1088 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1089 CASE( 'F' )1090 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1091 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1092 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1093 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1094 END SELECT1095 END DO1096 END DO1097 END DO1098 ENDIF1099 1100 ii0 = 145 ; ii1 = 146 ! Danish Straits (e2u was modified)1101 ij0 = 116 ; ij1 = 1161102 DO jk = 1, jpkm11103 DO jj = mj0(ij0), mj1(ij1)1104 DO ji = mi0(ii0), mi1(ii1)1105 SELECT CASE ( pout )1106 CASE( 'U' )1107 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1108 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1109 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1110 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1111 CASE( 'F' )1112 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1113 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1114 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1115 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1116 END SELECT1117 END DO1118 END DO1119 END DO1120 ENDIF1121 !1122 ! ! =====================1123 IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN ! ORCA R1 configuration1124 ! ! =====================1125 ! This dirty section will be suppressed by simplification process:1126 ! all this will come back in input files1127 ! Currently these hard-wired indices relate to configuration with1128 ! extend grid (jpjglo=332)1129 ! which had a grid-size of 362x292.1130 isrow = 332 - jpjglo1131 !1132 ii0 = 282 ; ii1 = 283 ! Gibraltar Strait (e2u was modified)1133 ij0 = 241 - isrow ; ij1 = 241 - isrow1134 DO jk = 1, jpkm11135 DO jj = mj0(ij0), mj1(ij1)1136 DO ji = mi0(ii0), mi1(ii1)1137 SELECT CASE ( pout )1138 CASE( 'U' )1139 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1140 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1141 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1142 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1143 CASE( 'F' )1144 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1145 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1146 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1147 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1148 END SELECT1149 END DO1150 END DO1151 END DO1152 !1153 ii0 = 314 ; ii1 = 315 ! Bhosporus Strait (e2u was modified)1154 ij0 = 248 - isrow ; ij1 = 248 - isrow1155 DO jk = 1, jpkm11156 DO jj = mj0(ij0), mj1(ij1)1157 DO ji = mi0(ii0), mi1(ii1)1158 SELECT CASE ( pout )1159 CASE( 'U' )1160 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1161 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1162 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1163 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1164 CASE( 'F' )1165 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1166 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1167 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1168 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1169 END SELECT1170 END DO1171 END DO1172 END DO1173 !1174 ii0 = 44 ; ii1 = 44 ! Lombok Strait (e1v was modified)1175 ij0 = 164 - isrow ; ij1 = 165 - isrow1176 DO jk = 1, jpkm11177 DO jj = mj0(ij0), mj1(ij1)1178 DO ji = mi0(ii0), mi1(ii1)1179 SELECT CASE ( pout )1180 CASE( 'V' )1181 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1182 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1183 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1184 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1185 END SELECT1186 END DO1187 END DO1188 END DO1189 !1190 ii0 = 48 ; ii1 = 48 ! Sumba Strait (e1v was modified) [closed from bathy_11 on]1191 ij0 = 164 - isrow ; ij1 = 165 - isrow1192 DO jk = 1, jpkm11193 DO jj = mj0(ij0), mj1(ij1)1194 DO ji = mi0(ii0), mi1(ii1)1195 SELECT CASE ( pout )1196 CASE( 'V' )1197 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1198 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1199 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1200 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1201 END SELECT1202 END DO1203 END DO1204 END DO1205 !1206 ii0 = 53 ; ii1 = 53 ! Ombai Strait (e1v was modified)1207 ij0 = 164 - isrow ; ij1 = 165 - isrow1208 DO jk = 1, jpkm11209 DO jj = mj0(ij0), mj1(ij1)1210 DO ji = mi0(ii0), mi1(ii1)1211 SELECT CASE ( pout )1212 CASE( 'V' )1213 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1214 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1215 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1216 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1217 END SELECT1218 END DO1219 END DO1220 END DO1221 !1222 ii0 = 56 ; ii1 = 56 ! Timor Passage (e1v was modified)1223 ij0 = 164 - isrow ; ij1 = 165 - isrow1224 DO jk = 1, jpkm11225 DO jj = mj0(ij0), mj1(ij1)1226 DO ji = mi0(ii0), mi1(ii1)1227 SELECT CASE ( pout )1228 CASE( 'V' )1229 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1230 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1231 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1232 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1233 END SELECT1234 END DO1235 END DO1236 END DO1237 !1238 ii0 = 55 ; ii1 = 55 ! West Halmahera Strait (e1v was modified)1239 ij0 = 181 - isrow ; ij1 = 182 - isrow1240 DO jk = 1, jpkm11241 DO jj = mj0(ij0), mj1(ij1)1242 DO ji = mi0(ii0), mi1(ii1)1243 SELECT CASE ( pout )1244 CASE( 'V' )1245 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1246 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1247 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1248 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1249 END SELECT1250 END DO1251 END DO1252 END DO1253 !1254 ii0 = 58 ; ii1 = 58 ! East Halmahera Strait (e1v was modified)1255 ij0 = 181 - isrow ; ij1 = 182 - isrow1256 DO jk = 1, jpkm11257 DO jj = mj0(ij0), mj1(ij1)1258 DO ji = mi0(ii0), mi1(ii1)1259 SELECT CASE ( pout )1260 CASE( 'V' )1261 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1262 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1263 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1264 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1265 END SELECT1266 END DO1267 END DO1268 END DO1269 ENDIF1270 ! ! =====================1271 IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN ! ORCA R05 configuration1272 ! ! =====================1273 !1274 ii0 = 563 ; ii1 = 564 ! Gibraltar Strait (e2u was modified)1275 ij0 = 327 ; ij1 = 3271276 DO jk = 1, jpkm11277 DO jj = mj0(ij0), mj1(ij1)1278 DO ji = mi0(ii0), mi1(ii1)1279 SELECT CASE ( pout )1280 CASE( 'U' )1281 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1282 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1283 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1284 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1285 CASE( 'F' )1286 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1287 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1288 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1289 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1290 END SELECT1291 END DO1292 END DO1293 END DO1294 !1295 ii0 = 627 ; ii1 = 628 ! Bosphorus Strait (e2u was modified)1296 ij0 = 343 ; ij1 = 3431297 DO jk = 1, jpkm11298 DO jj = mj0(ij0), mj1(ij1)1299 DO ji = mi0(ii0), mi1(ii1)1300 SELECT CASE ( pout )1301 CASE( 'U' )1302 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1303 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1304 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1305 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1306 CASE( 'F' )1307 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1308 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1309 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1310 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1311 END SELECT1312 END DO1313 END DO1314 END DO1315 !1316 ii0 = 93 ; ii1 = 94 ! Sumba Strait (e2u was modified)1317 ij0 = 232 ; ij1 = 2321318 DO jk = 1, jpkm11319 DO jj = mj0(ij0), mj1(ij1)1320 DO ji = mi0(ii0), mi1(ii1)1321 SELECT CASE ( pout )1322 CASE( 'U' )1323 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1324 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1325 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1326 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1327 CASE( 'F' )1328 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1329 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1330 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1331 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1332 END SELECT1333 END DO1334 END DO1335 END DO1336 !1337 ii0 = 103 ; ii1 = 103 ! Ombai Strait (e2u was modified)1338 ij0 = 232 ; ij1 = 2321339 DO jk = 1, jpkm11340 DO jj = mj0(ij0), mj1(ij1)1341 DO ji = mi0(ii0), mi1(ii1)1342 SELECT CASE ( pout )1343 CASE( 'U' )1344 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1345 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1346 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1347 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1348 CASE( 'F' )1349 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1350 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1351 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1352 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1353 END SELECT1354 END DO1355 END DO1356 END DO1357 !1358 ii0 = 15 ; ii1 = 15 ! Palk Strait (e2u was modified)1359 ij0 = 270 ; ij1 = 2701360 DO jk = 1, jpkm11361 DO jj = mj0(ij0), mj1(ij1)1362 DO ji = mi0(ii0), mi1(ii1)1363 SELECT CASE ( pout )1364 CASE( 'U' )1365 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) &1366 & * ( e1t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) &1367 & + e1t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) &1368 & ) / e1u(ji,jj) + e3u_0(ji,jj,jk)1369 CASE( 'F' )1370 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) &1371 & * ( e1u(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3u_0(ji ,jj,jk) ) &1372 & + e1u(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3u_0(ji+1,jj,jk) ) &1373 & ) / e1f(ji,jj) + e3f_0(ji,jj,jk)1374 END SELECT1375 END DO1376 END DO1377 END DO1378 !1379 ii0 = 87 ; ii1 = 87 ! Lombok Strait (e1v was modified)1380 ij0 = 232 ; ij1 = 2331381 DO jk = 1, jpkm11382 DO jj = mj0(ij0), mj1(ij1)1383 DO ji = mi0(ii0), mi1(ii1)1384 SELECT CASE ( pout )1385 CASE( 'V' )1386 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1387 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1388 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1389 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1390 END SELECT1391 END DO1392 END DO1393 END DO1394 !1395 ii0 = 662 ; ii1 = 662 ! Bab el Mandeb (e1v was modified)1396 ij0 = 276 ; ij1 = 2761397 DO jk = 1, jpkm11398 DO jj = mj0(ij0), mj1(ij1)1399 DO ji = mi0(ii0), mi1(ii1)1400 SELECT CASE ( pout )1401 CASE( 'V' )1402 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) &1403 & * ( e2t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) &1404 & + e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) &1405 & ) / e2v(ji,jj) + e3v_0(ji,jj,jk)1406 END SELECT1407 END DO1408 END DO1409 END DO1410 ENDIF1411 END SUBROUTINE dom_vvl_orca_fix1412 1413 1012 !!====================================================================== 1414 1013 END MODULE domvvl -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90
r5603 r5737 26 26 PRIVATE 27 27 28 PUBLIC dom_wri! routine called by inidom.F9029 28 PUBLIC dom_wri ! routine called by inidom.F90 29 PUBLIC dom_wri_coordinate ! routine called by domhgr.F90 30 30 !! * Substitutions 31 31 # include "vectopt_loop_substitute.h90" … … 36 36 !!---------------------------------------------------------------------- 37 37 CONTAINS 38 39 40 41 SUBROUTINE dom_wri_coordinate 42 !!---------------------------------------------------------------------- 43 !! *** ROUTINE dom_wri_coordinate *** 44 !! 45 !! ** Purpose : Create the NetCDF file which contains all the 46 !! standard coordinate information plus the surface, 47 !! e1e2u and e1e2v. By doing so, those surface will 48 !! not be changed by the reduction of e1u or e2v scale 49 !! factors in some straits. 50 !! NB: call just after the read of standard coordinate 51 !! and the reduction of scale factors in some straits 52 !! 53 !! ** output file : coordinate_e1e2u_v.nc 54 !!---------------------------------------------------------------------- 55 INTEGER :: inum0 ! temprary units for 'coordinate_e1e2u_v.nc' file 56 CHARACTER(len=21) :: clnam0 ! filename (mesh and mask informations) 57 ! ! workspaces 58 REAL(wp), POINTER, DIMENSION(:,: ) :: zprt, zprw 59 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 60 !!---------------------------------------------------------------------- 61 ! 62 IF( nn_timing == 1 ) CALL timing_start('dom_wri_coordinate') 63 ! 64 IF(lwp) WRITE(numout,*) 65 IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file' 66 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~' 67 68 clnam0 = 'coordinate_e1e2u_v' ! filename (mesh and mask informations) 69 70 ! create 'coordinate_e1e2u_v.nc' file 71 ! ============================ 72 ! 73 CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 74 ! 75 ! ! horizontal mesh (inum3) 76 CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r4 ) ! ! latitude 77 CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r4 ) 78 CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r4 ) 79 CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r4 ) 80 81 CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r4 ) ! ! longitude 82 CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r4 ) 83 CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r4 ) 84 CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r4 ) 85 86 CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 ) ! ! e1 scale factors 87 CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 ) 88 CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 ) 89 CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 ) 90 91 CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 ) ! ! e2 scale factors 92 CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 ) 93 CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 ) 94 CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 ) 95 96 CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 ) 97 CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 ) 98 99 CALL iom_close( inum0 ) 100 ! 101 IF( nn_timing == 1 ) CALL timing_stop('dom_wri_coordinate') 102 ! 103 END SUBROUTINE dom_wri_coordinate 104 38 105 39 106 SUBROUTINE dom_wri -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/divcur.F90
r5516 r5737 121 121 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj )*fse3u(ji-1,jj ,jk) * un(ji-1,jj ,jk) & 122 122 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji ,jj-1)*fse3v(ji ,jj-1,jk) * vn(ji ,jj-1,jk) ) & 123 / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )123 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 124 124 END DO 125 125 END DO … … 195 195 DO ji = 1, fs_jpim1 ! vector opt. 196 196 rotn(ji,jj,jk) = ( zwv(ji+1,jj ) - zwv(ji,jj) & 197 & - zwu(ji ,jj+1) + zwu(ji,jj) ) * fmask(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj))197 & - zwu(ji ,jj+1) + zwu(ji,jj) ) * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 198 198 END DO 199 199 END DO … … 203 203 ii = nicoa(jl,1,jk) 204 204 ij = njcoa(jl,1,jk) 205 rotn(ii,ij,jk) = 1. / ( e1f(ii,ij) * e2f(ii,ij) ) & 206 * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) 205 rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * ( + 4. * zwv(ii+1,ij) - zwv(ii+2,ij) + 0.2 * zwv(ii+3,ij) ) 207 206 END DO 208 207 DO jl = 1, npcoa(2,jk) 209 208 ii = nicoa(jl,2,jk) 210 209 ij = njcoa(jl,2,jk) 211 rotn(ii,ij,jk) = 1./(e1f(ii,ij)*e2f(ii,ij)) & 212 *(-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) 210 rotn(ii,ij,jk) = r1_e1e2f(ji,jj) * (-4.*zwv(ii,ij)+zwv(ii-1,ij)-0.2*zwv(ii-2,ij)) 213 211 END DO 214 212 DO jl = 1, npcoa(3,jk) 215 213 ii = nicoa(jl,3,jk) 216 214 ij = njcoa(jl,3,jk) 217 rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) ) & 218 * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) 215 rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( +4. * zwu(ii,ij+1) - zwu(ii,ij+2) + 0.2 * zwu(ii,ij+3) ) 219 216 END DO 220 217 DO jl = 1, npcoa(4,jk) 221 218 ii = nicoa(jl,4,jk) 222 219 ij = njcoa(jl,4,jk) 223 rotn(ii,ij,jk) = -1. / ( e1f(ii,ij)*e2f(ii,ij) ) & 224 * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 220 rotn(ii,ij,jk) = -r1_e1e2f(ji,jj) * ( -4. * zwu(ii,ij) + zwu(ii,ij-1) - 0.2 * zwu(ii,ij-2) ) 225 221 END DO 226 222 ! ! =============== … … 302 298 ( e2u(ji,jj)*fse3u(ji,jj,jk) * un(ji,jj,jk) - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * un(ji-1,jj,jk) & 303 299 + e1v(ji,jj)*fse3v(ji,jj,jk) * vn(ji,jj,jk) - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * vn(ji,jj-1,jk) ) & 304 / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )300 / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 305 301 END DO 306 302 END DO … … 320 316 rotn(ji,jj,jk) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) * vn(ji,jj,jk) & 321 317 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) * un(ji,jj,jk) ) & 322 & * fmask(ji,jj,jk) / ( e1f(ji,jj) * e2f(ji,jj))318 & * fmask(ji,jj,jk) * r1_e1e2f(ji,jj) 323 319 END DO 324 320 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90
r4990 r5737 90 90 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 91 91 DO ji = fs_2, fs_jpim1 ! vector opt. 92 zbu = e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk)93 zbv = e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk)92 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 93 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 94 94 ! 95 95 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj ,jk) - zfu_t(ji ,jj ,jk) & … … 114 114 DO jk = 1, jpkm1 ! ==================== ! 115 115 ! ! Vertical volume fluxesÊ 116 zfw(:,:,jk) = 0.25 * e1 t(:,:) *e2t(:,:) * wn(:,:,jk)116 zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 117 117 ! 118 118 IF( jk == 1 ) THEN ! surface/bottom advective fluxes … … 144 144 DO ji = fs_2, fs_jpim1 ! vector opt. 145 145 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) & 146 & / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )146 & / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 147 147 va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) & 148 & / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )148 & / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 149 149 END DO 150 150 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90
r5069 r5737 181 181 DO jj = 2, jpjm1 ! divergence of horizontal momentum fluxes 182 182 DO ji = fs_2, fs_jpim1 ! vector opt. 183 zbu = e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk)184 zbv = e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk)183 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk) 184 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk) 185 185 ! 186 186 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_t(ji+1,jj ,jk) - zfu_t(ji ,jj ,jk) & … … 203 203 DO jk = 1, jpkm1 ! ==================== ! 204 204 ! ! Vertical volume fluxesÊ 205 zfw(:,:,jk) = 0.25 * e1 t(:,:) *e2t(:,:) * wn(:,:,jk)205 zfw(:,:,jk) = 0.25 * e1e2t(:,:) * wn(:,:,jk) 206 206 ! 207 207 IF( jk == 1 ) THEN ! surface/bottom advective fluxes … … 233 233 DO ji = fs_2, fs_jpim1 ! vector opt. 234 234 ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) & 235 & / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )235 & / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 236 236 va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) & 237 & / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )237 & / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 238 238 END DO 239 239 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r5224 r5737 1046 1046 DO jj = 2, jpjm1 1047 1047 DO ji = 2, jpim1 1048 zsshu_n(ji,jj) = (e1 2u(ji,jj) * sshn(ji,jj) + e12u(ji+1, jj) * sshn(ji+1,jj)) * &1049 & r1_e1 2u(ji,jj) * umask(ji,jj,1) * 0.5_wp1050 zsshv_n(ji,jj) = (e1 2v(ji,jj) * sshn(ji,jj) + e12v(ji+1, jj) * sshn(ji,jj+1)) * &1051 & r1_e1 2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp1048 zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * & 1049 & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 1050 zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * & 1051 & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 1052 1052 END DO 1053 1053 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilap.F90
r4990 r5737 113 113 DO ji = fs_2, fs_jpim1 ! vector opt. 114 114 zlu(ji,jj,jk) = - ( zuf(ji,jj,jk) - zuf(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 115 & + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) /e1u(ji,jj)115 & + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj,jk) ) * r1_e1u(ji,jj) 116 116 117 117 zlv(ji,jj,jk) = + ( zuf(ji,jj,jk) - zuf(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 118 & + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) /e2v(ji,jj)118 & + ( hdivb(ji,jj+1,jk) - hdivb(ji,jj,jk) ) * r1_e2v(ji,jj) 119 119 END DO 120 120 END DO … … 122 122 DO jj = 2, jpjm1 123 123 DO ji = fs_2, fs_jpim1 ! vector opt. 124 zlu(ji,jj,jk) = - ( rotb (ji ,jj,jk) - rotb (ji,jj-1,jk) ) /e2u(ji,jj) &125 & + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj ,jk) ) /e1u(ji,jj)126 127 zlv(ji,jj,jk) = + ( rotb (ji,jj ,jk) - rotb (ji-1,jj,jk) ) /e1v(ji,jj) &128 & + ( hdivb(ji,jj+1,jk) - hdivb(ji ,jj,jk) ) /e2v(ji,jj)124 zlu(ji,jj,jk) = - ( rotb (ji ,jj,jk) - rotb (ji,jj-1,jk) ) * r1_e2u(ji,jj) & 125 & + ( hdivb(ji+1,jj,jk) - hdivb(ji,jj ,jk) ) * r1_e1u(ji,jj) 126 127 zlv(ji,jj,jk) = + ( rotb (ji,jj ,jk) - rotb (ji-1,jj,jk) ) * r1_e1v(ji,jj) & 128 & + ( hdivb(ji,jj+1,jk) - hdivb(ji ,jj,jk) ) * r1_e2v(ji,jj) 129 129 END DO 130 130 END DO … … 152 152 DO ji = 1, fs_jpim1 ! vector opt. 153 153 zuf(ji,jj,jk) = fmask(ji,jj,jk) * ( zcv(ji+1,jj ) - zcv(ji,jj) & 154 & - zcu(ji ,jj+1) + zcu(ji,jj) ) &155 & * fse3f(ji,jj,jk) / ( e1f(ji,jj)*e2f(ji,jj))154 & - zcu(ji ,jj+1) + zcu(ji,jj) ) & 155 & * fse3f(ji,jj,jk) * r1_e1e2f(ji,jj) 156 156 END DO 157 157 END DO … … 168 168 DO jj = 2, jpj 169 169 DO ji = fs_2, jpi ! vector opt. 170 zbt = e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk)170 zbt = e1e2t(ji,jj) * fse3t(ji,jj,jk) 171 171 zut(ji,jj,jk) = ( zlu(ji,jj,jk) - zlu(ji-1,jj ,jk) & 172 172 & + zlv(ji,jj,jk) - zlv(ji ,jj-1,jk) ) / zbt … … 192 192 ! horizontal biharmonic diffusive trends 193 193 zua = - ( zuf(ji ,jj,jk) - zuf(ji,jj-1,jk) ) / ze2u & 194 & + ( zut(ji+1,jj,jk) - zut(ji,jj ,jk) ) /e1u(ji,jj)194 & + ( zut(ji+1,jj,jk) - zut(ji,jj ,jk) ) * r1_e1u(ji,jj) 195 195 196 196 zva = + ( zuf(ji,jj ,jk) - zuf(ji-1,jj,jk) ) / ze2v & 197 & + ( zut(ji,jj+1,jk) - zut(ji ,jj,jk) ) /e2v(ji,jj)197 & + ( zut(ji,jj+1,jk) - zut(ji ,jj,jk) ) * r1_e2v(ji,jj) 198 198 ! add it to the general momentum trends 199 199 ua(ji,jj,jk) = ua(ji,jj,jk) + zua * ( fsahmu(ji,jj,jk)*nkahm_smag +(1 -nkahm_smag )) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90
r4990 r5737 80 80 ! horizontal diffusive trends 81 81 zua = - ( ze2u - rotb (ji,jj-1,jk)*fsahmf(ji,jj-1,jk)*fse3f(ji,jj-1,jk) ) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) & 82 + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v ) /e1u(ji,jj)82 + ( hdivb(ji+1,jj,jk)*fsahmt(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) 83 83 84 84 zva = + ( ze2u - rotb (ji-1,jj,jk)*fsahmf(ji-1,jj,jk)*fse3f(ji-1,jj,jk) ) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) & 85 + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v ) /e2v(ji,jj)85 + ( hdivb(ji,jj+1,jk)*fsahmt(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj) 86 86 87 87 ! add it to the general momentum trends -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r5656 r5737 108 108 END FUNCTION dyn_spg_ts_alloc 109 109 110 110 111 SUBROUTINE dyn_spg_ts( kt ) 111 112 !!---------------------------------------------------------------------- … … 338 339 DO jj = 2, jpjm1 339 340 DO ji = fs_2, fs_jpim1 ! vector opt. 340 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) /e1u(ji,jj)341 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)342 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) /e2v(ji,jj)343 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) /e2v(ji,jj)341 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 342 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 343 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 344 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 344 345 ! energy conserving formulation for planetary vorticity term 345 346 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) … … 352 353 DO ji = fs_2, fs_jpim1 ! vector opt. 353 354 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 354 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)355 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 355 356 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 356 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)357 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 357 358 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 358 359 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 363 364 DO jj = 2, jpjm1 364 365 DO ji = fs_2, fs_jpim1 ! vector opt. 365 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &366 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &367 & + ftse(ji,jj ) * zwy(ji ,jj-1) &368 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )369 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &370 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &371 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &372 & + ftne(ji,jj ) * zwx(ji ,jj ) )366 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 367 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 368 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 369 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 370 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 371 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 372 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 373 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 373 374 END DO 374 375 END DO … … 381 382 DO jj = 2, jpjm1 382 383 DO ji = fs_2, fs_jpim1 ! vector opt. 383 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) /e1u(ji,jj)384 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) /e2v(ji,jj)384 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj) 385 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj) 385 386 END DO 386 387 END DO … … 431 432 DO jj = 2, jpjm1 432 433 DO ji = fs_2, fs_jpim1 ! vector opt. 433 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) /e1u(ji,jj)434 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)434 zu_spg = grav * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 435 zv_spg = grav * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 435 436 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 436 437 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 441 442 DO ji = fs_2, fs_jpim1 ! vector opt. 442 443 zu_spg = grav * z1_2 * ( ssh_ib (ji+1,jj ) - ssh_ib (ji,jj) & 443 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) /e1u(ji,jj)444 & + ssh_ibb(ji+1,jj ) - ssh_ibb(ji,jj) ) * r1_e1u(ji,jj) 444 445 zv_spg = grav * z1_2 * ( ssh_ib (ji ,jj+1) - ssh_ib (ji,jj) & 445 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj)446 & + ssh_ibb(ji ,jj+1) - ssh_ibb(ji,jj) ) * r1_e2v(ji,jj) 446 447 zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg 447 448 zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg … … 549 550 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 550 551 DO ji = 2, fs_jpim1 ! Vector opt. 551 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &552 & * ( e1 2t(ji ,jj) * zsshp2_e(ji ,jj) &553 & + e1 2t(ji+1,jj) * zsshp2_e(ji+1,jj) )554 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &555 & * ( e1 2t(ji,jj ) * zsshp2_e(ji,jj ) &556 & + e1 2t(ji,jj+1) * zsshp2_e(ji,jj+1) )552 zwx(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 553 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 554 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 555 zwy(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 556 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 557 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 557 558 END DO 558 559 END DO … … 602 603 ! Sum over sub-time-steps to compute advective velocities 603 604 za2 = wgtbtp2(jn) 604 zu_sum (:,:) = zu_sum (:,:) + za2 * zwx (:,:) / e2u(:,:)605 zv_sum (:,:) = zv_sum (:,:) + za2 * zwy (:,:) / e1v(:,:)605 zu_sum(:,:) = zu_sum(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 606 zv_sum(:,:) = zv_sum(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 606 607 ! 607 608 ! Set next sea level: … … 609 610 DO ji = fs_2, fs_jpim1 ! vector opt. 610 611 zhdiv(ji,jj) = ( zwx(ji,jj) - zwx(ji-1,jj) & 611 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1 2t(ji,jj)612 & + zwy(ji,jj) - zwy(ji,jj-1) ) * r1_e1e2t(ji,jj) 612 613 END DO 613 614 END DO … … 627 628 DO jj = 2, jpjm1 628 629 DO ji = 2, jpim1 ! NO Vector Opt. 629 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &630 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &631 & + e1 2t(ji+1,jj ) * ssha_e(ji+1,jj ) )632 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &633 & * ( e1 2t(ji ,jj ) * ssha_e(ji ,jj ) &634 & + e1 2t(ji ,jj+1) * ssha_e(ji ,jj+1) )630 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 631 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 632 & + e1e2t(ji+1,jj ) * ssha_e(ji+1,jj ) ) 633 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 634 & * ( e1e2t(ji ,jj ) * ssha_e(ji ,jj ) & 635 & + e1e2t(ji ,jj+1) * ssha_e(ji ,jj+1) ) 635 636 END DO 636 637 END DO … … 666 667 DO jj = 2, jpjm1 667 668 DO ji = 2, jpim1 668 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1 2u(ji ,jj) &669 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj) &670 & + e1 2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) )671 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1 2v(ji ,jj ) &672 & * ( e1 2t(ji ,jj ) * zsshp2_e(ji ,jj ) &673 & + e1 2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) )669 zx1 = z1_2 * umask(ji ,jj,1) * r1_e1e2u(ji ,jj) & 670 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj) & 671 & + e1e2t(ji+1,jj ) * zsshp2_e(ji+1,jj ) ) 672 zy1 = z1_2 * vmask(ji ,jj,1) * r1_e1e2v(ji ,jj ) & 673 & * ( e1e2t(ji ,jj ) * zsshp2_e(ji ,jj ) & 674 & + e1e2t(ji ,jj+1) * zsshp2_e(ji ,jj+1) ) 674 675 zhust_e(ji,jj) = hu_0(ji,jj) + zx1 675 676 zhvst_e(ji,jj) = hv_0(ji,jj) + zy1 … … 688 689 DO jj = 2, jpjm1 689 690 DO ji = fs_2, fs_jpim1 ! vector opt. 690 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) /e1u(ji,jj)691 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)692 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) /e2v(ji,jj)693 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)691 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 692 zy2 = ( zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 693 zx1 = ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 694 zx2 = ( zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 694 695 zu_trd(ji,jj) = z1_4 * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 695 696 zv_trd(ji,jj) =-z1_4 * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) … … 701 702 DO ji = fs_2, fs_jpim1 ! vector opt. 702 703 zy1 = z1_8 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 703 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)704 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 704 705 zx1 = - z1_8 * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 705 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) /e2v(ji,jj)706 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 706 707 zu_trd(ji,jj) = zy1 * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 707 708 zv_trd(ji,jj) = zx1 * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 712 713 DO jj = 2, jpjm1 713 714 DO ji = fs_2, fs_jpim1 ! vector opt. 714 zu_trd(ji,jj) = + z1_12 /e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) &715 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) &716 & + ftse(ji,jj ) * zwy(ji ,jj-1) &717 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) )718 zv_trd(ji,jj) = - z1_12 /e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) &719 & + ftse(ji,jj+1) * zwx(ji ,jj+1) &720 & + ftnw(ji,jj ) * zwx(ji-1,jj ) &721 & + ftne(ji,jj ) * zwx(ji ,jj ) )715 zu_trd(ji,jj) = + z1_12 * r1_e1u(ji,jj) * ( ftne(ji,jj ) * zwy(ji ,jj ) & 716 & + ftnw(ji+1,jj) * zwy(ji+1,jj ) & 717 & + ftse(ji,jj ) * zwy(ji ,jj-1) & 718 & + ftsw(ji+1,jj) * zwy(ji+1,jj-1) ) 719 zv_trd(ji,jj) = - z1_12 * r1_e2v(ji,jj) * ( ftsw(ji,jj+1) * zwx(ji-1,jj+1) & 720 & + ftse(ji,jj+1) * zwx(ji ,jj+1) & 721 & + ftnw(ji,jj ) * zwx(ji-1,jj ) & 722 & + ftne(ji,jj ) * zwx(ji ,jj ) ) 722 723 END DO 723 724 END DO … … 729 730 DO jj = 2, jpjm1 730 731 DO ji = fs_2, fs_jpim1 ! vector opt. 731 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) /e1u(ji,jj)732 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) /e2v(ji,jj)732 zu_spg = grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 733 zv_spg = grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 733 734 zu_trd(ji,jj) = zu_trd(ji,jj) + zu_spg 734 735 zv_trd(ji,jj) = zv_trd(ji,jj) + zv_spg … … 745 746 DO ji = fs_2, fs_jpim1 ! vector opt. 746 747 ! Add surface pressure gradient 747 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) /e1u(ji,jj)748 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) /e2v(ji,jj)748 zu_spg = - grav * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 749 zv_spg = - grav * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 749 750 zwx(ji,jj) = zu_spg 750 751 zwy(ji,jj) = zv_spg … … 850 851 DO jj = 1, jpjm1 851 852 DO ji = 1, jpim1 ! NO Vector Opt. 852 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1 2u(ji,jj) &853 & * ( e1 2t(ji ,jj) * ssha(ji ,jj) &854 & + e1 2t(ji+1,jj) * ssha(ji+1,jj) )855 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1 2v(ji,jj) &856 & * ( e1 2t(ji,jj ) * ssha(ji,jj ) &857 & + e1 2t(ji,jj+1) * ssha(ji,jj+1) )853 zsshu_a(ji,jj) = z1_2 * umask(ji,jj,1) * r1_e1e2u(ji,jj) & 854 & * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 855 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 856 zsshv_a(ji,jj) = z1_2 * vmask(ji,jj,1) * r1_e1e2v(ji,jj) & 857 & * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 858 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 858 859 END DO 859 860 END DO … … 1093 1094 DO jj = 1, jpj 1094 1095 DO ji =1, jpi 1095 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))1096 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))1097 zcu(ji,jj) = sqrt(grav*ht_0(ji,jj)*(zxr2 + zyr2) )1096 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1097 zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 1098 zcu(ji,jj) = SQRT( grav * ht_0(ji,jj) * (zxr2 + zyr2) ) 1098 1099 END DO 1099 1100 END DO … … 1101 1102 DO jj = 1, jpj 1102 1103 DO ji =1, jpi 1103 zxr2 = 1./(e1t(ji,jj)*e1t(ji,jj))1104 zyr2 = 1./(e2t(ji,jj)*e2t(ji,jj))1105 zcu(ji,jj) = sqrt(grav*ht(ji,jj)*(zxr2 + zyr2) )1106 END DO 1107 END DO 1108 ENDIF 1109 1110 zcmax = MAXVAL( zcu(:,:))1104 zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1105 zyr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 1106 zcu(ji,jj) = SQRT( grav * ht(ji,jj) * (zxr2 + zyr2) ) 1107 END DO 1108 END DO 1109 ENDIF 1110 1111 zcmax = MAXVAL( zcu(:,:) ) 1111 1112 IF( lk_mpp ) CALL mpp_max( zcmax ) 1112 1113 … … 1114 1115 IF (ln_bt_nn_auto) nn_baro = CEILING( rdt / rn_bt_cmax * zcmax) 1115 1116 1116 rdtbt = rdt / FLOAT(nn_baro)1117 rdtbt = rdt / REAL( nn_baro , wp ) 1117 1118 zcmax = zcmax * rdtbt 1118 1119 ! Print results … … 1194 1195 !!====================================================================== 1195 1196 END MODULE dynspg_ts 1196 1197 1198 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r5029 r5737 213 213 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 214 214 !!---------------------------------------------------------------------- 215 !216 215 INTEGER , INTENT(in ) :: kt ! ocean time-step index 217 216 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 237 236 zfact2 = 0.5 * 0.5 ! Local constant initialization 238 237 239 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz )240 238 ! ! =============== 241 239 DO jk = 1, jpkm1 ! Horizontal slab … … 252 250 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 253 251 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 254 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj))252 & * 0.5 * r1_e1e2f(ji,jj) 255 253 END DO 256 254 END DO … … 262 260 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 263 261 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 264 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) )&262 & * 0.5 * r1_e1e2f(ji,jj) & 265 263 & ) 266 264 END DO … … 285 283 zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 286 284 zx2 = zwx(ji ,jj) + zwx(ji ,jj+1) 287 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 /e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 )288 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 /e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 )285 pua(ji,jj,jk) = pua(ji,jj,jk) + zfact2 * r1_e1u(ji,jj) * ( zwz(ji ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 286 pva(ji,jj,jk) = pva(ji,jj,jk) - zfact2 * r1_e2v(ji,jj) * ( zwz(ji-1,jj ) * zx1 + zwz(ji,jj) * zx2 ) 289 287 END DO 290 288 END DO … … 365 363 zww(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 366 364 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 367 & * 0.5 / ( e1 f(ji,jj) *e2f (ji,jj) * fse3f(ji,jj,jk) )365 & * 0.5 / ( e1e2f (ji,jj) * fse3f(ji,jj,jk) ) 368 366 END DO 369 367 END DO … … 380 378 zww(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 381 379 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 382 & * 0.5 / ( e1f(ji,jj) * e2f (ji,jj))380 & * 0.5 * r1_e1e2f(ji,jj) 383 381 END DO 384 382 END DO … … 393 391 DO jj = 2, jpjm1 394 392 DO ji = fs_2, fs_jpim1 ! vector opt. 395 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) /e1u(ji,jj)396 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) /e1u(ji,jj)397 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) /e2v(ji,jj)398 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) /e2v(ji,jj)393 zy1 = ( zwy(ji,jj-1) + zwy(ji+1,jj-1) ) * r1_e1u(ji,jj) 394 zy2 = ( zwy(ji,jj ) + zwy(ji+1,jj ) ) * r1_e1u(ji,jj) 395 zx1 = ( zwx(ji-1,jj) + zwx(ji-1,jj+1) ) * r1_e2v(ji,jj) 396 zx2 = ( zwx(ji ,jj) + zwx(ji ,jj+1) ) * r1_e2v(ji,jj) 399 397 ! enstrophy conserving formulation for relative vorticity term 400 398 zua = zfact1 * ( zww(ji ,jj-1) + zww(ji,jj) ) * ( zy1 + zy2 ) … … 481 479 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 482 480 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 483 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj))481 & * 0.5 * r1_e1e2f(ji,jj) 484 482 END DO 485 483 END DO … … 491 489 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 492 490 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 493 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj)) &491 & * 0.5 * r1_e1e2f(ji,jj) & 494 492 & ) 495 493 END DO … … 497 495 END SELECT 498 496 ! 499 IF( ln_sco ) THEN 500 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 501 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 502 zwz(ji,jj) = zwz(ji,jj) / fse3f(ji,jj,jk) 503 zwx(ji,jj) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 504 zwy(ji,jj) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 505 END DO 506 END DO 497 IF( ln_sco ) THEN !== horizontal fluxes ==! 498 zwz(:,:) = zwz(:,:) / fse3f(:,:,jk) 499 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 500 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 507 501 ELSE 508 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 509 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 510 zwx(ji,jj) = e2u(ji,jj) * un(ji,jj,jk) 511 zwy(ji,jj) = e1v(ji,jj) * vn(ji,jj,jk) 512 END DO 513 END DO 514 ENDIF 515 ! 516 ! Compute and add the vorticity term trend 517 ! ---------------------------------------- 502 zwx(:,:) = e2u(:,:) * un(:,:,jk) 503 zwy(:,:) = e1v(:,:) * vn(:,:,jk) 504 ENDIF 505 ! !== compute and add the vorticity term trend =! 518 506 DO jj = 2, jpjm1 519 507 DO ji = fs_2, fs_jpim1 ! vector opt. 520 zuav = zfact1 /e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) &521 & + zwy(ji ,jj ) + zwy(ji+1,jj ) )522 zvau =-zfact1 /e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) &523 & + zwx(ji ,jj ) + zwx(ji ,jj+1) )508 zuav = zfact1 * r1_e1u(ji,jj) * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & 509 & + zwy(ji ,jj ) + zwy(ji+1,jj ) ) 510 zvau =-zfact1 * r1_e2v(ji,jj) * ( zwx(ji-1,jj ) + zwx(ji-1,jj+1) & 511 & + zwx(ji ,jj ) + zwx(ji ,jj+1) ) 524 512 pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji ,jj-1) + zwz(ji,jj) ) 525 513 pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj ) + zwz(ji,jj) ) … … 553 541 !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 554 542 !!---------------------------------------------------------------------- 555 !556 543 INTEGER , INTENT(in ) :: kt ! ocean time-step index 557 544 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; … … 627 614 zfac12 = 1._wp / 12._wp ! Local constant initialization 628 615 629 630 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse )631 616 ! ! =============== 632 617 DO jk = 1, jpkm1 ! Horizontal slab … … 645 630 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 646 631 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 647 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj)) * ze3f(ji,jj,jk)632 & * 0.5 * r1_e1e2f(ji,jj) * ze3f(ji,jj,jk) 648 633 END DO 649 634 END DO … … 657 642 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 658 643 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 659 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) & 660 & ) * ze3f(ji,jj,jk) 644 & * 0.5 * r1_e1e2f(ji,jj) ) * ze3f(ji,jj,jk) 661 645 END DO 662 646 END DO 663 647 CALL lbc_lnk( zwz, 'F', 1. ) 664 648 END SELECT 665 649 ! 650 ! !== horizontal fluxes ==! 666 651 zwx(:,:) = e2u(:,:) * fse3u(:,:,jk) * un(:,:,jk) 667 652 zwy(:,:) = e1v(:,:) * fse3v(:,:,jk) * vn(:,:,jk) 668 653 669 ! Compute and add the vorticity term trend 670 ! ---------------------------------------- 654 ! !== compute and add the vorticity term trend =! 671 655 jj = 2 672 656 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 673 DO ji = 2, jpi 657 DO ji = 2, jpi ! split in 2 parts due to vector opt. 674 658 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) 675 659 ztnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj ) + zwz(ji ,jj ) … … 687 671 DO jj = 2, jpjm1 688 672 DO ji = fs_2, fs_jpim1 ! vector opt. 689 zua = + zfac12 /e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) &673 zua = + zfac12 * r1_e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & 690 674 & + ztse(ji,jj ) * zwy(ji ,jj-1) + ztsw(ji+1,jj) * zwy(ji+1,jj-1) ) 691 zva = - zfac12 /e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) &675 zva = - zfac12 * r1_e2v(ji,jj) * ( ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji ,jj+1) & 692 676 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 693 677 pua(ji,jj,jk) = pua(ji,jj,jk) + zua -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90
r5120 r5737 85 85 DO jj = 2, jpj ! vertical fluxes 86 86 DO ji = fs_2, jpi ! vector opt. 87 zww(ji,jj) = 0.25_wp * e1 t(ji,jj) *e2t(ji,jj) * wn(ji,jj,jk)87 zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 88 88 END DO 89 89 END DO … … 121 121 DO ji = fs_2, fs_jpim1 ! vector opt. 122 122 ! ! vertical momentum advective trends 123 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )124 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )123 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 124 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 125 125 ! ! add the trends to the general momentum trends 126 126 ua(ji,jj,jk) = ua(ji,jj,jk) + zua … … 146 146 ! 147 147 END SUBROUTINE dyn_zad 148 148 149 149 150 SUBROUTINE dyn_zad_zts ( kt ) … … 205 206 DO jj = 2, jpj 206 207 DO ji = fs_2, jpi ! vector opt. 207 zww(ji,jj,jk) = 0.25_wp * e1 t(ji,jj) *e2t(ji,jj) * wn(ji,jj,jk)208 zww(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 208 209 END DO 209 210 END DO … … 251 252 DO ji = fs_2, fs_jpim1 ! vector opt. 252 253 ! ! vertical momentum advective trends 253 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )254 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )254 zua = - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 255 zva = - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 255 256 zus(ji,jj,jk,jta) = zus(ji,jj,jk,jtb) + zua * zts 256 257 zvs(ji,jj,jk,jta) = zvs(ji,jj,jk,jtb) + zva * zts -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r5656 r5737 193 193 DO jj = 2, jpjm1 194 194 DO ji = fs_2, fs_jpim1 ! vector opt. 195 zhdiv(ji,jj,jk) = r1_e1 2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) )195 zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 196 196 END DO 197 197 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r4328 r5737 125 125 126 126 ! for a isobar float zsurfz is put to zero. The vertical velocity will be zero too. 127 zsurfz = e1t(iiloc(jfl),ijloc(jfl)) *e2t(iiloc(jfl),ijloc(jfl))127 zsurfz = e1e2t(iiloc(jfl),ijloc(jfl)) 128 128 zvol = zsurfz * fse3t(iiloc(jfl),ijloc(jfl),-ikl(jfl)) 129 129 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbdia.F90
r5215 r5737 191 191 192 192 nbergs_end = icb_utl_count() 193 zgrdd_berg_mass = SUM( berg_mass 193 zgrdd_berg_mass = SUM( berg_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 194 194 zgrdd_bits_mass = SUM( bits_mass(:,:)*e1e2t(:,:)*tmask_i(:,:) ) 195 195 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
r5215 r5737 156 156 ! use tmask rather than tmask_i when dealing with icebergs 157 157 IF( tmask(ii,ij,1) /= 0._wp ) THEN ! Add melting to the grid and field diagnostics 158 z1_e1e2 = 1._wp /e1e2t(ii,ij) * this%mass_scaling158 z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling 159 159 z1_dt_e1e2 = z1_dt * z1_e1e2 160 160 zmelt = ( zdM - ( zdMbitsE - zdMbitsM ) ) * z1_dt ! kg/s … … 195 195 ! 196 196 ELSE ! Diagnose mass distribution on grid 197 z1_e1e2 = 1._wp /e1e2t(ii,ij) * this%mass_scaling197 z1_e1e2 = r1_e1e2t(ii,ij) * this%mass_scaling 198 198 CALL icb_dia_size( ii, ij, zWn, zLn, zAbits, & 199 199 & this%mass_scaling, zMnew, znMbits, z1_e1e2) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r5656 r5737 129 129 ! 130 130 IF( ln_cfmeta ) THEN ! Add additional grid metadata 131 CALL iom_set_domain_attr("grid_T", area = e1 2t(nldi:nlei, nldj:nlej))132 CALL iom_set_domain_attr("grid_U", area = e1 2u(nldi:nlei, nldj:nlej))133 CALL iom_set_domain_attr("grid_V", area = e1 2v(nldi:nlei, nldj:nlej))134 CALL iom_set_domain_attr("grid_W", area = e1 2t(nldi:nlei, nldj:nlej))131 CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 132 CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 133 CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 134 CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 135 135 CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 136 136 CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r5407 r5737 197 197 END SUBROUTINE rst_read_open 198 198 199 199 200 SUBROUTINE rst_read 200 201 !!---------------------------------------------------------------------- … … 265 266 hdivb(:,:,:) = hdivn(:,:,:) 266 267 sshb (:,:) = sshn (:,:) 267 268 ! 268 269 IF( lk_vvl ) THEN 269 270 DO jk = 1, jpk … … 271 272 END DO 272 273 ENDIF 273 274 ! 274 275 ENDIF 275 276 ! -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90
r5120 r5737 208 208 DO ji = fs_2, fs_jpim1 ! vector opt. 209 209 ! ! horizontal and vertical density gradient at u- and v-points 210 zau = zgru(ji,jj,jk) /e1u(ji,jj)211 zav = zgrv(ji,jj,jk) /e2v(ji,jj)210 zau = zgru(ji,jj,jk) * r1_e1u(ji,jj) 211 zav = zgrv(ji,jj,jk) * r1_e2v(ji,jj) 212 212 zbu = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji+1,jj ,jk) ) 213 213 zbv = 0.5_wp * ( zdzr(ji,jj,jk) + zdzr(ji ,jj+1,jk) ) … … 426 426 DO jj = 2, jpjm1 427 427 DO ji = fs_2, fs_jpim1 ! vector opt. 428 uslp (ji,jj,1) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) )* umask(ji,jj,1)429 vslp (ji,jj,1) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) )* vmask(ji,jj,1)430 wslpi(ji,jj,1) = - 1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5431 wslpj(ji,jj,1) = - 1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5428 uslp (ji,jj,1) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,1) - fsdept_b(ji ,jj ,1) ) * umask(ji,jj,1) 429 vslp (ji,jj,1) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,1) - fsdept_b(ji ,jj ,1) ) * vmask(ji,jj,1) 430 wslpi(ji,jj,1) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,1) - fsdepw_b(ji-1,jj,1) ) * tmask(ji,jj,1) * 0.5 431 wslpj(ji,jj,1) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,1) - fsdepw_b(ji,jj-1,1) ) * tmask(ji,jj,1) * 0.5 432 432 END DO 433 433 END DO … … 436 436 DO jj = 2, jpjm1 437 437 DO ji = fs_2, fs_jpim1 ! vector opt. 438 uslp(ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 439 vslp(ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 440 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) & 441 & * wmask(ji,jj,jk) * 0.5 442 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) & 443 & * wmask(ji,jj,jk) * 0.5 438 uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 439 vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 440 wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 441 wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5 444 442 END DO 445 443 END DO … … 519 517 zdjt = ( tsb(ji,jj+1,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) ! j-gradient of T & S at v-point 520 518 zdjs = ( tsb(ji,jj+1,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 521 zdxrho_raw = ( - rab_b(ji+ip,jj ,jk,jp_tem) * zdit + rab_b(ji+ip,jj ,jk,jp_sal) * zdis ) /e1u(ji,jj)522 zdyrho_raw = ( - rab_b(ji ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji ,jj+jp,jk,jp_sal) * zdjs ) /e2v(ji,jj)519 zdxrho_raw = ( - rab_b(ji+ip,jj ,jk,jp_tem) * zdit + rab_b(ji+ip,jj ,jk,jp_sal) * zdis ) * r1_e1u(ji,jj) 520 zdyrho_raw = ( - rab_b(ji ,jj+jp,jk,jp_tem) * zdjt + rab_b(ji ,jj+jp,jk,jp_sal) * zdjs ) * r1_e2v(ji,jj) 523 521 zdxrho(ji+ip,jj ,jk,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 524 522 zdyrho(ji ,jj+jp,jk,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) … … 533 531 zdit = gtsu(ji,jj,jp_tem) ; zdjt = gtsv(ji,jj,jp_tem) ! i- & j-gradient of Temperature 534 532 zdis = gtsu(ji,jj,jp_sal) ; zdjs = gtsv(ji,jj,jp_sal) ! i- & j-gradient of Salinity 535 zdxrho_raw = ( - rab_b(ji+ip,jj ,iku,jp_tem) * zdit + rab_b(ji+ip,jj ,iku,jp_sal) * zdis ) /e1u(ji,jj)536 zdyrho_raw = ( - rab_b(ji ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji ,jj+jp,ikv,jp_sal) * zdjs ) /e2v(ji,jj)533 zdxrho_raw = ( - rab_b(ji+ip,jj ,iku,jp_tem) * zdit + rab_b(ji+ip,jj ,iku,jp_sal) * zdis ) * r1_e1u(ji,jj) 534 zdyrho_raw = ( - rab_b(ji ,jj+jp,ikv,jp_tem) * zdjt + rab_b(ji ,jj+jp,ikv,jp_sal) * zdjs ) * r1_e2v(ji,jj) 537 535 zdxrho(ji+ip,jj ,iku,1-ip) = SIGN( MAX( repsln, ABS( zdxrho_raw ) ), zdxrho_raw ) ! keep the sign 538 536 zdyrho(ji ,jj+jp,ikv,1-jp) = SIGN( MAX( repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) … … 593 591 ! Add s-coordinate slope at t-points (do this by *subtracting* gradient of depth) 594 592 zti_g_raw = ( zdxrho(ji+ip,jj,jk-kp,1-ip) / zdzrho(ji+ip,jj,jk-kp,kp) & 595 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) /e1u(ji,jj) ) * umask(ji,jj,jk)593 & - ( fsdept(ji+1,jj,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e1u(ji,jj) ) * umask(ji,jj,jk) 596 594 zti_mlb(ji+ip,jj ,1-ip,kp) = SIGN( MIN( rn_slpmax, ABS( zti_g_raw ) ), zti_g_raw ) 597 595 ENDIF … … 602 600 ELSE 603 601 ztj_g_raw = ( zdyrho(ji,jj+jp,jk-kp,1-jp) / zdzrho(ji,jj+jp,jk-kp,kp) & 604 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) /e2v(ji,jj) ) * vmask(ji,jj,jk)602 & - ( fsdept(ji,jj+1,jk-kp) - fsdept(ji,jj,jk-kp) ) * r1_e2v(ji,jj) ) * vmask(ji,jj,jk) 605 603 ztj_mlb(ji ,jj+jp,1-jp,kp) = SIGN( MIN( rn_slpmax, ABS( ztj_g_raw ) ), ztj_g_raw ) 606 604 ENDIF … … 630 628 ! raw slopes: unmasked unbounded slopes (relative to geopotential (zti_g) and model surface (zti) 631 629 ! 632 zti_raw = zdxrho(ji+ip,jj ,jk,1-ip) / zdzrho(ji+ip,jj ,jk,kp) ! unmasked630 zti_raw = zdxrho(ji+ip,jj ,jk,1-ip) / zdzrho(ji+ip,jj ,jk,kp) ! unmasked 633 631 ztj_raw = zdyrho(ji ,jj+jp,jk,1-jp) / zdzrho(ji ,jj+jp,jk,kp) 634 632 635 633 ! Must mask contribution to slope for triad jk=1,kp=0 that poke up though ocean surface 636 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) /e1u(ji,jj)637 ztj_coord = znot_thru_surface * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) / e2v(ji,jj)! unmasked634 zti_coord = znot_thru_surface * ( fsdept(ji+1,jj ,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) 635 ztj_coord = znot_thru_surface * ( fsdept(ji ,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) ! unmasked 638 636 zti_g_raw = zti_raw - zti_coord ! ref to geopot surfaces 639 637 ztj_g_raw = ztj_raw - ztj_coord … … 680 678 triadj(ji ,jj+jp,jk,1-jp,kp) = ztj_lim 681 679 ! 682 zbu = e1u(ji ,jj) *e2u(ji ,jj) * fse3u(ji ,jj,jk )683 zbv = e1v(ji ,jj) *e2v(ji ,jj) * fse3v(ji ,jj,jk )684 zbti = e1 t(ji+ip,jj) *e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp)685 zbtj = e1 t(ji,jj+jp) *e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp)680 zbu = e1e2u(ji ,jj) * fse3u(ji ,jj,jk ) 681 zbv = e1e2v(ji ,jj) * fse3v(ji ,jj,jk ) 682 zbti = e1e2t(ji+ip,jj) * fse3w(ji+ip,jj,jk+kp) 683 zbtj = e1e2t(ji,jj+jp) * fse3w(ji,jj+jp,jk+kp) 686 684 ! 687 685 !!gm this may inhibit vectorization on Vect Computers, and even on scalar computers.... ==> to be checked … … 782 780 zbv = 0.5_wp * ( p_dzr(ji,jj,ikv) + p_dzr(ji ,jj+1,ikv) ) 783 781 ! !- horizontal density gradient at u- & v-points 784 zau = p_gru(ji,jj,iku) /e1u(ji,jj)785 zav = p_grv(ji,jj,ikv) /e2v(ji,jj)782 zau = p_gru(ji,jj,iku) * r1_e1u(ji,jj) 783 zav = p_grv(ji,jj,ikv) * r1_e2v(ji,jj) 786 784 ! !- bound the slopes: abs(zw.)<= 1/100 and zb..<0 787 785 ! kxz max= ah slope max =< e1 e3 /(pi**2 2 dt) … … 877 875 DO jj = 2, jpjm1 878 876 DO ji = fs_2, fs_jpim1 ! vector opt. 879 uslp (ji,jj,jk) = - 1./e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk)880 vslp (ji,jj,jk) = - 1./e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk)881 wslpi(ji,jj,jk) = - 1./e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5882 wslpj(ji,jj,jk) = - 1./e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5877 uslp (ji,jj,jk) = -r1_e1u(ji,jj) * ( fsdept_b(ji+1,jj,jk) - fsdept_b(ji ,jj ,jk) ) * umask(ji,jj,jk) 878 vslp (ji,jj,jk) = -r1_e2v(ji,jj) * ( fsdept_b(ji,jj+1,jk) - fsdept_b(ji ,jj ,jk) ) * vmask(ji,jj,jk) 879 wslpi(ji,jj,jk) = -r1_e1t(ji,jj) * ( fsdepw_b(ji+1,jj,jk) - fsdepw_b(ji-1,jj,jk) ) * wmask(ji,jj,jk) * 0.5 880 wslpj(ji,jj,jk) = -r1_e2t(ji,jj) * ( fsdepw_b(ji,jj+1,jk) - fsdepw_b(ji,jj-1,jk) ) * wmask(ji,jj,jk) * 0.5 883 881 END DO 884 882 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/OBS/obs_readmdt.F90
r3294 r5737 24 24 USE lib_mpp ! MPP library 25 25 USE dom_oce, ONLY : & ! Domain variables 26 & tmask, tmask_i, e1 t,e2t, gphit, glamt26 & tmask, tmask_i, e1e2t, gphit, glamt 27 27 USE obs_const, ONLY : obfillflt ! Fillvalue 28 28 USE oce , ONLY : sshn ! Model variables … … 220 220 DO jj = 1, jpj 221 221 DO ji = 1, jpi 222 zdxdy = e1 t(ji,jj) *e2t(ji,jj) * zpromsk(ji,jj)222 zdxdy = e1e2t(ji,jj) * zpromsk(ji,jj) 223 223 zarea = zarea + zdxdy 224 224 zeta1 = zeta1 + mdt(ji,jj) * zdxdy -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r5516 r5737 67 67 PRIVATE 68 68 69 !! * Routine accessibility70 69 PUBLIC cice_sbc_init ! routine called by sbc_init 71 70 PUBLIC cice_sbc_final ! routine called by sbc_final … … 95 94 !! * Substitutions 96 95 # include "domzgr_substitute.h90" 97 96 !!---------------------------------------------------------------------- 97 !! NEMO/OPA 3.7 , NEMO-consortium (2015) 98 98 !! $Id$ 99 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 100 !!---------------------------------------------------------------------- 99 101 CONTAINS 100 102 … … 154 156 END SUBROUTINE sbc_ice_cice 155 157 156 SUBROUTINE cice_sbc_init (ksbc) 158 159 SUBROUTINE cice_sbc_init( ksbc ) 157 160 !!--------------------------------------------------------------------- 158 161 !! *** ROUTINE cice_sbc_init *** 159 162 !! ** Purpose: Initialise ice related fields for NEMO and coupling 160 163 !! 164 !!--------------------------------------------------------------------- 161 165 INTEGER, INTENT( in ) :: ksbc ! surface forcing type 162 166 REAL(wp), DIMENSION(:,:), POINTER :: ztmp1, ztmp2 … … 289 293 290 294 291 SUBROUTINE cice_sbc_in (kt, ksbc)295 SUBROUTINE cice_sbc_in( kt, ksbc ) 292 296 !!--------------------------------------------------------------------- 293 297 !! *** ROUTINE cice_sbc_in *** … … 296 300 INTEGER, INTENT(in ) :: kt ! ocean time step 297 301 INTEGER, INTENT(in ) :: ksbc ! surface forcing type 298 302 ! 299 303 INTEGER :: ji, jj, jl ! dummy loop indices 300 304 REAL(wp), DIMENSION(:,:), POINTER :: ztmp, zpice … … 490 494 ! x comp and y comp of sea surface slope (on F points) 491 495 ! T point to F point 492 DO jj=1,jpjm1 493 DO ji=1,jpim1 494 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj ))/e1u(ji,jj ) & 495 + (zpice(ji+1,jj+1)-zpice(ji,jj+1))/e1u(ji,jj+1) ) & 496 * fmask(ji,jj,1) 497 ENDDO 498 ENDDO 499 CALL nemo2cice(ztmp,ss_tltx,'F', -1. ) 496 DO jj = 1, jpjm1 497 DO ji = 1, jpim1 498 ztmp(ji,jj)=0.5 * ( (zpice(ji+1,jj )-zpice(ji,jj )) * r1_e1u(ji,jj ) & 499 & + (zpice(ji+1,jj+1)-zpice(ji,jj+1)) * r1_e1u(ji,jj+1) ) * fmask(ji,jj,1) 500 END DO 501 END DO 502 CALL nemo2cice( ztmp,ss_tltx,'F', -1. ) 500 503 501 504 ! T point to F point 502 DO jj=1,jpjm1 503 DO ji=1,jpim1 504 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj))/e2v(ji ,jj) & 505 + (zpice(ji+1,jj+1)-zpice(ji+1,jj))/e2v(ji+1,jj) ) & 506 * fmask(ji,jj,1) 507 ENDDO 508 ENDDO 505 DO jj = 1, jpjm1 506 DO ji = 1, jpim1 507 ztmp(ji,jj)=0.5 * ( (zpice(ji ,jj+1)-zpice(ji ,jj)) * r1_e2v(ji ,jj) & 508 & + (zpice(ji+1,jj+1)-zpice(ji+1,jj)) * r1_e2v(ji+1,jj) ) * fmask(ji,jj,1) 509 END DO 510 END DO 509 511 CALL nemo2cice(ztmp,ss_tlty,'F', -1. ) 510 512 … … 517 519 518 520 519 SUBROUTINE cice_sbc_out (kt,ksbc)521 SUBROUTINE cice_sbc_out( kt, ksbc ) 520 522 !!--------------------------------------------------------------------- 521 523 !! *** ROUTINE cice_sbc_out *** … … 575 577 ! Update taum with modulus of ice-ocean stress 576 578 ! strocnxT and strocnyT are not weighted by ice fraction in CICE so must be done here 577 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1* *2. + ztmp2**2.)579 taum(:,:)=(1.0-fr_i(:,:))*taum(:,:)+fr_i(:,:)*SQRT(ztmp1*ztmp1 + ztmp2*ztmp2) 578 580 579 581 ! Freshwater fluxes … … 888 890 #endif 889 891 !!--------------------------------------------------------------------- 890 891 892 CHARACTER(len=1), INTENT( in ) :: & 892 893 cd_type ! nature of pn grid-point … … 908 909 909 910 INTEGER :: ji, jj, jn ! dummy loop indices 911 !!--------------------------------------------------------------------- 910 912 911 913 ! A. Ensure all haloes are filled in NEMO field (pn) … … 1096 1098 !! Default option Dummy module NO CICE sea-ice model 1097 1099 !!---------------------------------------------------------------------- 1098 !! $Id$1099 1100 CONTAINS 1100 1101 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r4328 r5737 89 89 DO ji = 2, jpim1 90 90 zcoef = z2dt * z2dt * grav * bmask(ji,jj) 91 zcoefs = -zcoef * hv(ji ,jj-1) * e1 v(ji ,jj-1) /e2v(ji ,jj-1) ! south coefficient92 zcoefw = -zcoef * hu(ji-1,jj ) * e2 u(ji-1,jj ) /e1u(ji-1,jj ) ! west coefficient93 zcoefe = -zcoef * hu(ji ,jj ) * e2 u(ji ,jj ) /e1u(ji ,jj ) ! east coefficient94 zcoefn = -zcoef * hv(ji ,jj ) * e1 v(ji ,jj ) /e2v(ji ,jj ) ! north coefficient91 zcoefs = -zcoef * hv(ji ,jj-1) * e1_e2v(ji ,jj-1) ! south coefficient 92 zcoefw = -zcoef * hu(ji-1,jj ) * e2_e1u(ji-1,jj ) ! west coefficient 93 zcoefe = -zcoef * hu(ji ,jj ) * e2_e1u(ji ,jj ) ! east coefficient 94 zcoefn = -zcoef * hv(ji ,jj ) * e1_e2v(ji ,jj ) ! north coefficient 95 95 gcp(ji,jj,1) = zcoefs 96 96 gcp(ji,jj,2) = zcoefw 97 97 gcp(ji,jj,3) = zcoefe 98 98 gcp(ji,jj,4) = zcoefn 99 gcdmat(ji,jj) = e1 t(ji,jj) *e2t(ji,jj) * bmask(ji,jj) & ! diagonal coefficient99 gcdmat(ji,jj) = e1e2t(ji,jj) * bmask(ji,jj) & ! diagonal coefficient 100 100 & - zcoefs -zcoefw -zcoefe -zcoefn 101 101 END DO … … 110 110 111 111 ! south coefficient 112 zcoefs = -zcoef * hv(ji,jj-1) * e1 v(ji,jj-1)/e2v(ji,jj-1)112 zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 113 113 zcoefs = zcoefs * bdyvmask(ji,jj-1) 114 114 gcp(ji,jj,1) = zcoefs 115 115 116 116 ! west coefficient 117 zcoefw = -zcoef * hu(ji-1,jj) * e2 u(ji-1,jj)/e1u(ji-1,jj)117 zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 118 118 zcoefw = zcoefw * bdyumask(ji-1,jj) 119 119 gcp(ji,jj,2) = zcoefw 120 120 121 121 ! east coefficient 122 zcoefe = -zcoef * hu(ji,jj) * e2 u(ji,jj)/e1u(ji,jj)122 zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 123 123 zcoefe = zcoefe * bdyumask(ji,jj) 124 124 gcp(ji,jj,3) = zcoefe 125 125 126 126 ! north coefficient 127 zcoefn = -zcoef * hv(ji,jj) * e1 v(ji,jj)/e2v(ji,jj)127 zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 128 128 zcoefn = zcoefn * bdyvmask(ji,jj) 129 129 gcp(ji,jj,4) = zcoefn 130 130 131 131 ! diagonal coefficient 132 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 133 - zcoefs -zcoefw -zcoefe -zcoefn 132 gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 134 133 END DO 135 134 END DO … … 149 148 ! south coefficient 150 149 IF( ( nbondj == -1 .OR. nbondj == 2 ) .AND. ( jj == 3 ) ) THEN 151 zcoefs = -zcoef * hv(ji,jj-1) * e1 v(ji,jj-1)/e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1))150 zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1)*(1.-vmask(ji,jj-1,1)) 152 151 ELSE 153 zcoefs = -zcoef * hv(ji,jj-1) * e1 v(ji,jj-1)/e2v(ji,jj-1)152 zcoefs = -zcoef * hv(ji,jj-1) * e1_e2v(ji,jj-1) 154 153 END IF 155 154 gcp(ji,jj,1) = zcoefs … … 157 156 ! west coefficient 158 157 IF( ( nbondi == -1 .OR. nbondi == 2 ) .AND. ( ji == 3 ) ) THEN 159 zcoefw = -zcoef * hu(ji-1,jj) * e2 u(ji-1,jj)/e1u(ji-1,jj)*(1.-umask(ji-1,jj,1))158 zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj)*(1.-umask(ji-1,jj,1)) 160 159 ELSE 161 zcoefw = -zcoef * hu(ji-1,jj) * e2 u(ji-1,jj)/e1u(ji-1,jj)160 zcoefw = -zcoef * hu(ji-1,jj) * e2_e1u(ji-1,jj) 162 161 END IF 163 162 gcp(ji,jj,2) = zcoefw … … 165 164 ! east coefficient 166 165 IF( ( nbondi == 1 .OR. nbondi == 2 ) .AND. ( ji == nlci-2 ) ) THEN 167 zcoefe = -zcoef * hu(ji,jj) * e2 u(ji,jj)/e1u(ji,jj)*(1.-umask(ji,jj,1))166 zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj)*(1.-umask(ji,jj,1)) 168 167 ELSE 169 zcoefe = -zcoef * hu(ji,jj) * e2 u(ji,jj)/e1u(ji,jj)168 zcoefe = -zcoef * hu(ji,jj) * e2_e1u(ji,jj) 170 169 END IF 171 170 gcp(ji,jj,3) = zcoefe … … 173 172 ! north coefficient 174 173 IF( ( nbondj == 1 .OR. nbondj == 2 ) .AND. ( jj == nlcj-2 ) ) THEN 175 zcoefn = -zcoef * hv(ji,jj) * e1 v(ji,jj)/e2v(ji,jj)*(1.-vmask(ji,jj,1))174 zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj)*(1.-vmask(ji,jj,1)) 176 175 ELSE 177 zcoefn = -zcoef * hv(ji,jj) * e1 v(ji,jj)/e2v(ji,jj)176 zcoefn = -zcoef * hv(ji,jj) * e1_e2v(ji,jj) 178 177 END IF 179 178 gcp(ji,jj,4) = zcoefn 180 179 ! 181 180 ! diagonal coefficient 182 gcdmat(ji,jj) = e1t(ji,jj)*e2t(ji,jj)*bmask(ji,jj) & 183 & - zcoefs -zcoefw -zcoefe -zcoefn 181 gcdmat(ji,jj) = e1e2t(ji,jj)*bmask(ji,jj) - zcoefs -zcoefw -zcoefe -zcoefn 184 182 END DO 185 183 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r5541 r5737 260 260 DO jj = 2, jpjm1 261 261 DO ji = fs_2, fs_jpim1 ! vector opt. 262 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )262 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 263 263 ! advective trends 264 264 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r5656 r5737 148 148 END DO 149 149 # if defined key_diaeiv 150 IF( cdtype == 'TRA') w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1 t(:,:) *e2t(:,:) )150 IF( cdtype == 'TRA') w_eiv(:,:,jk) = zw_eiv(:,:) / ( e1e2t(:,:) ) 151 151 # endif 152 152 ENDIF -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_mle.F90
r5215 r5737 28 28 PUBLIC tra_adv_mle_init ! routine called in traadv.F90 29 29 30 ! 30 ! !!* namelist namtra_adv_mle * 31 31 LOGICAL, PUBLIC :: ln_mle ! flag to activate the Mixed Layer Eddy (MLE) parameterisation 32 32 INTEGER :: nn_mle ! MLE type: =0 standard Fox-Kemper ; =1 new formulation … … 34 34 INTEGER :: nn_conv ! =1 no MLE in case of convection ; =0 always MLE 35 35 REAL(wp) :: rn_ce ! MLE coefficient 36 ! 36 ! ! parameters used in nn_mle = 0 case 37 37 REAL(wp) :: rn_lf ! typical scale of mixed layer front 38 REAL(wp) :: rn_time ! time scale for mixing momentum across the mixed layer39 ! 40 REAL(wp) :: rn_lat 41 REAL(wp) :: rn_rho_c_mle ! Density criterion for definition of MLD used by FK38 REAL(wp) :: rn_time ! time scale for mixing momentum across the mixed layer 39 ! ! parameters used in nn_mle = 1 case 40 REAL(wp) :: rn_lat ! reference latitude for a 5 km scale of ML front 41 REAL(wp) :: rn_rho_c_mle ! Density criterion for definition of MLD used by FK 42 42 43 43 REAL(wp) :: r5_21 = 5.e0 / 21.e0 ! factor used in mle streamfunction computation … … 52 52 # include "vectopt_loop_substitute.h90" 53 53 !!---------------------------------------------------------------------- 54 !! NEMO/OPA 4.0 , NEMO Consortium (201 1)54 !! NEMO/OPA 4.0 , NEMO Consortium (2015) 55 55 !! $Id$ 56 56 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 80 80 !! Fox-Kemper and Ferrari, JPO, 38, 1166-1179, 2008 81 81 !!---------------------------------------------------------------------- 82 !83 82 INTEGER , INTENT(in ) :: kt ! ocean time-step index 84 83 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 93 92 REAL(wp) :: zcvw, zmvw ! - - 94 93 REAL(wp) :: zc ! - - 95 94 ! 96 95 INTEGER :: ii, ij, ik ! local integers 97 96 INTEGER, DIMENSION(3) :: ilocu ! … … 101 100 INTEGER, POINTER, DIMENSION(:,:) :: inml_mle 102 101 !!---------------------------------------------------------------------- 103 102 ! 104 103 IF( nn_timing == 1 ) CALL timing_start('tra_adv_mle') 105 104 CALL wrk_alloc( jpi, jpj, zpsim_u, zpsim_v, zmld, zbm, zhu, zhv, zn2, zLf_NH, zLf_MH) … … 171 170 DO jj = 1, jpjm1 172 171 DO ji = 1, fs_jpim1 ! vector opt. 173 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2 u(ji,jj) &174 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj)) &175 & / ( e1u(ji,jj) *MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) ) )172 zpsim_u(ji,jj) = rn_ce * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 173 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) & 174 & / ( MAX( rn_lf * rfu(ji,jj) , SQRT( rb_c * zhu(ji,jj) ) ) ) 176 175 ! 177 zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj) * e1 v(ji,jj) &178 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj)) &179 & / ( e2v(ji,jj) *MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) ) )176 zpsim_v(ji,jj) = rn_ce * zhv(ji,jj) * zhv(ji,jj) * e1_e2v(ji,jj) & 177 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) & 178 & / ( MAX( rn_lf * rfv(ji,jj) , SQRT( rb_c * zhv(ji,jj) ) ) ) 180 179 END DO 181 180 END DO … … 184 183 DO jj = 1, jpjm1 185 184 DO ji = 1, fs_jpim1 ! vector opt. 186 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2 u(ji,jj) / e1u(ji,jj)&185 zpsim_u(ji,jj) = rc_f * zhu(ji,jj) * zhu(ji,jj) * e2_e1u(ji,jj) & 187 186 & * ( zbm(ji+1,jj) - zbm(ji,jj) ) * MIN( 111.e3_wp , e1u(ji,jj) ) 188 187 ! 189 zpsim_v(ji,jj) = rc_f * zhv(ji,jj) * zhv(ji,jj) * e1 v(ji,jj) / e2v(ji,jj)&188 zpsim_v(ji,jj) = rc_f * zhv(ji,jj) * zhv(ji,jj) * e1_e2v(ji,jj) & 190 189 & * ( zbm(ji,jj+1) - zbm(ji,jj) ) * MIN( 111.e3_wp , e2v(ji,jj) ) 191 190 END DO … … 252 251 ! divide by cross distance to give streamfunction with dimensions m^2/s 253 252 DO jk = 1, ikmax+1 254 zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) /e2u(:,:)255 zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) /e1v(:,:)253 zpsi_uw(:,:,jk) = zpsi_uw(:,:,jk) * r1_e2u(:,:) 254 zpsi_vw(:,:,jk) = zpsi_vw(:,:,jk) * r1_e1v(:,:) 256 255 END DO 257 256 CALL iom_put( "psiu_mle", zpsi_uw ) ! i-mle streamfunction … … 281 280 NAMELIST/namtra_adv_mle/ ln_mle , nn_mle, rn_ce, rn_lf, rn_time, rn_lat, nn_mld_uv, nn_conv, rn_rho_c_mle 282 281 !!---------------------------------------------------------------------- 283 284 282 285 283 REWIND( numnam_ref ) ! Namelist namtra_adv_mle in reference namelist : Tracer advection scheme -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r5147 r5737 182 182 z0u = SIGN( 0.5, pun(ji,jj,jk) ) 183 183 zalpha = 0.5 - z0u 184 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )184 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 185 185 zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 186 186 zzwy = ptb(ji ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk) … … 189 189 z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 190 190 zalpha = 0.5 - z0v 191 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )191 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 192 192 zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 193 193 zzwy = ptb(ji,jj ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk) … … 203 203 DO jj = 2, jpjm1 204 204 DO ji = fs_2, fs_jpim1 ! vector opt. 205 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )205 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 206 206 ! horizontal advective trends 207 207 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 262 262 DO jj = 2, jpjm1 263 263 DO ji = fs_2, fs_jpim1 ! vector opt. 264 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3w(ji,jj,jk+1) )264 zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 265 265 z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 266 266 zalpha = 0.5 + z0w -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r5147 r5737 139 139 z0u = SIGN( 0.5, pun(ji,jj,jk) ) 140 140 zalpha = 0.5 - z0u 141 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1 u(ji,jj) *e2u(ji,jj) * fse3u(ji,jj,jk) )141 zu = z0u - 0.5 * pun(ji,jj,jk) * zdt / ( e1e2u(ji,jj) * fse3u(ji,jj,jk) ) 142 142 zzwx = ptb(ji+1,jj,jk,jn) + zu * zslpx(ji+1,jj,jk) 143 143 zzwy = ptb(ji ,jj,jk,jn) + zu * zslpx(ji ,jj,jk) … … 146 146 z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 147 147 zalpha = 0.5 - z0v 148 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1 v(ji,jj) *e2v(ji,jj) * fse3v(ji,jj,jk) )148 zv = z0v - 0.5 * pvn(ji,jj,jk) * zdt / ( e1e2v(ji,jj) * fse3v(ji,jj,jk) ) 149 149 zzwx = ptb(ji,jj+1,jk,jn) + zv * zslpy(ji,jj+1,jk) 150 150 zzwy = ptb(ji,jj ,jk,jn) + zv * zslpy(ji,jj ,jk) … … 183 183 DO jj = 2, jpjm1 184 184 DO ji = fs_2, fs_jpim1 ! vector opt. 185 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )185 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 186 186 ! horizontal advective trends 187 187 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 243 243 DO jj = 2, jpjm1 244 244 DO ji = fs_2, fs_jpim1 ! vector opt. 245 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3w(ji,jj,jk+1) )245 zbtr = 1. / ( e1e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 246 246 z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 247 247 zalpha = 0.5 + z0w … … 269 269 DO jj = 2, jpjm1 270 270 DO ji = fs_2, fs_jpim1 ! vector opt. 271 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )271 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 272 272 ! vertical advective trends 273 273 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90
r5147 r5737 220 220 DO jj = 2, jpjm1 221 221 DO ji = fs_2, fs_jpim1 ! vector opt. 222 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )222 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 223 223 ! horizontal advective trends 224 224 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) … … 344 344 DO jj = 2, jpjm1 345 345 DO ji = fs_2, fs_jpim1 ! vector opt. 346 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )346 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 347 347 ! horizontal advective trends 348 348 ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) … … 407 407 DO jj = 2, jpjm1 408 408 DO ji = fs_2, fs_jpim1 ! vector opt. 409 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )409 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 410 410 ! k- vertical advective trends 411 411 ztra = - zbtr * ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r5147 r5737 173 173 DO jj = 2, jpjm1 174 174 DO ji = fs_2, fs_jpim1 ! vector opt. 175 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )175 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 176 176 ! total intermediate advective trends 177 177 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 242 242 DO jj = 2, jpjm1 243 243 DO ji = fs_2, fs_jpim1 ! vector opt. 244 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )244 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 245 245 ! total advective trends 246 246 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 278 278 END SUBROUTINE tra_adv_tvd 279 279 280 280 281 SUBROUTINE tra_adv_tvd_zts ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 281 282 & ptb, ptn, pta, kjpt ) … … 410 411 DO jj = 2, jpjm1 411 412 DO ji = fs_2, fs_jpim1 ! vector opt. 412 zbtr = 1._wp / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )413 zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 413 414 ! total intermediate advective trends 414 415 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 504 505 DO jj = 2, jpjm1 505 506 DO ji = fs_2, fs_jpim1 506 zbtr = 1._wp / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )507 zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 507 508 ! total advective trends 508 509 ztra = - zbtr * ( zhdiv(ji,jj,jk) + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) … … 534 535 DO jj = 2, jpjm1 535 536 DO ji = fs_2, fs_jpim1 ! vector opt. 536 zbtr = 1. / ( e1 t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )537 zbtr = 1. / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 537 538 ! total advective trends 538 539 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 572 573 END SUBROUTINE tra_adv_tvd_zts 573 574 575 574 576 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 575 577 !!--------------------------------------------------------------------- -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_ubs.F90
r5147 r5737 118 118 DO jj = 1, jpjm1 ! First derivative (gradient) 119 119 DO ji = 1, fs_jpim1 ! vector opt. 120 zeeu = e2 u(ji,jj) * fse3u(ji,jj,jk) / e1u(ji,jj) * umask(ji,jj,jk)121 zeev = e1 v(ji,jj) * fse3v(ji,jj,jk) / e2v(ji,jj) * vmask(ji,jj,jk)120 zeeu = e2_e1u(ji,jj) * fse3u(ji,jj,jk) * umask(ji,jj,jk) 121 zeev = e1_e2v(ji,jj) * fse3v(ji,jj,jk) * vmask(ji,jj,jk) 122 122 ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 123 123 ztv(ji,jj,jk) = zeev * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) … … 250 250 DO jj = 2, jpjm1 251 251 DO ji = fs_2, fs_jpim1 ! vector opt. 252 zbtr = 1. e0 / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )252 zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 253 253 z_hdivn = ( pwn(ji,jj,jk) - pwn(ji,jj,jk+1) ) * zbtr 254 254 zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk) + ptn(ji,jj,jk,jn) * z_hdivn -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r4990 r5737 29 29 USE phycst ! physical constant 30 30 USE eosbn2 ! equation of state 31 USE trd_oce ! trends: ocean variables31 USE trd_oce ! trends: ocean variables 32 32 USE trdtra ! trends: active tracers 33 33 ! … … 198 198 DO jj = 1, jpj 199 199 DO ji = 1, jpi 200 ik = mbkt(ji,jj) 201 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S200 ik = mbkt(ji,jj) ! bottom T-level index 201 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S 202 202 END DO 203 203 END DO … … 205 205 DO jj = 2, jpjm1 ! Compute the trend 206 206 DO ji = 2, jpim1 207 ik = mbkt(ji,jj) 208 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,ik)209 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)&210 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) )&211 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) )&212 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) )&213 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) * zbtr207 ik = mbkt(ji,jj) ! bottom T-level index 208 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 209 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 210 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 211 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 212 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 213 & / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) ) 214 214 END DO 215 215 END DO … … 263 263 ! 264 264 ! ! up -slope T-point (shelf bottom point) 265 zbtr = r1_e1 2t(iis,jj) / fse3t(iis,jj,ikus)265 zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 266 266 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 267 267 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 268 268 ! 269 269 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 270 zbtr = r1_e1 2t(iid,jj) / fse3t(iid,jj,jk)270 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 271 271 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 272 272 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 273 273 END DO 274 274 ! 275 zbtr = r1_e1 2t(iid,jj) / fse3t(iid,jj,ikud)275 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 276 276 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 277 277 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 285 285 ! 286 286 ! up -slope T-point (shelf bottom point) 287 zbtr = r1_e1 2t(ji,ijs) / fse3t(ji,ijs,ikvs)287 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 288 288 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 289 289 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 290 290 ! 291 291 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 292 zbtr = r1_e1 2t(ji,ijd) / fse3t(ji,ijd,jk)292 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 293 293 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 294 294 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 295 295 END DO 296 296 ! ! down-slope T-point (deep bottom point) 297 zbtr = r1_e1 2t(ji,ijd) / fse3t(ji,ijd,ikvd)297 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 298 298 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 299 299 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 566 566 567 567 ! !* masked diffusive flux coefficients 568 ahu_bbl_0(:,:) = rn_ahtbbl * e2 u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)* umask(:,:,1)569 ahv_bbl_0(:,:) = rn_ahtbbl * e1 v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)* vmask(:,:,1)568 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 569 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 570 570 571 571 -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90
r5147 r5737 112 112 DO jj = 1, jpjm1 113 113 DO ji = 1, fs_jpim1 ! vector opt. 114 zeeu(ji,jj) = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk)115 zeev(ji,jj) = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk)114 zeeu(ji,jj) = e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk) 115 zeev(ji,jj) = e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk) 116 116 END DO 117 117 END DO … … 145 145 DO jj = 2, jpjm1 ! Second derivative (divergence) time the eddy diffusivity coefficient 146 146 DO ji = fs_2, fs_jpim1 ! vector opt. 147 zbtr = 1.0 / ( e1 2t(ji,jj) * fse3t_n(ji,jj,jk) )147 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 148 148 zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & 149 149 & + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) … … 163 163 DO ji = fs_2, fs_jpim1 ! vector opt. 164 164 ! horizontal diffusive trends 165 zbtr = 1.0 / ( e1 2t(ji,jj) * fse3t_n(ji,jj,jk) )165 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 166 166 ztra = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) 167 167 ! add it to the general tracer trends -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilapg.F90
r5147 r5737 210 210 DO jj = 1, jpjm1 211 211 DO ji = 1, jpim1 212 zabe1 = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)213 zabe2 = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)212 zabe1 = e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 213 zabe2 = e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 214 214 215 215 zmku = 1./MAX( tmask(ji+1,jj,jk )+tmask(ji,jj,jk+1) & … … 279 279 DO jk = 2, jpkm1 280 280 DO ji = 2, jpim1 281 zcof0 = e1 2t(ji,jj) / fse3w_n(ji,jj,jk) &281 zcof0 = e1e2t(ji,jj) / fse3w_n(ji,jj,jk) & 282 282 & * ( wslpi(ji,jj,jk) * wslpi(ji,jj,jk) & 283 283 & + wslpj(ji,jj,jk) * wslpj(ji,jj,jk) ) … … 310 310 DO ji = 2, jpim1 311 311 ! eddy coef. divided by the volume element 312 zbtr = 1.0 / ( e1 2t(ji,jj) * fse3t_n(ji,jj,jk) )312 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 313 313 ! vertical divergence 314 314 ztav = fsahtt(ji,jj,jk) * ( zftw(ji,jk) - zftw(ji,jk+1) ) … … 322 322 DO ji = 2, jpim1 323 323 ! inverse of the volume element 324 zbtr = 1.0 / ( e1 2t(ji,jj) * fse3t_n(ji,jj,jk) )324 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 325 325 ! vertical divergence 326 326 ztav = zftw(ji,jk) - zftw(ji,jk+1) -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90
r5149 r5737 200 200 DO jj = 1 , jpjm1 201 201 DO ji = 1, fs_jpim1 ! vector opt. 202 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)203 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)202 zabe1 = ( fsahtu(ji,jj,jk) + pahtb0 ) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 203 zabe2 = ( fsahtv(ji,jj,jk) + pahtb0 ) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 204 204 ! 205 205 zmsku = 1. / MAX( tmask(ji+1,jj,jk ) + tmask(ji,jj,jk+1) & … … 225 225 DO jj = 2 , jpjm1 226 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zbtr = 1.0 / ( e1 2t(ji,jj) * fse3t_n(ji,jj,jk) )227 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 228 228 ztra = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 229 229 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra … … 313 313 DO jj = 2, jpjm1 314 314 DO ji = fs_2, fs_jpim1 ! vector opt. 315 zbtr = 1.0 / ( e1 2t(ji,jj) * fse3t_n(ji,jj,jk) )315 zbtr = 1.0 / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 316 316 ztra = ( ztfw(ji,jj,jk) - ztfw(ji,jj,jk+1) ) * zbtr 317 317 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90
r5147 r5737 96 96 DO jj = 1, jpjm1 97 97 DO ji = 1, fs_jpim1 ! vector opt. 98 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)99 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)98 zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk) 99 zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk) 100 100 ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) ) 101 101 ztv(ji,jj,jk) = zabe2 * ( ptb(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) … … 109 109 ikv = mbkv(ji,jj) 110 110 IF( iku == jk ) THEN 111 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)111 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku) 112 112 ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn) 113 113 ENDIF 114 114 IF( ikv == jk ) THEN 115 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)115 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 116 116 ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn) 117 117 ENDIF … … 128 128 ikv = mikv(ji,jj) 129 129 IF( iku == MAX(2,jk) ) THEN 130 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)130 zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e2_e1u(ji,jj) * fse3u_n(ji,jj,iku) 131 131 ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn) 132 132 ENDIF 133 133 IF( ikv == MAX(2,jk) ) THEN 134 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)134 zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e1_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 135 135 ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn) 136 136 END IF … … 144 144 DO jj = 2, jpjm1 145 145 DO ji = fs_2, fs_jpim1 ! vector opt. 146 zbtr = 1._wp / ( e1 2t(ji,jj) * fse3t_n(ji,jj,jk) )146 zbtr = 1._wp / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) ) 147 147 ! horizontal diffusive trends added to the general tracer trends 148 148 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) & -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/TRD/trdken.F90
r5656 r5737 96 96 nkstp = kt 97 97 DO jk = 1, jpkm1 98 bu (:,:,jk) = e1u(:,:) *e2u(:,:) * fse3u_n(:,:,jk)99 bv (:,:,jk) = e1v(:,:) *e2v(:,:) * fse3v_n(:,:,jk)98 bu (:,:,jk) = e1e2u(:,:) * fse3u_n(:,:,jk) 99 bv (:,:,jk) = e1e2v(:,:) * fse3v_n(:,:,jk) 100 100 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) * tmask(:,:,jk) 101 101 END DO … … 263 263 ENDIF 264 264 ! ! allocate box volume arrays 265 IF 265 IF( trd_ken_alloc() /= 0 ) CALL ctl_stop('trd_ken_alloc: failed to allocate arrays') 266 266 ! 267 267 !!gm IF( .NOT. (ln_hpg_zco.OR.ln_hpg_zps) ) & 268 268 !!gm & CALL ctl_stop('trd_ken_init : only full and partial cells are coded for conversion rate') 269 269 ! 270 IF ( .NOT.lk_vvl ) THEN! constant volume: bu, bv, 1/bt computed one for all270 IF( .NOT.lk_vvl ) THEN ! constant volume: bu, bv, 1/bt computed one for all 271 271 DO jk = 1, jpkm1 272 bu (:,:,jk) = e1u(:,:) *e2u(:,:) * fse3u_n(:,:,jk)273 bv (:,:,jk) = e1v(:,:) *e2v(:,:) * fse3v_n(:,:,jk)272 bu (:,:,jk) = e1e2u(:,:) * fse3u_n(:,:,jk) 273 bv (:,:,jk) = e1e2v(:,:) * fse3v_n(:,:,jk) 274 274 r1_bt(:,:,jk) = 1._wp / ( e1e2t(:,:) * fse3t_n(:,:,jk) ) 275 275 END DO -
branches/2015/dev_r5721_CNRS9_NOC3_LDF/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r5130 r5737 54 54 # include "vectopt_loop_substitute.h90" 55 55 !!---------------------------------------------------------------------- 56 !! NEMO/OPA 4.0 , NEMO Consortium (2011)56 !! NEMO/OPA 3.7 , NEMO Consortium (2014) 57 57 !! $Id$ 58 58 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 136 136 137 137 DO jk = 2, jpkm1 !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 138 DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 139 DO ji = 1, jpi 140 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s 141 END DO 142 END DO 138 zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk) !kz max = 300 cm2/s 143 139 END DO 144 140 145 141 IF( kt == nit000 ) THEN !* check at first time-step: diagnose the energy consumed by zav_tide 146 ztpc = 0. e0142 ztpc = 0._wp 147 143 DO jk= 1, jpk 148 144 DO jj= 1, jpj 149 145 DO ji= 1, jpi 150 ztpc = ztpc + fse3w(ji,jj,jk) * e1 t(ji,jj) * e2t(ji,jj)&151 & 146 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) & 147 & * MAX( 0.e0, rn2(ji,jj,jk) ) * zav_tide(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 152 148 END DO 153 149 END DO 154 150 END DO 155 151 ztpc= rau0 / ( rn_tfe * rn_me ) * ztpc 152 IF( lk_mpp ) CALL mpp_sum( ztpc ) 156 153 IF(lwp) WRITE(numout,*) 157 154 IF(lwp) WRITE(numout,*) ' N Total power consumption by av_tide : ztpc = ', ztpc * 1.e-12 ,'TW' … … 167 164 ! ! ----------------------- ! 168 165 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing 169 DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 170 DO ji = 1, jpi 171 avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 172 avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 173 END DO 174 END DO 175 END DO 176 177 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing 166 avt(:,:,jk) = avt(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 167 avm(:,:,jk) = avm(:,:,jk) + zav_tide(:,:,jk) * wmask(:,:,jk) 178 168 DO jj = 2, jpjm1 179 169 DO ji = fs_2, fs_jpim1 ! vector opt. … … 239 229 DO jk = 1, jpkm1 240 230 zdn2dz (:,:,jk) = rn2(:,:,jk) - rn2(:,:,jk+1) ! Vertical profile of dN2/dz 241 !CDIR NOVERRCHK242 231 zempba_3d_1(:,:,jk) = SQRT( MAX( 0.e0, rn2(:,:,jk) ) ) ! - - of N 243 232 zempba_3d_2(:,:,jk) = MAX( 0.e0, rn2(:,:,jk) ) ! - - of N^2 … … 248 237 zsum2(:,:) = 0.e0 249 238 DO jk= 2, jpk 250 zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)251 zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)239 zsum1(:,:) = zsum1(:,:) + zempba_3d_1(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk) 240 zsum2(:,:) = zsum2(:,:) + zempba_3d_2(:,:,jk) * fse3w(:,:,jk) * wmask(:,:,jk) 252 241 END DO 253 242 DO jj = 1, jpj … … 285 274 zkz(:,:) = 0.e0 ! Associated potential energy consummed over the whole water column 286 275 DO jk = 2, jpkm1 287 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)276 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zavt_itf(:,:,jk) * wmask(:,:,jk) 288 277 END DO 289 278 … … 295 284 296 285 DO jk = 2, jpkm1 ! Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zavt_itf bound by 300 cm2/s 297 zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * tmask(:,:,jk) * tmask(:,:,jk-1) ! kz max = 120 cm2/s286 zavt_itf(:,:,jk) = zavt_itf(:,:,jk) * MIN( zkz(:,:), 120./10. ) * wmask(:,:,jk) ! kz max = 120 cm2/s 298 287 END DO 299 288 … … 303 292 DO jj= 1, jpj 304 293 DO ji= 1, jpi 305 ztpc = ztpc + e1 t(ji,jj) *e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) &306 & * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)294 ztpc = ztpc + e1e2t(ji,jj) * fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) & 295 & * zavt_itf(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 307 296 END DO 308 297 END DO 309 298 END DO 299 IF( lk_mpp ) CALL mpp_sum( ztpc ) 310 300 ztpc= rau0 * ztpc / ( rn_me * rn_tfe_itf ) 311 301 IF(lwp) WRITE(numout,*) ' N Total power consumption by zavt_itf: ztpc = ', ztpc * 1.e-12 ,'TW' … … 429 419 !============ 430 420 !TG: Bug for VVL? Should this section be moved out of _init and be updated at every timestep? 421 !!gm : you are right, but tidal mixing acts in deep ocean (H>500m) where e3 is O(100m) 422 !! the error is thus ~1% which I feel comfortable with, compared to uncertainties in tidal energy dissipation. 431 423 ! Vertical structure (az_tmx) 432 424 DO jj = 1, jpj ! part independent of the level … … 460 452 DO jj = 1, jpj 461 453 DO ji = 1, jpi 462 ztpc = ztpc + fse3w(ji,jj,jk) * e1 t(ji,jj) *e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)454 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 463 455 END DO 464 456 END DO 465 457 END DO 458 IF( lk_mpp ) CALL mpp_sum( ztpc ) 466 459 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 467 460 … … 474 467 zkz(:,:) = 0.e0 475 468 DO jk = 2, jpkm1 476 DO jj = 1, jpj 477 DO ji = 1, jpi 478 zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX(0.e0, rn2(ji,jj,jk)) * rau0 * zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 479 END DO 480 END DO 469 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX(0.e0, rn2(:,:,jk)) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 481 470 END DO 482 471 ! Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz … … 499 488 500 489 DO jk = 2, jpkm1 501 DO jj = 1, jpj 502 DO ji = 1, jpi 503 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s 504 END DO 505 END DO 490 zav_tide(:,:,jk) = zav_tide(:,:,jk) * MIN( zkz(:,:), 30./6. ) * wmask(:,:,jk) !kz max = 300 cm2/s 506 491 END DO 507 492 ztpc = 0.e0 … … 510 495 DO jj = 1, jpj 511 496 DO ji = 1, jpi 512 ztpc = ztpc + fse3w(ji,jj,jk) * e1 t(ji,jj) *e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj)497 ztpc = ztpc + fse3w(ji,jj,jk) * e1e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 513 498 END DO 514 499 END DO 515 500 END DO 501 IF( lk_mpp ) CALL mpp_sum( ztpc ) 516 502 ztpc= rau0 * 1/(rn_tfe * rn_me) * ztpc 517 503 WRITE(numout,*) ' 2 Total power consumption of the tidally driven part of Kz : ztpc = ', ztpc * 1.e-12 ,'TW' 518 504 !!gm bug mpp in these diagnostics 519 505 DO jk = 1, jpk 520 ze_z = SUM( e1 t(:,:) * e2t(:,:) * zav_tide(:,:,jk)* tmask_i(:,:) ) &521 & / MAX( 1.e-20, SUM( e1 t(:,:) * e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )522 ztpc = 1. E50506 ze_z = SUM( e1e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) ) & 507 & / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 508 ztpc = 1.e50 523 509 DO jj = 1, jpj 524 510 DO ji = 1, jpi 525 IF( zav_tide(ji,jj,jk) /= 0.e0 ) ztpc = Min( ztpc, zav_tide(ji,jj,jk) )511 IF( zav_tide(ji,jj,jk) /= 0.e0 ) ztpc = MIN( ztpc, zav_tide(ji,jj,jk) ) 526 512 END DO 527 513 END DO … … 530 516 END DO 531 517 532 WRITE(numout,*) ' e_tide : ', SUM( e1 t*e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW'518 WRITE(numout,*) ' e_tide : ', SUM( e1e2t*en_tmx ) / ( rn_tfe * rn_me ) * 1.e-12, 'TW' 533 519 WRITE(numout,*) 534 520 WRITE(numout,*) ' Initial profile of tidal vertical mixing' … … 539 525 END DO 540 526 END DO 541 ze_z = SUM( e1 t(:,:) * e2t(:,:) * zkz(:,:)* tmask_i(:,:) ) &542 & / MAX( 1.e-20, SUM( e1 t(:,:) * e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )527 ze_z = SUM( e1e2t(:,:) * zkz (:,:) * tmask_i(:,:) ) & 528 & / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 543 529 WRITE(numout,*) ' jk= ', jk,' ', ze_z * 1.e4,' cm2/s' 544 530 END DO 545 531 DO jk = 1, jpk 546 532 zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 547 ze_z = SUM( e1 t(:,:) * e2t(:,:) * zkz(:,:)* tmask_i(:,:) ) &548 & / MAX( 1.e-20, SUM( e1 t(:,:) * e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) )533 ze_z = SUM( e1e2t(:,:) * zkz (:,:) * tmask_i(:,:) ) & 534 & / MAX( 1.e-20, SUM( e1e2t(:,:) * wmask(:,:,jk) * tmask_i(:,:) ) ) 549 535 WRITE(numout,*) 550 536 WRITE(numout,*) ' N2 min - jk= ', jk,' ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4, & 551 537 & 'max= ', MAXVAL(zkz)*1.e4, ' cm2/s' 552 538 END DO 539 !!gm end bug mpp 553 540 ! 554 541 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.