Changeset 3374
- Timestamp:
- 2012-04-30T13:24:25+02:00 (12 years ago)
- Location:
- branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB
- Files:
-
- 6 edited
-
icbclv.F90 (modified) (1 diff)
-
icbdyn.F90 (modified) (1 diff)
-
icbini.F90 (modified) (4 diffs)
-
icblbc.F90 (modified) (8 diffs)
-
icbthm.F90 (modified) (1 diff)
-
icbutl.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbclv.F90
r3373 r3374 133 133 newpt%lon = glamt(ji,jj) ! at t-point (centre of the cell) 134 134 newpt%lat = gphit(ji,jj) 135 newpt%xi = REAL( nimpp+ji-1, wp )136 newpt%yj = REAL( njmpp+jj-1, wp )135 newpt%xi = REAL( mig(ji), wp ) 136 newpt%yj = REAL( mjg(jj), wp ) 137 137 ! 138 138 newpt%uvel = 0._wp ! initially at rest -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90
r3373 r3374 194 194 ! 195 195 ! map into current processor 196 ii0 = ii0 - nimpp + 1197 ij0 = ij0 - njmpp + 1198 ii = ii - nimpp + 1199 ij = ij - njmpp + 1196 ii0 = mi1( ii0 ) 197 ij0 = mj1( ij0 ) 198 ii = mi1( ii ) 199 ij = mj1( ij ) 200 200 ! 201 201 IF( tmask(ii,ij,1) /= 0._wp ) RETURN ! berg reach a new t-cell, but an ocean one -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r3372 r3374 106 106 DO ji = 1, jpi 107 107 src_calving_hflx(ji,jj) = narea 108 src_calving (ji,jj) = nicbpack * (njmpp+jj-1) + nimpp+ji-1 !!gm use here mjg(jj) and mig(ji)... 109 !!gm src_calving (ji,jj) = nicbpack * mjg(jj) + mig(ji) 108 src_calving (ji,jj) = nicbpack * mjg(jj) + mig(ji) 110 109 END DO 111 110 END DO … … 124 123 i1 = i3 - i2*nicbpack 125 124 i3 = INT( src_calving_hflx(ji,jj) ) 126 IF( i1 == nimpp+ji-1.AND. i3 == narea ) THEN125 IF( i1 == mig(ji) .AND. i3 == narea ) THEN 127 126 IF( nicbdi < 0 ) THEN ; nicbdi = ji 128 127 ELSE ; nicbei = ji … … 140 139 i1 = i3 - i2*nicbpack 141 140 i3 = INT( src_calving_hflx(ji,jj) ) 142 IF( i2 == njmpp+jj-1.AND. i3 == narea ) THEN141 IF( i2 == mjg(jj) .AND. i3 == narea ) THEN 143 142 IF( nicbdj < 0 ) THEN ; nicbdj = jj 144 143 ELSE ; nicbej = jj … … 300 299 rn_test_box(3) < gphit(ji,jj) .AND. gphit(ji,jj) < rn_test_box(4) ) THEN 301 300 localberg%mass_scaling = rn_mass_scaling(iberg) 302 localpt%xi = REAL( nimpp+ji-1, wp )303 localpt%yj = REAL( njmpp+jj-1, wp )301 localpt%xi = REAL( mig(ji), wp ) 302 localpt%yj = REAL( mjg(jj), wp ) 304 303 localpt%lon = icb_utl_bilin(glamt, localpt%xi, localpt%yj, 'T', 0, 0 ) 305 304 localpt%lat = icb_utl_bilin(gphit, localpt%xi, localpt%yj, 'T', 0, 0 ) -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90
r3372 r3374 93 93 pt => this%current_point 94 94 iine = INT( pt%xi + 0.5 ) 95 IF( iine > nimpp+nicbei-1) THEN95 IF( iine > mig(nicbei) ) THEN 96 96 pt%xi = ricb_right + MOD(pt%xi, 1._wp ) - 1._wp 97 ELSE IF( iine < nimpp+nicbdi-1) THEN97 ELSE IF( iine < mig(nicbdi) ) THEN 98 98 pt%xi = ricb_left + MOD(pt%xi, 1._wp ) 99 99 ENDIF … … 129 129 pt => this%current_point 130 130 ijne = INT( pt%yj + 0.5 ) 131 IF( ijne .GT. njmpp+nicbej-1) THEN131 IF( ijne .GT. mjg(nicbej) ) THEN 132 132 ! 133 133 iine = INT( pt%xi + 0.5 ) 134 ipts = nicbfldpts ( iine-nimpp+1)134 ipts = nicbfldpts (mi1(iine)) 135 135 ! 136 136 ! moving across the cut line means both position and … … 236 236 pt => this%current_point 237 237 iine = INT( pt%xi + 0.5 ) 238 IF( ipe_E >= 0 .AND. iine > nimpp+nicbei-1) THEN238 IF( ipe_E >= 0 .AND. iine > mig(nicbei) ) THEN 239 239 tmpberg => this 240 240 this => this%next … … 249 249 CALL icb_pack_into_buffer( tmpberg, obuffer_e, ibergs_to_send_e) 250 250 CALL icb_utl_delete(first_berg, tmpberg) 251 ELSE IF( ipe_W >= 0 .AND. iine < nimpp+nicbdi-1) THEN251 ELSE IF( ipe_W >= 0 .AND. iine < mig(nicbdi) ) THEN 252 252 tmpberg => this 253 253 this => this%next … … 374 374 pt => this%current_point 375 375 ijne = INT( pt%yj + 0.5 ) 376 IF( ipe_N >= 0 .AND. ijne .GT. njmpp+nicbej-1) THEN376 IF( ipe_N >= 0 .AND. ijne .GT. mjg(nicbej) ) THEN 377 377 tmpberg => this 378 378 this => this%next … … 384 384 CALL icb_pack_into_buffer( tmpberg, obuffer_n, ibergs_to_send_n) 385 385 CALL icb_utl_delete(first_berg, tmpberg) 386 ELSE IF( ipe_S >= 0 .AND. ijne .LT. njmpp+nicbdj-1) THEN386 ELSE IF( ipe_S >= 0 .AND. ijne .LT. mjg(nicbdj) ) THEN 387 387 tmpberg => this 388 388 this => this%next … … 542 542 iine = INT( pt%xi + 0.5 ) 543 543 ijne = INT( pt%yj + 0.5 ) 544 ! CALL check_position(grd, this, 'exchange (bot)') 545 IF( iine .LT. nimpp+nicbdi-1 .OR. & 546 iine .GT. nimpp+nicbei-1 .OR. & 547 ijne .LT. njmpp+nicbdj-1 .OR. & 548 ijne .GT. njmpp+nicbej-1) THEN 544 IF( iine .LT. mig(nicbdi) .OR. & 545 iine .GT. mig(nicbei) .OR. & 546 ijne .LT. mjg(nicbdj) .OR. & 547 ijne .GT. mjg(nicbej)) THEN 549 548 i = i + 1 550 549 WRITE(numicb,*) 'berg lost in halo: ', this%number(:),iine,ijne … … 607 606 iine = INT( pt%xi + 0.5 ) 608 607 ijne = INT( pt%yj + 0.5 ) 609 ipts = nicbfldpts ( iine-nimpp+1)610 iproc = nicbflddest( iine-nimpp+1)611 IF( ijne .GT. njmpp+nicbej-1) THEN608 ipts = nicbfldpts (mi1(iine)) 609 iproc = nicbflddest(mi1(iine)) 610 IF( ijne .GT. mjg(nicbej) ) THEN 612 611 IF( iproc == ifldproc ) THEN 613 612 ! -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbthm.F90
r3373 r3374 82 82 zxi = pt%xi ! position in (i,j) referential 83 83 zyj = pt%yj 84 ii = INT( zxi + 0.5 ) - nimpp + 1 ! t-cell of the berg 85 ij = INT( zyj + 0.5 ) - njmpp + 1 84 ii = INT( zxi + 0.5 ) ! T-cell of the berg 85 ii = mi1( ii ) 86 ij = INT( zyj + 0.5 ) 87 ij = mi1( ij ) 86 88 zVol = zT * zW * zL 87 89 zdt = berg_dt ; z1_dt = 1._wp / zdt -
branches/2012/dev_r3337_NOCS10_ICB/NEMOGCM/NEMO/OPA_SRC/ICB/icbutl.F90
r3373 r3374 215 215 ! 216 216 ! find position in this processor 217 ii = ii - nimpp + 1218 ij = ij - njmpp + 1217 ii = mi1( ii ) 218 ij = mj1( ij ) 219 219 ! 220 220 icb_utl_bilin = ( pfld(ii,ij ) * (1.-zi) + pfld(ii+1,ij ) * zi ) * (1.-zj) & … … 253 253 ! 254 254 ! find position in this processor !!gm use here mig, mjg arrays 255 ii = ii - nimpp + 1256 ij = ij - njmpp + 1255 ii = mi1( ii ) 256 ij = mj1( ij ) 257 257 z4(1) = pfld(ii ,ij ) 258 258 z4(2) = pfld(ii+1,ij ) … … 303 303 304 304 ! find position in this processor 305 ii = ii - nimpp + 1306 ij = ij - njmpp + 1305 ii = mi1( ii ) 306 ij = mj1( ij ) 307 307 308 308 IF( 0.0_wp <= zi .AND. zi < 0.5_wp ) THEN
Note: See TracChangeset
for help on using the changeset viewer.
