- Timestamp:
- 2016-10-04T15:01:17+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r6596 r6982 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 30 !! 3.4 ! 2011-11 (C. Harris) decomposition changes for running with CICE 30 !! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms 31 !! - ! 2011-11 (C. Harris) decomposition changes for running with CICE 32 !! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening 33 !! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication 34 !! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla) 31 35 !!---------------------------------------------------------------------- 32 36 … … 64 68 #endif 65 69 USE bdy_par 70 USE usrdef_nam ! user defined configuration 66 71 67 72 IMPLICIT NONE … … 74 79 75 80 !!---------------------------------------------------------------------- 76 !! NEMO/OPA 4.0 , NEMO Consortium (201 1)81 !! NEMO/OPA 4.0 , NEMO Consortium (2016) 77 82 !! $Id$ 78 83 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 84 89 !! *** ROUTINE nemo_gcm *** 85 90 !! 86 !! ** Purpose : NEMO solves the primitive equations on an orthogonal 91 !! ** Purpose : NEMO solves the primitive equations on an orthogonal 87 92 !! curvilinear mesh on the sphere. 88 93 !! … … 124 129 ! !-----------------------! 125 130 istp = nit000 126 131 #if defined key_agrif 132 CALL Agrif_Regrid() 133 #endif 134 127 135 DO WHILE ( istp <= nitend .AND. nstop == 0 ) 128 136 #if defined key_agrif 129 CALL Agrif_Step( stp )! AGRIF: time stepping137 CALL stp ! AGRIF: time stepping 130 138 #else 131 CALL stp( istp ) ! standard time stepping 139 IF ( .NOT. ln_diurnal_only ) THEN 140 CALL stp( istp ) ! standard time stepping 141 ELSE 142 CALL stp_diurnal( istp ) ! time step only the diurnal SST 143 ENDIF 132 144 #endif 133 145 istp = istp + 1 134 146 IF( lk_mpp ) CALL mpp_max( nstop ) 135 END DO147 END DO 136 148 ! 137 149 IF( ln_icebergs ) CALL icb_end( nitend ) … … 157 169 ! 158 170 #if defined key_iomput 159 CALL xios_finalize ! end mpp communications with xios160 IF( lk_oasis ) CALL cpl_finalize! end coupling and mpp communications with OASIS171 CALL xios_finalize ! end mpp communications with xios 172 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 161 173 #else 162 174 IF( lk_oasis ) THEN … … 176 188 !! ** Purpose : initialization of the NEMO GCM 177 189 !!---------------------------------------------------------------------- 178 INTEGER :: ji ! dummy loop indices 179 INTEGER :: ilocal_comm ! local integer 180 INTEGER :: ios 181 CHARACTER(len=80), DIMENSION(16) :: cltxt 182 CHARACTER(len=80) :: clname 190 INTEGER :: ji ! dummy loop indices 191 INTEGER :: ilocal_comm ! local integer 192 INTEGER :: ios, inum ! - - 193 REAL(wp) :: ziglo, zjglo, zkglo, zperio ! local scalars 194 CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam, clbug 195 CHARACTER(len=80) :: clname 183 196 ! 184 197 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 185 198 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 186 & nn_bench, nn_timing, nn_diacfl 187 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, & 188 & jperio, ln_use_jattr 189 !!---------------------------------------------------------------------- 190 ! 191 cltxt = '' 199 & nn_timing, nn_diacfl 200 NAMELIST/namcfg/ ln_read_cfg, ln_write_cfg, cp_cfg, jp_cfg, ln_use_jattr 201 !!---------------------------------------------------------------------- 202 ! 203 cltxt = '' 204 cltxt2 = '' 205 clnam = '' 206 clbug = '' 207 cxios_context = 'nemo' 192 208 ! 193 209 ! ! Open reference namelist and configuration namelist files … … 221 237 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 222 238 223 ! Force values for AGRIF zoom (cf. agrif_user.F90) 239 !!gm WRITE(clbug(3),*) ' after namelist namcfg read nstop', nstop 240 241 ! !--------------------------! 242 ! ! Set global domain size ! (control print return in cltxt2) 243 ! !--------------------------! 244 IF( ln_read_cfg ) THEN ! Read sizes in configuration "mesh_mask" file 245 CALL iom_open( 'domain_cfg', inum ) 246 CALL iom_get( inum, 'jpiglo', ziglo ) ; jpiglo = INT( ziglo ) 247 CALL iom_get( inum, 'jpjglo', zjglo ) ; jpjglo = INT( zjglo ) 248 CALL iom_get( inum, 'jpkglo', zkglo ) ; jpkglo = INT( zkglo ) 249 CALL iom_get( inum, 'jperio', zperio ) ; jperio = INT( zperio ) 250 CALL iom_close( inum ) 251 WRITE(cltxt2(1),*) 252 WRITE(cltxt2(2),*) 'domain_cfg : domain size read in "domain_cfg" file : jp(i,j,k)glo = ', jpiglo, jpjglo, jpkglo 253 WRITE(cltxt2(3),*) '~~~~~~~~~~ lateral boudary type of the global domain jperio= ', jperio 254 ! 255 ELSE ! user-defined namelist 256 CALL usr_def_nam( cltxt2, clnam, jpiglo, jpjglo, jpkglo, jperio ) 257 ENDIF 258 jpk = jpkglo 259 ! 224 260 #if defined key_agrif 225 IF( .NOT. Agrif_Root() ) THEN 226 jpiglo = nbcellsx + 2 + 2*nbghostcells 227 jpjglo = nbcellsy + 2 + 2*nbghostcells 228 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 229 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 230 jpidta = jpiglo 231 jpjdta = jpjglo 232 nperio = 0 233 jperio = 0 234 ln_use_jattr = .false. 235 ENDIF 261 IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90) 262 jpiglo = nbcellsx + 2 + 2*nbghostcells 263 jpjglo = nbcellsy + 2 + 2*nbghostcells 264 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 265 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 266 nperio = 0 267 jperio = 0 268 ln_use_jattr = .false. 269 ENDIF 236 270 #endif 237 271 ! … … 273 307 WRITE( numond, namctl ) 274 308 WRITE( numond, namcfg ) 309 IF( .NOT.ln_read_cfg ) THEN 310 DO ji = 1, SIZE(clnam) 311 IF( TRIM(clnam (ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print 312 END DO 313 ENDIF 275 314 ENDIF 276 315 277 316 ! If dimensions of processor grid weren't specified in the namelist file 278 317 ! then we calculate them here now that we have our communicator size 279 IF( (jpni < 1) .OR. (jpnj < 1) )THEN318 IF( jpni < 1 .OR. jpnj < 1 ) THEN 280 319 #if defined key_mpp_mpi 281 IF( Agrif_Root() ) CALL nemo_partition(mppsize)320 IF( Agrif_Root() ) CALL nemo_partition( mppsize ) 282 321 #else 283 322 jpni = 1 … … 285 324 jpnij = jpni*jpnj 286 325 #endif 287 END 326 ENDIF 288 327 289 328 ! Calculate domain dimensions given calculated jpni and jpnj … … 299 338 #endif 300 339 ENDIF 301 jpk = jpkdta ! third dim 302 jpim1 = jpi-1 ! inner domain indices 303 jpjm1 = jpj-1 ! " " 304 jpkm1 = jpk-1 ! " " 305 jpij = jpi*jpj ! jpi x j 340 341 !!gm ??? why here it has already been done in line 301 ! 342 jpk = jpkglo ! third dim 343 !!gm end 344 345 #if defined key_agrif 346 ! simple trick to use same vertical grid as parent but different number of levels: 347 ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 348 ! Suppress once vertical online interpolation is ok 349 IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo ) 350 #endif 351 jpim1 = jpi-1 ! inner domain indices 352 jpjm1 = jpj-1 ! " " 353 jpkm1 = jpk-1 ! " " 354 jpij = jpi*jpj ! jpi x j 306 355 307 356 IF(lwp) THEN ! open listing units … … 317 366 WRITE(numout,*) ' NEMO team' 318 367 WRITE(numout,*) ' Ocean General Circulation Model' 319 WRITE(numout,*) ' version 3. 6(2015) '368 WRITE(numout,*) ' version 3.7 (2015) ' 320 369 WRITE(numout,*) ' StandAlone Surface version (SAS) ' 321 370 WRITE(numout,*) … … 324 373 IF( TRIM(cltxt(ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode 325 374 END DO 375 WRITE(numout,*) 376 WRITE(numout,*) 377 DO ji = 1, SIZE(cltxt2) 378 ! IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) cltxt2(ji) ! control print of domain size 379 IF( cltxt2(ji) /= '' ) WRITE(numout,*) cltxt2(ji) ! control print of domain size 380 END DO 381 ! 326 382 WRITE(numout,cform_aaa) ! Flag AAAAAAA 327 383 ! … … 392 448 WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt 393 449 WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt 394 WRITE(numout,*) ' benchmark parameter (0/1) nn_bench = ', nn_bench450 WRITE(numout,*) ' timing activated (0/1) nn_timing = ', nn_timing 395 451 ENDIF 396 452 ! … … 402 458 isplt = nn_isplt 403 459 jsplt = nn_jsplt 404 nbench = nn_bench405 460 406 461 IF(lwp) THEN ! control print … … 409 464 WRITE(numout,*) '~~~~~~~ ' 410 465 WRITE(numout,*) ' Namelist namcfg' 411 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 412 WRITE(numout,*) ' configuration zoom name cp_cfz = ', TRIM(cp_cfz) 413 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 414 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 466 WRITE(numout,*) ' read configuration definition files ln_read_cfg = ', ln_read_cfg 467 WRITE(numout,*) ' configuration name cp_cfg = ', TRIM(cp_cfg) 468 WRITE(numout,*) ' configuration resolution jp_cfg = ', jp_cfg 415 469 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 416 470 ENDIF … … 609 663 610 664 ! Clear the error flag and initialise output vars 611 kerr = 0612 kfax = 1665 kerr = 0 666 kfax = 1 613 667 knfax = 0 614 668 ! 615 669 ! Find the factors of n. 616 670 IF( kn == 1 ) GOTO 20 … … 620 674 ! l points to the allowed factor list. 621 675 ! ifac holds the current factor. 622 676 ! 623 677 inu = kn 624 678 knfax = 0 625 679 ! 626 680 DO jl = ntest, 1, -1 627 681 ! … … 647 701 ! 648 702 END DO 649 703 ! 650 704 20 CONTINUE ! Label 20 is the exit point from the factor search loop. 651 705 ! … … 653 707 654 708 #if defined key_mpp_mpi 709 655 710 SUBROUTINE nemo_northcomms 656 711 !!====================================================================== … … 666 721 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 667 722 !!---------------------------------------------------------------------- 668 669 723 INTEGER :: sxM, dxM, sxT, dxT, jn 670 724 INTEGER :: njmppmax 671 725 !!---------------------------------------------------------------------- 726 ! 672 727 njmppmax = MAXVAL( njmppt ) 673 728 ! 674 729 !initializes the north-fold communication variables 675 730 isendto(:) = 0 676 nsndto = 0677 731 nsndto = 0 732 ! 678 733 !if I am a process in the north 679 734 IF ( njmpp == njmppmax ) THEN
Note: See TracChangeset
for help on using the changeset viewer.