Changeset 6126 for branches/2015
- Timestamp:
- 2015-12-18T13:58:27+01:00 (8 years ago)
- Location:
- branches/2015/dev_r5546_CNRS19_HPC_scalability/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 3 edited
-
ice.F90 (modified) (3 diffs)
-
limhdf.F90 (modified) (10 diffs)
-
limtrp.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5546_CNRS19_HPC_scalability/NEMOGCM/NEMO/LIM_SRC_3/ice.F90
r5341 r6126 300 300 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hfx_res !: residual heat flux due to correction of ice thickness 301 301 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 302 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ftr_ice !: transmitted solar radiation under ice 303 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: pahu3D , pahv3D 303 304 304 305 !!-------------------------------------------------------------------------- … … 437 438 & wfx_res(jpi,jpj) , wfx_sni(jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) , & 438 439 & afx_tot(jpi,jpj) , afx_thd(jpi,jpj), afx_dyn(jpi,jpj) , & 439 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), qlead (jpi,jpj) ,&440 & sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) ,&440 & fhtur (jpi,jpj) , ftr_ice(jpi,jpj,jpl), pahu3D(jpi,jpj,jpl+1), pahv3D(jpi,jpj,jpl+1), & 441 & qlead (jpi,jpj) , sfx_res(jpi,jpj) , sfx_bri(jpi,jpj) , sfx_dyn(jpi,jpj) , & 441 442 & sfx_bog(jpi,jpj) , sfx_bom(jpi,jpj) , sfx_sum(jpi,jpj) , sfx_sni(jpi,jpj) , sfx_opw(jpi,jpj) , & 442 443 & hfx_res(jpi,jpj) , hfx_snw(jpi,jpj) , hfx_sub(jpi,jpj) , hfx_err(jpi,jpj) , & … … 508 509 !!====================================================================== 509 510 END MODULE ice 511 -
branches/2015/dev_r5546_CNRS19_HPC_scalability/NEMOGCM/NEMO/LIM_SRC_3/limhdf.F90
r6052 r6126 7 7 !! - ! 2001-05 (G. Madec, R. Hordoir) opa norm 8 8 !! 1.0 ! 2002-08 (C. Ethe) F90, free form 9 !! 3.0 ! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf _multiple9 !! 3.0 ! 2015-08 (O. Tintó and M. Castrillo) added lim_hdf (multiple) 10 10 !!---------------------------------------------------------------------- 11 11 #if defined key_lim3 … … 28 28 PRIVATE 29 29 30 PUBLIC lim_hdf ! called by lim_trp 31 PUBLIC lim_hdf_multiple ! called by lim_trp 30 PUBLIC lim_hdf ! called by lim_trp 32 31 PUBLIC lim_hdf_init ! called by sbc_lim_init 33 32 … … 45 44 CONTAINS 46 45 47 SUBROUTINE lim_hdf( ptab )46 SUBROUTINE lim_hdf( ptab , ihdf_vars , jpl , nlay_i ) 48 47 !!------------------------------------------------------------------- 49 48 !! *** ROUTINE lim_hdf *** … … 56 55 !! ** Action : update ptab with the diffusive contribution 57 56 !!------------------------------------------------------------------- 58 REAL(wp), DIMENSION(jpi,jpj), INTENT( inout ) :: ptab ! Field on which the diffusion is applied59 !60 INTEGER :: ji, jj ! dummy loop indices61 INTEGER :: iter, ierr ! local integers62 REAL(wp) :: zrlxint, zconv ! local scalars63 REAL(wp), POINTER, DIMENSION(:,:) :: zrlx, zflu, zflv, zdiv0, zdiv, ztab064 CHARACTER(lc) :: charout ! local character65 REAL(wp), PARAMETER :: zrelax = 0.5_wp ! relaxation constant for iterative procedure66 REAL(wp), PARAMETER :: zalfa = 0.5_wp ! =1.0/0.5/0.0 = implicit/Cranck-Nicholson/explicit67 INTEGER , PARAMETER :: its = 100 ! Maximum number of iteration68 !!-------------------------------------------------------------------69 70 CALL wrk_alloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 )71 72 ! !== Initialisation ==!73 !74 IF( linit ) THEN ! Metric coefficient (compute at the first call and saved in efact)75 ALLOCATE( efact(jpi,jpj) , STAT=ierr )76 IF( lk_mpp ) CALL mpp_sum( ierr )77 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'lim_hdf : unable to allocate arrays' )78 DO jj = 2, jpjm179 DO ji = fs_2 , fs_jpim1 ! vector opt.80 efact(ji,jj) = ( e2u(ji,jj) + e2u(ji-1,jj) + e1v(ji,jj) + e1v(ji,jj-1) ) * r1_e12t(ji,jj)81 END DO82 END DO83 linit = .FALSE.84 ENDIF85 ! ! Time integration parameters86 !87 ztab0(:, : ) = ptab(:,:) ! Arrays initialization88 zdiv0(:, 1 ) = 0._wp89 zdiv0(:,jpj) = 0._wp90 zflu (jpi,:) = 0._wp91 zflv (jpi,:) = 0._wp92 zdiv0(1, :) = 0._wp93 zdiv0(jpi,:) = 0._wp94 95 zconv = 1._wp !== horizontal diffusion using a Crant-Nicholson scheme ==!96 iter = 097 !98 DO WHILE( zconv > ( 2._wp * 1.e-04 ) .AND. iter <= its ) ! Sub-time step loop99 !100 iter = iter + 1 ! incrementation of the sub-time step number101 !102 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction103 DO ji = 1 , fs_jpim1 ! vector opt.104 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )105 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )106 END DO107 END DO108 !109 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes110 DO ji = fs_2 , fs_jpim1 ! vector opt.111 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)112 END DO113 END DO114 !115 IF( iter == 1 ) zdiv0(:,:) = zdiv(:,:) ! save the 1st evaluation of the diffusive trend in zdiv0116 !117 DO jj = 2, jpjm1 ! iterative evaluation118 DO ji = fs_2 , fs_jpim1 ! vector opt.119 zrlxint = ( ztab0(ji,jj) &120 & + rdt_ice * ( zalfa * ( zdiv(ji,jj) + efact(ji,jj) * ptab(ji,jj) ) &121 & + ( 1.0 - zalfa ) * zdiv0(ji,jj) ) &122 & ) / ( 1.0 + zalfa * rdt_ice * efact(ji,jj) )123 zrlx(ji,jj) = ptab(ji,jj) + zrelax * ( zrlxint - ptab(ji,jj) )124 END DO125 END DO126 CALL lbc_lnk( zrlx, 'T', 1. ) ! lateral boundary condition127 !128 IF ( MOD( iter - 1 , nn_convfrq ) == 0 ) THEN ! convergence test every nn_convfrq iterations (perf. optimization)129 zconv = 0._wp130 DO jj = 2, jpjm1131 DO ji = fs_2, fs_jpim1132 zconv = MAX( zconv, ABS( zrlx(ji,jj) - ptab(ji,jj) ) )133 END DO134 END DO135 IF( lk_mpp ) CALL mpp_max( zconv ) ! max over the global domain136 ENDIF137 !138 ptab(:,:) = zrlx(:,:)139 !140 END DO ! end of sub-time step loop141 142 ! -----------------------143 !!! final step (clem) !!!144 DO jj = 1, jpjm1 ! diffusive fluxes in U- and V- direction145 DO ji = 1 , fs_jpim1 ! vector opt.146 zflu(ji,jj) = pahu(ji,jj) * e2u(ji,jj) * r1_e1u(ji,jj) * ( ptab(ji+1,jj) - ptab(ji,jj) )147 zflv(ji,jj) = pahv(ji,jj) * e1v(ji,jj) * r1_e2v(ji,jj) * ( ptab(ji,jj+1) - ptab(ji,jj) )148 END DO149 END DO150 !151 DO jj= 2, jpjm1 ! diffusive trend : divergence of the fluxes152 DO ji = fs_2 , fs_jpim1 ! vector opt.153 zdiv(ji,jj) = ( zflu(ji,jj) - zflu(ji-1,jj) + zflv(ji,jj) - zflv(ji,jj-1) ) * r1_e12t(ji,jj)154 ptab(ji,jj) = ztab0(ji,jj) + 0.5 * ( zdiv(ji,jj) + zdiv0(ji,jj) )155 END DO156 END DO157 CALL lbc_lnk( ptab, 'T', 1. ) ! lateral boundary condition158 !!! final step (clem) !!!159 ! -----------------------160 161 IF(ln_ctl) THEN162 zrlx(:,:) = ptab(:,:) - ztab0(:,:)163 WRITE(charout,FMT="(' lim_hdf : zconv =',D23.16, ' iter =',I4,2X)") zconv, iter164 CALL prt_ctl( tab2d_1=zrlx, clinfo1=charout )165 ENDIF166 !167 CALL wrk_dealloc( jpi, jpj, zrlx, zflu, zflv, zdiv0, zdiv, ztab0 )168 !169 END SUBROUTINE lim_hdf170 171 172 SUBROUTINE lim_hdf_multiple( ptab , ihdf_vars , jpl , nlay_i )173 !!-------------------------------------------------------------------174 !! *** ROUTINE lim_hdf ***175 !!176 !! ** purpose : Compute and add the diffusive trend on sea-ice variables177 !!178 !! ** method : Second order diffusive operator evaluated using a179 !! Cranck-Nicholson time Scheme.180 !!181 !! ** Action : update ptab with the diffusive contribution182 !!-------------------------------------------------------------------183 57 INTEGER :: jpl, nlay_i, isize, ihdf_vars 184 58 REAL(wp), DIMENSION(:,:,:), INTENT( inout ),TARGET :: ptab ! Field on which the diffusion is applied 185 REAL(wp), POINTER, DIMENSION(:,:,:) :: pahu3D , pahv3D186 59 ! 187 60 INTEGER :: ji, jj, jk, jl , jm ! dummy loop indices … … 204 77 205 78 ! !== Initialisation ==! 206 isize = jpl*(ihdf_vars+nlay_i) 79 ! +1 open water diffusion 80 isize = jpl*(ihdf_vars+nlay_i)+1 207 81 ALLOCATE( zconv (isize) ) 208 82 ALLOCATE( pt2d_array(isize) , zrlx_array(isize) ) … … 212 86 CALL wrk_alloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 213 87 CALL wrk_alloc( jpi, jpj, zflu, zflv, zdiv ) 214 CALL wrk_alloc( jpi, jpj, jpl, pahu3D , pahv3D )215 216 217 DO jl = 1 , jpl218 jm = (jl-1)*(ihdf_vars+nlay_i)+1219 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row220 DO ji = 1 , fs_jpim1 ! vector opt.221 pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ptab(ji ,jj,jm) ) ) ) &222 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ptab(ji+1, jj, jm ) ) ) ) * ahiu(ji,jj)223 pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -ptab(ji, jj, jm ) ) ) ) &224 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- ptab(ji, jj+1, jm ) ) ) ) * ahiv(ji,jj)225 END DO226 END DO227 END DO228 88 229 89 DO jk= 1 , isize … … 266 126 iter = iter + 1 ! incrementation of the sub-time step number 267 127 ! 268 269 128 DO jk = 1 , isize 270 129 jl = (jk-1) /( ihdf_vars+nlay_i)+1 … … 353 212 CALL wrk_dealloc( jpi, jpj, isize, zrlx, zdiv0, ztab0 ) 354 213 CALL wrk_dealloc( jpi, jpj, zflu, zflv, zdiv ) 355 CALL wrk_dealloc( jpi, jpj, jpl, pahu3D , pahv3D )356 214 357 215 DEALLOCATE( zconv ) … … 360 218 DEALLOCATE( psgn_array ) 361 219 ! 362 END SUBROUTINE lim_hdf _multiple220 END SUBROUTINE lim_hdf 363 221 364 222 … … 408 266 !!====================================================================== 409 267 END MODULE limhdf 268 -
branches/2015/dev_r5546_CNRS19_HPC_scalability/NEMOGCM/NEMO/LIM_SRC_3/limtrp.F90
r5579 r6126 90 90 CALL wrk_alloc( jpi,jpj,nlay_i,jpl, z0ei ) 91 91 CALL wrk_alloc( jpi,jpj,jpl, zhimax, zviold, zvsold, zsmvold ) 92 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i) ,zhdfptab)92 CALL wrk_alloc( jpi,jpj,jpl*(ihdf_vars + nlay_i)+1,zhdfptab) 93 93 94 94 IF( numit == nstart .AND. lwp ) THEN … … 290 290 ! Diffusion of Ice fields 291 291 !------------------------------------------------------------------------------! 292 293 !294 !--------------------------------295 ! diffusion of open water area296 !--------------------------------297 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points298 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row299 DO ji = 1 , fs_jpim1 ! vector opt.300 pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) &301 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj)302 pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) &303 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj)304 END DO305 END DO306 !307 CALL lim_hdf( ato_i (:,:) )308 309 292 !------------------------------------ 310 293 ! Diffusion of other ice variables 311 294 !------------------------------------ 312 DO jl = 1, jpl 313 jm=(jl-1)*(ihdf_vars+nlay_i)+1 314 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 ! IMPORTANT a_i must go in the first position because 315 ! it is needed at this position inside lim_hdf_multiple. 295 jm=1 296 DO jl = 1, jpl 297 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 298 ! DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 299 ! DO ji = 1 , fs_jpim1 ! vector opt. 300 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj,jl) ) ) ) & 301 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj,jl) ) ) ) * ahiu(ji,jj) 302 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji,jj ,jl) ) ) ) & 303 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji,jj+1,jl) ) ) ) * ahiv(ji,jj) 304 ! END DO 305 ! END DO 306 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 307 DO ji = 1 , fs_jpim1 ! vector opt. 308 pahu3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji ,jj, jl ) ) ) ) & 309 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji+1,jj, jl ) ) ) ) * ahiu(ji,jj) 310 pahv3D(ji,jj,jl) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -a_i(ji, jj, jl ) ) ) ) & 311 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- a_i(ji, jj+1,jl ) ) ) ) * ahiv(ji,jj) 312 END DO 313 END DO 314 315 zhdfptab(:,:,jm)= a_i (:,:, jl); jm = jm + 1 316 316 zhdfptab(:,:,jm)= v_i (:,:, jl); jm = jm + 1 317 317 zhdfptab(:,:,jm)= v_s (:,:, jl); jm = jm + 1 … … 319 319 zhdfptab(:,:,jm)= oa_i (:,:, jl); jm = jm + 1 320 320 zhdfptab(:,:,jm)= e_s (:,:,1,jl); jm = jm + 1 321 ! Sample of adding more variables to apply lim_hdf using lim_hdf _multipleoptimization---321 ! Sample of adding more variables to apply lim_hdf using lim_hdf optimization--- 322 322 ! zhdfptab(:,:,jm) = variable_1 (:,:,1,jl); jm = jm + 1 323 323 ! zhdfptab(:,:,jm) = variable_2 (:,:,1,jl); jm = jm + 1 … … 329 329 END DO 330 330 END DO 331 CALL lim_hdf_multiple( zhdfptab, ihdf_vars, jpl, nlay_i) 332 333 DO jl = 1, jpl 334 jm=(jl-1)*(ihdf_vars+nlay_i)+1 331 ! 332 !-------------------------------- 333 ! diffusion of open water area 334 !-------------------------------- 335 ! ! Masked eddy diffusivity coefficient at ocean U- and V-points 336 !DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 337 ! DO ji = 1 , fs_jpim1 ! vector opt. 338 ! pahu(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 339 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 340 ! pahv(ji,jj) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 341 ! & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 342 ! END DO 343 !END DO 344 345 DO jj = 1, jpjm1 ! NB: has not to be defined on jpj line and jpi row 346 DO ji = 1 , fs_jpim1 ! vector opt. 347 pahu3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji ,jj) ) ) ) & 348 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji+1,jj) ) ) ) * ahiu(ji,jj) 349 pahv3D(ji,jj,jpl+1) = ( 1._wp - MAX( 0._wp, SIGN( 1._wp, -at_i(ji,jj ) ) ) ) & 350 & * ( 1._wp - MAX( 0._wp, SIGN( 1._wp,- at_i(ji,jj+1) ) ) ) * ahiv(ji,jj) 351 END DO 352 END DO 353 ! 354 zhdfptab(:,:,jm)= ato_i (:,:); 355 CALL lim_hdf( zhdfptab, ihdf_vars, jpl, nlay_i) 356 357 jm=1 358 DO jl = 1, jpl 335 359 a_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 336 360 v_i (:,:, jl) = zhdfptab(:,:,jm); jm = jm + 1 … … 348 372 END DO 349 373 374 ato_i (:,:) = zhdfptab(:,:,jm) 350 375 351 376 !------------------------------------------------------------------------------! … … 487 512 CALL wrk_dealloc( jpi,jpj,nlay_i,jpl, z0ei ) 488 513 CALL wrk_dealloc( jpi,jpj,jpl, zviold, zvsold, zhimax, zsmvold ) 489 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i) ,zhdfptab)514 CALL wrk_dealloc( jpi,jpj,jpl*(ihdf_vars+nlay_i)+1,zhdfptab) 490 515 ! 491 516 IF( nn_timing == 1 ) CALL timing_stop('limtrp') … … 503 528 !!====================================================================== 504 529 END MODULE limtrp 530
Note: See TracChangeset
for help on using the changeset viewer.
