Changeset 10425 for NEMO/trunk/src/OCE/DOM
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE/DOM
- Files:
-
- 10 edited
-
closea.F90 (modified) (11 diffs)
-
domain.F90 (modified) (7 diffs)
-
dommsk.F90 (modified) (3 diffs)
-
domngb.F90 (modified) (1 diff)
-
domvvl.F90 (modified) (13 diffs)
-
domwri.F90 (modified) (4 diffs)
-
domzgr.F90 (modified) (1 diff)
-
iscplhsb.F90 (modified) (2 diffs)
-
iscplini.F90 (modified) (1 diff)
-
iscplrst.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DOM/closea.F90
r10069 r10425 118 118 ! number of closed seas = global maximum value in closea_mask field 119 119 jncs = maxval(closea_mask(:,:)) 120 IF( lk_mpp ) CALL mpp_max(jncs)120 CALL mpp_max('closea', jncs) 121 121 IF( jncs > 0 ) THEN 122 122 IF( lwp ) WRITE(numout,*) 'Number of closed seas : ',jncs … … 146 146 ! number of closed seas rnf mappings = global maximum in closea_mask_rnf field 147 147 jncsr = maxval(closea_mask_rnf(:,:)) 148 IF( lk_mpp ) CALL mpp_max(jncsr)148 CALL mpp_max('closea', jncsr) 149 149 IF( jncsr > 0 ) THEN 150 150 IF( lwp ) WRITE(numout,*) 'Number of closed seas rnf mappings : ',jncsr … … 166 166 ! number of closed seas empmr mappings = global maximum value in closea_mask_empmr field 167 167 jncse = maxval(closea_mask_empmr(:,:)) 168 IF( lk_mpp ) CALL mpp_max(jncse)168 CALL mpp_max('closea', jncse) 169 169 IF( jncse > 0 ) THEN 170 170 IF( lwp ) WRITE(numout,*) 'Number of closed seas empmr mappings : ',jncse … … 237 237 surfe(:) = 0.e0_wp 238 238 ! 239 surf(jncs+1) = glob_sum( e1e2t(:,:) ) ! surface of the global ocean239 surf(jncs+1) = glob_sum( 'closea', e1e2t(:,:) ) ! surface of the global ocean 240 240 ! 241 241 ! ! surface areas of closed seas … … 243 243 ztmp2d(:,:) = 0.e0_wp 244 244 WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:) 245 surf(jc) = glob_sum( ztmp2d(:,:) )245 surf(jc) = glob_sum( 'closea', ztmp2d(:,:) ) 246 246 END DO 247 247 ! … … 254 254 ztmp2d(:,:) = 0.e0_wp 255 255 WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:) 256 surfr(jcr) = glob_sum( ztmp2d(:,:) )256 surfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) ) 257 257 END DO 258 258 ENDIF … … 263 263 ztmp2d(:,:) = 0.e0_wp 264 264 WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) == 0 ) ztmp2d(:,:) = e1e2t(:,:) * tmask_i(:,:) 265 surfe(jce) = glob_sum( ztmp2d(:,:) )265 surfe(jce) = glob_sum( 'closea', ztmp2d(:,:) ) 266 266 END DO 267 267 ENDIF … … 301 301 ztmp2d(:,:) = 0.e0_wp 302 302 WHERE( closea_mask(:,:) == jc ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 303 zfwf(jc) = glob_sum( ztmp2d(:,:) )303 zfwf(jc) = glob_sum( 'closea', ztmp2d(:,:) ) 304 304 END DO 305 305 zfwf_total = SUM(zfwf) … … 316 316 ztmp2d(:,:) = 0.e0_wp 317 317 WHERE( closea_mask_rnf(:,:) == jcr .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 318 zfwfr(jcr) = glob_sum( ztmp2d(:,:) )318 zfwfr(jcr) = glob_sum( 'closea', ztmp2d(:,:) ) 319 319 ! 320 320 ! The following if avoids the redistribution of the round off … … 345 345 ztmp2d(:,:) = 0.e0_wp 346 346 WHERE( closea_mask_empmr(:,:) == jce .and. closea_mask(:,:) > 0 ) ztmp2d(:,:) = e1e2t(:,:) * ( emp(:,:)-rnf(:,:) ) * tmask_i(:,:) 347 zfwfe(jce) = glob_sum( ztmp2d(:,:) )347 zfwfe(jce) = glob_sum( 'closea', ztmp2d(:,:) ) 348 348 ! 349 349 ! The following if avoids the redistribution of the round off … … 396 396 emp (:,:) = emp (:,:) * tmask(:,:,1) 397 397 ! 398 CALL lbc_lnk( emp , 'T', 1._wp )398 CALL lbc_lnk( 'closea', emp , 'T', 1._wp ) 399 399 ! 400 400 END SUBROUTINE sbc_clo -
NEMO/trunk/src/OCE/DOM/domain.F90
r10068 r10425 469 469 !! ** Method : compute and print extrema of masked scale factors 470 470 !!---------------------------------------------------------------------- 471 INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2471 INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2 472 472 INTEGER, DIMENSION(2) :: iloc ! 473 473 REAL(wp) :: ze1min, ze1max, ze2min, ze2max … … 475 475 ! 476 476 IF(lk_mpp) THEN 477 CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )478 CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )479 CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )480 CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )477 CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 478 CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 479 CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 480 CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 481 481 ELSE 482 482 ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) … … 486 486 ! 487 487 iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 488 i imi1= iloc(1) + nimpp - 1489 i jmi1= iloc(2) + njmpp - 1488 imi1(1) = iloc(1) + nimpp - 1 489 imi1(2) = iloc(2) + njmpp - 1 490 490 iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 491 i imi2= iloc(1) + nimpp - 1492 i jmi2= iloc(2) + njmpp - 1491 imi2(1) = iloc(1) + nimpp - 1 492 imi2(2) = iloc(2) + njmpp - 1 493 493 iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 494 i ima1= iloc(1) + nimpp - 1495 i jma1= iloc(2) + njmpp - 1494 ima1(1) = iloc(1) + nimpp - 1 495 ima1(2) = iloc(2) + njmpp - 1 496 496 iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 497 i ima2= iloc(1) + nimpp - 1498 i jma2= iloc(2) + njmpp - 1497 ima2(1) = iloc(1) + nimpp - 1 498 ima2(2) = iloc(2) + njmpp - 1 499 499 ENDIF 500 500 IF(lwp) THEN … … 502 502 WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 503 503 WRITE(numout,*) '~~~~~~~' 504 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, i ima1, ijma1505 WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, i imi1, ijmi1506 WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, i ima2, ijma2507 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, i imi2, ijmi2504 WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 505 WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 506 WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 507 WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 508 508 ENDIF 509 509 ! … … 553 553 !- or they may be present as global attributes 554 554 !- (netcdf only) 555 IF( iom_file(inum)%iolib == jpnf90 ) THEN 556 CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found 557 CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found 558 IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN' 559 IF( kk_cfg == -999 ) kk_cfg = -9999999 560 ENDIF 555 CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found 556 CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found 557 IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN' 558 IF( kk_cfg == -999 ) kk_cfg = -9999999 561 559 ! 562 560 ENDIF … … 608 606 ! 609 607 clnam = cn_domcfg_out ! filename (configuration information) 610 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. , kiolib = jprstlib)608 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 611 609 612 610 ! … … 693 691 ! 694 692 ! Add some global attributes ( netcdf only ) 695 IF( iom_file(inum)%iolib == jpnf90 ) THEN 696 CALL iom_putatt( inum, 'nn_cfg', nn_cfg ) 697 CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) ) 698 ENDIF 693 CALL iom_putatt( inum, 'nn_cfg', nn_cfg ) 694 CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) ) 699 695 ! 700 696 ! ! ============================ -
NEMO/trunk/src/OCE/DOM/dommsk.F90
r10068 r10425 145 145 !SF add here lbc_lnk: bug not still understood : cause now domain configuration is read ! 146 146 !!gm I don't understand why... 147 CALL lbc_lnk( tmask , 'T', 1._wp ) ! Lateral boundary conditions147 CALL lbc_lnk( 'dommsk', tmask , 'T', 1._wp ) ! Lateral boundary conditions 148 148 149 149 ! Mask corrections for bdy (read in mppini2) … … 183 183 END DO 184 184 END DO 185 CALL lbc_lnk_multi( umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. ) ! Lateral boundary conditions185 CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1., vmask, 'V', 1., fmask, 'F', 1. ) ! Lateral boundary conditions 186 186 187 187 ! Ocean/land mask at wu-, wv- and w points (computed from tmask) … … 283 283 DEALLOCATE( zwf ) 284 284 ! 285 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask285 CALL lbc_lnk( 'dommsk', fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 286 286 ! 287 287 ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat -
NEMO/trunk/src/OCE/DOM/domngb.F90
r10068 r10425 67 67 68 68 IF( lk_mpp ) THEN 69 CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj) 69 CALL mpp_minloc( 'domngb', zdist(:,:), zmask, zmini, iloc) 70 kii = iloc(1) ; kjj = iloc(2) 70 71 ELSE 71 72 iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 ) -
NEMO/trunk/src/OCE/DOM/domvvl.F90
r10213 r10425 79 79 & dtilde_e3t_a(jpi,jpj,jpk) , un_td (jpi,jpj,jpk) , vn_td (jpi,jpj,jpk) , & 80 80 & STAT = dom_vvl_alloc ) 81 IF( lk_mpp ) CALL mpp_sum (dom_vvl_alloc )82 IF( dom_vvl_alloc /= 0 ) CALL ctl_ warn('dom_vvl_alloc: failed to allocate arrays')81 CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 82 IF( dom_vvl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 83 83 un_td = 0._wp 84 84 vn_td = 0._wp … … 86 86 IF( ln_vvl_ztilde ) THEN 87 87 ALLOCATE( frq_rst_e3t(jpi,jpj) , frq_rst_hdv(jpi,jpj) , hdiv_lf(jpi,jpj,jpk) , STAT= dom_vvl_alloc ) 88 IF( lk_mpp ) CALL mpp_sum (dom_vvl_alloc )89 IF( dom_vvl_alloc /= 0 ) CALL ctl_ warn('dom_vvl_alloc: failed to allocate arrays')88 CALL mpp_sum ( 'domvvl', dom_vvl_alloc ) 89 IF( dom_vvl_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dom_vvl_alloc: failed to allocate arrays' ) 90 90 ENDIF 91 91 ! … … 410 410 ! ! d - thickness diffusion transport: boundary conditions 411 411 ! (stored for tracer advction and continuity equation) 412 CALL lbc_lnk_multi( un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp)412 CALL lbc_lnk_multi( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 413 413 414 414 ! 4 - Time stepping of baroclinic scale factors … … 421 421 z2dt = 2.0_wp * rdt 422 422 ENDIF 423 CALL lbc_lnk( tilde_e3t_a(:,:,:), 'T', 1._wp )423 CALL lbc_lnk( 'domvvl', tilde_e3t_a(:,:,:), 'T', 1._wp ) 424 424 tilde_e3t_a(:,:,:) = tilde_e3t_b(:,:,:) + z2dt * tmask(:,:,:) * tilde_e3t_a(:,:,:) 425 425 … … 431 431 END DO 432 432 z_tmax = MAXVAL( ze3t(:,:,:) ) 433 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain433 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 434 434 z_tmin = MINVAL( ze3t(:,:,:) ) 435 IF( lk_mpp ) CALL mpp_min(z_tmin ) ! min over the global domain435 CALL mpp_min( 'domvvl', z_tmin ) ! min over the global domain 436 436 ! - ML - test: for the moment, stop simulation for too large e3_t variations 437 437 IF( ( z_tmax > rn_zdef_max ) .OR. ( z_tmin < - rn_zdef_max ) ) THEN 438 438 IF( lk_mpp ) THEN 439 CALL mpp_maxloc( ze3t, tmask, z_tmax, ijk_max(1), ijk_max(2), ijk_max(3))440 CALL mpp_minloc( ze3t, tmask, z_tmin, ijk_min(1), ijk_min(2), ijk_min(3))439 CALL mpp_maxloc( 'domvvl', ze3t, tmask, z_tmax, ijk_max ) 440 CALL mpp_minloc( 'domvvl', ze3t, tmask, z_tmin, ijk_min ) 441 441 ELSE 442 442 ijk_max = MAXLOC( ze3t(:,:,:) ) … … 452 452 WRITE(numout, *) 'MIN( tilde_e3t_a(:,:,:) / e3t_0(:,:,:) ) =', z_tmin 453 453 WRITE(numout, *) 'at i, j, k=', ijk_min 454 CALL ctl_ warn('MAX( ABS( tilde_e3t_a(:,:,:) ) / e3t_0(:,:,:) ) too high')454 CALL ctl_stop( 'STOP', 'MAX( ABS( tilde_e3t_a(:,:,: ) ) / e3t_0(:,:,:) ) too high') 455 455 ENDIF 456 456 ENDIF … … 495 495 IF ( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 496 496 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( zht(:,:) ) ) 497 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain497 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 498 498 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(SUM(tilde_e3t_a))) =', z_tmax 499 499 END IF … … 504 504 END DO 505 505 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshn(:,:) - zht(:,:) ) ) 506 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain506 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 507 507 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshn-SUM(e3t_n))) =', z_tmax 508 508 ! … … 512 512 END DO 513 513 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + ssha(:,:) - zht(:,:) ) ) 514 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain514 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 515 515 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+ssha-SUM(e3t_a))) =', z_tmax 516 516 ! … … 520 520 END DO 521 521 z_tmax = MAXVAL( tmask(:,:,1) * tmask_i(:,:) * ABS( ht_0(:,:) + sshb(:,:) - zht(:,:) ) ) 522 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain522 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 523 523 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ht_0+sshb-SUM(e3t_b))) =', z_tmax 524 524 ! 525 525 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshb(:,:) ) ) 526 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain526 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 527 527 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshb))) =', z_tmax 528 528 ! 529 529 z_tmax = MAXVAL( tmask(:,:,1) * ABS( sshn(:,:) ) ) 530 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain530 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 531 531 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(sshn))) =', z_tmax 532 532 ! 533 533 z_tmax = MAXVAL( tmask(:,:,1) * ABS( ssha(:,:) ) ) 534 IF( lk_mpp ) CALL mpp_max(z_tmax ) ! max over the global domain534 CALL mpp_max( 'domvvl', z_tmax ) ! max over the global domain 535 535 IF( lwp ) WRITE(numout, *) kt,' MAXVAL(abs(ssha))) =', z_tmax 536 536 END IF … … 713 713 END DO 714 714 END DO 715 CALL lbc_lnk( pe3_out(:,:,:), 'U', 1._wp )715 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 716 716 pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 717 717 ! … … 726 726 END DO 727 727 END DO 728 CALL lbc_lnk( pe3_out(:,:,:), 'V', 1._wp )728 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 729 729 pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 730 730 ! … … 740 740 END DO 741 741 END DO 742 CALL lbc_lnk( pe3_out(:,:,:), 'F', 1._wp )742 CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 743 743 pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 744 744 ! -
NEMO/trunk/src/OCE/DOM/domwri.F90
r10068 r10425 72 72 ! ! create 'mesh_mask.nc' file 73 73 ! ! ============================ 74 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. , kiolib = jprstlib)74 CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 75 75 ! 76 76 ! ! global domain size … … 210 210 ! 211 211 puniq(:,:) = ztstref(:,:) ! default definition 212 CALL lbc_lnk( puniq, cdgrd, 1. ) ! apply boundary conditions212 CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. ) ! apply boundary conditions 213 213 lldbl(:,:,1) = puniq(:,:) == ztstref(:,:) ! check which values have been changed 214 214 ! … … 271 271 END DO 272 272 END DO 273 CALL lbc_lnk( zx1, 'T', 1. )273 CALL lbc_lnk( 'domwri', zx1, 'T', 1. ) 274 274 ! 275 275 IF( PRESENT( px1 ) ) px1 = zx1 … … 277 277 zrxmax = MAXVAL( zx1 ) 278 278 ! 279 IF( lk_mpp ) CALL mpp_max(zrxmax ) ! max over the global domain279 CALL mpp_max( 'domwri', zrxmax ) ! max over the global domain 280 280 ! 281 281 IF(lwp) THEN -
NEMO/trunk/src/OCE/DOM/domzgr.F90
r10068 r10425 307 307 END DO 308 308 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 309 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 )310 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 )311 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( zk, 'F', 1. ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 )312 ! 313 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( zk, 'U', 1. ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 )314 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( zk, 'V', 1. ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 )309 zk(:,:) = REAL( miku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1. ) ; miku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 310 zk(:,:) = REAL( mikv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1. ) ; mikv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 311 zk(:,:) = REAL( mikf(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'F', 1. ) ; mikf(:,:) = MAX( NINT( zk(:,:) ), 1 ) 312 ! 313 zk(:,:) = REAL( mbku(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'U', 1. ) ; mbku(:,:) = MAX( NINT( zk(:,:) ), 1 ) 314 zk(:,:) = REAL( mbkv(:,:), wp ) ; CALL lbc_lnk( 'domzgr', zk, 'V', 1. ) ; mbkv(:,:) = MAX( NINT( zk(:,:) ), 1 ) 315 315 ! 316 316 END SUBROUTINE zgr_top_bot -
NEMO/trunk/src/OCE/DOM/iscplhsb.F90
r10069 r10425 206 206 207 207 ! build array of total problematic point on each cpu (share to each cpu) 208 CALL mpp_max( inpts,jpnij)208 CALL mpp_max('iscplhsb', inpts,jpnij) 209 209 210 210 ! size of the new variable … … 243 243 ! build array of total problematic point on each cpu (share to each cpu) 244 244 ! point coordinates 245 CALL mpp_max( zlat ,npts)246 CALL mpp_max( zlon ,npts)247 CALL mpp_max( izpts,npts)245 CALL mpp_max('iscplhsb', zlat ,npts) 246 CALL mpp_max('iscplhsb', zlon ,npts) 247 CALL mpp_max('iscplhsb', izpts,npts) 248 248 249 249 ! correction values 250 CALL mpp_max( zcorr_vol,npts)251 CALL mpp_max( zcorr_sal,npts)252 CALL mpp_max( zcorr_tem,npts)250 CALL mpp_max('iscplhsb', zcorr_vol,npts) 251 CALL mpp_max('iscplhsb', zcorr_sal,npts) 252 CALL mpp_max('iscplhsb', zcorr_tem,npts) 253 253 254 254 ! put correction term in the closest cell -
NEMO/trunk/src/OCE/DOM/iscplini.F90
r10069 r10425 48 48 ALLOCATE( htsc_iscpl(jpi,jpj,jpk,jpts) , hdiv_iscpl(jpi,jpj,jpk) , STAT=iscpl_alloc ) 49 49 ! 50 IF( lk_mpp ) CALL mpp_sum (iscpl_alloc )50 CALL mpp_sum ( 'iscplini', iscpl_alloc ) 51 51 IF( iscpl_alloc > 0 ) CALL ctl_warn('iscpl_alloc: allocation of arrays failed') 52 52 END FUNCTION iscpl_alloc -
NEMO/trunk/src/OCE/DOM/iscplrst.F90
r10069 r10425 82 82 cfile='correction' 83 83 cfile = TRIM( cfile ) 84 CALL iom_open ( cfile, inum0, ldwrt = .TRUE. , kiolib = jprstlib)84 CALL iom_open ( cfile, inum0, ldwrt = .TRUE. ) 85 85 CALL iom_rstput( 0, 0, inum0, 'vol_cor', hdiv_iscpl(:,:,:) ) 86 86 CALL iom_rstput( 0, 0, inum0, 'tem_cor', htsc_iscpl(:,:,:,jp_tem) ) … … 175 175 END DO 176 176 END DO 177 CALL lbc_lnk_multi( sshn, 'T', 1., zsmask1, 'T', 1. )177 CALL lbc_lnk_multi( 'iscplrst', sshn, 'T', 1., zsmask1, 'T', 1. ) 178 178 zssh0 = sshn 179 179 zsmask0 = zsmask1 … … 344 344 END DO 345 345 346 CALL lbc_lnk_multi( tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., ztmask1, 'T', 1.)346 CALL lbc_lnk_multi( 'iscplrst', tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., ztmask1, 'T', 1.) 347 347 348 348 ! update
Note: See TracChangeset
for help on using the changeset viewer.
