Changeset 3604 for trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
- Timestamp:
- 2012-11-19T15:21:34+01:00 (11 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 (modified) (29 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r3558 r3604 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 … … 56 56 USE phycst ! physical constant (par_cst routine) 57 57 USE trdmod ! momentum/tracers trends (trd_mod_init routine) 58 USE asm trj! writing out state trajectory58 USE asmbkg ! writing out state trajectory 59 59 USE diaptr ! poleward transports (dia_ptr_init routine) 60 60 USE diadct ! sections transports (dia_dct_init routine) … … 76 76 USE mod_ioclient 77 77 #endif 78 USE tamtrj ! Output trajectory, needed for TAM 78 79 79 80 IMPLICIT NONE … … 82 83 PUBLIC nemo_gcm ! called by model.F90 83 84 PUBLIC nemo_init ! needed by AGRIF 85 PUBLIC nemo_alloc ! needed by TAM 84 86 85 87 CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing … … 96 98 !! *** ROUTINE nemo_gcm *** 97 99 !! 98 !! ** Purpose : NEMO solves the primitive equations on an orthogonal 100 !! ** Purpose : NEMO solves the primitive equations on an orthogonal 99 101 !! curvilinear mesh on the sphere. 100 102 !! … … 140 142 IF( lk_asminc ) THEN 141 143 IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields 142 IF( ln_trjwri ) CALL asm_trj_wri( nit000 - 1 ) ! Output trajectory fields143 144 IF( ln_asmdin ) THEN ! Direct initialization 144 145 IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers 145 IF( ln_dyninc ) THEN 146 CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 147 IF ( ln_asmdin ) CALL ssh_wzv ( nit000 - 1 ) ! update vertical velocity 148 ENDIF 146 IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics 149 147 IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH 150 148 ENDIF 151 149 ENDIF 152 150 153 151 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 154 152 #if defined key_agrif … … 163 161 164 162 IF( lk_diaobs ) CALL dia_obs_wri 165 163 166 164 ! !------------------------! 167 165 ! !== finalize the run ==! … … 171 169 IF( nstop /= 0 .AND. lwp ) THEN ! error print 172 170 WRITE(numout,cform_err) 173 WRITE(numout,*) nstop, ' error have been found' 171 WRITE(numout,*) nstop, ' error have been found' 174 172 ENDIF 175 173 ! … … 240 238 lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print 241 239 242 ! If dimensions of processor grid weren't specified in the namelist file 240 ! If dimensions of processor grid weren't specified in the namelist file 243 241 ! then we calculate them here now that we have our communicator size 244 242 IF( (jpni < 1) .OR. (jpnj < 1) )THEN … … 258 256 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 259 257 #if defined key_nemocice_decomp 260 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 258 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 261 259 #else 262 260 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. … … 280 278 WRITE(numout,*) 281 279 WRITE(numout,*) 282 DO ji = 1, SIZE(cltxt) 280 DO ji = 1, SIZE(cltxt) 283 281 IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 284 282 END DO … … 287 285 ENDIF 288 286 289 ! Now we know the dimensions of the grid and numout has been set we can 287 ! Now we know the dimensions of the grid and numout has been set we can 290 288 ! allocate arrays 291 289 CALL nemo_alloc() … … 314 312 IF( ln_ctl ) CALL prt_ctl_init ! Print control 315 313 316 IF( lk_obc ) CALL obc_init ! Open boundaries 314 IF( lk_obc ) CALL obc_init ! Open boundaries 317 315 IF( lk_bdy ) CALL bdy_init ! Open boundaries initialisation 318 316 IF( lk_bdy ) CALL bdy_dta_init ! Open boundaries initialisation of external data arrays … … 326 324 327 325 ! ! Ocean physics 328 CALL sbc_init ! Forcings : surface module 326 CALL sbc_init ! Forcings : surface module 329 327 ! ! Vertical physics 330 328 CALL zdf_init ! namelist read … … 335 333 IF( lk_zdfkpp ) CALL zdf_kpp_init ! KPP closure scheme 336 334 IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing 337 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 335 IF( lk_zdfddm .AND. .NOT. lk_zdfkpp ) & 338 336 & CALL zdf_ddm_init ! double diffusive mixing 339 337 ! ! Lateral physics … … 358 356 CALL dyn_zdf_init ! vertical diffusion 359 357 CALL dyn_spg_init ! surface pressure gradient 360 358 361 359 ! ! Misc. options 362 360 IF( nn_cla == 1 ) CALL cla_init ! Cross Land Advection 363 361 364 362 #if defined key_top 365 363 ! ! Passive tracers … … 377 375 CALL dia_obs_init ! Initialize observational data 378 376 CALL dia_obs( nit000 - 1 ) ! Observation operator for restart 379 ENDIF 377 ENDIF 380 378 ! ! Assimilation increments 381 379 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 382 380 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 381 CALL tam_trj_init ! Trajectory handling 383 382 ! 384 383 END SUBROUTINE nemo_init … … 389 388 !! *** ROUTINE nemo_ctl *** 390 389 !! 391 !! ** Purpose : control print setting 390 !! ** Purpose : control print setting 392 391 !! 393 392 !! ** Method : - print namctl information and check some consistencies … … 436 435 ! ! indices used for the SUM control 437 436 IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area 438 lsp_area = .FALSE. 437 lsp_area = .FALSE. 439 438 ELSE ! print control done over a specific area 440 439 lsp_area = .TRUE. … … 458 457 ENDIF 459 458 ! 460 IF( nbench == 1 ) THEN ! Benchmark 459 IF( nbench == 1 ) THEN ! Benchmark 461 460 SELECT CASE ( cp_cfg ) 462 461 CASE ( 'gyre' ) ; CALL ctl_warn( ' The Benchmark is activated ' ) … … 521 520 !!---------------------------------------------------------------------- 522 521 ! 523 ierr = oce_alloc () ! ocean 522 ierr = oce_alloc () ! ocean 524 523 ierr = ierr + dia_wri_alloc () 525 524 ierr = ierr + dom_oce_alloc () ! ocean domain … … 541 540 !! *** ROUTINE nemo_partition *** 542 541 !! 543 !! ** Purpose : 542 !! ** Purpose : 544 543 !! 545 544 !! ** Method : … … 589 588 !! 590 589 !! ** Purpose : return the prime factors of n. 591 !! knfax factors are returned in array kfax which is of 590 !! knfax factors are returned in array kfax which is of 592 591 !! maximum dimension kmaxfax. 593 592 !! ** Method : … … 657 656 !!===================================================================== 658 657 !!---------------------------------------------------------------------- 659 !! 658 !! 660 659 !! ** Purpose : Initialization of the northern neighbours lists. 661 660 !!---------------------------------------------------------------------- 662 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 661 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 663 662 !!---------------------------------------------------------------------- 664 663 … … 742 741 jtyp = 5 743 742 lrankset = .FALSE. 744 znnbrs = narea 743 znnbrs = narea 745 744 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 746 745 … … 755 754 ENDIF 756 755 757 znnbrs = narea 756 znnbrs = narea 758 757 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 759 758 … … 778 777 END DO 779 778 ! 780 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 779 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 781 780 ! can use peer to peer communications at the north fold 782 781 !
Note: See TracChangeset
for help on using the changeset viewer.
