- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/nemogcm.F90 (modified) (27 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/nemogcm.F90
r10588 r13463 46 46 USE closea ! treatment of closed seas (for ln_closea) 47 47 USE usrdef_nam ! user defined configuration 48 USE tideini ! tidal components initialization (tide_ini routine) 49 USE bdy_oce, ONLY : ln_bdy 48 USE tide_mod, ONLY : tide_init ! tidal components initialization (tide_init routine) 50 49 USE bdyini ! open boundary cond. setting (bdy_init routine) 51 50 USE istate ! initial state setting (istate_init routine) … … 59 58 USE diaobs ! Observation diagnostics (dia_obs_init routine) 60 59 USE diacfl ! CFL diagnostics (dia_cfl_init routine) 60 USE diamlr ! IOM context management for multiple-linear-regression analysis 61 #if defined key_qco 62 USE stepMLF ! NEMO time-stepping (stp_MLF routine) 63 #else 61 64 USE step ! NEMO time-stepping (stp routine) 65 #endif 66 USE isfstp ! ice shelf (isf_stp_init routine) 62 67 USE icbini ! handle bergs, initialisation 63 68 USE icbstp ! handle bergs, calving, themodynamics and transport … … 68 73 USE stopar ! Stochastic param.: ??? 69 74 USE stopts ! Stochastic param.: ??? 70 USE diu rnal_bulk ! diurnal bulk SST75 USE diu_layers ! diurnal bulk SST and coolskin 71 76 USE step_diu ! diurnal bulk SST timestepping (called from here if run offline) 72 77 USE crsini ! initialise grid coarsening utility 73 USE diatmb ! Top,middle,bottom output74 78 USE dia25h ! 25h mean output 79 USE diadetide ! Weights computation for daily detiding of model diagnostics 75 80 USE sbc_oce , ONLY : lk_oasis 76 81 USE wet_dry ! Wetting and drying setting (wad_init routine) … … 82 87 #endif 83 88 ! 89 USE prtctl ! Print control 90 USE in_out_manager ! I/O manager 84 91 USE lib_mpp ! distributed memory computing 85 92 USE mppini ! shared/distributed memory setting (mpp_init routine) 86 USE lbcnfd , ONLY : isendto, nsndto , nfsloop, nfeloop! Setup of north fold exchanges93 USE lbcnfd , ONLY : isendto, nsndto ! Setup of north fold exchanges 87 94 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 88 95 #if defined key_iomput … … 92 99 USE agrif_all_update ! Master Agrif update 93 100 #endif 101 USE halo_mng 94 102 95 103 IMPLICIT NONE … … 103 111 104 112 #if defined key_mpp_mpi 113 ! need MPI_Wtime 105 114 INCLUDE 'mpif.h' 106 115 #endif … … 128 137 !!---------------------------------------------------------------------- 129 138 INTEGER :: istp ! time step index 139 REAL(wp):: zstptiming ! elapsed time for 1 time step 130 140 !!---------------------------------------------------------------------- 131 141 ! … … 137 147 ! !-----------------------! 138 148 #if defined key_agrif 139 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM140 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 149 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 150 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 141 151 # if defined key_top 142 152 CALL Agrif_Declare_Var_top ! " " " " " TOP 143 153 # endif 144 # if defined key_si3145 CALL Agrif_Declare_Var_ice ! " " " " " Sea ice146 # endif147 154 #endif 148 155 ! check that all process are still there... If some process have an error, … … 155 162 ! !== time stepping ==! 156 163 ! !-----------------------! 164 ! 165 ! !== set the model time-step ==! 166 ! 157 167 istp = nit000 158 168 ! … … 169 179 ! 170 180 ! Recursive update from highest nested level to lowest: 181 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 171 182 CALL Agrif_step_child_adj(Agrif_Update_All) 172 183 ! 173 184 DO WHILE( istp <= nitend .AND. nstop == 0 ) 185 #if defined key_qco 186 CALL stp_MLF 187 #else 174 188 CALL stp 189 #endif 175 190 istp = istp + 1 176 191 END DO 177 192 ! 178 IF( .NOT. Agrif_Root() ) THEN179 CALL Agrif_ParentGrid_To_ChildGrid()180 IF( ln_diaobs ) CALL dia_obs_wri181 IF( ln_timing ) CALL timing_finalize182 CALL Agrif_ChildGrid_To_ParentGrid()183 ENDIF184 !185 193 # else 186 194 ! … … 188 196 ! 189 197 DO WHILE( istp <= nitend .AND. nstop == 0 ) 190 #if defined key_mpp_mpi 198 191 199 ncom_stp = istp 192 IF ( istp == ( nit000 + 1 ) ) elapsed_time = MPI_Wtime() 193 IF ( istp == nitend ) elapsed_time = MPI_Wtime() - elapsed_time 194 #endif 200 IF( ln_timing ) THEN 201 zstptiming = MPI_Wtime() 202 IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming 203 IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time 204 ENDIF 205 206 #if defined key_qco 207 CALL stp_MLF ( istp ) 208 #else 195 209 CALL stp ( istp ) 210 #endif 196 211 istp = istp + 1 212 213 IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming 214 197 215 END DO 198 216 ! … … 220 238 ! 221 239 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,*) 240 WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found' 241 IF( ngrdstop > 0 ) THEN 242 WRITE(ctmp9,'(i2)') ngrdstop 243 WRITE(ctmp2,*) ' E R R O R detected in Agrif grid '//TRIM(ctmp9) 244 WRITE(ctmp3,*) ' Look for "E R R O R" messages in all existing '//TRIM(ctmp9)//'_ocean_output* files' 245 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2, ' ', ctmp3 ) 246 ELSE 247 WRITE(ctmp2,*) ' Look for "E R R O R" messages in all existing ocean_output* files' 248 CALL ctl_stop( ' ', ctmp1, ' ', ctmp2 ) 249 ENDIF 225 250 ENDIF 226 251 ! … … 234 259 #else 235 260 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 communications261 ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications 237 262 ENDIF 238 263 #endif … … 240 265 IF(lwm) THEN 241 266 IF( nstop == 0 ) THEN ; STOP 0 242 ELSE ; STOP 999267 ELSE ; STOP 123 243 268 ENDIF 244 269 ENDIF … … 253 278 !! ** Purpose : initialization of the NEMO GCM 254 279 !!---------------------------------------------------------------------- 255 INTEGER :: ji ! dummy loop indices 256 INTEGER :: ios, ilocal_comm ! local integers 257 CHARACTER(len=120), DIMENSION(60) :: cltxt, cltxt2, clnam 258 !! 259 NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, & 260 & nn_isplt , nn_jsplt, nn_jctls, nn_jctle, & 261 & ln_timing, ln_diacfl 280 INTEGER :: ios, ilocal_comm ! local integers 281 !! 282 NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl, & 283 & nn_isplt, nn_jsplt, nn_ictls, nn_ictle, nn_jctls, nn_jctle 262 284 NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 263 285 !!---------------------------------------------------------------------- 264 286 ! 265 cltxt = ''266 cltxt2 = ''267 clnam = ''268 287 cxios_context = 'nemo' 269 288 ! 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 ! !--------------------------------------------! 289 ! !-------------------------------------------------! 290 ! ! set communicator & select the local rank ! 291 ! ! must be done as soon as possible to get narea ! 292 ! !-------------------------------------------------! 293 ! 304 294 #if defined key_iomput 305 295 IF( Agrif_Root() ) THEN 306 296 IF( lk_oasis ) THEN 307 297 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 xios298 CALL xios_initialize( "not used" , local_comm =ilocal_comm ) ! send nemo communicator to xios 309 299 ELSE 310 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm )! nemo local communicator given by xios300 CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios 311 301 ENDIF 312 302 ENDIF 313 ! Nodes selection (control print return in cltxt) 314 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 303 CALL mpp_start( ilocal_comm ) 315 304 #else 316 305 IF( lk_oasis ) THEN … … 318 307 CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis 319 308 ENDIF 320 ! Nodes selection (control print return in cltxt) 321 narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) 309 CALL mpp_start( ilocal_comm ) 322 310 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 ) THEN 331 ! Activate finer control of report outputs 332 ! optionally switch off output from selected areas (note this only 333 ! 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. ) 311 CALL mpp_start( ) 312 ENDIF 313 #endif 314 ! 315 narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 ) 316 lwm = (narea == 1) ! control of output namelists 317 ! 318 ! !---------------------------------------------------------------! 319 ! ! Open output files, reference and configuration namelist files ! 320 ! !---------------------------------------------------------------! 321 ! 322 ! open ocean.output as soon as possible to get all output prints (including errors messages) 323 IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 324 ! open reference and configuration namelist files 325 CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm ) 326 CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm ) 327 IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 328 ! open /dev/null file to be able to supress output write easily 329 IF( Agrif_Root() ) THEN 330 CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. ) 331 #ifdef key_agrif 337 332 ELSE 338 ! Use ln_ctl to turn on or off all options.339 CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. ) 340 ENDIF 341 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 print353 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 )333 numnul = Agrif_Parent(numnul) 334 #endif 335 ENDIF 336 ! !--------------------! 337 ! ! Open listing units ! -> need sn_cfctl from namctl to define lwp 338 ! !--------------------! 339 ! 340 READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 ) 341 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' ) 342 READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 ) 343 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' ) 344 ! 345 ! finalize the definition of namctl variables 346 IF( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax .OR. MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) & 347 & CALL nemo_set_cfctl( sn_cfctl, .FALSE. ) 348 ! 349 lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print 350 ! 351 IF(lwp) THEN ! open listing units 352 ! 353 IF( .NOT. lwm ) & ! alreay opened for narea == 1 354 & CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea ) 360 355 ! 361 356 WRITE(numout,*) 362 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV -CMCC'357 WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 363 358 WRITE(numout,*) ' NEMO team' 364 359 WRITE(numout,*) ' Ocean General Circulation Model' … … 380 375 WRITE(numout,*) 381 376 382 DO ji = 1, SIZE(cltxt) 383 IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) TRIM(cltxt(ji)) ! control print of mynode 384 END DO 377 ! Print the working precision to ocean.output 378 IF (wp == dp) THEN 379 WRITE(numout,*) "Working precision = double-precision" 380 ELSE 381 WRITE(numout,*) "Working precision = single-precision" 382 ENDIF 385 383 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 384 ! 391 385 WRITE(numout,cform_aaa) ! Flag AAAAAAA 392 386 ! 393 387 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 399 388 ! 389 IF(lwm) WRITE( numond, namctl ) 390 ! 391 ! !------------------------------------! 392 ! ! Set global domain size parameters ! 393 ! !------------------------------------! 394 ! 395 READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 ) 396 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' ) 397 READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 ) 398 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' ) 399 ! 400 IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file 401 CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 402 ELSE ! user-defined namelist 403 CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 404 ENDIF 405 ! 406 IF(lwm) WRITE( numond, namcfg ) 407 ! 408 ! !-----------------------------------------! 409 ! ! mpp parameters and domain decomposition ! 410 ! !-----------------------------------------! 411 CALL mpp_init 412 413 CALL halo_mng_init() 400 414 ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 401 415 CALL nemo_alloc() 402 416 417 ! Initialise time level indices 418 Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 419 #if defined key_agrif 420 Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices 421 #endif 403 422 ! !-------------------------------! 404 423 ! ! NEMO general initialization ! … … 415 434 IF( lk_c1d ) CALL c1d_init ! 1D column configuration 416 435 CALL wad_init ! Wetting and drying options 417 CALL dom_init("OPA") ! Domain 418 IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization 419 IF( ln_ctl ) CALL prt_ctl_init ! Print control 436 437 #if defined key_agrif 438 CALL Agrif_Declare_Var_ini ! " " " " " DOM 439 #endif 440 CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain 441 IF( ln_crs ) CALL crs_init( Nnn ) ! coarsened grid: domain initialization 442 IF( sn_cfctl%l_prtctl ) & 443 & CALL prt_ctl_init ! Print control 420 444 421 CALL diurnal_sst_bulk_init! diurnal sst445 CALL diurnal_sst_bulk_init ! diurnal sst 422 446 IF( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin 423 447 ! 424 IF( ln_diurnal_only ) THEN ! diurnal only: a subset of the initialisation routines425 CALL istate_init 426 CALL sbc_init 427 CALL tra_qsr_init 428 IF( ln_diaobs ) THEN 429 CALL dia_obs_init 430 CALL dia_obs( nit000 - 1 )! Observation operator for restart448 IF( ln_diurnal_only ) THEN ! diurnal only: a subset of the initialisation routines 449 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 450 CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module 451 CALL tra_qsr_init ! penetrative solar radiation qsr 452 IF( ln_diaobs ) THEN ! Observation & model comparison 453 CALL dia_obs_init( Nnn ) ! Initialize observational data 454 CALL dia_obs( nit000 - 1, Nnn ) ! Observation operator for restart 431 455 ENDIF 432 IF( lk_asminc ) CALL asm_inc_init 456 IF( lk_asminc ) CALL asm_inc_init( Nbb, Nnn, Nrhs ) ! Assimilation increments 433 457 ! 434 458 RETURN ! end of initialization 435 459 ENDIF 436 437 CALL istate_init ! ocean initial state (Dynamics and tracers) 460 ! 461 462 CALL istate_init( Nbb, Nnn, Naa ) ! ocean initial state (Dynamics and tracers) 438 463 439 464 ! ! external forcing 440 CALL tide_init ! tidal harmonics441 CALL sbc_init ! surface boundary conditions (including sea-ice)442 CALL bdy_init ! Open boundaries initialisation465 CALL tide_init ! tidal harmonics 466 CALL sbc_init( Nbb, Nnn, Naa ) ! surface boundary conditions (including sea-ice) 467 CALL bdy_init ! Open boundaries initialisation 443 468 444 469 ! ! Ocean physics 445 CALL zdf_phy_init ! Vertical physics470 CALL zdf_phy_init( Nnn ) ! Vertical physics 446 471 447 472 ! ! Lateral physics … … 459 484 460 485 ! ! Dynamics 461 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping462 CALL dyn_adv_init ! advection (vector or flux form)463 CALL dyn_vor_init ! vorticity term including Coriolis464 CALL dyn_ldf_init ! lateral mixing465 CALL dyn_hpg_init 466 CALL dyn_spg_init ! surface pressure gradient486 IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping 487 CALL dyn_adv_init ! advection (vector or flux form) 488 CALL dyn_vor_init ! vorticity term including Coriolis 489 CALL dyn_ldf_init ! lateral mixing 490 CALL dyn_hpg_init( Nnn ) ! horizontal gradient of Hydrostatic pressure 491 CALL dyn_spg_init ! surface pressure gradient 467 492 468 493 #if defined key_top 469 494 ! ! Passive tracers 470 CALL trc_init 495 CALL trc_init( Nbb, Nnn, Naa ) 471 496 #endif 472 497 IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing 473 498 474 499 ! ! Icebergs 475 CALL icb_init( rdt, nit000) ! initialise icebergs instance 500 CALL icb_init( rn_Dt, nit000) ! initialise icebergs instance 501 502 ! ice shelf 503 CALL isf_init( Nbb, Nnn, Naa ) 476 504 477 505 ! ! Misc. options … … 480 508 481 509 ! ! Diagnostics 482 IF( lk_floats ) CALL flo_init! drifting Floats510 CALL flo_init( Nnn ) ! drifting Floats 483 511 IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics 484 CALL dia_ptr_init ! Poleward TRansports initialization 485 IF( lk_diadct ) CALL dia_dct_init ! Sections tranports 486 CALL dia_hsb_init ! heat content, salt content and volume budgets 487 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends 488 CALL dia_obs_init ! Initialize observational data 489 CALL dia_tmb_init ! TMB outputs 490 CALL dia_25h_init ! 25h mean outputs 491 IF( ln_diaobs ) CALL dia_obs( nit000-1 ) ! Observation operator for restart 512 ! CALL dia_ptr_init ! Poleward TRansports initialization 513 CALL dia_dct_init ! Sections tranports 514 CALL dia_hsb_init( Nnn ) ! heat content, salt content and volume budgets 515 CALL trd_init( Nnn ) ! Mixed-layer/Vorticity/Integral constraints trends 516 CALL dia_obs_init( Nnn ) ! Initialize observational data 517 CALL dia_25h_init( Nbb ) ! 25h mean outputs 518 CALL dia_detide_init ! Weights computation for daily detiding of model diagnostics 519 IF( ln_diaobs ) CALL dia_obs( nit000-1, Nnn ) ! Observation operator for restart 520 CALL dia_mlr_init ! Initialisation of IOM context management for multiple-linear-regression analysis 492 521 493 522 ! ! Assimilation increments 494 IF( lk_asminc ) CALL asm_inc_init 523 IF( lk_asminc ) CALL asm_inc_init( Nbb, Nnn, Nrhs ) ! Initialize assimilation increments 495 524 ! 496 525 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA … … 507 536 !! ** Purpose : control print setting 508 537 !! 509 !! ** Method : - print namctl information and check some consistencies538 !! ** Method : - print namctl and namcfg information and check some consistencies 510 539 !!---------------------------------------------------------------------- 511 540 ! … … 515 544 WRITE(numout,*) '~~~~~~~~' 516 545 WRITE(numout,*) ' Namelist namctl' 517 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl518 WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config519 546 WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat 520 547 WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat 521 548 WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout 522 549 WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout 523 WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout 524 WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop 550 WRITE(numout,*) ' sn_cfctl%l_prtctl = ', sn_cfctl%l_prtctl 551 WRITE(numout,*) ' sn_cfctl%l_prttrc = ', sn_cfctl%l_prttrc 552 WRITE(numout,*) ' sn_cfctl%l_oasout = ', sn_cfctl%l_oasout 525 553 WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin 526 554 WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax 527 555 WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr 528 556 WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr 529 WRITE(numout,*) ' level of print nn_print = ', nn_print530 WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls531 WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle532 WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls533 WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle534 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt535 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt536 557 WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing 537 558 WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl 538 559 ENDIF 539 560 ! 540 nprint = nn_print ! convert DOCTOR namelist names into OLD names 541 nictls = nn_ictls 542 nictle = nn_ictle 543 njctls = nn_jctls 544 njctle = nn_jctle 545 isplt = nn_isplt 546 jsplt = nn_jsplt 547 561 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file 548 562 IF(lwp) THEN ! control print 549 563 WRITE(numout,*) … … 556 570 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 557 571 ENDIF 558 IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file559 !560 ! ! Parameter control561 !562 IF( ln_ctl ) THEN ! sub-domain area indices for the control prints563 IF( lk_mpp .AND. jpnij > 1 ) THEN564 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain565 ELSE566 IF( isplt == 1 .AND. jsplt == 1 ) THEN567 CALL ctl_warn( ' - isplt & jsplt are equal to 1', &568 & ' - the print control will be done over the whole domain' )569 ENDIF570 ijsplt = isplt * jsplt ! total number of processors ijsplt571 ENDIF572 IF(lwp) WRITE(numout,*)' - The total number of processors over which the'573 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt574 !575 ! ! indices used for the SUM control576 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area577 lsp_area = .FALSE.578 ELSE ! print control done over a specific area579 lsp_area = .TRUE.580 IF( nictls < 1 .OR. nictls > jpiglo ) THEN581 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )582 nictls = 1583 ENDIF584 IF( nictle < 1 .OR. nictle > jpiglo ) THEN585 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )586 nictle = jpiglo587 ENDIF588 IF( njctls < 1 .OR. njctls > jpjglo ) THEN589 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )590 njctls = 1591 ENDIF592 IF( njctle < 1 .OR. njctle > jpjglo ) THEN593 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )594 njctle = jpjglo595 ENDIF596 ENDIF597 ENDIF598 572 ! 599 573 IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', & … … 621 595 IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file 622 596 IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file 623 IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist624 IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist625 597 IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist 626 IF( numnam_ice_ref /= -1 ) CLOSE( numnam_ice_ref ) ! ice reference namelist627 IF( numnam_ice_cfg /= -1 ) CLOSE( numnam_ice_cfg ) ! ice configuration namelist628 598 IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist 629 599 IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution) … … 650 620 USE trc_oce , ONLY : trc_oce_alloc 651 621 USE bdy_oce , ONLY : bdy_oce_alloc 652 #if defined key_diadct653 USE diadct , ONLY : diadct_alloc654 #endif655 622 ! 656 623 INTEGER :: ierr … … 664 631 ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization) 665 632 ! 666 #if defined key_diadct667 ierr = ierr + diadct_alloc () !668 #endif669 !670 633 CALL mpp_sum( 'nemogcm', ierr ) 671 634 IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' ) … … 673 636 END SUBROUTINE nemo_alloc 674 637 675 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all ) 638 639 SUBROUTINE nemo_set_cfctl(sn_cfctl, setto ) 676 640 !!---------------------------------------------------------------------- 677 641 !! *** ROUTINE nemo_set_cfctl *** 678 642 !! 679 643 !! ** Purpose : Set elements of the output control structure to setto. 680 !! for_all should be .false. unless all areas are to be681 !! treated identically.682 644 !! 683 645 !! ** Method : Note this routine can be used to switch on/off some 684 !! types of output for selected areas but any output types 685 !! that involve global communications (e.g. mpp_max, glob_sum) 686 !! should be protected from selective switching by the 687 !! for_all argument 688 !!---------------------------------------------------------------------- 689 LOGICAL :: setto, for_all 690 TYPE(sn_ctl) :: sn_cfctl 691 !!---------------------------------------------------------------------- 692 IF( for_all ) THEN 693 sn_cfctl%l_runstat = setto 694 sn_cfctl%l_trcstat = setto 695 ENDIF 646 !! types of output for selected areas. 647 !!---------------------------------------------------------------------- 648 TYPE(sn_ctl), INTENT(inout) :: sn_cfctl 649 LOGICAL , INTENT(in ) :: setto 650 !!---------------------------------------------------------------------- 651 sn_cfctl%l_runstat = setto 652 sn_cfctl%l_trcstat = setto 696 653 sn_cfctl%l_oceout = setto 697 654 sn_cfctl%l_layout = setto 698 sn_cfctl%l_mppout = setto 699 sn_cfctl%l_mpptop = setto 655 sn_cfctl%l_prtctl = setto 656 sn_cfctl%l_prttrc = setto 657 sn_cfctl%l_oasout = setto 700 658 END SUBROUTINE nemo_set_cfctl 701 659 702 660 !!====================================================================== 703 661 END MODULE nemogcm 704
Note: See TracChangeset
for help on using the changeset viewer.
