Changeset 2053 for branches/DEV_r2006_merge_TRA_TRC/NEMO
- Timestamp:
- 2010-08-13T11:32:52+02:00 (14 years ago)
- Location:
- branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC
- Files:
-
- 4 added
- 33 deleted
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/dtadyn.F90
r1735 r2053 16 16 USE phycst ! physical constants 17 17 USE sbc_oce 18 USE trabbl 18 19 USE ldfslp 19 USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine)20 USE ldfeiv ! eddy induced velocity coef. 20 21 USE ldftra_oce ! ocean tracer lateral physics 21 22 USE zdfmxl 22 USE trabbl23 23 USE eosbn2 24 24 USE zdfddm ! vertical physics: double diffusion … … 41 41 ndtadyn = 73 , & ! Number of dat in one year 42 42 ndtatot = 73 , & ! Number of data in the input field 43 nsptint = 1 , & ! type of spatial interpolation 44 nficdyn = 2 ! number of dynamical fields 43 nsptint = 1 ! type of spatial interpolation 45 44 46 45 CHARACTER(len=45) :: & … … 66 65 vdta , & ! meridional velocity at two consecutive times 67 66 wdta , & ! vertical velocity at two consecutive times 68 #if defined key_trc_diatrd69 hdivdta, & ! horizontal divergence70 #endif71 67 avtdta ! vertical diffusivity coefficient 72 68 … … 86 82 #endif 87 83 88 #if ! defined key_off_degrad && defined key_traldf_c2d 89 REAL(wp), DIMENSION(jpi,jpj,2) :: & 90 ahtwdta ! Lateral diffusivity 91 # if defined key_trcldf_eiv 84 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 92 85 REAL(wp), DIMENSION(jpi,jpj,2) :: & 93 86 aeiwdta ! G&M coefficient 94 # endif 95 #endif 96 97 #if defined key_off_degrad 87 #endif 88 89 #if defined key_degrad 98 90 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 99 91 ahtudta, ahtvdta, ahtwdta ! Lateral diffusivity 100 # if defined key_tr cldf_eiv92 # if defined key_traldf_eiv 101 93 REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: & 102 94 aeiudta, aeivdta, aeiwdta ! G&M coefficient 103 95 # endif 104 96 105 #endif106 107 #if defined key_trcbbl_dif || defined key_trcbbl_adv108 REAL(wp), DIMENSION(jpi,jpj,2) :: &109 bblxdta , & ! frequency of bbl in the x direction at 2 consecutive times110 bblydta ! frequency of bbl in the y direction at 2 consecutive times111 97 #endif 112 98 … … 147 133 INTEGER :: iper, iperm1, iswap, izt 148 134 149 REAL(wp) :: z pdtan, zpdtpe, zdemi, zt135 REAL(wp) :: zt 150 136 REAL(wp) :: zweigh 151 152 ! 0. Initialization 153 ! ----------------- 154 155 IF( lfirdyn ) THEN 156 ! first time step MUST BE nit000 157 IF( kt /= nit000 ) THEN 158 IF (lwp) THEN 159 WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt = ',kt ,' nit000 = ',nit000 160 STOP 'dtadyn' 161 ENDIF 162 ENDIF 163 ! Initialize the parameters of the interpolation 164 CALL dta_dyn_init 165 ENDIF 137 !!---------------------------------------------------------------------- 166 138 167 139 zt = ( FLOAT (kt) + rnspdta2 ) / rnspdta … … 211 183 ENDIF 212 184 213 #if defined key_ldfslp 214 ! Computes slopes215 ! Caution : here tn, sn and avt are used as workspace216 tn (:,:,:) = tdta (:,:,:,2)217 sn (:,:,:) = sdta (:,:,:,2)218 avt(:,:,:) = avtdta(:,:,:,2)185 IF( lk_ldfslp ) THEN 186 ! Computes slopes 187 ! Caution : here tn, sn and avt are used as workspace 188 tn (:,:,:) = tdta (:,:,:,2) 189 sn (:,:,:) = sdta (:,:,:,2) 190 avt(:,:,:) = avtdta(:,:,:,2) 219 191 220 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density221 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency222 IF( ln_zps ) &223 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative224 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level225 & gtv, gsv, grv )226 CALL zdf_mxl( kt ) ! mixed layer depth227 CALL ldf_slp( kt, rhd, rn2 )192 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density 193 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency 194 IF( ln_zps ) & 195 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative 196 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 197 & gtv, gsv, grv ) 198 CALL zdf_mxl( kt ) ! mixed layer depth 199 CALL ldf_slp( kt, rhd, rn2 ) 228 200 229 uslpdta (:,:,:,2) = uslp (:,:,:)230 vslpdta (:,:,:,2) = vslp (:,:,:)231 wslpidta(:,:,:,2) = wslpi(:,:,:)232 wslpjdta(:,:,:,2) = wslpj(:,:,:)233 #endif 201 uslpdta (:,:,:,2) = uslp (:,:,:) 202 vslpdta (:,:,:,2) = vslp (:,:,:) 203 wslpidta(:,:,:,2) = wslpi(:,:,:) 204 wslpjdta(:,:,:,2) = wslpj(:,:,:) 205 END IF 234 206 235 207 ! swap from record 2 to 1 … … 240 212 CALL dynrea( kt, iper ) ! data read for the iper period 241 213 242 #if defined key_ldfslp 243 ! Computes slopes244 ! Caution : here tn, sn and avt are used as workspace245 tn (:,:,:) = tdta (:,:,:,2)246 sn (:,:,:) = sdta (:,:,:,2)247 avt(:,:,:) = avtdta(:,:,:,2)248 249 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density250 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency251 IF( ln_zps ) &252 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative253 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level254 & gtv, gsv, grv )255 CALL zdf_mxl( kt ) ! mixed layer depth256 CALL ldf_slp( kt, rhd, rn2 )257 258 uslpdta (:,:,:,2) = uslp (:,:,:)259 vslpdta (:,:,:,2) = vslp (:,:,:)260 wslpidta(:,:,:,2) = wslpi(:,:,:)261 wslpjdta(:,:,:,2) = wslpj(:,:,:)262 #endif 214 IF( lk_ldfslp ) THEN 215 ! Computes slopes 216 ! Caution : here tn, sn and avt are used as workspace 217 tn (:,:,:) = tdta (:,:,:,2) 218 sn (:,:,:) = sdta (:,:,:,2) 219 avt(:,:,:) = avtdta(:,:,:,2) 220 221 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density 222 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency 223 IF( ln_zps ) & 224 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative 225 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 226 & gtv, gsv, grv ) 227 CALL zdf_mxl( kt ) ! mixed layer depth 228 CALL ldf_slp( kt, rhd, rn2 ) 229 230 uslpdta (:,:,:,2) = uslp (:,:,:) 231 vslpdta (:,:,:,2) = vslp (:,:,:) 232 wslpidta(:,:,:,2) = wslpi(:,:,:) 233 wslpjdta(:,:,:,2) = wslpj(:,:,:) 234 END IF 263 235 ! 264 236 lfirdyn=.FALSE. ! trace the first call … … 288 260 CALL dynrea( kt, iper ) ! data read for the iper period 289 261 290 #if defined key_ldfslp 291 ! Computes slopes292 ! Caution : here tn, sn and avt are used as workspace293 tn (:,:,:) = tdta (:,:,:,2)294 sn (:,:,:) = sdta (:,:,:,2)295 avt(:,:,:) = avtdta(:,:,:,2)296 297 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density298 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency299 IF( ln_zps ) &300 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative301 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level302 & gtv, gsv, grv )303 CALL zdf_mxl( kt ) ! mixed layer depth304 CALL ldf_slp( kt, rhd, rn2 )305 306 uslpdta (:,:,:,2) = uslp (:,:,:)307 vslpdta (:,:,:,2) = vslp (:,:,:)308 wslpidta(:,:,:,2) = wslpi(:,:,:)309 wslpjdta(:,:,:,2) = wslpj(:,:,:)310 #endif 262 IF( lk_ldfslp ) THEN 263 ! Computes slopes 264 ! Caution : here tn, sn and avt are used as workspace 265 tn (:,:,:) = tdta (:,:,:,2) 266 sn (:,:,:) = sdta (:,:,:,2) 267 avt(:,:,:) = avtdta(:,:,:,2) 268 269 CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density 270 CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency 271 IF( ln_zps ) & 272 & CALL zps_hde( kt, tn , sn , rhd, & ! Partial steps: before Horizontal DErivative 273 & gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 274 & gtv, gsv, grv ) 275 CALL zdf_mxl( kt ) ! mixed layer depth 276 CALL ldf_slp( kt, rhd, rn2 ) 277 278 uslpdta (:,:,:,2) = uslp (:,:,:) 279 vslpdta (:,:,:,2) = vslp (:,:,:) 280 wslpidta(:,:,:,2) = wslpi(:,:,:) 281 wslpjdta(:,:,:,2) = wslpj(:,:,:) 282 END IF 311 283 312 284 ! store the information of the period read … … 341 313 CALL eos( tn, sn, rhd, rhop ) 342 314 343 #if ! defined key_ off_degrad && defined key_traldf_c2d315 #if ! defined key_degrad && defined key_traldf_c2d 344 316 ! In case of 2D varying coefficients, we need aeiv and aeiu 345 IF( lk_traldf_eiv ) CALL ldf_eiv( kt ) ! eddy induced velocity coefficient 346 #endif 317 IF( lk_traldf_eiv ) CALL dta_eiv( kt ) ! eddy induced velocity coefficient 318 #endif 319 320 ! Compute bbl coefficients if needed 321 IF( lk_trabbl ) THEN 322 tb(:,:,:) = tn(:,:,:) 323 sb(:,:,:) = sn(:,:,:) 324 CALL bbl( kt, 'TRC') 325 END IF 347 326 348 327 END SUBROUTINE dta_dyn … … 377 356 zemp, zqsr, zmld, zice, zwspd, & 378 357 ztaux, ztauy 379 #if defined key_trcbbl_dif || defined key_trcbbl_adv 380 REAL(wp), DIMENSION(jpi,jpj) :: zbblx, zbbly 381 #endif 382 383 #if ! defined key_off_degrad && defined key_traldf_c2d 384 REAL(wp), DIMENSION(jpi,jpj) :: zahtw 385 # if defined key_trcldf_eiv 358 359 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 386 360 REAL(wp), DIMENSION(jpi,jpj) :: zaeiw 387 # endif 388 #endif 389 390 #if defined key_off_degrad 361 #endif 362 363 #if defined key_degrad 391 364 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 392 365 zahtu, zahtv, zahtw ! Lateral diffusivity 393 # if defined key_tr cldf_eiv366 # if defined key_traldf_eiv 394 367 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 395 368 zaeiu, zaeiv, zaeiw ! G&M coefficient … … 409 382 WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr 410 383 WRITE(numout,*) ' ~~~~~~~' 411 #if defined key_ off_degrad384 #if defined key_degrad 412 385 WRITE(numout,*) ' Degraded fields' 413 386 #endif … … 443 416 CALL iom_get( numfl_v, jpdom_data, 'vomecrty', zv (:,:,:), jkenr ) 444 417 445 #if defined key_trcbbl_dif || defined key_trcbbl_adv446 IF( iom_varid( numfl_u, 'sobblcox', ldstop = .FALSE. ) > 0 .AND. &447 & iom_varid( numfl_v, 'sobblcoy', ldstop = .FALSE. ) > 0 ) THEN448 CALL iom_get( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:), jkenr )449 CALL iom_get( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:), jkenr )450 ELSE451 CALL bbl_sign( zt, zs, zbblx, zbbly )452 ENDIF453 #endif454 455 418 ! file grid-W 456 419 !! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw (:,:,:), jkenr ) … … 464 427 #endif 465 428 466 #if ! defined key_off_degrad && defined key_traldf_c2d 467 CALL iom_get( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr ) 468 # if defined key_trcldf_eiv 429 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 469 430 CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr ) 470 # endif 471 #endif 472 473 #if defined key_off_degrad 431 #endif 432 433 #if defined key_degrad 474 434 CALL iom_get( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr ) 475 435 CALL iom_get( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr ) 476 436 CALL iom_get( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr ) 477 # if defined key_tr cldf_eiv437 # if defined key_traldf_eiv 478 438 CALL iom_get( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr ) 479 439 CALL iom_get( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr ) … … 486 446 wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 487 447 488 #if defined key_trc_diatrd489 hdivdta(:,:,:,2) = zhdiv(:,:,:) * tmask(:,:,:)490 #endif491 492 448 tdta(:,:,:,2) = zt (:,:,:) * tmask(:,:,:) 493 449 sdta(:,:,:,2) = zs (:,:,:) * tmask(:,:,:) 494 450 avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 495 451 496 #if ! defined key_off_degrad && defined key_traldf_c2d 497 ahtwdta(:,:,2) = zahtw(:,:) * tmask(:,:,1) 498 #if defined key_trcldf_eiv 452 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 499 453 aeiwdta(:,:,2) = zaeiw(:,:) * tmask(:,:,1) 500 454 #endif 501 #endif 502 503 #if defined key_off_degrad 455 456 #if defined key_degrad 504 457 ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:) 505 458 ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:) 506 459 ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:) 507 # if defined key_tr cldf_eiv460 # if defined key_traldf_eiv 508 461 aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:) 509 462 aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:) … … 520 473 hmlddta(:,:,2) = zmld(:,:) * tmask(:,:,1) 521 474 522 #if defined key_trcbbl_dif || defined key_trcbbl_adv523 bblxdta(:,:,2) = MAX( 0., zbblx(:,:) )524 bblydta(:,:,2) = MAX( 0., zbbly(:,:) )525 526 WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0.527 WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0.528 #endif529 530 475 IF( kt == nitend ) THEN 531 476 CALL iom_close ( numfl_t ) … … 557 502 REAL(wp) :: znspyr !: number of time step per year 558 503 559 NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, nficdyn,lperdyn, &504 NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn, & 560 505 & cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 561 506 !!---------------------------------------------------------------------- … … 577 522 WRITE(numout,*) ' total number of elements in the FILE ndtatot = ' , ndtatot 578 523 WRITE(numout,*) ' type of interpolation nsptint = ' , nsptint 579 WRITE(numout,*) ' number of dynamics FILE nficdyn = ' , nficdyn580 524 WRITE(numout,*) ' loop on the same FILE lperdyn = ' , lperdyn 581 525 WRITE(numout,*) ' ' … … 590 534 rnspdta = znspyr / FLOAT( ndtadyn ) 591 535 rnspdta2 = rnspdta * 0.5 536 537 CALL dta_dyn( nit000 ) 592 538 593 539 END SUBROUTINE dta_dyn_init … … 658 604 659 605 END SUBROUTINE wzv 606 607 SUBROUTINE dta_eiv( kt ) 608 !!---------------------------------------------------------------------- 609 !! *** ROUTINE dta_eiv *** 610 !! 611 !! ** Purpose : Compute the eddy induced velocity coefficient from the 612 !! growth rate of baroclinic instability. 613 !! 614 !! ** Method : Specific to the offline model. Computes the horizontal 615 !! values from the vertical value 616 !! 617 !! History : 618 !! 9.0 ! 06-03 (O. Aumont) Free form, F90 619 !!---------------------------------------------------------------------- 620 !! * Arguments 621 INTEGER, INTENT( in ) :: kt ! ocean time-step inedx 622 623 !! * Local declarations 624 INTEGER :: ji, jj ! dummy loop indices 625 !!---------------------------------------------------------------------- 626 627 IF( kt == nit000 ) THEN 628 IF(lwp) WRITE(numout,*) 629 IF(lwp) WRITE(numout,*) 'dta_eiv : eddy induced velocity coefficients' 630 IF(lwp) WRITE(numout,*) '~~~~~~~' 631 ENDIF 632 633 ! Average the diffusive coefficient at u- v- points 634 DO jj = 2, jpjm1 635 DO ji = fs_2, fs_jpim1 ! vector opt. 636 aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) 637 aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) 638 END DO 639 END DO 640 641 ! lateral boundary condition on aeiu, aeiv 642 CALL lbc_lnk( aeiu, 'U', 1. ) 643 CALL lbc_lnk( aeiv, 'V', 1. ) 644 645 END SUBROUTINE dta_eiv 660 646 661 647 SUBROUTINE tau2wnd( ptaux, ptauy, pwspd ) … … 692 678 END SUBROUTINE tau2wnd 693 679 694 #if defined key_trcbbl_dif || defined key_trcbbl_adv695 696 SUBROUTINE bbl_sign( ptn, psn, pbblx, pbbly )697 !!----------------------------------------------------------------------698 !! *** ROUTINE bbl_sign ***699 !!700 !! ** Purpose : Compute the sign of local gradient of density multiplied by the slope701 !! along the bottom slope gradient : grad( rho) * grad(h)702 !! Need to compute the diffusive bottom boundary layer703 !!704 !! ** Method : When the product grad( rho) * grad(h) < 0 (where grad705 !! is an along bottom slope gradient) an additional lateral diffu-706 !! sive trend along the bottom slope is added to the general tracer707 !! trend, otherwise nothing is done. See trcbbl.F90708 !!709 !!710 !! History :711 !! 9.0 ! 02-07 (G. Madec) Vector optimization712 !!----------------------------------------------------------------------713 !! * Arguments714 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) :: &715 ptn , & !: temperature716 psn !: salinity717 REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) :: &718 pbblx , pbbly !: sign of bbl in i-j direction resp.719 720 !! * Local declarations721 INTEGER :: ji, jj ! dummy loop indices722 INTEGER :: ik723 REAL(wp) :: &724 ztx, zsx, zhx, zalbetx, zgdrhox, & ! temporary scalars725 zty, zsy, zhy, zalbety, zgdrhoy726 REAL(wp), DIMENSION(jpi,jpj) :: &727 ztnb, zsnb, zdep728 REAL(wp) :: fsalbt, pft, pfs, pfh ! statement function729 !!----------------------------------------------------------------------730 ! ratio alpha/beta731 ! ================732 ! fsalbt: ratio of thermal over saline expension coefficients733 ! pft : potential temperature in degrees celcius734 ! pfs : salinity anomaly (s-35) in psu735 ! pfh : depth in meters736 737 fsalbt( pft, pfs, pfh ) = &738 ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft &739 - 0.203814e-03 ) * pft &740 + 0.170907e-01 ) * pft &741 + 0.665157e-01 &742 +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs &743 + ( ( - 0.302285e-13 * pfh &744 - 0.251520e-11 * pfs &745 + 0.512857e-12 * pft * pft ) * pfh &746 - 0.164759e-06 * pfs &747 +( 0.791325e-08 * pft - 0.933746e-06 ) * pft &748 + 0.380374e-04 ) * pfh749 750 ! 0. 2D fields of bottom temperature and salinity, and bottom slope751 ! -----------------------------------------------------------------752 ! mbathy= number of w-level, minimum value=1 (cf domrea.F90)753 # if defined key_vectopt_loop754 jj = 1755 DO ji = 1, jpij ! vector opt. (forced unrolling)756 # else757 DO jj = 1, jpj758 DO ji = 1, jpi759 # endif760 ik = MAX( mbathy(ji,jj) - 1, 1 ) ! vertical index of the bottom ocean T-level761 ztnb(ji,jj) = ptn(ji,jj,ik) * tmask(ji,jj,1) ! masked T and S at ocean bottom762 zsnb(ji,jj) = psn(ji,jj,ik) * tmask(ji,jj,1)763 zdep(ji,jj) = fsdept(ji,jj,ik) ! depth of the ocean bottom T-level764 # if ! defined key_vectopt_loop765 END DO766 # endif767 END DO768 769 !!----------------------------------------------------------------------770 ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0771 ! --------------------------------------------772 ! Sign of the local density gradient along the i- and j-slopes773 ! multiplied by the slope of the ocean bottom774 775 SELECT CASE ( neos )776 777 CASE ( 0 ) ! Jackett and McDougall (1994) formulation778 779 # if defined key_vectopt_loop780 jj = 1781 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)782 # else783 DO jj = 1, jpjm1784 DO ji = 1, jpim1785 # endif786 ! temperature, salinity anomalie and depth787 ztx = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) )788 zsx = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0789 zhx = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) )790 !791 zty = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) )792 zsy = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0793 zhy = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) )794 ! masked ratio alpha/beta795 zalbetx = fsalbt( ztx, zsx, zhx ) * umask(ji,jj,1)796 zalbety = fsalbt( zty, zsy, zhy ) * vmask(ji,jj,1)797 ! local density gradient along i-bathymetric slope798 zgdrhox = zalbetx * ( ztnb(ji+1,jj) - ztnb(ji,jj) ) &799 - ( zsnb(ji+1,jj) - zsnb(ji,jj) )800 ! local density gradient along j-bathymetric slope801 zgdrhoy = zalbety * ( ztnb(ji,jj+1) - ztnb(ji,jj) ) &802 - ( zsnb(ji,jj+1) - zsnb(ji,jj) )803 ! sign of local i-gradient of density multiplied by the i-slope804 pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) )805 ! sign of local j-gradient of density multiplied by the j-slope806 pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) )807 # if ! defined key_vectopt_loop808 END DO809 # endif810 END DO811 812 CASE ( 1 ) ! Linear formulation function of temperature only813 !814 # if defined key_vectopt_loop815 jj = 1816 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)817 # else818 DO jj = 1, jpjm1819 DO ji = 1, jpim1820 # endif821 ! local 'density/temperature' gradient along i-bathymetric slope822 zgdrhox = ztnb(ji+1,jj) - ztnb(ji,jj)823 ! local density gradient along j-bathymetric slope824 zgdrhoy = ztnb(ji,jj+1) - ztnb(ji,jj)825 ! sign of local i-gradient of density multiplied by the i-slope826 pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) )827 ! sign of local j-gradient of density multiplied by the j-slope828 pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) )829 # if ! defined key_vectopt_loop830 END DO831 # endif832 END DO833 834 CASE ( 2 ) ! Linear formulation function of temperature and salinity835 836 # if defined key_vectopt_loop837 jj = 1838 DO ji = 1, jpij-jpi ! vector opt. (forced unrolling)839 # else840 DO jj = 1, jpjm1841 DO ji = 1, jpim1842 # endif843 ! local density gradient along i-bathymetric slope844 zgdrhox = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) ) &845 - ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) )846 ! local density gradient along j-bathymetric slope847 zgdrhoy = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) ) &848 - ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) )849 ! sign of local i-gradient of density multiplied by the i-slope850 pbblx(ji,jj) = 0.5 - SIGN( 0.5, - zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) )851 ! sign of local j-gradient of density multiplied by the j-slope852 pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) )853 # if ! defined key_vectopt_loop854 END DO855 # endif856 END DO857 858 CASE DEFAULT859 860 WRITE(ctmp1,*) ' bad flag value for neos = ', neos861 CALL ctl_stop(ctmp1)862 863 END SELECT864 865 ! Lateral boundary conditions866 CALL lbc_lnk( pbblx, 'U', 1. )867 CALL lbc_lnk( pbbly, 'V', 1. )868 869 END SUBROUTINE bbl_sign870 871 #endif872 873 680 SUBROUTINE swap_dyn_data 874 681 !!---------------------------------------------------------------------- … … 889 696 vdta (:,:,:,1) = vdta (:,:,:,2) 890 697 wdta (:,:,:,1) = wdta (:,:,:,2) 891 #if defined key_trc_diatrd892 hdivdta(:,:,:,1) = hdivdta(:,:,:,2)893 #endif894 698 895 699 #if defined key_ldfslp … … 905 709 qsrdta (:,:,1) = qsrdta (:,:,2) 906 710 907 #if ! defined key_off_degrad && defined key_traldf_c2d 908 ahtwdta(:,:,1) = ahtwdta(:,:,2) 909 # if defined key_trcldf_eiv 711 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 910 712 aeiwdta(:,:,1) = aeiwdta(:,:,2) 911 # endif 912 #endif 913 914 #if defined key_off_degrad 713 #endif 714 715 #if defined key_degrad 915 716 ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 916 717 ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 917 718 ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 918 # if defined key_tr cldf_eiv719 # if defined key_traldf_eiv 919 720 aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 920 721 aeivdta(:,:,:,1) = aeivdta(:,:,:,2) … … 923 724 #endif 924 725 925 #if defined key_trcbbl_dif || defined key_trcbbl_adv926 bblxdta(:,:,1) = bblxdta(:,:,2)927 bblydta(:,:,1) = bblydta(:,:,2)928 #endif929 930 726 END SUBROUTINE swap_dyn_data 931 727 … … 946 742 vn (:,:,:) = vdta (:,:,:,2) 947 743 wn (:,:,:) = wdta (:,:,:,2) 948 949 #if defined key_trc_diatrd950 hdivn(:,:,:) = hdivdta(:,:,:,2)951 #endif952 744 953 745 #if defined key_zdfddm … … 970 762 qsr (:,:) = qsrdta (:,:,2) 971 763 972 #if ! defined key_off_degrad && defined key_traldf_c2d 973 ahtw(:,:) = ahtwdta(:,:,2) 974 # if defined key_trcldf_eiv 764 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 975 765 aeiw(:,:) = aeiwdta(:,:,2) 976 # endif 977 #endif 978 979 #if defined key_off_degrad 766 #endif 767 768 #if defined key_degrad 980 769 ahtu(:,:,:) = ahtudta(:,:,:,2) 981 770 ahtv(:,:,:) = ahtvdta(:,:,:,2) 982 771 ahtw(:,:,:) = ahtwdta(:,:,:,2) 983 # if defined key_tr cldf_eiv772 # if defined key_traldf_eiv 984 773 aeiu(:,:,:) = aeiudta(:,:,:,2) 985 774 aeiv(:,:,:) = aeivdta(:,:,:,2) … … 989 778 #endif 990 779 991 #if defined key_trcbbl_dif || defined key_trcbbl_adv992 bblx(:,:) = bblxdta(:,:,2)993 bbly(:,:) = bblydta(:,:,2)994 #endif995 996 780 END SUBROUTINE assign_dyn_data 997 781 … … 1019 803 vn (:,:,:) = zweighm1 * vdta (:,:,:,1) + pweigh * vdta (:,:,:,2) 1020 804 wn (:,:,:) = zweighm1 * wdta (:,:,:,1) + pweigh * wdta (:,:,:,2) 1021 1022 #if defined key_trc_diatrd1023 hdivn(:,:,:) = zweighm1 * hdivdta(:,:,:,1) + pweigh * hdivdta(:,:,:,2)1024 #endif1025 805 1026 806 #if defined key_zdfddm … … 1043 823 qsr (:,:) = zweighm1 * qsrdta (:,:,1) + pweigh * qsrdta (:,:,2) 1044 824 1045 #if ! defined key_off_degrad && defined key_traldf_c2d 1046 ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + pweigh * ahtwdta(:,:,2) 1047 # if defined key_trcldf_eiv 825 #if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 1048 826 aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + pweigh * aeiwdta(:,:,2) 1049 # endif 1050 #endif 1051 1052 #if defined key_off_degrad 827 #endif 828 829 #if defined key_degrad 1053 830 ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + pweigh * ahtudta(:,:,:,2) 1054 831 ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + pweigh * ahtvdta(:,:,:,2) 1055 832 ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + pweigh * ahtwdta(:,:,:,2) 1056 # if defined key_tr cldf_eiv833 # if defined key_traldf_eiv 1057 834 aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + pweigh * aeiudta(:,:,:,2) 1058 835 aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + pweigh * aeivdta(:,:,:,2) … … 1061 838 #endif 1062 839 1063 #if defined key_trcbbl_dif || defined key_trcbbl_adv1064 bblx(:,:) = zweighm1 * bblxdta(:,:,1) + pweigh * bblxdta(:,:,2)1065 bbly(:,:) = zweighm1 * bblydta(:,:,1) + pweigh * bblydta(:,:,2)1066 #endif1067 1068 840 END SUBROUTINE linear_interp_dyn_data 1069 841 -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/opa.F90
r1749 r2053 21 21 22 22 ! ocean physics 23 USE ldftra ! lateral diffusivity setting (ldftra_init routine) 24 USE traqsr ! solar radiation penetration (tra_qsr_init routine) 23 USE ldftra ! lateral diffusivity setting (ldf_tra_init routine) 24 USE ldfslp ! slopes of neutral surfaces (ldf_slp_init routine) 25 USE traqsr ! solar radiation penetration (tra_qsr_init routine) 26 USE trabbl ! bottom boundary layer (tra_bbl_init routine) 27 USE zpshde ! partial step: hor. derivative (zps_hde_init routine) 28 USE zdfini 29 USE zdfddm 30 USE zdfkpp 25 31 26 32 USE phycst ! physical constant (par_cst routine) 27 33 USE dtadyn ! Lecture and Interpolation of the dynamical fields 28 34 USE trcini ! Initilization of the passive tracers 29 USE step ! OPA time-stepping (stp routine) 35 USE stpctl 36 USE daymod ! calendar (day routine) 37 USE trcstp ! passive tracer time-stepping (trc_stp routine) 38 USE dtadyn ! Lecture and interpolation of the dynamical fields 39 USE stpctl ! time stepping control (stp_ctl routine) 30 40 31 41 USE iom … … 66 76 !! internal report, IPSL. 67 77 !!---------------------------------------------------------------------- 68 INTEGER :: istp! time step index78 INTEGER :: istp, indic ! time step index 69 79 !!---------------------------------------------------------------------- 70 80 … … 80 90 ! 81 91 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 82 CALL stp( istp ) 92 ! 93 IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init) 94 CALL iom_setkt( istp ) ! say to iom that we are at time step kstp 95 CALL dta_dyn ( istp ) ! Interpolation of the dynamical fields 96 CALL trc_stp ( istp ) ! time-stepping 97 CALL stp_ctl ( istp, indic ) ! Time loop: control and print 83 98 istp = istp + 1 84 99 IF( lk_mpp ) CALL mpp_max( nstop ) … … 134 149 !!---------------------------------------------------------------------- 135 150 !! * Local declarations 151 #if defined key_oasis3 || defined key_oasis4 || defined key_iomput 152 INTEGER :: ilocal_comm 153 #endif 154 CHARACTER(len=80),dimension(10) :: cltxt = '' 155 INTEGER :: ji ! local loop indices 156 !! 157 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 158 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 159 !!---------------------------------------------------------------------- 160 161 ! 162 ! ! open Namelist file 163 CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 164 ! 165 READ( numnam, namctl ) ! Namelist namctl : Control prints & Benchmark 166 ! 167 ! !--------------------------------------------! 168 ! ! set communicator & select the local node ! 169 ! !--------------------------------------------! 136 170 #if defined key_iomput 137 INTEGER :: localComm 171 # if defined key_oasis3 || defined key_oasis4 172 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 173 CALL init_ioclient() ! io_server will get its communicators (if needed) from oasis (we don't see it) 174 # else 175 CALL init_ioclient( ilocal_comm ) ! nemo local communicator (used or not) given by the io_server 176 # endif 177 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection 178 179 #else 180 # if defined key_oasis3 || defined key_oasis4 181 CALL cpl_prism_init( ilocal_comm ) ! nemo local communicator given by oasis 182 narea = mynode( cltxt, ilocal_comm ) ! Nodes selection (control print return in cltxt) 183 # else 184 narea = mynode( cltxt ) ! Nodes selection (control print return in cltxt) 185 # endif 138 186 #endif 139 CHARACTER (len=20) :: namelistname 140 CHARACTER (len=28) :: file_out 141 NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & 142 & isplt , jsplt , njctls, njctle, nbench 143 144 !!---------------------------------------------------------------------- 145 146 ! Initializations 147 ! =============== 148 149 file_out = 'ocean.output' 150 151 ! open listing and namelist units 152 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & 153 & 'SEQUENTIAL', 1, 6, .FALSE., 1 ) 154 155 namelistname = 'namelist' 156 CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL', & 157 & 1, numout, .FALSE., 1 ) 158 159 WRITE(numout,*) 160 WRITE(numout,*) ' L O D Y C - I P S L' 161 WRITE(numout,*) ' O P A model' 162 WRITE(numout,*) ' Ocean General Circulation Model' 163 WRITE(numout,*) ' version OPA 9.0 (2005) ' 164 WRITE(numout,*) 165 WRITE(numout,*) 166 167 ! Namelist namctl : Control prints & Benchmark 168 REWIND( numnam ) 169 READ ( numnam, namctl ) 170 171 #if defined key_iomput 172 CALL init_ioclient(localcomm) 173 narea = mynode(localComm) 174 #else 175 ! Nodes selection 176 narea = mynode() 177 #endif 178 179 ! Nodes selection 180 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 181 lwp = narea == 1 182 183 ! open additionnal listing 184 IF( ln_ctl ) THEN 185 IF( narea-1 > 0 ) THEN 186 WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1 187 CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED', & 188 & 'SEQUENTIAL', 1, numout, .FALSE., 1 ) 189 lwp = .TRUE. 190 ! 191 WRITE(numout,*) 192 WRITE(numout,*) ' L O D Y C - I P S L' 193 WRITE(numout,*) ' O P A model' 194 WRITE(numout,*) ' Ocean General Circulation Model' 195 WRITE(numout,*) ' version OPA 9.0 (2005) ' 196 WRITE(numout,*) ' MPI Ocean output ' 197 WRITE(numout,*) 198 WRITE(numout,*) 199 ENDIF 187 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) 188 189 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 190 191 IF(lwp) THEN ! open listing units 192 ! 193 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 194 ! 195 WRITE(numout,*) 196 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean' 197 WRITE(numout,*) ' NEMO team' 198 WRITE(numout,*) ' Ocean General Circulation Model' 199 WRITE(numout,*) ' version 3.2 (2009) ' 200 WRITE(numout,*) 201 WRITE(numout,*) 202 DO ji = 1, SIZE(cltxt) 203 IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 204 END DO 205 WRITE(numout,cform_aaa) ! Flag AAAAAAA 206 ! 200 207 ENDIF 201 208 … … 209 216 210 217 ! Domain decomposition 211 IF( jpni * jpnj == jpnij ) THEN 212 CALL mpp_init ! standard cutting out 213 ELSE 214 CALL mpp_init2 ! eliminate land processors 215 ENDIF 216 217 CALL phy_cst ! Physical constants 218 CALL eos_init ! Equation of state 219 CALL dom_cfg ! Domain configuration 220 CALL dom_init ! Domain 221 CALL istate_init ! ocean initial state (Dynamics and tracers) 222 CALL trc_ini ! Passive tracers 223 CALL dta_dyn( nit000 ) ! Initialization for the dynamics 224 CALL tra_qsr_init ! Solar radiation penetration 225 #if ! defined key_off_degrad 226 CALL ldf_tra_init ! Lateral ocean tracer physics 227 #endif 228 CALL iom_init ! iom_put initialization 218 ! Domain decomposition 219 IF( jpni*jpnj == jpnij ) THEN ; CALL mpp_init ! standard cutting out 220 ELSE ; CALL mpp_init2 ! eliminate land processors 221 ENDIF 222 223 224 225 CALL phy_cst ! Physical constants 226 CALL eos_init ! Equation of state 227 CALL dom_cfg ! Domain configuration 228 CALL dom_init ! Domain 229 230 IF( ln_zps ) CALL zps_hde_init ! Partial steps: horizontal derivative 231 CALL istate_init ! ocean initial state (Dynamics and tracers) 232 233 ! ! Ocean physics 234 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 235 & CALL zdf_ddm_init ! double diffusive mixing 236 ! ! Lateral physics 237 #if ! defined key_degrad 238 CALL ldf_tra_init ! Lateral ocean tracer physics 239 #endif 240 IF( lk_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 241 ! ! Active tracers 242 CALL tra_qsr_init ! penetrative solar radiation qsr 243 IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme 244 245 CALL trc_ini ! Passive tracers 246 CALL dta_dyn_init ! Initialization for the dynamics 247 CALL iom_init ! iom_put initialization 229 248 230 249 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 236 255 !! *** ROUTINE opa *** 237 256 !! 238 !! ** Purpose : Initialize logical flags that control the choice of 239 !! some algorithm or control print 240 !! 241 !! ** Method : Read in namilist namflg logical flags 242 !! 243 !! History : 244 !! 9.0 ! 03-11 (G. Madec) Original code 245 !!---------------------------------------------------------------------- 246 !! * Local declarations 247 248 ! Parameter control and print 249 ! --------------------------- 250 IF(lwp) THEN 257 !! ** Purpose : Initialise logical flags that control the choice of 258 !! some algorithm or control print 259 !! 260 !! ** Method : - print namctl information 261 !! - Read in namilist namflg logical flags 262 !!---------------------------------------------------------------------- 263 264 IF(lwp) THEN ! Parameter print 251 265 WRITE(numout,*) 252 266 WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 253 267 WRITE(numout,*) '~~~~~~~ ' 254 WRITE(numout,*) ' Namelist namctl' 255 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl 256 WRITE(numout,*) ' level of print nprint = ', nprint 257 WRITE(numout,*) ' Start i indice for SUM control nictls = ', nictls 258 WRITE(numout,*) ' End i indice for SUM control nictle = ', nictle 259 WRITE(numout,*) ' Start j indice for SUM control njctls = ', njctls 260 WRITE(numout,*) ' End j indice for SUM control njctle = ', njctle 261 WRITE(numout,*) ' number of proc. following i isplt = ', isplt 262 WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt 263 WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench 264 ENDIF 265 266 ! ... Control the sub-domain area indices for the control prints 267 IF( ln_ctl ) THEN 268 IF( lk_mpp ) THEN 269 ! the domain is forced to the real splitted domain in MPI 270 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 268 WRITE(numout,*) ' Namelist namctl' 269 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl 270 WRITE(numout,*) ' level of print nn_print = ', nn_print 271 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls 272 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle 273 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls 274 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle 275 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt 276 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt 277 WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench 278 ENDIF 279 280 nprint = nn_print ! convert DOCTOR namelist names into OLD names 281 nictls = nn_ictls 282 nictle = nn_ictle 283 njctls = nn_jctls 284 njctle = nn_jctle 285 isplt = nn_isplt 286 jsplt = nn_jsplt 287 nbench = nn_bench 288 ! ! Parameter control 289 ! 290 IF( ln_ctl ) THEN ! sub-domain area indices for the control prints 291 IF( lk_mpp ) THEN 292 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real splitted domain 271 293 ELSE 272 294 IF( isplt == 1 .AND. jsplt == 1 ) THEN 273 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 274 & ' - the print control will be done over the whole domain' ) 275 ENDIF 276 277 ! compute the total number of processors ijsplt 278 ijsplt = isplt*jsplt 295 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 296 & ' - the print control will be done over the whole domain' ) 297 ENDIF 298 ijsplt = isplt * jsplt ! total number of processors ijsplt 279 299 ENDIF 280 281 300 IF(lwp) WRITE(numout,*)' - The total number of processors over which the' 282 301 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt 283 284 ! Control the indices used for the SUM control 285 IF( nictls+nictle+njctls+njctle == 0 ) THEN 286 ! the print control is done over the default area 302 ! 303 ! ! indices used for the SUM control 304 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area 287 305 lsp_area = .FALSE. 288 ELSE 289 ! the print control is done over a specific area 306 ELSE ! print control done over a specific area 290 307 lsp_area = .TRUE. 291 308 IF( nictls < 1 .OR. nictls > jpiglo ) THEN … … 293 310 nictls = 1 294 311 ENDIF 295 296 312 IF( nictle < 1 .OR. nictle > jpiglo ) THEN 297 313 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 298 314 nictle = jpiglo 299 315 ENDIF 300 301 316 IF( njctls < 1 .OR. njctls > jpjglo ) THEN 302 317 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 303 318 njctls = 1 304 319 ENDIF 305 306 320 IF( njctle < 1 .OR. njctle > jpjglo ) THEN 307 321 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 308 322 njctle = jpjglo 309 323 ENDIF 310 311 ENDIF ! IF( nictls+nictle+njctls+njctle == 0 ) 312 ENDIF ! IF(ln_ctl) 313 314 IF( nbench == 1 ) THEN 324 ENDIF 325 ENDIF 326 327 IF( nbench == 1 ) THEN ! Benchmark 315 328 SELECT CASE ( cp_cfg ) 316 CASE ( 'gyre' ) 317 CALL ctl_warn( ' The Benchmark is activated ' ) 318 CASE DEFAULT 319 CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must & 320 & be used or set nbench = 0' ) 329 CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' ) 330 CASE DEFAULT ; CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:', & 331 & ' key_gyre must be used or set nbench = 0' ) 321 332 END SELECT 322 333 ENDIF -
branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/stpctl.F90
r1152 r2053 1 1 MODULE stpctl 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE stpctl *** 4 4 !! Ocean run control : gross check of the ocean time stepping 5 !!============================================================================== 5 !!====================================================================== 6 !! History : OPA ! 1991-03 (G. Madec) Original code 7 !! 6.0 ! 1992-06 (M. Imbard) 8 !! 8.0 ! 1997-06 (A.M. Treguier) 9 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 10 !! 2.0 ! 2009-07 (G. Madec) Add statistic for time-spliting 11 !!---------------------------------------------------------------------- 6 12 7 13 !!---------------------------------------------------------------------- 8 14 !! stp_ctl : Control the run 9 15 !!---------------------------------------------------------------------- 10 !! * Modules used11 16 USE oce ! ocean dynamics and tracers variables 12 17 USE dom_oce ! ocean space and time domain variables … … 18 23 PRIVATE 19 24 20 !! * Accessibility21 25 PUBLIC stp_ctl ! routine called by step.F90 26 !!---------------------------------------------------------------------- 27 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 28 !! $Id$ 29 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 22 30 !!---------------------------------------------------------------------- 23 31 24 32 CONTAINS 25 33 26 SUBROUTINE stp_ctl( kt )34 SUBROUTINE stp_ctl( kt, kindic ) 27 35 !!---------------------------------------------------------------------- 28 36 !! *** ROUTINE stp_ctl *** … … 32 40 !! ** Method : - Save the time step in numstp 33 41 !! - Print it each 50 time steps 34 !! - Print solver statistics in numsol35 !! - Stop the run IF problem for the solver ( indec < 0 )36 42 !! 37 !! History : 38 !! ! 91-03 () 39 !! ! 91-11 (G. Madec) 40 !! ! 92-06 (M. Imbard) 41 !! ! 97-06 (A.M. Treguier) 42 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module 43 !! ** Actions : 'time.step' file containing the last ocean time-step 44 !! 43 45 !!---------------------------------------------------------------------- 44 !! * Arguments45 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 46 47 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (2005) 49 !! $Id$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 47 INTEGER, INTENT( inout ) :: kindic ! indicator of solver convergence 51 48 !!---------------------------------------------------------------------- 52 49 … … 56 53 WRITE(numout,*) '~~~~~~~' 57 54 ! open time.step file 58 CALL ctl opn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1)55 CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 59 56 ENDIF 60 57 61 ! save the current time step in numstp 62 ! ------------------------------------ 63 IF(lwp) WRITE(numstp,9100) kt 64 IF(lwp) REWIND(numstp) 65 9100 FORMAT(1x, i8) 58 IF(lwp) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp 59 IF(lwp) REWIND( numstp ) ! -------------------------- 66 60 67 61 ! 68 62 END SUBROUTINE stp_ctl 69 63
Note: See TracChangeset
for help on using the changeset viewer.