Changeset 9213 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2018-01-12T10:38:50+01:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 edited
-
ASM/asminc.F90 (modified) (14 diffs)
-
nemogcm.F90 (modified) (20 diffs)
-
step_oce.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r9168 r9213 74 74 REAL(wp), PUBLIC, DIMENSION(:) , ALLOCATABLE :: wgtiau !: IAU weights for each time step 75 75 #if defined key_asminc 76 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: ssh_iau!: IAU-weighted sea surface height increment76 REAL(wp), PUBLIC, DIMENSION(:,:) , ALLOCATABLE :: ssh_iau !: IAU-weighted sea surface height increment 77 77 #endif 78 78 ! !!! time steps relative to the cycle interval [0,nitend-nit000-1] … … 254 254 !-------------------------------------------------------------------- 255 255 256 IF 257 256 IF( ln_asmiau ) THEN 257 ! 258 258 ALLOCATE( wgtiau( icycper ) ) 259 259 ! 260 260 wgtiau(:) = 0._wp 261 262 IF ( niaufn == 0 ) THEN 263 264 !--------------------------------------------------------- 265 ! Constant IAU forcing 266 !--------------------------------------------------------- 267 261 ! 262 ! !--------------------------------------------------------- 263 IF( niaufn == 0 ) THEN ! Constant IAU forcing 264 ! !--------------------------------------------------------- 268 265 DO jt = 1, iiauper 269 266 wgtiau(jt+nitiaustr-1) = 1.0 / REAL( iiauper ) 270 267 END DO 271 272 ELSEIF ( niaufn == 1 ) THEN 273 274 !--------------------------------------------------------- 275 ! Linear hat-like, centred in middle of IAU interval 276 !--------------------------------------------------------- 277 268 ! !--------------------------------------------------------- 269 ELSEIF ( niaufn == 1 ) THEN ! Linear hat-like, centred in middle of IAU interval 270 ! !--------------------------------------------------------- 278 271 ! Compute the normalization factor 279 znorm = 0. 0280 IF ( MOD( iiauper, 2 ) == 0 ) THEN! Even number of time steps in IAU interval272 znorm = 0._wp 273 IF( MOD( iiauper, 2 ) == 0 ) THEN ! Even number of time steps in IAU interval 281 274 imid = iiauper / 2 282 275 DO jt = 1, imid … … 284 277 END DO 285 278 znorm = 2.0 * znorm 286 ELSE ! Odd number of time steps in IAU interval279 ELSE ! Odd number of time steps in IAU interval 287 280 imid = ( iiauper + 1 ) / 2 288 281 DO jt = 1, imid - 1 … … 292 285 ENDIF 293 286 znorm = 1.0 / znorm 294 287 ! 295 288 DO jt = 1, imid - 1 296 289 wgtiau(jt+nitiaustr-1) = REAL( jt ) * znorm … … 299 292 wgtiau(jt+nitiaustr-1) = REAL( iiauper - jt + 1 ) * znorm 300 293 END DO 301 294 ! 302 295 ENDIF 303 296 … … 325 318 !-------------------------------------------------------------------- 326 319 327 ALLOCATE( t_bkginc(jpi,jpj,jpk) ) 328 ALLOCATE( s_bkginc(jpi,jpj,jpk) ) 329 ALLOCATE( u_bkginc(jpi,jpj,jpk) ) 330 ALLOCATE( v_bkginc(jpi,jpj,jpk) ) 331 ALLOCATE( ssh_bkginc(jpi,jpj) ) 332 ALLOCATE( seaice_bkginc(jpi,jpj)) 333 t_bkginc (:,:,:) = 0._wp 334 s_bkginc (:,:,:) = 0._wp 335 u_bkginc (:,:,:) = 0._wp 336 v_bkginc (:,:,:) = 0._wp 337 ssh_bkginc (:,:) = 0._wp 338 seaice_bkginc(:,:) = 0._wp 320 ALLOCATE( t_bkginc (jpi,jpj,jpk) ) ; t_bkginc (:,:,:) = 0._wp 321 ALLOCATE( s_bkginc (jpi,jpj,jpk) ) ; s_bkginc (:,:,:) = 0._wp 322 ALLOCATE( u_bkginc (jpi,jpj,jpk) ) ; u_bkginc (:,:,:) = 0._wp 323 ALLOCATE( v_bkginc (jpi,jpj,jpk) ) ; v_bkginc (:,:,:) = 0._wp 324 ALLOCATE( ssh_bkginc (jpi,jpj) ) ; ssh_bkginc (:,:) = 0._wp 325 ALLOCATE( seaice_bkginc(jpi,jpj) ) ; seaice_bkginc(:,:) = 0._wp 339 326 #if defined key_asminc 340 ALLOCATE( ssh_iau(jpi,jpj) ) 341 ssh_iau (:,:) = 0._wp 327 ALLOCATE( ssh_iau (jpi,jpj) ) ; ssh_iau (:,:) = 0._wp 342 328 #endif 343 329 #if defined key_cice && defined key_asminc 344 ALLOCATE( ndaice_da(jpi,jpj) ) 345 ndaice_da (:,:) = 0._wp 346 #endif 347 IF ( ( ln_trainc ).OR.( ln_dyninc ).OR.( ln_sshinc ).OR.( ln_seaiceinc ) ) THEN 348 349 !-------------------------------------------------------------------- 350 ! Read the increments from file 351 !-------------------------------------------------------------------- 352 330 ALLOCATE( ndaice_da (jpi,jpj) ) ; ndaice_da (:,:) = 0._wp 331 #endif 332 ! 333 IF ( ln_trainc .OR. ln_dyninc .OR. & !-------------------------------------- 334 & ln_sshinc .OR. ln_seaiceinc ) THEN ! Read the increments from file 335 ! !-------------------------------------- 353 336 CALL iom_open( c_asminc, inum ) 354 355 CALL iom_get( inum, 'time', zdate_inc ) 356 337 ! 338 CALL iom_get( inum, 'time' , zdate_inc ) 357 339 CALL iom_get( inum, 'z_inc_dateb', z_inc_dateb ) 358 340 CALL iom_get( inum, 'z_inc_datef', z_inc_datef ) 359 341 z_inc_dateb = zdate_inc 360 342 z_inc_datef = zdate_inc 361 343 ! 362 344 IF(lwp) THEN 363 345 WRITE(numout,*) 364 WRITE(numout,*) 'asm_inc_init : Assimilation increments valid ', & 365 & ' between dates ', z_inc_dateb,' and ', & 366 & z_inc_datef 346 WRITE(numout,*) 'asm_inc_init : Assimilation increments valid between dates ', z_inc_dateb,' and ', z_inc_datef 367 347 WRITE(numout,*) '~~~~~~~~~~~~' 368 348 ENDIF 369 370 IF ( ( z_inc_dateb < ndastp + nn_time0*0.0001_wp )&371 & .OR.( z_inc_datef > ditend_date ) ) &372 & CALL ctl_warn( ' Validity time of assimilation increments is ', &373 & ' outside the assimilation interval' )349 ! 350 IF ( ( z_inc_dateb < ndastp + nn_time0*0.0001_wp ) .OR. & 351 & ( z_inc_datef > ditend_date ) ) & 352 & CALL ctl_warn( ' Validity time of assimilation increments is ', & 353 & ' outside the assimilation interval' ) 374 354 375 355 IF ( ( ln_asmdin ).AND.( zdate_inc /= ditdin_date ) ) & … … 418 398 WHERE( ABS( seaice_bkginc(:,:) ) > 1.0e+10 ) seaice_bkginc(:,:) = 0.0 419 399 ENDIF 420 400 ! 421 401 CALL iom_close( inum ) 422 423 ENDIF 424 425 !----------------------------------------------------------------------- 426 ! Apply divergence damping filter 427 !----------------------------------------------------------------------- 428 429 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN 430 ! 402 ! 403 ENDIF 404 ! 405 ! !-------------------------------------- 406 IF ( ln_dyninc .AND. nn_divdmp > 0 ) THEN ! Apply divergence damping filter 407 ! !-------------------------------------- 431 408 ALLOCATE( zhdiv(jpi,jpj) ) 432 409 ! … … 460 437 ! 461 438 ENDIF 462 463 !----------------------------------------------------------------------- 464 ! Allocate and initialize the background state arrays 465 !----------------------------------------------------------------------- 466 467 IF ( ln_asmdin ) THEN 468 ! 469 ALLOCATE( t_bkg(jpi,jpj,jpk) ) 470 ALLOCATE( s_bkg(jpi,jpj,jpk) ) 471 ALLOCATE( u_bkg(jpi,jpj,jpk) ) 472 ALLOCATE( v_bkg(jpi,jpj,jpk) ) 473 ALLOCATE( ssh_bkg(jpi,jpj) ) 474 ! 475 t_bkg(:,:,:) = 0._wp 476 s_bkg(:,:,:) = 0._wp 477 u_bkg(:,:,:) = 0._wp 478 v_bkg(:,:,:) = 0._wp 479 ssh_bkg(:,:) = 0._wp 439 ! 440 ! !----------------------------------------------------- 441 IF ( ln_asmdin ) THEN ! Allocate and initialize the background state arrays 442 ! !----------------------------------------------------- 443 ! 444 ALLOCATE( t_bkg (jpi,jpj,jpk) ) ; t_bkg (:,:,:) = 0._wp 445 ALLOCATE( s_bkg (jpi,jpj,jpk) ) ; s_bkg (:,:,:) = 0._wp 446 ALLOCATE( u_bkg (jpi,jpj,jpk) ) ; u_bkg (:,:,:) = 0._wp 447 ALLOCATE( v_bkg (jpi,jpj,jpk) ) ; v_bkg (:,:,:) = 0._wp 448 ALLOCATE( ssh_bkg(jpi,jpj) ) ; ssh_bkg(:,:) = 0._wp 449 ! 480 450 ! 481 451 !-------------------------------------------------------------------- … … 489 459 IF(lwp) THEN 490 460 WRITE(numout,*) 491 WRITE(numout,*) 'asm_inc_init : Assimilation background state valid at : ', & 492 & zdate_bkg 493 WRITE(numout,*) '~~~~~~~~~~~~' 494 ENDIF 495 ! 496 IF ( zdate_bkg /= ditdin_date ) & 461 WRITE(numout,*) ' ==>>> Assimilation background state valid at : ', zdate_bkg 462 WRITE(numout,*) 463 ENDIF 464 ! 465 IF ( zdate_bkg /= ditdin_date ) & 497 466 & CALL ctl_warn( ' Validity time of assimilation background state does', & 498 467 & ' not agree with Direct Initialization time' ) … … 521 490 ENDIF 522 491 ! 492 IF(lwp) WRITE(numout,*) ' ==>>> Euler time step switch is ', neuler 493 ! 494 IF( lk_asminc ) THEN !== data assimilation ==! 495 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields 496 IF( ln_asmdin ) THEN ! Direct initialization 497 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers 498 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 499 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH 500 ENDIF 501 ENDIF 502 ! 523 503 END SUBROUTINE asm_inc_init 504 505 524 506 SUBROUTINE tra_asm_inc( kt ) 525 507 !!---------------------------------------------------------------------- … … 786 768 END SUBROUTINE ssh_asm_inc 787 769 770 788 771 SUBROUTINE ssh_asm_div( kt, phdivn ) 789 772 !!---------------------------------------------------------------------- … … 824 807 END SUBROUTINE ssh_asm_div 825 808 809 826 810 SUBROUTINE seaice_asm_inc( kt, kindic ) 827 811 !!---------------------------------------------------------------------- … … 886 870 ! seaice salinity balancing (to add) 887 871 #endif 888 872 ! 889 873 #if defined key_cice && defined key_asminc 890 874 ! Sea-ice : CICE case. Pass ice increment tendency into CICE 891 875 ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rdt 892 876 #endif 893 877 ! 894 878 IF ( kt == nitiaufin_r ) THEN 895 879 DEALLOCATE( seaice_bkginc ) 896 880 ENDIF 897 881 ! 898 882 ELSE 899 883 ! 900 884 #if defined key_cice && defined key_asminc 901 885 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 902 886 #endif 903 887 ! 904 888 ENDIF 905 889 ! !----------------------------------------- … … 949 933 #if defined key_cice && defined key_asminc 950 934 ndaice_da(:,:) = 0._wp ! Sea-ice : CICE case. Zero ice increment tendency into CICE 951 952 935 #endif 953 936 ! -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r9210 r9213 28 28 !! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 29 29 !! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation 30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_n orthcomms30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_nfdcom 31 31 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 32 32 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_n orthcomms: setup avoiding MPI communication33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_nfdcom: setup avoiding MPI communication 34 34 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 35 35 !! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface … … 44 44 !! nemo_partition: calculate MPP domain decomposition 45 45 !! factorise : calculate the factors of the no. of MPI processes 46 !! nemo_nfdcom : Setup for north fold exchanges with explicit point-to-point messaging 46 47 !!---------------------------------------------------------------------- 47 48 USE step_oce ! module used in the ocean time stepping module (step.F90) … … 88 89 USE lib_mpp ! distributed memory computing 89 90 USE mppini ! shared/distributed memory setting (mpp_init routine) 90 USE lbcnfd , ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges91 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 91 92 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 92 93 #if defined key_iomput … … 104 105 105 106 !!---------------------------------------------------------------------- 106 !! NEMO/OPA 3.7 , NEMO Consortium (2016)107 !! NEMO/OPA 4.0 , NEMO Consortium (2018) 107 108 !! $Id$ 108 109 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 130 131 CALL Agrif_Init_Grids() ! AGRIF: set the meshes 131 132 #endif 132 !133 133 ! !-----------------------! 134 134 CALL nemo_init !== Initialisations ==! … … 161 161 END DO 162 162 #else 163 164 !!gm This data assimilation calls should be part of the initialisation (i.e. put in asm_inc_init)165 !166 IF( lk_asminc ) THEN !== data assimilation ==! (done prior to time stepping)167 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields168 IF( ln_asmdin ) THEN ! Direct initialization169 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers170 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics171 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH172 ENDIF173 ENDIF174 !!gm end175 163 ! 176 164 # if defined key_agrif 177 165 ! !== AGRIF time-stepping ==! 178 166 CALL Agrif_Regrid() 167 ! 179 168 DO WHILE( istp <= nitend .AND. nstop == 0 ) 180 169 CALL stp … … 222 211 IF( nstop /= 0 .AND. lwp ) THEN ! error print 223 212 WRITE(numout,cform_err) 224 WRITE(numout,*) ' nemo_gcm: a total of ', nstop, ' errors have been found'213 WRITE(numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 225 214 WRITE(numout,*) 226 215 ENDIF … … 249 238 !!---------------------------------------------------------------------- 250 239 INTEGER :: ji ! dummy loop indices 251 INTEGER :: ios, ilocal_comm ! local integer 252 INTEGER :: iiarea, ijarea ! local integers253 INTEGER :: iirest, ijrest ! local integers240 INTEGER :: ios, ilocal_comm ! local integers 241 INTEGER :: iiarea, ijarea ! - - 242 INTEGER :: iirest, ijrest ! - - 254 243 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam 255 ! 244 !! 256 245 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 257 246 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 258 247 & ln_timing, ln_diacfl 259 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_ write_cfg, cn_domcfg_out, ln_use_jattr, ln_closea248 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 260 249 !!---------------------------------------------------------------------- 261 250 ! … … 269 258 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 270 259 ! 271 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints260 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 272 261 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 273 262 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) … … 276 265 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 277 266 ! 278 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints267 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 279 268 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 280 269 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 281 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark270 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 282 271 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 283 272 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) … … 435 424 436 425 ! ! Domain decomposition 437 CALL mpp_init 438 IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists 439 ! 440 IF( ln_timing ) CALL timing_init 426 CALL mpp_init ! MPP 427 IF( ln_nnogather ) CALL nemo_nfdcom ! northfold neighbour lists 441 428 ! 442 429 ! ! General initialization 443 CALL phy_cst ! Physical constants 444 CALL eos_init ! Equation of state 445 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 446 CALL wad_init ! Wetting and drying options 447 CALL dom_init ! Domain 448 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 449 IF( ln_ctl ) CALL prt_ctl_init ! Print control 430 IF( ln_timing ) CALL timing_init ! timing 431 IF( ln_timing ) CALL timing_start( 'nemo_init') 432 ! 433 CALL phy_cst ! Physical constants 434 CALL eos_init ! Equation of state 435 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 436 CALL wad_init ! Wetting and drying options 437 CALL dom_init ! Domain 438 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 439 IF( ln_ctl ) CALL prt_ctl_init ! Print control 450 440 451 CALL diurnal_sst_bulk_init ! diurnal sst 452 IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin 441 CALL diurnal_sst_bulk_init ! diurnal sst 442 IF( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin 443 ! 444 IF( ln_diurnal_only ) THEN ! diurnal only: a subset of the initialisation routines 445 CALL istate_init ! ocean initial state (Dynamics and tracers) 446 CALL sbc_init ! Forcings : surface module 447 CALL tra_qsr_init ! penetrative solar radiation qsr 448 IF( ln_diaobs ) THEN ! Observation & model comparison 449 CALL dia_obs_init ! Initialize observational data 450 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 451 ENDIF 452 IF( lk_asminc ) CALL asm_inc_init ! Assimilation increments 453 ! 454 RETURN ! end of initialization 455 ENDIF 453 456 454 ! IF ln_diurnal_only, then we only want a subset of the initialisation routines 455 IF( ln_diurnal_only ) THEN 456 CALL istate_init ! ocean initial state (Dynamics and tracers) 457 CALL sbc_init ! Forcings : surface module 458 CALL tra_qsr_init ! penetrative solar radiation qsr 459 IF( ln_diaobs ) THEN ! Observation & model comparison 460 CALL dia_obs_init ! Initialize observational data 461 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 462 ENDIF 463 ! ! Assimilation increments 464 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 465 466 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 467 RETURN 468 ENDIF 469 470 CALL istate_init ! ocean initial state (Dynamics and tracers) 457 CALL istate_init ! ocean initial state (Dynamics and tracers) 471 458 472 459 ! ! external forcing 473 CALL tide_init ! tidal harmonics474 CALL sbc_init ! surface boundary conditions (including sea-ice)475 CALL bdy_init ! Open boundaries initialisation460 CALL tide_init ! tidal harmonics 461 CALL sbc_init ! surface boundary conditions (including sea-ice) 462 CALL bdy_init ! Open boundaries initialisation 476 463 477 464 ! ! Ocean physics … … 520 507 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends 521 508 CALL dia_obs_init ! Initialize observational data 522 IF( ln_diaobs ) CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 509 CALL dia_tmb_init ! TMB outputs 510 CALL dia_25h_init ! 25h mean outputs 511 IF( ln_diaobs ) CALL dia_obs( nit000-1 ) ! Observation operator for restart 523 512 524 513 ! ! Assimilation increments 525 514 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 526 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 527 CALL dia_tmb_init ! TMB outputs 528 CALL dia_25h_init ! 25h mean outputs 515 ! 516 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 517 ! 518 IF( ln_timing ) CALL timing_stop( 'nemo_init') 529 519 ! 530 520 END SUBROUTINE nemo_init … … 543 533 WRITE(numout,*) 544 534 WRITE(numout,*) 'nemo_ctl: Control prints' 545 WRITE(numout,*) '~~~~~~~ 535 WRITE(numout,*) '~~~~~~~~' 546 536 WRITE(numout,*) ' Namelist namctl' 547 537 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl … … 563 553 njctle = nn_jctle 564 554 isplt = nn_isplt 565 jsplt = nn_jsplt 555 jsplt = nn_jsplt 566 556 567 557 IF(lwp) THEN ! control print 568 558 WRITE(numout,*) 569 WRITE(numout,*) 'namcfg : configuration initialization through namelist read'570 WRITE(numout,*) '~~~~~~ '571 559 WRITE(numout,*) ' Namelist namcfg' 572 560 WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg 573 561 WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg) 574 WRITE(numout,*) ' write configuration definition file ln_write_cfg = ', ln_write_cfg 562 WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea 563 WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg 575 564 WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out) 576 565 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 577 566 ENDIF 567 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 568 ! 578 569 ! ! Parameter control 579 570 ! … … 615 606 ENDIF 616 607 ! 617 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 618 & 'f2003 standard. ' , & 619 & 'Compile with key_nosignedzero enabled' ) 608 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & 609 & 'Compile with key_nosignedzero enabled' ) 620 610 ! 621 611 #if defined key_agrif … … 664 654 !! ** Method : 665 655 !!---------------------------------------------------------------------- 666 USE diawri , ONLY: dia_wri_alloc 667 USE dom_oce , ONLY: dom_oce_alloc 668 USE trc_oce , ONLY: trc_oce_alloc 656 USE diawri , ONLY : dia_wri_alloc 657 USE dom_oce , ONLY : dom_oce_alloc 658 USE trc_oce , ONLY : trc_oce_alloc 659 USE bdy_oce , ONLY : bdy_oce_alloc 669 660 #if defined key_diadct 670 USE diadct , ONLY : diadct_alloc661 USE diadct , ONLY : diadct_alloc 671 662 #endif 672 USE bdy_oce , ONLY: bdy_oce_alloc673 663 ! 674 664 INTEGER :: ierr 675 665 !!---------------------------------------------------------------------- 676 666 ! 677 ierr = oce_alloc ()! ocean678 ierr = ierr + dia_wri_alloc 679 ierr = ierr + dom_oce_alloc ()! ocean domain680 ierr = ierr + zdf_oce_alloc ()! ocean vertical physics681 !682 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays667 ierr = oce_alloc () ! ocean 668 ierr = ierr + dia_wri_alloc() 669 ierr = ierr + dom_oce_alloc() ! ocean domain 670 ierr = ierr + zdf_oce_alloc() ! ocean vertical physics 671 ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays 672 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 683 673 ! 684 674 #if defined key_diadct 685 ierr = ierr + diadct_alloc ()!675 ierr = ierr + diadct_alloc () ! 686 676 #endif 687 ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization)688 677 ! 689 678 IF( lk_mpp ) CALL mpp_sum( ierr ) 690 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc 679 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) 691 680 ! 692 681 END SUBROUTINE nemo_alloc … … 766 755 knfax = 0 767 756 ! 768 ! Find the factors of n. 769 IF( kn .NE. 1 ) THEN 770 757 IF( kn /= 1 ) THEN ! Find the factors of n 758 ! 771 759 ! nu holds the unfactorised part of the number. 772 760 ! knfax holds the number of factors found. … … 781 769 ifac = ilfax(jl) 782 770 IF( ifac > inu ) CYCLE 783 771 ! 784 772 ! Test whether the factor will divide. 785 773 ! 786 774 IF( MOD(inu,ifac) == 0 ) THEN 787 775 ! … … 807 795 #if defined key_mpp_mpi 808 796 809 SUBROUTINE nemo_n orthcomms810 !!---------------------------------------------------------------------- 811 !! *** ROUTINE nemo_n orthcomms***797 SUBROUTINE nemo_nfdcom 798 !!---------------------------------------------------------------------- 799 !! *** ROUTINE nemo_nfdcom *** 812 800 !! ** Purpose : Setup for north fold exchanges with explicit 813 801 !! point-to-point messaging … … 828 816 nsndto = 0 829 817 ! 830 !if I am a process in the north 831 IF ( njmpp == njmppmax ) THEN 832 !sxM is the first point (in the global domain) needed to compute the 833 !north-fold for the current process 834 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 835 !dxM is the last point (in the global domain) needed to compute the 836 !north-fold for the current process 837 dxM = jpiglo - nimppt(narea) + 2 838 839 !loop over the other north-fold processes to find the processes 840 !managing the points belonging to the sxT-dxT range 841 842 DO jn = 1, jpni 843 !sxT is the first point (in the global domain) of the jn 844 !process 845 sxT = nfiimpp(jn, jpnj) 846 !dxT is the last point (in the global domain) of the jn 847 !process 848 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 849 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 850 nsndto = nsndto + 1 851 isendto(nsndto) = jn 852 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 853 nsndto = nsndto + 1 854 isendto(nsndto) = jn 855 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 856 nsndto = nsndto + 1 857 isendto(nsndto) = jn 858 ENDIF 859 END DO 860 nfsloop = 1 861 nfeloop = nlci 862 DO jn = 2,jpni-1 863 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 864 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 865 nfsloop = nldi 866 ENDIF 867 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 868 nfeloop = nlei 869 ENDIF 870 ENDIF 871 END DO 872 818 IF ( njmpp == njmppmax ) THEN ! if I am a process in the north 819 ! 820 !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 821 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 822 !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 823 dxM = jpiglo - nimppt(narea) + 2 824 ! 825 ! loop over the other north-fold processes to find the processes 826 ! managing the points belonging to the sxT-dxT range 827 ! 828 DO jn = 1, jpni 829 ! 830 sxT = nfiimpp(jn, jpnj) ! sxT = 1st point (in the global domain) of the jn process 831 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 ! dxT = last point (in the global domain) of the jn process 832 ! 833 IF ( sxT < sxM .AND. sxM < dxT ) THEN 834 nsndto = nsndto + 1 835 isendto(nsndto) = jn 836 ELSEIF( sxM <= sxT .AND. dxM >= dxT ) THEN 837 nsndto = nsndto + 1 838 isendto(nsndto) = jn 839 ELSEIF( dxM < dxT .AND. sxT < dxM ) THEN 840 nsndto = nsndto + 1 841 isendto(nsndto) = jn 842 ENDIF 843 ! 844 END DO 845 nfsloop = 1 846 nfeloop = nlci 847 DO jn = 2,jpni-1 848 IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 849 IF( nfipproc(jn-1,jpnj) == -1 ) nfsloop = nldi 850 IF( nfipproc(jn+1,jpnj) == -1 ) nfeloop = nlei 851 ENDIF 852 END DO 853 ! 873 854 ENDIF 874 855 l_north_nogather = .TRUE. 875 END SUBROUTINE nemo_northcomms 856 ! 857 END SUBROUTINE nemo_nfdcom 876 858 877 859 #else 878 SUBROUTINE nemo_n orthcomms! Dummy routine879 WRITE(*,*) 'nemo_n orthcomms: You should not have seen this print! error?'880 END SUBROUTINE nemo_n orthcomms860 SUBROUTINE nemo_nfdcom ! Dummy routine 861 WRITE(*,*) 'nemo_nfdcom: You should not have seen this print! error?' 862 END SUBROUTINE nemo_nfdcom 881 863 #endif 882 864 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r9023 r9213 82 82 USE diaharm 83 83 USE diacfl 84 USE diaobs ! Observation operator 84 85 USE flo_oce ! floats variables 85 86 USE floats ! floats computation (flo_stp routine) … … 93 94 USE restart ! ocean restart (rst_wri routine) 94 95 USE prtctl ! Print control (prt_ctl routine) 95 96 USE diaobs ! Observation operator97 96 98 97 USE in_out_manager ! I/O manager
Note: See TracChangeset
for help on using the changeset viewer.
