Changeset 531 for trunk/NEMO/OPA_SRC/opa.F90
- Timestamp:
- 2006-10-19T14:55:25+02:00 (18 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/opa.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/opa.F90
r516 r531 166 166 CHARACTER (len=20) :: namelistname 167 167 CHARACTER (len=28) :: file_out 168 NAMELIST/namctl/ 169 & isplt , jsplt , njctls, njctle, nbench168 NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle, & 169 & isplt , jsplt , njctls, njctle, nbench, nbit_cmp 170 170 !!---------------------------------------------------------------------- 171 171 … … 229 229 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 230 230 231 CALL opa_flg ! Control prints & Benchmark 232 233 ! Domain decomposition 234 IF( jpni*jpnj == jpnij ) THEN 235 CALL mpp_init ! standard cutting out 236 ELSE 237 CALL mpp_init2 ! eliminate land processors 238 ENDIF 239 240 CALL phy_cst ! Physical constants 241 242 CALL dom_cfg ! Domain configuration 243 244 CALL dom_init ! Domain 245 246 IF( ln_ctl ) CALL prt_ctl_init ! Print control 247 248 IF( lk_cfg_1d ) CALL fcorio_1d ! redefine Coriolis at T-point 249 250 IF( lk_obc ) CALL obc_init ! Open boundaries 251 252 CALL day( nit000 ) ! Calendar 253 254 CALL istate_init ! ocean initial state (Dynamics and tracers) 255 256 !!add 257 CALL eos( tb, sb, rhd, rhop ) ! before potential and in situ densities 258 259 CALL bn2( tb, sb, rn2 ) ! before Brunt-Vaisala frequency 260 261 IF( ln_zps .AND. .NOT. lk_cfg_1d ) & 262 & CALL zps_hde( nit000, tb, sb, rhd, & ! Partial steps: before Horizontal DErivative 263 gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 264 gtv, gsv, grv ) 265 !!add 266 267 CALL oc_fz_pt ! Surface freezing point 268 269 #if defined key_ice_lim 270 CALL ice_init ! Sea ice model 271 #endif 272 273 ! ! Ocean physics 274 275 CALL ldf_dyn_init ! Lateral ocean momentum physics 276 277 CALL ldf_tra_init ! Lateral ocean tracer physics 278 279 CALL zdf_init ! Vertical ocean physics 280 281 CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends 282 283 284 #if defined key_passivetrc 285 CALL ini_trc ! Passive tracers 286 #endif 287 288 #if defined key_coupled 289 itro = nitend - nit000 + 1 ! Coupled 290 istp0 = NINT( rdt ) 291 CALL cpl_init( itro, nexco, istp0 ) ! Signal processing and process id exchange 292 #endif 293 294 CALL flx_init ! Thermohaline forcing initialization 295 296 CALL flx_fwb_init ! FreshWater Budget correction 297 298 CALL dia_ptr_init ! Poleward TRansports initialization 299 300 ! ! =============== ! 301 ! ! time stepping ! 302 ! ! =============== ! 303 304 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 305 306 IF( lk_cfg_1d ) THEN 307 CALL init_1d 308 ENDIF 309 310 END SUBROUTINE opa_init 311 312 313 SUBROUTINE opa_flg 314 !!---------------------------------------------------------------------- 315 !! *** ROUTINE opa *** 316 !! 317 !! ** Purpose : Initialize logical flags that control the choice of 318 !! some algorithm or control print 319 !! 320 !! ** Method : Read in namilist namflg logical flags 321 !! 322 !! History : 323 !! 9.0 ! 03-11 (G. Madec) Original code 324 !!---------------------------------------------------------------------- 325 !! * Local declarations 326 327 NAMELIST/namflg/ ln_dynhpg_imp 328 !!---------------------------------------------------------------------- 329 330 ! Parameter control and print 331 ! --------------------------- 231 332 IF(lwp) THEN 232 333 WRITE(numout,*) 233 WRITE(numout,*) 'opa_ init: Control prints & Benchmark'234 WRITE(numout,*) '~~~~~~~ ~'334 WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 335 WRITE(numout,*) '~~~~~~~ ' 235 336 WRITE(numout,*) ' Namelist namctl' 236 337 WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl … … 243 344 WRITE(numout,*) ' number of proc. following j jsplt = ', jsplt 244 345 WRITE(numout,*) ' benchmark parameter (0/1) nbench = ', nbench 245 ENDIF 246 ! Domain decomposition 247 IF( jpni*jpnj == jpnij ) THEN 248 CALL mpp_init ! standard cutting out 249 ELSE 250 CALL mpp_init2 ! eliminate land processors 251 ENDIF 252 253 CALL phy_cst ! Physical constants 254 255 CALL dom_cfg ! Domain configuration 256 257 CALL dom_init ! Domain 258 259 IF( ln_ctl ) CALL prt_ctl_init ! Print control 260 261 IF( lk_cfg_1d ) CALL fcorio_1d ! redefine Coriolis at T-point 262 263 IF( lk_obc ) CALL obc_init ! Open boundaries 264 265 CALL day( nit000 ) ! Calendar 266 267 CALL istate_init ! ocean initial state (Dynamics and tracers) 268 269 !!add 270 CALL eos( tb, sb, rhd, rhop ) ! before potential and in situ densities 271 272 CALL bn2( tb, sb, rn2 ) ! before Brunt-Vaisala frequency 273 274 IF( ln_zps .AND. .NOT. lk_cfg_1d ) & 275 & CALL zps_hde( nit000, tb, sb, rhd, & ! Partial steps: before Horizontal DErivative 276 gtu, gsu, gru, & ! of t, s, rd at the bottom ocean level 277 gtv, gsv, grv ) 278 !!add 279 280 CALL oc_fz_pt ! Surface freezing point 281 282 #if defined key_ice_lim 283 CALL ice_init ! Sea ice model 284 #endif 285 286 ! ! Ocean scheme 287 288 CALL opa_flg ! Choice of algorithms 289 290 ! ! Ocean physics 291 292 CALL ldf_dyn_init ! Lateral ocean momentum physics 293 294 CALL ldf_tra_init ! Lateral ocean tracer physics 295 296 CALL zdf_init ! Vertical ocean physics 297 298 CALL trd_mod_init ! Mixed-layer/Vorticity/Integral constraints trends 299 300 301 #if defined key_passivetrc 302 CALL ini_trc ! Passive tracers 303 #endif 304 305 #if defined key_coupled 306 itro = nitend - nit000 + 1 ! Coupled 307 istp0 = NINT( rdt ) 308 CALL cpl_init( itro, nexco, istp0 ) ! Signal processing and process id exchange 309 #endif 310 311 CALL flx_init ! Thermohaline forcing initialization 312 313 CALL flx_fwb_init ! FreshWater Budget correction 314 315 CALL dia_ptr_init ! Poleward TRansports initialization 316 317 ! ! =============== ! 318 ! ! time stepping ! 319 ! ! =============== ! 320 321 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 322 323 IF( lk_cfg_1d ) THEN 324 CALL init_1d 325 ENDIF 326 327 END SUBROUTINE opa_init 328 329 330 SUBROUTINE opa_flg 331 !!---------------------------------------------------------------------- 332 !! *** ROUTINE opa *** 333 !! 334 !! ** Purpose : Initialize logical flags that control the choice of 335 !! some algorithm or control print 336 !! 337 !! ** Method : Read in namilist namflg logical flags 338 !! 339 !! History : 340 !! 9.0 ! 03-11 (G. Madec) Original code 341 !!---------------------------------------------------------------------- 342 !! * Local declarations 343 344 NAMELIST/namflg/ ln_dynhpg_imp 345 !!---------------------------------------------------------------------- 346 WRITE(numout,*) ' bit comparison mode (0/1) nbit_cmp = ', nbit_cmp 347 ENDIF 348 349 ! ... Control the sub-domain area indices for the control prints 350 IF( ln_ctl ) THEN 351 IF( lk_mpp ) THEN 352 ! the domain is forced to the real splitted domain in MPI 353 isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 354 ELSE 355 IF( isplt == 1 .AND. jsplt == 1 ) THEN 356 CALL ctl_warn( ' - isplt & jsplt are equal to 1', & 357 & ' - the print control will be done over the whole domain' ) 358 ENDIF 359 360 ! compute the total number of processors ijsplt 361 ijsplt = isplt*jsplt 362 ENDIF 363 364 IF(lwp) WRITE(numout,*)' - The total number of processors over which the' 365 IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt 366 367 ! Control the indices used for the SUM control 368 IF( nictls+nictle+njctls+njctle == 0 ) THEN 369 ! the print control is done over the default area 370 lsp_area = .FALSE. 371 ELSE 372 ! the print control is done over a specific area 373 lsp_area = .TRUE. 374 IF( nictls < 1 .OR. nictls > jpiglo ) THEN 375 CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 376 nictls = 1 377 ENDIF 378 379 IF( nictle < 1 .OR. nictle > jpiglo ) THEN 380 CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 381 nictle = jpiglo 382 ENDIF 383 384 IF( njctls < 1 .OR. njctls > jpjglo ) THEN 385 CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 386 njctls = 1 387 ENDIF 388 389 IF( njctle < 1 .OR. njctle > jpjglo ) THEN 390 CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 391 njctle = jpjglo 392 ENDIF 393 394 ENDIF ! IF( nictls+nictle+njctls+njctle == 0 ) 395 ENDIF ! IF(ln_ctl) 396 397 IF( nbench == 1 ) THEN 398 SELECT CASE ( cp_cfg ) 399 CASE ( 'gyre' ) 400 CALL ctl_warn( ' The Benchmark is activated ' ) 401 CASE DEFAULT 402 CALL ctl_stop( ' The Benchmark is based on the GYRE configuration: key_gyre must be used or set nbench = 0' ) 403 END SELECT 404 ENDIF 405 406 SELECT CASE ( nbit_cmp ) 407 CASE ( 1 ) 408 CALL ctl_warn( ' Bit comparison enabled Single and multiple processor results should bit compare', & 409 & ' WARNING: RESULTS ARE NOT PHYSICAL.' ) 410 CASE DEFAULT 411 CALL ctl_warn( ' Bit comparison not enabled. Single and multiple processor results will differ.' ) 412 END SELECT 413 346 414 347 415 ! Read Namelist namflg : algorithm FLaG … … 352 420 ! Parameter control and print 353 421 ! --------------------------- 354 ! Control print355 422 IF(lwp) THEN 356 423 WRITE(numout,*) 357 WRITE(numout,*) 'opa_flg : algorithm flag initialization'424 WRITE(numout,*) 'opa_flg : Hydrostatic pressure gradient algorithm' 358 425 WRITE(numout,*) '~~~~~~~' 359 426 WRITE(numout,*) ' Namelist namflg : set algorithm flags' 360 WRITE(numout,*)361 427 WRITE(numout,*) ' centered (F) or semi-implicit (T) ln_dynhpg_imp = ', ln_dynhpg_imp 362 428 WRITE(numout,*) ' hydrostatic pressure gradient'
Note: See TracChangeset
for help on using the changeset viewer.
