- Timestamp:
- 2015-07-21T13:25:36+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
- Property svn:keywords set to Id
r5120 r5621 42 42 USE step_oce ! module used in the ocean time stepping module 43 43 USE sbc_oce ! surface boundary condition: ocean 44 USE cla ! cross land advection (tra_cla routine)45 44 USE domcfg ! domain configuration (dom_cfg routine) 46 45 USE daymod ! calendar … … 50 49 USE step ! NEMO time-stepping (stp routine) 51 50 USE lib_mpp ! distributed memory computing 51 #if defined key_nosignedzero 52 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 53 #endif 52 54 #if defined key_iomput 53 55 USE xios 54 56 #endif 57 USE cpl_oasis3 55 58 USE sbcssm 56 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 59 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 60 USE icbstp ! handle bergs, calving, themodynamics and transport 61 #if defined key_bdy 62 USE bdyini ! open boundary cond. setting (bdy_init routine). clem: mandatory for LIM3 63 USE bdydta ! open boundary cond. setting (bdy_dta_init routine). clem: mandatory for LIM3 64 #endif 65 USE bdy_par 57 66 58 67 IMPLICIT NONE … … 66 75 !!---------------------------------------------------------------------- 67 76 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 68 !! $Id : nemogcm.F90 3294 2012-01-28 16:44:18Z rblod$77 !! $Id$ 69 78 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 70 79 !!---------------------------------------------------------------------- … … 96 105 ! !-----------------------! 97 106 #if defined key_agrif 98 CALL Agrif_Declare_Var ! AGRIF: set the meshes 107 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 108 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 109 # if defined key_top 110 CALL Agrif_Declare_Var_top ! " " " " " TOP 111 # endif 112 # if defined key_lim2 113 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 114 # endif 99 115 #endif 100 116 ! check that all process are still there... If some process have an error, … … 118 134 IF( lk_mpp ) CALL mpp_max( nstop ) 119 135 END DO 136 ! 137 IF( ln_icebergs ) CALL icb_end( nitend ) 138 120 139 ! !------------------------! 121 140 ! !== finalize the run ==! … … 136 155 ! 137 156 CALL nemo_closefile 157 ! 138 158 #if defined key_iomput 139 159 CALL xios_finalize ! end mpp communications with xios 160 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 140 161 #else 141 IF( lk_mpp ) CALL mppstop ! end mpp communications 162 IF( lk_oasis ) THEN 163 CALL cpl_finalize ! end coupling and mpp communications with OASIS 164 ELSE 165 IF( lk_mpp ) CALL mppstop ! end mpp communications 166 ENDIF 142 167 #endif 143 168 ! … … 154 179 INTEGER :: ilocal_comm ! local integer 155 180 INTEGER :: ios 156 157 181 CHARACTER(len=80), DIMENSION(16) :: cltxt 158 !! 182 CHARACTER(len=80) :: clname 183 ! 159 184 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 160 185 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & … … 163 188 & jpizoom, jpjzoom, jperio, ln_use_jattr 164 189 !!---------------------------------------------------------------------- 190 ! 165 191 cltxt = '' 166 192 ! 167 193 ! ! Open reference namelist and configuration namelist files 168 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 169 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 194 IF( lk_oasis ) THEN 195 CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 196 CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 197 cxios_context = 'sas' 198 clname = 'output.namelist_sas.dyn' 199 ELSE 200 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 201 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 202 cxios_context = 'nemo' 203 clname = 'output.namelist.dyn' 204 ENDIF 170 205 ! 171 206 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark … … 186 221 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 187 222 223 ! Force values for AGRIF zoom (cf. agrif_user.F90) 224 #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 jpizoom = 1 233 jpjzoom = 1 234 nperio = 0 235 jperio = 0 236 ln_use_jattr = .false. 237 ENDIF 238 #endif 239 ! 188 240 ! !--------------------------------------------! 189 241 ! ! set communicator & select the local node ! … … 193 245 #if defined key_iomput 194 246 IF( Agrif_Root() ) THEN 195 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) 196 ENDIF 197 narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 247 IF( lk_oasis ) THEN 248 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 249 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 250 ELSE 251 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 252 ENDIF 253 ENDIF 254 narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 198 255 #else 199 ilocal_comm = 0 200 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 256 IF( lk_oasis ) THEN 257 IF( Agrif_Root() ) THEN 258 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 259 ENDIF 260 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 261 ELSE 262 ilocal_comm = 0 263 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 264 ENDIF 201 265 #endif 202 266 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) … … 229 293 ! than variables 230 294 IF( Agrif_Root() ) THEN 295 #if defined key_nemocice_decomp 296 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 297 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 298 #else 231 299 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 232 #if defined key_nemocice_decomp233 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.234 #else235 300 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 236 301 #endif 302 ENDIF 237 303 jpk = jpkdta ! third dim 238 304 jpim1 = jpi-1 ! inner domain indices … … 240 306 jpkm1 = jpk-1 ! " " 241 307 jpij = jpi*jpj ! jpi x j 242 ENDIF243 308 244 309 IF(lwp) THEN ! open listing units 245 310 ! 246 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 311 IF( lk_oasis ) THEN 312 CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 313 ELSE 314 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 315 ENDIF 247 316 ! 248 317 WRITE(numout,*) … … 287 356 288 357 IF( ln_ctl ) CALL prt_ctl_init ! Print control 289 CALL flush(numout)290 291 358 CALL day_init ! model calendar (using both namelist and restart infos) 292 359 293 360 CALL sbc_init ! Forcings : surface module 361 362 ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from 363 ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 364 ! This is not clean and should be changed in the future. 365 IF( lk_bdy ) CALL bdy_init 366 IF( lk_bdy ) CALL bdy_dta_init 367 ! ==> 294 368 295 369 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler … … 397 471 ENDIF 398 472 ! 473 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 474 & 'f2003 standard. ' , & 475 & 'Compile with key_nosignedzero enabled' ) 476 ! 399 477 END SUBROUTINE nemo_ctl 400 478 … … 436 514 USE diawri , ONLY: dia_wri_alloc 437 515 USE dom_oce , ONLY: dom_oce_alloc 438 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 439 ! 440 INTEGER :: ierr,ierr4 516 #if defined key_bdy 517 USE bdy_oce , ONLY: bdy_oce_alloc 518 USE oce ! clem: mandatory for LIM3 because needed for bdy arrays 519 #else 520 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 521 #endif 522 ! 523 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 524 INTEGER :: jpm 441 525 !!---------------------------------------------------------------------- 442 526 ! 443 527 ierr = dia_wri_alloc () 444 528 ierr = ierr + dom_oce_alloc () ! ocean domain 445 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 446 & snwice_fmass(jpi,jpj), STAT= ierr4 ) 447 ierr = ierr + ierr4 529 #if defined key_bdy 530 ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization) 531 ierr = ierr + oce_alloc () ! (tsn...) 532 #endif 533 534 #if ! defined key_bdy 535 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 536 & snwice_fmass(jpi,jpj) , STAT= ierr1 ) 537 ! 538 ! lim code currently uses surface temperature and salinity in tsn array for initialisation 539 ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use 540 ! clem: should not be needed. To be checked out 541 jpm = MAX(jp_tem, jp_sal) 542 ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 ) 543 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 ) 544 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 ) 545 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 546 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 547 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 548 #endif 448 549 ! 449 550 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 470 571 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 471 572 !!---------------------------------------------------------------------- 472 573 ! 473 574 ierr = 0 474 575 ! 475 576 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 476 577 ! 477 578 IF( nfact <= 1 ) THEN 478 579 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 516 617 INTEGER, PARAMETER :: ntest = 14 517 618 INTEGER :: ilfax(ntest) 518 619 ! 519 620 ! lfax contains the set of allowed factors. 520 621 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 601 702 !loop over the other north-fold processes to find the processes 602 703 !managing the points belonging to the sxT-dxT range 603 DO jn = jpnij - jpni +1, jpnij604 IF ( njmppt(jn) == njmppmax ) THEN704 705 DO jn = 1, jpni 605 706 !sxT is the first point (in the global domain) of the jn 606 707 !process 607 sxT = n imppt(jn)708 sxT = nfiimpp(jn, jpnj) 608 709 !dxT is the last point (in the global domain) of the jn 609 710 !process 610 dxT = n imppt(jn) + nlcit(jn) - 1711 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 611 712 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 612 713 nsndto = nsndto + 1 613 isendto(nsndto) = jn614 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN714 isendto(nsndto) = jn 715 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 615 716 nsndto = nsndto + 1 616 717 isendto(nsndto) = jn … … 619 720 isendto(nsndto) = jn 620 721 END IF 621 END IF622 722 END DO 723 nfsloop = 1 724 nfeloop = nlci 725 DO jn = 2,jpni-1 726 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 727 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 728 nfsloop = nldi 729 ENDIF 730 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 731 nfeloop = nlei 732 ENDIF 733 ENDIF 734 END DO 735 623 736 ENDIF 624 737 l_north_nogather = .TRUE.
Note: See TracChangeset
for help on using the changeset viewer.
