- Timestamp:
- 2013-01-23T15:33:04+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3701 r3764 6 6 !! History : OPA ! 1990-10 (C. Levy, G. Madec) Original code 7 7 !! 7.0 ! 1991-11 (M. Imbard, C. Levy, G. Madec) 8 !! 7.1 ! 1993-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 9 !! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 8 !! 7.1 ! 1993-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 9 !! P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1 10 10 !! - ! 1992-06 (L.Terray) coupling implementation 11 !! - ! 1993-11 (M.A. Filiberti) IGLOO sea-ice 12 !! 8.0 ! 1996-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 11 !! - ! 1993-11 (M.A. Filiberti) IGLOO sea-ice 12 !! 8.0 ! 1996-03 (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar, 13 13 !! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0 14 14 !! 8.1 ! 1997-06 (M. Imbard, G. Madec) 15 !! 8.2 ! 1999-11 (M. Imbard, H. Goosse) LIM sea-ice model 16 !! ! 1999-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 15 !! 8.2 ! 1999-11 (M. Imbard, H. Goosse) LIM sea-ice model 16 !! ! 1999-12 (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols) OPEN-MP 17 17 !! ! 2000-07 (J-M Molines, M. Imbard) Open Boundary Conditions (CLIPPER) 18 18 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and modules … … 25 25 !! - ! 2007-07 (J. Chanut, A. Sellar) Unstructured open boundaries (BDY) 26 26 !! 3.2 ! 2009-08 (S. Masson) open/write in the listing file in mpp 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 27 !! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 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 … … 34 34 !! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice 35 35 !! nemo_init : initialization of the NEMO system 36 !! nemo_ctl : initialisation of the contol print 36 !! nemo_ctl : initialisation of the contol print 37 37 !! nemo_closefile : close remaining open files 38 38 !! nemo_alloc : dynamical allocation … … 64 64 USE diadct ! sections transports (dia_dct_init routine) 65 65 USE diaobs ! Observation diagnostics (dia_obs_init routine) 66 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 66 67 USE step ! NEMO time-stepping (stp routine) 67 68 USE icbini ! handle bergs, initialisation … … 83 84 USE sbctide, ONLY: lk_tide 84 85 85 86 86 IMPLICIT NONE 87 87 PRIVATE … … 89 89 PUBLIC nemo_gcm ! called by model.F90 90 90 PUBLIC nemo_init ! needed by AGRIF 91 PUBLIC nemo_alloc ! needed by TAM 91 92 92 93 CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing … … 103 104 !! *** ROUTINE nemo_gcm *** 104 105 !! 105 !! ** Purpose : NEMO solves the primitive equations on an orthogonal 106 !! ** Purpose : NEMO solves the primitive equations on an orthogonal 106 107 !! curvilinear mesh on the sphere. 107 108 !! … … 151 152 IF( lk_asminc ) THEN 152 153 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields 153 IF( ln_trjwri ) CALL asm_trj_wri( nit000 - 1 ) ! Output trajectory fields154 154 IF( ln_asmdin ) THEN ! Direct initialization 155 155 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers 156 IF( ln_dyninc ) THEN 157 CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 158 IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 ) ! update vertical velocity 159 ENDIF 156 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 160 157 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH 161 158 ENDIF 162 159 ENDIF 163 160 164 161 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 165 162 #if defined key_agrif … … 176 173 ! 177 174 IF( ln_icebergs ) CALL icb_end( nitend ) 178 175 179 176 ! !------------------------! 180 177 ! !== finalize the run ==! … … 184 181 IF( nstop /= 0 .AND. lwp ) THEN ! error print 185 182 WRITE(numout,cform_err) 186 WRITE(numout,*) nstop, ' error have been found' 183 WRITE(numout,*) nstop, ' error have been found' 187 184 ENDIF 188 185 ! … … 261 258 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 262 259 263 ! If dimensions of processor grid weren't specified in the namelist file 260 ! If dimensions of processor grid weren't specified in the namelist file 264 261 ! then we calculate them here now that we have our communicator size 265 262 IF( (jpni < 1) .OR. (jpnj < 1) )THEN … … 302 299 WRITE(numout,*) 303 300 WRITE(numout,*) 304 DO ji = 1, SIZE(cltxt) 301 DO ji = 1, SIZE(cltxt) 305 302 IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 306 303 END DO … … 309 306 ENDIF 310 307 311 ! Now we know the dimensions of the grid and numout has been set we can 308 ! Now we know the dimensions of the grid and numout has been set we can 312 309 ! allocate arrays 313 310 CALL nemo_alloc() … … 336 333 IF( ln_ctl ) CALL prt_ctl_init ! Print control 337 334 338 IF( lk_obc ) CALL obc_init ! Open boundaries 335 IF( lk_obc ) CALL obc_init ! Open boundaries 339 336 340 337 CALL istate_init ! ocean initial state (Dynamics and tracers) … … 349 346 350 347 ! ! Ocean physics 351 CALL sbc_init ! Forcings : surface module 348 CALL sbc_init ! Forcings : surface module 352 349 ! ! Vertical physics 353 350 CALL zdf_init ! namelist read … … 358 355 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme 359 356 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 360 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 357 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 361 358 & CALL zdf_ddm_init ! double diffusive mixing 362 359 ! ! Lateral physics … … 381 378 CALL dyn_zdf_init ! vertical diffusion 382 379 CALL dyn_spg_init ! surface pressure gradient 383 380 384 381 ! ! Misc. options 385 382 IF( nn_cla == 1 ) CALL cla_init ! Cross Land Advection … … 401 398 CALL dia_obs_init ! Initialize observational data 402 399 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 403 ENDIF 400 ENDIF 404 401 ! ! Assimilation increments 405 402 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments … … 413 410 !! *** ROUTINE nemo_ctl *** 414 411 !! 415 !! ** Purpose : control print setting 412 !! ** Purpose : control print setting 416 413 !! 417 414 !! ** Method : - print namctl information and check some consistencies … … 460 457 ! ! indices used for the SUM control 461 458 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area 462 lsp_area = .FALSE. 459 lsp_area = .FALSE. 463 460 ELSE ! print control done over a specific area 464 461 lsp_area = .TRUE. … … 482 479 ENDIF 483 480 ! 484 IF( nbench == 1 ) THEN ! Benchmark 481 IF( nbench == 1 ) THEN ! Benchmark 485 482 SELECT CASE ( cp_cfg ) 486 483 CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' ) … … 493 490 & 'with the IOM Input/Output manager. ' , & 494 491 & 'Compile with key_iomput enabled' ) 492 ! 493 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 494 & 'f2003 standard. ' , & 495 & 'Compile with key_nosignedzero enabled' ) 495 496 ! 496 497 END SUBROUTINE nemo_ctl … … 544 545 !!---------------------------------------------------------------------- 545 546 ! 546 ierr = oce_alloc () ! ocean 547 ierr = oce_alloc () ! ocean 547 548 ierr = ierr + dia_wri_alloc () 548 549 ierr = ierr + dom_oce_alloc () ! ocean domain … … 568 569 !! *** ROUTINE nemo_partition *** 569 570 !! 570 !! ** Purpose : 571 !! ** Purpose : 571 572 !! 572 573 !! ** Method : … … 616 617 !! 617 618 !! ** Purpose : return the prime factors of n. 618 !! knfax factors are returned in array kfax which is of 619 !! knfax factors are returned in array kfax which is of 619 620 !! maximum dimension kmaxfax. 620 621 !! ** Method : … … 684 685 !!===================================================================== 685 686 !!---------------------------------------------------------------------- 686 !! 687 !! 687 688 !! ** Purpose : Initialization of the northern neighbours lists. 688 689 !!---------------------------------------------------------------------- 689 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 690 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 690 691 !!---------------------------------------------------------------------- 691 692 … … 769 770 jtyp = 5 770 771 lrankset = .FALSE. 771 znnbrs = narea 772 znnbrs = narea 772 773 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 773 774 … … 782 783 ENDIF 783 784 784 znnbrs = narea 785 znnbrs = narea 785 786 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 786 787 … … 805 806 END DO 806 807 ! 807 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 808 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 808 809 ! can use peer to peer communications at the north fold 809 810 !
Note: See TracChangeset
for help on using the changeset viewer.
