Changeset 10425 for NEMO/trunk/src/TOP
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- Location:
- NEMO/trunk/src/TOP
- Files:
-
- 36 edited
-
C14/trcwri_c14.F90 (modified) (1 diff)
-
CFC/trcsms_cfc.F90 (modified) (1 diff)
-
MY_TRC/trcsms_my_trc.F90 (modified) (1 diff)
-
PISCES/P2Z/p2zbio.F90 (modified) (1 diff)
-
PISCES/P2Z/p2zexp.F90 (modified) (3 diffs)
-
PISCES/P4Z/p4zche.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zflx.F90 (modified) (3 diffs)
-
PISCES/P4Z/p4zlim.F90 (modified) (2 diffs)
-
PISCES/P4Z/p4zopt.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zprod.F90 (modified) (2 diffs)
-
PISCES/P4Z/p4zrem.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zsbc.F90 (modified) (2 diffs)
-
PISCES/P4Z/p4zsed.F90 (modified) (1 diff)
-
PISCES/P4Z/p4zsink.F90 (modified) (2 diffs)
-
PISCES/P4Z/p4zsms.F90 (modified) (8 diffs)
-
PISCES/P4Z/p5zlim.F90 (modified) (2 diffs)
-
PISCES/P4Z/p5zprod.F90 (modified) (2 diffs)
-
PISCES/SED/sed.F90 (modified) (2 diffs)
-
PISCES/SED/sed_oce.F90 (modified) (1 diff)
-
PISCES/SED/sedadv.F90 (modified) (1 diff)
-
PISCES/SED/sedrst.F90 (modified) (4 diffs)
-
PISCES/sms_pisces.F90 (modified) (2 diffs)
-
PISCES/trcini_pisces.F90 (modified) (2 diffs)
-
TRP/trcnxt.F90 (modified) (2 diffs)
-
TRP/trcrad.F90 (modified) (6 diffs)
-
TRP/trcsbc.F90 (modified) (3 diffs)
-
TRP/trdmxl_trc.F90 (modified) (6 diffs)
-
TRP/trdmxl_trc_rst.F90 (modified) (3 diffs)
-
TRP/trdtrc_oce.F90 (modified) (2 diffs)
-
trc.F90 (modified) (2 diffs)
-
trcbdy.F90 (modified) (1 diff)
-
trcini.F90 (modified) (3 diffs)
-
trcnam.F90 (modified) (3 diffs)
-
trcrst.F90 (modified) (8 diffs)
-
trcstp.F90 (modified) (3 diffs)
-
trcsub.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/TOP/C14/trcwri_c14.F90
r10070 r10425 96 96 97 97 IF( iom_use("AtmC14") ) THEN 98 zarea = glob_sum( e1e2t(:,:) ) ! global ocean surface99 ztemp = glob_sum( c14sbc(:,:) * e1e2t(:,:) )98 zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface 99 ztemp = glob_sum( 'trcwri_c14', c14sbc(:,:) * e1e2t(:,:) ) 100 100 ztemp = ( ztemp / zarea - 1._wp ) * 1000._wp 101 101 CALL iom_put( "AtmC14" , ztemp ) ! Global atmospheric DeltaC14 [permil] 102 102 ENDIF 103 103 IF( iom_use("K_C14") ) THEN 104 ztemp = glob_sum ( exch_c14(:,:) * e1e2t(:,:) )104 ztemp = glob_sum ( 'trcwri_c14', exch_c14(:,:) * e1e2t(:,:) ) 105 105 ztemp = rsiyea * ztemp / zarea 106 106 CALL iom_put( "K_C14" , ztemp ) ! global mean exchange velocity for C14/C ratio [m/yr] 107 107 ENDIF 108 108 IF( iom_use("K_CO2") ) THEN 109 zarea = glob_sum( e1e2t(:,:) ) ! global ocean surface110 ztemp = glob_sum ( exch_co2(:,:) * e1e2t(:,:) )109 zarea = glob_sum( 'trcwri_c14', e1e2t(:,:) ) ! global ocean surface 110 ztemp = glob_sum ( 'trcwri_c14', exch_co2(:,:) * e1e2t(:,:) ) 111 111 ztemp = 360000._wp * ztemp / zarea ! cm/h units: directly comparable with literature 112 112 CALL iom_put( "K_CO2", ztemp ) ! global mean CO2 piston velocity [cm/hr] 113 113 ENDIF 114 114 IF( iom_use("C14Inv") ) THEN 115 ztemp = glob_sum( trn(:,:,:,jp_c14) * cvol(:,:,:) )115 ztemp = glob_sum( 'trcwri_c14', trn(:,:,:,jp_c14) * cvol(:,:,:) ) 116 116 ztemp = atomc14 * xdicsur * ztemp 117 117 CALL iom_put( "C14Inv", ztemp ) ! Radiocarbon ocean inventory [10^26 atoms] -
NEMO/trunk/src/TOP/CFC/trcsms_cfc.F90
r10068 r10425 310 310 & STAT=trc_sms_cfc_alloc ) 311 311 ! 312 IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_ warn('trc_sms_cfc_alloc : failed to allocate arrays.')312 IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_sms_cfc_alloc : failed to allocate arrays.' ) 313 313 ! 314 314 END FUNCTION trc_sms_cfc_alloc -
NEMO/trunk/src/TOP/MY_TRC/trcsms_my_trc.F90
r10068 r10425 81 81 trc_sms_my_trc_alloc = 0 ! set to zero if no array to be allocated 82 82 ! 83 IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_ warn('trc_sms_my_trc_alloc : failed to allocate arrays')83 IF( trc_sms_my_trc_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_sms_my_trc_alloc : failed to allocate arrays' ) 84 84 ! 85 85 END FUNCTION trc_sms_my_trc_alloc -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zbio.F90
r10068 r10425 341 341 ! 342 342 IF( lk_iomput ) THEN 343 CALL lbc_lnk( zw2d(:,:,:),'T', 1. )344 CALL lbc_lnk_multi( zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. )343 CALL lbc_lnk( 'p2zbio', zw2d(:,:,:),'T', 1. ) 344 CALL lbc_lnk_multi( 'p2zbio', zw3d(:,:,:,1),'T', 1., zw3d(:,:,:,2),'T', 1., zw3d(:,:,:,3),'T', 1. ) 345 345 ! Save diagnostics 346 346 CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) -
NEMO/trunk/src/TOP/PISCES/P2Z/p2zexp.F90
r10068 r10425 113 113 END DO 114 114 115 CALL lbc_lnk( sedpocn, 'T', 1. )115 CALL lbc_lnk( 'p2zexp', sedpocn, 'T', 1. ) 116 116 117 117 ! Oa & Ek: diagnostics depending on jpdia2d ! left as example … … 229 229 END DO 230 230 END DO 231 CALL lbc_lnk( cmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged)232 areacot = glob_sum( e1e2t(:,:) * cmask(:,:) )231 CALL lbc_lnk( 'p2zexp', cmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 232 areacot = glob_sum( 'p2zexp', e1e2t(:,:) * cmask(:,:) ) 233 233 ! 234 234 IF( ln_rsttr ) THEN … … 248 248 ALLOCATE( cmask(jpi,jpj) , dminl(jpi,jpj) , dmin3(jpi,jpj,jpk), & 249 249 & sedpocb(jpi,jpj) , sedpocn(jpi,jpj), STAT=p2z_exp_alloc ) 250 IF( p2z_exp_alloc /= 0 ) CALL ctl_ warn('p2z_exp_alloc : failed to allocate arrays.')250 IF( p2z_exp_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p2z_exp_alloc : failed to allocate arrays.' ) 251 251 ! 252 252 END FUNCTION p2z_exp_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zche.F90
r10222 r10425 823 823 p4z_che_alloc = MAXVAL( ierr ) 824 824 ! 825 IF( p4z_che_alloc /= 0 ) CALL ctl_ warn('p4z_che_alloc : failed to allocate arrays.')825 IF( p4z_che_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_che_alloc : failed to allocate arrays.' ) 826 826 ! 827 827 END FUNCTION p4z_che_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zflx.F90
r10068 r10425 172 172 END DO 173 173 174 t_oce_co2_flx = glob_sum( oce_co2(:,:) ) ! Total Flux of Carbon 174 IF( iom_use("tcflx") .OR. iom_use("tcflxcum") .OR. kt == nitrst & 175 & .OR. (ln_check_mass .AND. kt == nitend) ) & 176 t_oce_co2_flx = glob_sum( 'p4zflx', oce_co2(:,:) ) ! Total Flux of Carbon 175 177 t_oce_co2_flx_cum = t_oce_co2_flx_cum + t_oce_co2_flx ! Cumulative Total Flux of Carbon 176 ! t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2178 ! t_atm_co2_flx = glob_sum( 'p4zflx', satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2 177 179 t_atm_co2_flx = atcco2 ! Total atmospheric pCO2 178 180 … … 205 207 CALL iom_put( "Dpo2" , zw2d ) 206 208 ENDIF 207 IF( iom_use( "tcflx" ) )CALL iom_put( "tcflx" , t_oce_co2_flx * rfact2r ) ! molC/s208 CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum )! molC209 CALL iom_put( "tcflx" , t_oce_co2_flx * rfact2r ) ! molC/s 210 CALL iom_put( "tcflxcum" , t_oce_co2_flx_cum ) ! molC 209 211 ! 210 212 DEALLOCATE( zw2d ) … … 376 378 ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 377 379 ! 378 IF( p4z_flx_alloc /= 0 ) CALL ctl_ warn('p4z_flx_alloc : failed to allocate arrays')380 IF( p4z_flx_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_flx_alloc : failed to allocate arrays' ) 379 381 ! 380 382 END FUNCTION p4z_flx_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zlim.F90
r10227 r10425 293 293 !! *** ROUTINE p5z_lim_alloc *** 294 294 !!---------------------------------------------------------------------- 295 USE lib_mpp , ONLY: ctl_ warn295 USE lib_mpp , ONLY: ctl_stop 296 296 !!---------------------------------------------------------------------- 297 297 … … 306 306 & xlimsi (jpi,jpj,jpk), STAT=p4z_lim_alloc ) 307 307 ! 308 IF( p4z_lim_alloc /= 0 ) CALL ctl_ warn('p4z_lim_alloc : failed to allocate arrays.')308 IF( p4z_lim_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_lim_alloc : failed to allocate arrays.' ) 309 309 ! 310 310 END FUNCTION p4z_lim_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90
r10362 r10425 463 463 ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc ) 464 464 ! 465 IF( p4z_opt_alloc /= 0 ) CALL ctl_ warn('p4z_opt_alloc : failed to allocate arrays.')465 IF( p4z_opt_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_opt_alloc : failed to allocate arrays.' ) 466 466 ! 467 467 END FUNCTION p4z_opt_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zprod.F90
r10401 r10425 340 340 ! Total primary production per year 341 341 IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 342 & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) )342 & tpp = glob_sum( 'p4zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 343 343 344 344 IF( lk_iomput ) THEN … … 529 529 ALLOCATE( quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc ) 530 530 ! 531 IF( p4z_prod_alloc /= 0 ) CALL ctl_ warn('p4z_prod_alloc : failed to allocate arrays.')531 IF( p4z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_prod_alloc : failed to allocate arrays.' ) 532 532 ! 533 533 END FUNCTION p4z_prod_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zrem.F90
r10362 r10425 363 363 ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 364 364 ! 365 IF( p4z_rem_alloc /= 0 ) CALL ctl_ warn('p4z_rem_alloc: failed to allocate arrays')365 IF( p4z_rem_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_rem_alloc: failed to allocate arrays' ) 366 366 ! 367 367 END FUNCTION p4z_rem_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsbc.F90
r10416 r10425 368 368 ztimes_riv = 1._wp / REAL(ntimes_riv, wp) 369 369 DO jm = 1, ntimes_riv 370 rivinput(ifpr) = rivinput(ifpr) + glob_sum( zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv )370 rivinput(ifpr) = rivinput(ifpr) + glob_sum( 'p4zsbc', zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv ) 371 371 END DO 372 372 DEALLOCATE( zriver) … … 449 449 END DO 450 450 ! 451 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged)451 CALL lbc_lnk( 'p4zsbc', zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 452 452 ! 453 453 DO jk = 1, jpk -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsed.F90
r10416 r10425 504 504 ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc ) 505 505 ! 506 IF( p4z_sed_alloc /= 0 ) CALL ctl_ warn('p4z_sed_alloc: failed to allocate arrays')506 IF( p4z_sed_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_alloc: failed to allocate arrays' ) 507 507 ! 508 508 END FUNCTION p4z_sed_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsink.F90
r10416 r10425 127 127 ! Total carbon export per year 128 128 IF( iom_use( "tcexp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 129 & t_oce_co2_exp = glob_sum( ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) )129 & t_oce_co2_exp = glob_sum( 'p4zsink', ( sinking(:,:,ik100) + sinking2(:,:,ik100) ) * e1e2t(:,:) * tmask(:,:,1) ) 130 130 ! 131 131 IF( lk_iomput ) THEN … … 220 220 ! 221 221 p4z_sink_alloc = MAXVAL( ierr ) 222 IF( p4z_sink_alloc /= 0 ) CALL ctl_ warn('p4z_sink_alloc : failed to allocate arrays.')222 IF( p4z_sink_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p4z_sink_alloc : failed to allocate arrays.' ) 223 223 ! 224 224 END FUNCTION p4z_sink_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p4zsms.F90
r10416 r10425 361 361 ! ! --------------------------- ! 362 362 ! set total alkalinity, phosphate, nitrate & silicate 363 zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6364 365 zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea366 zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r367 zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3368 zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea363 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 364 365 zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 366 zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 367 zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 368 zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 369 369 370 370 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn … … 382 382 ! 383 383 IF( .NOT. ln_top_euler ) THEN 384 zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea385 zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r386 zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3387 zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea384 zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea 385 zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r 386 zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3 387 zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 388 388 389 389 IF(lwp) WRITE(numout,*) ' ' … … 449 449 ENDIF 450 450 ! 451 no3budget = glob_sum( zwork(:,:,:) * cvol(:,:,:) )451 no3budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) 452 452 no3budget = no3budget / areatot 453 453 CALL iom_put( "pno3tot", no3budget ) … … 467 467 ENDIF 468 468 ! 469 po4budget = glob_sum( zwork(:,:,:) * cvol(:,:,:) )469 po4budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) 470 470 po4budget = po4budget / areatot 471 471 CALL iom_put( "ppo4tot", po4budget ) … … 475 475 zwork(:,:,:) = trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi) 476 476 ! 477 silbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) )477 silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) 478 478 silbudget = silbudget / areatot 479 479 CALL iom_put( "psiltot", silbudget ) … … 483 483 zwork(:,:,:) = trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2. 484 484 ! 485 alkbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) ) !485 alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) ! 486 486 alkbudget = alkbudget / areatot 487 487 CALL iom_put( "palktot", alkbudget ) … … 493 493 & + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * ferat3 494 494 ! 495 ferbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:) )495 ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) 496 496 ferbudget = ferbudget / areatot 497 497 CALL iom_put( "pfertot", ferbudget ) … … 502 502 ! -------------------------------------------------------------------------------- 503 503 IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 504 znitrpottot = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )504 znitrpottot = glob_sum ( 'p4zsms', nitrpot(:,:,:) * nitrfix * cvol(:,:,:) ) 505 505 CALL iom_put( "tnfix" , znitrpottot * xfact3 ) ! Global nitrogen fixation molC/l to molN/m3 506 506 ENDIF 507 507 ! 508 508 IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 509 zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )510 zsdenittot = glob_sum ( sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) )509 zrdenittot = glob_sum ( 'p4zsms', denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) ) 510 zsdenittot = glob_sum ( 'p4zsms', sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 511 511 CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 ) ! Total denitrification molC/l to molN/m3 512 512 ENDIF 513 513 ! 514 514 IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer 515 t_atm_co2_flx = t_atm_co2_flx / glob_sum( e1e2t(:,:) )515 t_atm_co2_flx = t_atm_co2_flx / glob_sum( 'p4zsms', e1e2t(:,:) ) 516 516 t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 ) 517 517 tpp = tpp * 1000. * xfact1 -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zlim.F90
r10362 r10425 535 535 !! *** ROUTINE p5z_lim_alloc *** 536 536 !!---------------------------------------------------------------------- 537 USE lib_mpp , ONLY: ctl_ warn537 USE lib_mpp , ONLY: ctl_stop 538 538 INTEGER :: ierr(2) ! Local variables 539 539 !!---------------------------------------------------------------------- … … 559 559 p5z_lim_alloc = MAXVAL( ierr ) 560 560 ! 561 IF( p5z_lim_alloc /= 0 ) CALL ctl_ warn('p5z_lim_alloc : failed to allocate arrays.')561 IF( p5z_lim_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_lim_alloc : failed to allocate arrays.' ) 562 562 ! 563 563 END FUNCTION p5z_lim_alloc -
NEMO/trunk/src/TOP/PISCES/P4Z/p5zprod.F90
r10362 r10425 462 462 ! Total primary production per year 463 463 IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc ) ) & 464 & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) )464 & tpp = glob_sum( 'p5zprod', ( zprorcan(:,:,:) + zprorcad(:,:,:) + zprorcap(:,:,:) ) * cvol(:,:,:) ) 465 465 466 466 IF( lk_iomput ) THEN … … 624 624 ALLOCATE( zdaylen(jpi,jpj), STAT = p5z_prod_alloc ) 625 625 ! 626 IF( p5z_prod_alloc /= 0 ) CALL ctl_ warn('p5z_prod_alloc : failed to allocate arrays.')626 IF( p5z_prod_alloc /= 0 ) CALL ctl_stop( 'STOP', 'p5z_prod_alloc : failed to allocate arrays.' ) 627 627 ! 628 628 END FUNCTION p5z_prod_alloc -
NEMO/trunk/src/TOP/PISCES/SED/sed.F90
r10222 r10425 154 154 !! *** ROUTINE sed_alloc *** 155 155 !!------------------------------------------------------------------- 156 USE lib_mpp, ONLY: ctl_ warn156 USE lib_mpp, ONLY: ctl_stop 157 157 !!------------------------------------------------------------------- 158 158 ! … … 166 166 & mol_wgt(jpsol), STAT=sed_alloc ) 167 167 168 IF( sed_alloc /= 0 ) CALL ctl_ warn('sed_alloc: failed to allocate arrays')168 IF( sed_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sed_alloc: failed to allocate arrays' ) 169 169 ! 170 170 END FUNCTION sed_alloc -
NEMO/trunk/src/TOP/PISCES/SED/sed_oce.F90
r10225 r10425 25 25 !! *** ROUTINE sed_alloc *** 26 26 !!------------------------------------------------------------------- 27 USE lib_mpp, ONLY: ctl_ warn27 USE lib_mpp, ONLY: ctl_stop 28 28 !!------------------------------------------------------------------- 29 29 ! 30 30 ALLOCATE( profsed(jpksed) , profsedw(jpksed) , STAT=sed_oce_alloc ) 31 31 32 IF( sed_oce_alloc /= 0 ) CALL ctl_ warn('sed_oce_alloc: failed to allocate arrays')32 IF( sed_oce_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sed_oce_alloc: failed to allocate arrays' ) 33 33 ! 34 34 END FUNCTION sed_oce_alloc -
NEMO/trunk/src/TOP/PISCES/SED/sedadv.F90
r10222 r10425 436 436 & ckpor(jpksed) , STAT = sed_adv_alloc ) 437 437 ! 438 IF( sed_adv_alloc /= 0 ) CALL ctl_ warn('sed_adv_alloc : failed to allocate arrays.')438 IF( sed_adv_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sed_adv_alloc : failed to allocate arrays.' ) 439 439 ! 440 440 END FUNCTION sed_adv_alloc -
NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90
r10333 r10425 78 78 IF(lwp) WRITE(numsed,*) & 79 79 ' open sed restart.output NetCDF file: ',TRIM(clpath)//clname 80 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., k iolib = jprstlib, kdlev = jpksed )80 CALL iom_open( TRIM(clpath)//TRIM(clname), numrsw, ldwrt = .TRUE., kdlev = jpksed ) 81 81 lrst_sed = .TRUE. 82 82 ENDIF … … 105 105 CHARACTER(len = 20) :: cltra 106 106 CHARACTER(LEN=20) :: name1 107 INTEGER :: jlibalt = jprstlib108 107 LOGICAL :: llok 109 108 !-------------------------------------------------------------------- … … 338 337 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 339 338 ! 340 INTEGER :: jlibalt = jprstlib341 339 LOGICAL :: llok 342 340 REAL(wp) :: zkt, zrdttrc1 … … 353 351 354 352 IF( ln_rst_sed ) THEN 355 CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr , kiolib = jlibalt)353 CALL iom_open( TRIM(cn_sedrst_indir)//'/'//cn_sedrst_in, numrsr ) 356 354 CALL iom_get ( numrsr, 'kt', zkt ) ! last time-step of previous run 357 355 -
NEMO/trunk/src/TOP/PISCES/sms_pisces.F90
r10416 r10425 131 131 !! *** ROUTINE sms_pisces_alloc *** 132 132 !!---------------------------------------------------------------------- 133 USE lib_mpp , ONLY: ctl_ warn133 USE lib_mpp , ONLY: ctl_stop 134 134 INTEGER :: ierr(10) ! Local variables 135 135 !!---------------------------------------------------------------------- … … 186 186 sms_pisces_alloc = MAXVAL( ierr ) 187 187 ! 188 IF( sms_pisces_alloc /= 0 ) CALL ctl_ warn('sms_pisces_alloc: failed to allocate arrays')188 IF( sms_pisces_alloc /= 0 ) CALL ctl_stop( 'STOP', 'sms_pisces_alloc: failed to allocate arrays' ) 189 189 ! 190 190 END FUNCTION sms_pisces_alloc -
NEMO/trunk/src/TOP/PISCES/trcini_pisces.F90
r10416 r10425 118 118 ierr = ierr + p4z_rem_alloc() 119 119 ! 120 IF( lk_mpp ) CALL mpp_sum(ierr )120 CALL mpp_sum( 'trcini_pisces', ierr ) 121 121 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'pisces_alloc: unable to allocate PISCES arrays' ) 122 122 ! … … 311 311 ierr = ierr + p2z_exp_alloc() 312 312 ! 313 IF( lk_mpp ) CALL mpp_sum(ierr )313 CALL mpp_sum( 'trcini_pisces', ierr ) 314 314 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'p2z_ini: unable to allocate LOBSTER arrays' ) 315 315 -
NEMO/trunk/src/TOP/TRP/trcnxt.F90
r10097 r10425 97 97 #endif 98 98 ! Update after tracer on domain lateral boundaries 99 CALL lbc_lnk( tra(:,:,:,:), 'T', 1. )99 CALL lbc_lnk( 'trcnxt', tra(:,:,:,:), 'T', 1. ) 100 100 101 101 IF( ln_bdy ) CALL trc_bdy( kt ) … … 164 164 ENDIF 165 165 ! 166 CALL lbc_lnk_multi( trb(:,:,:,:), 'T', 1._wp, trn(:,:,:,:), 'T', 1._wp, tra(:,:,:,:), 'T', 1._wp )166 CALL lbc_lnk_multi( 'trcnxt', trb(:,:,:,:), 'T', 1._wp, trn(:,:,:,:), 'T', 1._wp, tra(:,:,:,:), 'T', 1._wp ) 167 167 ENDIF 168 168 ! -
NEMO/trunk/src/TOP/TRP/trcrad.F90
r10068 r10425 19 19 USE trdtra 20 20 USE prtctl_trc ! Print control for debbuging 21 USE lib_fortran 21 22 22 23 IMPLICIT NONE … … 27 28 28 29 LOGICAL , PUBLIC :: ln_trcrad !: flag to artificially correct negative concentrations 30 REAL(wp), DIMENSION(:,:), ALLOCATABLE:: gainmass 29 31 30 32 !!---------------------------------------------------------------------- … … 104 106 ENDIF 105 107 ENDIF 108 ! 109 ALLOCATE( gainmass(jptra,2) ) 110 gainmass(:,:) = 0. 106 111 ! 107 112 END SUBROUTINE trc_rad_ini … … 129 134 CHARACTER( len = 1), OPTIONAL , INTENT(in ) :: cpreserv ! flag to preserve content or not 130 135 ! 131 INTEGER :: ji, jj, jk, jn ! dummy loop indices 132 LOGICAL :: lldebug = .FALSE. ! local logical 133 REAL(wp):: ztrcorb, ztrmasb, zs2rdt ! temporary scalars 134 REAL(wp):: zcoef , ztrcorn, ztrmasn ! - - 135 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrdb, ztrtrdn ! workspace arrays 136 !!---------------------------------------------------------------------- 137 ! 138 IF( l_trdtrc ) ALLOCATE( ztrtrdb(jpi,jpj,jpk), ztrtrdn(jpi,jpj,jpk) ) 136 INTEGER :: ji, ji2, jj, jj2, jk, jn ! dummy loop indices 137 INTEGER :: icnt 138 LOGICAL :: lldebug = .FALSE. ! local logical 139 REAL(wp):: zcoef, zs2rdt, ztotmass 140 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrneg, ztrpos 141 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrtrd ! workspace arrays 142 !!---------------------------------------------------------------------- 143 ! 144 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 145 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 139 146 ! 140 147 IF( PRESENT( cpreserv ) ) THEN !== total tracer concentration is preserved ==! 141 148 ! 142 DO jn = jp_sms0, jp_sms1 143 ! 144 ztrcorb = 0._wp ; ztrmasb = 0._wp 145 ztrcorn = 0._wp ; ztrmasn = 0._wp 146 ! 147 IF( l_trdtrc ) THEN 148 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 149 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 150 ENDIF 151 ! ! sum over the global domain 152 ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 153 ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 154 ! 155 ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 156 ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 157 ! 158 IF( ztrcorb /= 0 ) THEN 159 zcoef = 1. + ztrcorb / ztrmasb 160 DO jk = 1, jpkm1 161 ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 162 ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 163 END DO 164 ENDIF 165 ! 166 IF( ztrcorn /= 0 ) THEN 167 zcoef = 1. + ztrcorn / ztrmasn 168 DO jk = 1, jpkm1 169 ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 170 ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 171 END DO 172 ENDIF 173 ! 174 IF( l_trdtrc ) THEN 175 ! 176 zs2rdt = 1. / ( 2. * rdt ) 177 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 178 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 179 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 180 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 181 ! 182 ENDIF 183 ! 184 END DO 185 ! 186 ELSE !== total CFC content is NOT strictly preserved ==! 187 ! 188 DO jn = jp_sms0, jp_sms1 189 ! 190 IF( l_trdtrc ) THEN 191 ztrtrdb(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 192 ztrtrdn(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 193 ENDIF 149 ALLOCATE( ztrneg(1:jpi,1:jpj,jp_sms0:jp_sms1), ztrpos(1:jpi,1:jpj,jp_sms0:jp_sms1) ) 150 151 DO jn = jp_sms0, jp_sms1 152 ztrneg(:,:,jn) = SUM( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the negative values 153 ztrpos(:,:,jn) = SUM( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the positive values 154 END DO 155 CALL sum3x3( ztrneg ) 156 CALL sum3x3( ztrpos ) 157 158 DO jn = jp_sms0, jp_sms1 159 ! 160 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 194 161 ! 195 162 DO jk = 1, jpkm1 196 163 DO jj = 1, jpj 197 164 DO ji = 1, jpi 198 ptrn(ji,jj,jk,jn) = MAX( 0. , ptrn(ji,jj,jk,jn) ) 199 ptrb(ji,jj,jk,jn) = MAX( 0. , ptrb(ji,jj,jk,jn) ) 165 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 166 ! 167 ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * tmask(ji,jj,jk) ! really needed? 168 IF( ptrb(ji,jj,jk,jn) < 0. ) ptrb(ji,jj,jk,jn) = 0. ! supress negative values 169 IF( ptrb(ji,jj,jk,jn) > 0. ) THEN ! use positive values to compensate mass gain 170 zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptrb > 0 171 ptrb(ji,jj,jk,jn) = ptrb(ji,jj,jk,jn) * zcoef 172 IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value 173 gainmass(jn,1) = gainmass(jn,1) - ptrb(ji,jj,jk,jn) * cvol(ji,jj,jk) ! we are adding mass... 174 ptrb(ji,jj,jk,jn) = 0. ! limit the compensation to keep positive value 175 ENDIF 176 ENDIF 177 ! 178 ENDIF 200 179 END DO 201 180 END DO … … 203 182 ! 204 183 IF( l_trdtrc ) THEN 205 ! 206 zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 207 ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 208 ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt 209 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrdb ) ! Asselin-like trend handling 210 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrdn ) ! standard trend handling 211 ! 184 ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 185 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd ) ! Asselin-like trend handling 186 ENDIF 187 ! 188 END DO 189 190 IF( kt == nitend ) THEN 191 CALL mpp_sum( 'trcrad', gainmass(:,1) ) 192 DO jn = jp_sms0, jp_sms1 193 IF( gainmass(jn,1) > 0. ) THEN 194 ztotmass = glob_sum( 'trcrad', ptrb(:,:,:,jn) * cvol(:,:,:) ) 195 IF(lwp) WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrb, traceur ', jn & 196 & , ' total mass : ', ztotmass, ', mass gain : ', gainmass(jn,1) 197 END IF 198 END DO 199 ENDIF 200 201 DO jn = jp_sms0, jp_sms1 202 ztrneg(:,:,jn) = SUM( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the negative values 203 ztrpos(:,:,jn) = SUM( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:), dim = 3 ) ! sum of the positive values 204 END DO 205 CALL sum3x3( ztrneg ) 206 CALL sum3x3( ztrpos ) 207 208 DO jn = jp_sms0, jp_sms1 209 ! 210 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrn(:,:,:,jn) ! save input trb for trend computation 211 ! 212 DO jk = 1, jpkm1 213 DO jj = 1, jpj 214 DO ji = 1, jpi 215 IF( ztrneg(ji,jj,jn) /= 0. ) THEN ! if negative values over the 3x3 box 216 ! 217 ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * tmask(ji,jj,jk) ! really needed? 218 IF( ptrn(ji,jj,jk,jn) < 0. ) ptrn(ji,jj,jk,jn) = 0. ! supress negative values 219 IF( ptrn(ji,jj,jk,jn) > 0. ) THEN ! use positive values to compensate mass gain 220 zcoef = 1. + ztrneg(ji,jj,jn) / ztrpos(ji,jj,jn) ! ztrpos > 0 as ptrb > 0 221 ptrn(ji,jj,jk,jn) = ptrn(ji,jj,jk,jn) * zcoef 222 IF( zcoef < 0. ) THEN ! if the compensation exceed the positive value 223 gainmass(jn,2) = gainmass(jn,2) - ptrn(ji,jj,jk,jn) * cvol(ji,jj,jk) ! we are adding mass... 224 ptrn(ji,jj,jk,jn) = 0. ! limit the compensation to keep positive value 225 ENDIF 226 ENDIF 227 ! 228 ENDIF 229 END DO 230 END DO 231 END DO 232 ! 233 IF( l_trdtrc ) THEN 234 ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 235 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd ) ! standard trend handling 236 ENDIF 237 ! 238 END DO 239 240 IF( kt == nitend ) THEN 241 CALL mpp_sum( 'trcrad', gainmass(:,2) ) 242 DO jn = jp_sms0, jp_sms1 243 IF( gainmass(jn,2) > 0. ) THEN 244 ztotmass = glob_sum( 'trcrad', ptrn(:,:,:,jn) * cvol(:,:,:) ) 245 WRITE(numout, '(a, i2, a, D23.16, a, D23.16)') 'trcrad ptrn, traceur ', jn & 246 & , ' total mass : ', ztotmass, ', mass gain : ', gainmass(jn,1) 247 END IF 248 END DO 249 ENDIF 250 251 DEALLOCATE( ztrneg, ztrpos ) 252 ! 253 ELSE !== total CFC content is NOT strictly preserved ==! 254 ! 255 DO jn = jp_sms0, jp_sms1 256 ! 257 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrb(:,:,:,jn) ! save input trb for trend computation 258 ! 259 WHERE( ptrb(:,:,:,jn) < 0. ) ptrb(:,:,:,jn) = 0. 260 ! 261 IF( l_trdtrc ) THEN 262 ztrtrd(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 263 CALL trd_tra( kt, 'TRC', jn, jptra_radb, ztrtrd ) ! Asselin-like trend handling 264 ENDIF 265 ! 266 IF( l_trdtrc ) ztrtrd(:,:,:) = ptrn(:,:,:,jn) ! save input trn for trend computation 267 ! 268 WHERE( ptrn(:,:,:,jn) < 0. ) ptrn(:,:,:,jn) = 0. 269 ! 270 IF( l_trdtrc ) THEN 271 ztrtrd(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrd(:,:,:) ) * zs2rdt 272 CALL trd_tra( kt, 'TRC', jn, jptra_radn, ztrtrd ) ! standard trend handling 212 273 ENDIF 213 274 ! … … 216 277 ENDIF 217 278 ! 218 IF( l_trdtrc ) DEALLOCATE( ztrtrd b, ztrtrdn)279 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 219 280 ! 220 281 END SUBROUTINE trc_rad_sms -
NEMO/trunk/src/TOP/TRP/trcsbc.F90
r10068 r10425 113 113 114 114 ! 0. initialization 115 DO jn = 1, jptra 116 ! 117 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 118 ! 119 IF( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 115 IF( nn_ice_tr == -1 ) THEN ! No tracers in sea ice (null concentration in sea ice) 116 ! 117 DO jn = 1, jptra 120 118 DO jj = 2, jpj 121 119 DO ji = fs_2, fs_jpim1 ! vector opt. … … 123 121 END DO 124 122 END DO 125 ELSE 123 END DO 124 ! 125 ELSE 126 ! 127 DO jn = 1, jptra 126 128 DO jj = 2, jpj 127 129 DO ji = fs_2, fs_jpim1 ! vector opt. … … 143 145 END DO 144 146 END DO 145 ENDIF 146 ! 147 CALL lbc_lnk( sbc_trc(:,:,jn), 'T', 1. ) 148 ! Concentration dilution effect on tracers due to evaporation & precipitation 147 END DO 148 ENDIF 149 ! 150 CALL lbc_lnk( 'trcsbc', sbc_trc(:,:,:), 'T', 1. ) 151 ! Concentration dilution effect on tracers due to evaporation & precipitation 152 DO jn = 1, jptra 153 ! 154 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) ! save trends 155 ! 149 156 DO jj = 2, jpj 150 157 DO ji = fs_2, fs_jpim1 ! vector opt. -
NEMO/trunk/src/TOP/TRP/trdmxl_trc.F90
r10068 r10425 64 64 & ndextrd1(jpi*jpj), nidtrd(jptra), nh_t(jptra), STAT=trd_mxl_trc_alloc) 65 65 ! 66 IF( lk_mpp ) CALL mpp_sum (trd_mxl_trc_alloc )67 IF( trd_mxl_trc_alloc /=0 ) CALL ctl_ warn('trd_mxl_trc_alloc: failed to allocate arrays')66 CALL mpp_sum ( 'trdmxl_trc', trd_mxl_trc_alloc ) 67 IF( trd_mxl_trc_alloc /=0 ) CALL ctl_stop( 'STOP', 'trd_mxl_trc_alloc: failed to allocate arrays' ) 68 68 ! 69 69 END FUNCTION trd_mxl_trc_alloc … … 290 290 IF( ln_trdtrc(jn) ) THEN 291 291 DO jl = 1, jpltrd_trc 292 CALL lbc_lnk( tmltrd_trc(:,:,jl,jn), 'T', 1. ) ! lateral boundary conditions292 CALL lbc_lnk( 'trdmxl_trc', tmltrd_trc(:,:,jl,jn), 'T', 1. ) ! lateral boundary conditions 293 293 END DO 294 294 ENDIF … … 425 425 !-- Lateral boundary conditions 426 426 IF ( cn_cfg .NE. 'gyre' ) THEN 427 CALL lbc_lnk_multi( ztmltot(:,:,jn) , 'T', 1. , ztmlres(:,:,jn) , 'T', 1., &427 CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot(:,:,jn) , 'T', 1. , ztmlres(:,:,jn) , 'T', 1., & 428 428 & ztmlatf(:,:,jn) , 'T', 1. , ztmlrad(:,:,jn) , 'T', 1. ) 429 429 ENDIF … … 476 476 !-- Lateral boundary conditions 477 477 IF ( cn_cfg .NE. 'gyre' ) THEN ! other than GYRE configuration 478 CALL lbc_lnk_multi( ztmltot2(:,:,jn), 'T', 1., ztmlres2(:,:,jn), 'T', 1. )478 CALL lbc_lnk_multi( 'trdmxl_trc', ztmltot2(:,:,jn), 'T', 1., ztmlres2(:,:,jn), 'T', 1. ) 479 479 DO jl = 1, jpltrd_trc 480 CALL lbc_lnk( ztmltrd2(:,:,jl,jn), 'T', 1. ) ! will be output in the NetCDF trends file480 CALL lbc_lnk( 'trdmxl_trc', ztmltrd2(:,:,jl,jn), 'T', 1. ) ! will be output in the NetCDF trends file 481 481 END DO 482 482 ENDIF … … 776 776 777 777 IF( ( lk_trdmxl_trc ) .AND. ( MOD( nitend-nittrc000+1, nn_trd_trc ) /= 0 ) ) THEN 778 WRITE(numout,cform_err) 779 WRITE(numout,*) ' Your nitend parameter, nitend = ', nitend 780 WRITE(numout,*) ' is no multiple of the trends diagnostics frequency ' 781 WRITE(numout,*) ' you defined, nn_trd_trc = ', nn_trd_trc 782 WRITE(numout,*) ' This will not allow you to restart from this simulation. ' 783 WRITE(numout,*) ' You should reconsider this choice. ' 784 WRITE(numout,*) 785 WRITE(numout,*) ' N.B. the nitend parameter is also constrained to be a ' 786 WRITE(numout,*) ' multiple of the sea-ice frequency parameter (typically 5) ' 787 nstop = nstop + 1 778 WRITE(ctmp1,*) ' Your nitend parameter, nitend = ', nitend 779 WRITE(ctmp2,*) ' is no multiple of the trends diagnostics frequency ' 780 WRITE(ctmp3,*) ' you defined, nn_trd_trc = ', nn_trd_trc 781 WRITE(ctmp4,*) ' This will not allow you to restart from this simulation. ' 782 WRITE(ctmp5,*) ' You should reconsider this choice. ' 783 WRITE(ctmp6,*) 784 WRITE(ctmp7,*) ' N.B. the nitend parameter is also constrained to be a ' 785 WRITE(ctmp8,*) ' multiple of the sea-ice frequency parameter (typically 5) ' 786 CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4, ctmp5, ctmp6, ctmp7, ctmp8 ) 788 787 ENDIF 789 788 … … 795 794 796 795 IF( ( ln_trcadv_muscl .OR. ln_trcadv_muscl2 ) .AND. .NOT. ln_trdmxl_trc_instant ) THEN 797 WRITE(numout,cform_err) 798 WRITE(numout,*) ' Currently, you can NOT use simultaneously tracer MUSCL ' 799 WRITE(numout,*) ' advection and window averaged diagnostics of ML trends. ' 800 WRITE(numout,*) ' WHY? Everything in trdmxl_trc is coded for leap-frog, and ' 801 WRITE(numout,*) ' MUSCL scheme is Euler forward for passive tracers (note ' 802 WRITE(numout,*) ' that MUSCL is leap-frog for active tracers T/S). ' 803 WRITE(numout,*) ' In particuliar, entrainment trend would be FALSE. However ' 804 WRITE(numout,*) ' this residual is correct for instantaneous ML diagnostics.' 805 WRITE(numout,*) 806 nstop = nstop + 1 796 WRITE(ctmp1,*) ' Currently, you can NOT use simultaneously tracer MUSCL ' 797 WRITE(ctmp2,*) ' advection and window averaged diagnostics of ML trends. ' 798 WRITE(ctmp3,*) ' WHY? Everything in trdmxl_trc is coded for leap-frog, and ' 799 WRITE(ctmp4,*) ' MUSCL scheme is Euler forward for passive tracers (note ' 800 WRITE(ctmp5,*) ' that MUSCL is leap-frog for active tracers T/S). ' 801 WRITE(ctmp6,*) ' In particuliar, entrainment trend would be FALSE. However ' 802 WRITE(ctmp7,*) ' this residual is correct for instantaneous ML diagnostics.' 803 CALL ctl_stop( ctmp1, ctmp2, ctmp3, ctmp4, ctmp5, ctmp6, ctmp7 ) 807 804 ENDIF 808 805 -
NEMO/trunk/src/TOP/TRP/trdmxl_trc_rst.F90
r10068 r10425 54 54 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 55 55 IF(lwp) WRITE(numout,*) ' open ocean restart_mld_trc NetCDF 'TRIM(clpath)//TRIM(clname) 56 CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE. , kiolib = jprstlib)56 CALL iom_open( TRIM(clpath)//TRIM(clname), nummldw_trc, ldwrt = .TRUE. ) 57 57 ENDIF 58 58 … … 127 127 CHARACTER (len=35) :: charout 128 128 INTEGER :: jk, jn, jl ! loop indice 129 INTEGER :: jlibalt = jprstlib130 129 LOGICAL :: llok 131 130 CHARACTER(LEN=256) :: clpath ! full path to restart file … … 140 139 clpath = TRIM(cn_trcrst_indir) 141 140 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 142 CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum , kiolib = jlibalt)141 CALL iom_open( TRIM(clpath)//TRIM(cn_trdrst_trc_in), inum ) 143 142 144 143 IF( ln_trdmxl_trc_instant ) THEN -
NEMO/trunk/src/TOP/TRP/trdtrc_oce.F90
r10068 r10425 117 117 !! *** ROUTINE trd_trc_oce_alloc *** 118 118 !!---------------------------------------------------------------------- 119 USE lib_mpp, ONLY: ctl_ warn119 USE lib_mpp, ONLY: ctl_stop 120 120 INTEGER :: ierr(2) 121 121 !!---------------------------------------------------------------------- … … 146 146 trd_trc_oce_alloc = MAXVAL(ierr) 147 147 ! 148 IF( trd_trc_oce_alloc /= 0 ) CALL ctl_ warn('trd_trc_oce_alloc: failed to allocate arrays')148 IF( trd_trc_oce_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trd_trc_oce_alloc: failed to allocate arrays' ) 149 149 ! 150 150 # if defined key_trdmxl_trc -
NEMO/trunk/src/TOP/trc.F90
r10222 r10425 141 141 !! *** ROUTINE trc_alloc *** 142 142 !!------------------------------------------------------------------- 143 USE lib_mpp, ONLY: ctl_ warn143 USE lib_mpp, ONLY: ctl_stop 144 144 !!------------------------------------------------------------------- 145 145 INTEGER :: ierr(4) … … 166 166 ! 167 167 trc_alloc = MAXVAL( ierr ) 168 IF( trc_alloc /= 0 ) CALL ctl_ warn('trc_alloc: failed to allocate arrays')168 IF( trc_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_alloc: failed to allocate arrays' ) 169 169 ! 170 170 END FUNCTION trc_alloc -
NEMO/trunk/src/TOP/trcbdy.F90
r10069 r10425 71 71 END SELECT 72 72 ! Boundary points should be updated 73 CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy )73 CALL lbc_bdy_lnk( 'trcbdy', tra(:,:,:,jn), 'T', 1., ib_bdy ) 74 74 ! 75 75 END DO -
NEMO/trunk/src/TOP/trcini.F90
r10375 r10425 72 72 CALL trc_ice_ini ! Tracers in sea ice 73 73 ! 74 IF(lw p) CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea )74 IF(lwm) CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 75 75 ! 76 76 CALL trc_ini_state ! passive tracers initialisation : from a restart or from clim … … 119 119 END DO 120 120 ! ! total volume of the ocean 121 areatot = glob_sum( cvol(:,:,:) )121 areatot = glob_sum( 'trcini', cvol(:,:,:) ) 122 122 ! 123 123 trai(:) = 0._wp ! initial content of all tracers 124 124 DO jn = 1, jptra 125 trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )125 trai(jn) = trai(jn) + glob_sum( 'trcini', trn(:,:,:,jn) * cvol(:,:,:) ) 126 126 END DO 127 127 … … 292 292 #endif 293 293 ! 294 IF( lk_mpp ) CALL mpp_sum(ierr )294 CALL mpp_sum( 'trcini', ierr ) 295 295 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' ) 296 296 ! -
NEMO/trunk/src/TOP/trcnam.F90
r10068 r10425 23 23 USE trdtrc_oce ! 24 24 USE iom ! I/O manager 25 #if defined key_mpp_mpi 26 USE lib_mpp, ONLY: ncom_dttrc 27 #endif 25 28 26 29 IMPLICIT NONE … … 76 79 ENDIF 77 80 ! 78 rdttrc = rdt * FLOAT( nn_dttrc ) ! passive tracer time-step 81 rdttrc = rdt * FLOAT( nn_dttrc ) ! passive tracer time-step 79 82 ! 80 83 IF(lwp) THEN ! control print … … 128 131 ENDIF 129 132 ! 130 END SUBROUTINE trc_nam_run 133 #if defined key_mpp_mpi 134 ncom_dttrc = nn_dttrc ! make nn_fsbc available for lib_mpp 135 #endif 136 ! 137 END SUBROUTINE trc_nam_run 131 138 132 139 -
NEMO/trunk/src/TOP/trcrst.F90
r10222 r10425 23 23 USE iom 24 24 USE daymod 25 USE lib_mpp 25 26 26 27 IMPLICIT NONE … … 87 88 IF(lwp) WRITE(numout,*) & 88 89 ' open trc restart.output NetCDF file: ',TRIM(clpath)//clname 89 CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE. , kiolib = jprstlib)90 CALL iom_open( TRIM(clpath)//TRIM(clname), numrtw, ldwrt = .TRUE. ) 90 91 lrst_trc = .TRUE. 91 92 ENDIF … … 116 117 END DO 117 118 ! 119 CALL iom_delay_rst( 'READ', 'TOP', numrtr ) ! read only TOP delayed global communication variables 120 118 121 END SUBROUTINE trc_rst_read 119 122 … … 127 130 !! 128 131 INTEGER :: jn 129 REAL(wp) :: zarak0130 132 !!---------------------------------------------------------------------- 131 133 ! … … 141 143 END DO 142 144 ! 145 CALL iom_delay_rst( 'WRITE', 'TOP', numrtw ) ! save only TOP delayed global communication variables 146 143 147 IF( kt == nitrst ) THEN 144 148 CALL trc_rst_stat ! statistics … … 184 188 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 185 189 ! 186 INTEGER :: jlibalt = jprstlib187 190 LOGICAL :: llok 188 191 REAL(wp) :: zrdttrc1, zkt, zndastp, zdayfrac, ksecs, ktime … … 199 202 200 203 IF( ln_rsttr ) THEN 201 CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr , kiolib = jlibalt)204 CALL iom_open( TRIM(cn_trcrst_indir)//'/'//cn_trcrst_in, numrtr ) 202 205 CALL iom_get ( numrtr, 'kt', zkt ) ! last time-step of previous run 203 206 … … 316 319 ! 317 320 DO jn = 1, jptra 318 ztraf = glob_sum( trn(:,:,:,jn) * zvol(:,:,:) )321 ztraf = glob_sum( 'trcrst', trn(:,:,:,jn) * zvol(:,:,:) ) 319 322 zmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 320 323 zmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 321 324 IF( lk_mpp ) THEN 322 CALL mpp_min( zmin ) ! min over the global domain323 CALL mpp_max( zmax ) ! max over the global domain325 CALL mpp_min( 'trcrst', zmin ) ! min over the global domain 326 CALL mpp_max( 'trcrst', zmax ) ! max over the global domain 324 327 END IF 325 328 zmean = ztraf / areatot -
NEMO/trunk/src/TOP/trcstp.F90
r10068 r10425 20 20 USE trdtrc_oce 21 21 USE trdmxl_trc 22 USE sms_pisces, ONLY : ln_check_mass 22 23 ! 23 24 USE prtctl_trc ! Print control for debbuging … … 73 74 cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 74 75 END DO 75 areatot = glob_sum( cvol(:,:,:) ) 76 IF ( ln_ctl .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) & 77 & .OR. iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) & 78 & .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) & 79 & areatot = glob_sum( 'trcstp', cvol(:,:,:) ) 76 80 ENDIF 77 81 ! … … 105 109 ENDIF 106 110 ! 107 ztrai = 0._wp ! content of all tracers 108 DO jn = 1, jptra 109 ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 110 END DO 111 IF( lwp ) WRITE(numstr,9300) kt, ztrai / areatot 111 IF (ln_ctl ) THEN 112 ztrai = 0._wp ! content of all tracers 113 DO jn = 1, jptra 114 ztrai = ztrai + glob_sum( 'trcstp', trn(:,:,:,jn) * cvol(:,:,:) ) 115 END DO 116 IF( lwm ) WRITE(numstr,9300) kt, ztrai / areatot 117 ENDIF 112 118 9300 FORMAT(i10,D23.16) 113 119 ! -
NEMO/trunk/src/TOP/trcsub.F90
r10068 r10425 308 308 309 309 ierr = trc_sub_alloc () 310 IF( lk_mpp ) CALL mpp_sum(ierr )310 CALL mpp_sum( 'trcsub', ierr ) 311 311 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' ) 312 312 … … 510 510 IF( ln_bdy ) THEN 511 511 ssha(:,:) = ssha(:,:) * bdytmask(:,:) 512 CALL lbc_lnk( ssha, 'T', 1. )512 CALL lbc_lnk( 'trcsub', ssha, 'T', 1. ) 513 513 ENDIF 514 514 ENDIF … … 535 535 !! *** ROUTINE trc_sub_alloc *** 536 536 !!------------------------------------------------------------------- 537 USE lib_mpp, ONLY: ctl_ warn537 USE lib_mpp, ONLY: ctl_stop 538 538 INTEGER :: ierr(3) 539 539 !!------------------------------------------------------------------- … … 577 577 trc_sub_alloc = MAXVAL( ierr ) 578 578 ! 579 IF( trc_sub_alloc /= 0 ) CALL ctl_ warn('trc_sub_alloc: failed to allocate arrays')579 IF( trc_sub_alloc /= 0 ) CALL ctl_stop( 'STOP', 'trc_sub_alloc: failed to allocate arrays' ) 580 580 ! 581 581 END FUNCTION trc_sub_alloc
Note: See TracChangeset
for help on using the changeset viewer.
