Changeset 11536 for NEMO/trunk/src/OCE/nemogcm.F90
- Timestamp:
- 2019-09-11T15:54:18+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/nemogcm.F90
r10588 r11536 59 59 USE diaobs ! Observation diagnostics (dia_obs_init routine) 60 60 USE diacfl ! CFL diagnostics (dia_cfl_init routine) 61 USE diaharm ! tidal harmonics diagnostics (dia_harm_init routine) 61 62 USE step ! NEMO time-stepping (stp routine) 62 63 USE icbini ! handle bergs, initialisation … … 103 104 104 105 #if defined key_mpp_mpi 106 ! need MPI_Wtime 105 107 INCLUDE 'mpif.h' 106 108 #endif … … 128 130 !!---------------------------------------------------------------------- 129 131 INTEGER :: istp ! time step index 132 REAL(wp):: zstptiming ! elapsed time for 1 time step 130 133 !!---------------------------------------------------------------------- 131 134 ! … … 188 191 ! 189 192 DO WHILE( istp <= nitend .AND. nstop == 0 ) 190 #if defined key_mpp_mpi 193 191 194 ncom_stp = istp 192 IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime() 193 IF ( istp == nitend ) elapsed_time = MPI_Wtime() - elapsed_time 194 #endif 195 IF( ln_timing ) THEN 196 zstptiming = MPI_Wtime() 197 IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming 198 IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time 199 ENDIF 200 195 201 CALL stp ( istp ) 196 202 istp = istp + 1 203 204 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 205 197 206 END DO 198 207 ! … … 220 229 ! 221 230 IF( nstop /= 0 .AND. lwp ) THEN ! error print 222 WRITE(numout,cform_err) 223 WRITE(numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 224 WRITE(numout,*) 231 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 232 CALL ctl_stop( ctmp1 ) 225 233 ENDIF 226 234 ! … … 234 242 #else 235 243 IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS 236 ELSEIF( lk_mpp ) THEN ; CALL mppstop ( ldfinal = .TRUE. )! end mpp communications244 ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 237 245 ENDIF 238 246 #endif … … 240 248 IF(lwm) THEN 241 249 IF( nstop == 0 ) THEN ; STOP 0 242 ELSE ; STOP 999250 ELSE ; STOP 123 243 251 ENDIF 244 252 ENDIF … … 253 261 !! ** Purpose : initialization of the NEMO GCM 254 262 !!---------------------------------------------------------------------- 255 INTEGER :: ji ! dummy loop indices 256 INTEGER :: ios, ilocal_comm ! local integers 257 CHARACTER(len=120), DIMENSION(60) :: cltxt, cltxt2, clnam 263 INTEGER :: ios, ilocal_comm ! local integers 258 264 !! 259 265 NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, & … … 263 269 !!---------------------------------------------------------------------- 264 270 ! 265 cltxt = ''266 cltxt2 = ''267 clnam = ''268 271 cxios_context = 'nemo' 269 272 ! 270 ! ! Open reference namelist and configuration namelist files 271 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 272 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 273 ! 274 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 275 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 276 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. ) 277 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 278 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 279 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. ) 280 ! 281 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 282 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 283 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. ) 284 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 285 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 286 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 287 288 ! !--------------------------! 289 ! ! Set global domain size ! (control print return in cltxt2) 290 ! !--------------------------! 291 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 292 CALL domain_cfg ( cltxt2, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 293 ! 294 ELSE ! user-defined namelist 295 CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 296 ENDIF 297 ! 298 ! 299 ! !--------------------------------------------! 300 ! ! set communicator & select the local node ! 301 ! ! NB: mynode also opens output.namelist.dyn ! 302 ! ! on unit number numond on first proc ! 303 ! !--------------------------------------------! 273 ! !-------------------------------------------------! 274 ! ! set communicator & select the local rank ! 275 ! ! must be done as soon as possible to get narea ! 276 ! !-------------------------------------------------! 277 ! 304 278 #if defined key_iomput 305 279 IF( Agrif_Root() ) THEN 306 280 IF( lk_oasis ) THEN 307 281 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 308 CALL xios_initialize( "not used" , local_comm= ilocal_comm )! send nemo communicator to xios282 CALL xios_initialize( "not used" , local_comm =ilocal_comm ) ! send nemo communicator to xios 309 283 ELSE 310 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )! nemo local communicator given by xios284 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios 311 285 ENDIF 312 286 ENDIF 313 ! Nodes selection (control print return in cltxt) 314 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 287 CALL mpp_start( ilocal_comm ) 315 288 #else 316 289 IF( lk_oasis ) THEN … … 318 291 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 319 292 ENDIF 320 ! Nodes selection (control print return in cltxt) 321 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 293 CALL mpp_start( ilocal_comm ) 322 294 ELSE 323 ilocal_comm = 0 ! Nodes selection (control print return in cltxt)324 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )325 ENDIF 326 #endif 327 328 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )329 330 IF( sn_cfctl%l_config ) THEN331 ! Activate finer control of report outputs332 ! optionally switch off output from selected areas (note this only333 ! applies to output which does not involve global communications)334 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &335 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &336 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )337 ELSE338 ! Use ln_ctl to turn on or off all options.339 CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )340 ENDIF341 342 lwm = (narea == 1) ! control of output namelists343 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print344 345 IF(lwm) THEN ! write merged namelists from earlier to output namelist346 ! ! now that the file has been opened in call to mynode.347 ! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)348 WRITE( numond, namctl)349 WRITE( numond, namcfg)350 IF( .NOT.ln_read_cfg ) THEN351 DO ji = 1, SIZE(clnam)352 IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print 353 END DO354 ENDIF355 ENDIF356 357 IF(lwp) THEN ! open listing units358 !359 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )295 CALL mpp_start( ) 296 ENDIF 297 #endif 298 ! 299 narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 ) 300 lwm = (narea == 1) ! control of output namelists 301 ! 302 ! !---------------------------------------------------------------! 303 ! ! Open output files, reference and configuration namelist files ! 304 ! !---------------------------------------------------------------! 305 ! 306 ! open ocean.output as soon as possible to get all output prints (including errors messages) 307 IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 308 ! open reference and configuration namelist files 309 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 310 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 311 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 312 ! open /dev/null file to be able to supress output write easily 313 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 314 ! 315 ! !--------------------! 316 ! ! Open listing units ! -> need ln_ctl from namctl to define lwp 317 ! !--------------------! 318 ! 319 REWIND( numnam_ref ) ! Namelist namctl in reference namelist 320 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 321 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' ) 322 REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist 323 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 324 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 325 ! 326 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 327 ! 328 IF(lwp) THEN ! open listing units 329 ! 330 IF( .NOT. lwm ) & ! alreay opened for narea == 1 331 & CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 360 332 ! 361 333 WRITE(numout,*) 362 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV -CMCC'334 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 363 335 WRITE(numout,*) ' NEMO team' 364 336 WRITE(numout,*) ' Ocean General Circulation Model' … … 379 351 WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ " 380 352 WRITE(numout,*) 381 382 DO ji = 1, SIZE(cltxt)383 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) TRIM(cltxt(ji)) ! control print of mynode384 END DO385 WRITE(numout,*)386 WRITE(numout,*)387 DO ji = 1, SIZE(cltxt2)388 IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) TRIM(cltxt2(ji)) ! control print of domain size389 END DO390 353 ! 391 354 WRITE(numout,cform_aaa) ! Flag AAAAAAA 392 355 ! 393 356 ENDIF 394 ! open /dev/null file to be able to supress output write easily 395 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 396 ! 397 ! ! Domain decomposition 398 CALL mpp_init ! MPP 357 ! 358 ! finalize the definition of namctl variables 359 IF( sn_cfctl%l_config ) THEN 360 ! Activate finer control of report outputs 361 ! optionally switch off output from selected areas (note this only 362 ! applies to output which does not involve global communications) 363 IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. & 364 & ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) & 365 & CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. ) 366 ELSE 367 ! Use ln_ctl to turn on or off all options. 368 CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 369 ENDIF 370 ! 371 IF(lwm) WRITE( numond, namctl ) 372 ! 373 ! !------------------------------------! 374 ! ! Set global domain size parameters ! 375 ! !------------------------------------! 376 ! 377 REWIND( numnam_ref ) ! Namelist namcfg in reference namelist 378 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 379 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 380 REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist 381 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 382 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 383 ! 384 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 385 CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 386 ELSE ! user-defined namelist 387 CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 388 ENDIF 389 ! 390 IF(lwm) WRITE( numond, namcfg ) 391 ! 392 ! !-----------------------------------------! 393 ! ! mpp parameters and domain decomposition ! 394 ! !-----------------------------------------! 395 CALL mpp_init 399 396 400 397 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays … … 480 477 481 478 ! ! Diagnostics 482 IF( lk_floats )CALL flo_init ! drifting Floats479 CALL flo_init ! drifting Floats 483 480 IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics 484 481 CALL dia_ptr_init ! Poleward TRansports initialization 485 IF( lk_diadct )CALL dia_dct_init ! Sections tranports482 CALL dia_dct_init ! Sections tranports 486 483 CALL dia_hsb_init ! heat content, salt content and volume budgets 487 484 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends … … 489 486 CALL dia_tmb_init ! TMB outputs 490 487 CALL dia_25h_init ! 25h mean outputs 491 IF( ln_diaobs ) CALL dia_obs( nit000-1 ) ! Observation operator for restart 488 CALL dia_harm_init ! tidal harmonics outputs 489 IF( ln_diaobs ) CALL dia_obs( nit000-1 ) ! Observation operator for restart 492 490 493 491 ! ! Assimilation increments … … 507 505 !! ** Purpose : control print setting 508 506 !! 509 !! ** Method : - print namctl information and check some consistencies507 !! ** Method : - print namctl and namcfg information and check some consistencies 510 508 !!---------------------------------------------------------------------- 511 509 ! … … 650 648 USE trc_oce , ONLY : trc_oce_alloc 651 649 USE bdy_oce , ONLY : bdy_oce_alloc 652 #if defined key_diadct653 USE diadct , ONLY : diadct_alloc654 #endif655 650 ! 656 651 INTEGER :: ierr … … 664 659 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 665 660 ! 666 #if defined key_diadct667 ierr = ierr + diadct_alloc () !668 #endif669 !670 661 CALL mpp_sum( 'nemogcm', ierr ) 671 662 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) … … 673 664 END SUBROUTINE nemo_alloc 674 665 666 675 667 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 676 668 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.