- Timestamp:
- 2015-06-22T16:40:58+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/restart_datestamp/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5420 r5462 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 57 61 58 62 IMPLICIT NONE … … 96 100 ! !-----------------------! 97 101 #if defined key_agrif 98 CALL Agrif_Declare_Var ! AGRIF: set the meshes 102 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 103 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 104 # if defined key_top 105 CALL Agrif_Declare_Var_top ! " " " " " TOP 106 # endif 107 # if defined key_lim2 108 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 109 # endif 99 110 #endif 100 111 ! check that all process are still there... If some process have an error, … … 118 129 IF( lk_mpp ) CALL mpp_max( nstop ) 119 130 END DO 131 ! 132 IF( ln_icebergs ) CALL icb_end( nitend ) 133 120 134 ! !------------------------! 121 135 ! !== finalize the run ==! … … 136 150 ! 137 151 CALL nemo_closefile 152 ! 138 153 #if defined key_iomput 139 154 CALL xios_finalize ! end mpp communications with xios 155 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 140 156 #else 141 IF( lk_mpp ) CALL mppstop ! end mpp communications 157 IF( lk_oasis ) THEN 158 CALL cpl_finalize ! end coupling and mpp communications with OASIS 159 ELSE 160 IF( lk_mpp ) CALL mppstop ! end mpp communications 161 ENDIF 142 162 #endif 143 163 ! … … 154 174 INTEGER :: ilocal_comm ! local integer 155 175 INTEGER :: ios 156 157 176 CHARACTER(len=80), DIMENSION(16) :: cltxt 158 !! 177 CHARACTER(len=80) :: clname 178 ! 159 179 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 160 180 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 161 181 & nn_bench, nn_timing 162 182 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 163 & jpizoom, jpjzoom, jperio 164 !!---------------------------------------------------------------------- 183 & jpizoom, jpjzoom, jperio, ln_use_jattr 184 !!---------------------------------------------------------------------- 185 ! 165 186 cltxt = '' 166 187 ! 167 188 ! ! 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. ) 189 IF( lk_oasis ) THEN 190 CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 191 CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 192 cxios_context = 'sas' 193 clname = 'output.namelist_sas.dyn' 194 ELSE 195 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 196 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 197 cxios_context = 'nemo' 198 clname = 'output.namelist.dyn' 199 ENDIF 170 200 ! 171 201 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark … … 186 216 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 187 217 218 ! Force values for AGRIF zoom (cf. agrif_user.F90) 219 #if defined key_agrif 220 IF( .NOT. Agrif_Root() ) THEN 221 jpiglo = nbcellsx + 2 + 2*nbghostcells 222 jpjglo = nbcellsy + 2 + 2*nbghostcells 223 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 224 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 225 jpidta = jpiglo 226 jpjdta = jpjglo 227 jpizoom = 1 228 jpjzoom = 1 229 nperio = 0 230 jperio = 0 231 ln_use_jattr = .false. 232 ENDIF 233 #endif 234 ! 188 235 ! !--------------------------------------------! 189 236 ! ! set communicator & select the local node ! … … 193 240 #if defined key_iomput 194 241 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 242 IF( lk_oasis ) THEN 243 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 244 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 245 ELSE 246 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 247 ENDIF 248 ENDIF 249 narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 198 250 #else 199 ilocal_comm = 0 200 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 251 IF( lk_oasis ) THEN 252 IF( Agrif_Root() ) THEN 253 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 254 ENDIF 255 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 256 ELSE 257 ilocal_comm = 0 258 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 259 ENDIF 201 260 #endif 202 261 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) … … 229 288 ! than variables 230 289 IF( Agrif_Root() ) THEN 290 #if defined key_nemocice_decomp 291 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 292 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 293 #else 231 294 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 295 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 236 296 #endif 297 ENDIF 237 298 jpk = jpkdta ! third dim 238 299 jpim1 = jpi-1 ! inner domain indices … … 240 301 jpkm1 = jpk-1 ! " " 241 302 jpij = jpi*jpj ! jpi x j 242 ENDIF243 303 244 304 IF(lwp) THEN ! open listing units 245 305 ! 246 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 306 IF( lk_oasis ) THEN 307 CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 308 ELSE 309 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 310 ENDIF 247 311 ! 248 312 WRITE(numout,*) … … 250 314 WRITE(numout,*) ' NEMO team' 251 315 WRITE(numout,*) ' Ocean General Circulation Model' 252 WRITE(numout,*) ' version 3. 4 (2011) '316 WRITE(numout,*) ' version 3.6 (2015) ' 253 317 WRITE(numout,*) ' StandAlone Surface version (SAS) ' 254 318 WRITE(numout,*) … … 287 351 288 352 IF( ln_ctl ) CALL prt_ctl_init ! Print control 289 CALL flush(numout)290 291 353 CALL day_init ! model calendar (using both namelist and restart infos) 292 354 … … 348 410 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 349 411 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 412 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 350 413 ENDIF 351 414 ! ! Parameter control … … 396 459 ENDIF 397 460 ! 461 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 462 & 'f2003 standard. ' , & 463 & 'Compile with key_nosignedzero enabled' ) 464 ! 398 465 END SUBROUTINE nemo_ctl 399 466 … … 437 504 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 438 505 ! 439 INTEGER :: ierr,ierr4 506 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 507 INTEGER :: jpm 440 508 !!---------------------------------------------------------------------- 441 509 ! … … 443 511 ierr = ierr + dom_oce_alloc () ! ocean domain 444 512 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 445 & snwice_fmass(jpi,jpj), STAT= ierr4 ) 446 ierr = ierr + ierr4 513 & snwice_fmass(jpi,jpj), STAT= ierr1 ) 514 ! 515 ! lim code currently uses surface temperature and salinity in tsn array for initialisation 516 ! and ub, vb arrays in ice dynamics 517 ! so allocate enough of arrays to use 518 ! 519 jpm = MAX(jp_tem, jp_sal) 520 ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 ) 521 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 ) 522 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 ) 523 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 524 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 525 526 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 447 527 ! 448 528 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 469 549 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 470 550 !!---------------------------------------------------------------------- 471 551 ! 472 552 ierr = 0 473 553 ! 474 554 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 475 555 ! 476 556 IF( nfact <= 1 ) THEN 477 557 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 515 595 INTEGER, PARAMETER :: ntest = 14 516 596 INTEGER :: ilfax(ntest) 517 597 ! 518 598 ! lfax contains the set of allowed factors. 519 599 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 600 680 !loop over the other north-fold processes to find the processes 601 681 !managing the points belonging to the sxT-dxT range 602 DO jn = jpnij - jpni +1, jpnij603 IF ( njmppt(jn) == njmppmax ) THEN682 683 DO jn = 1, jpni 604 684 !sxT is the first point (in the global domain) of the jn 605 685 !process 606 sxT = n imppt(jn)686 sxT = nfiimpp(jn, jpnj) 607 687 !dxT is the last point (in the global domain) of the jn 608 688 !process 609 dxT = n imppt(jn) + nlcit(jn) - 1689 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 610 690 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 611 691 nsndto = nsndto + 1 612 isendto(nsndto) = jn613 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN692 isendto(nsndto) = jn 693 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 614 694 nsndto = nsndto + 1 615 695 isendto(nsndto) = jn … … 618 698 isendto(nsndto) = jn 619 699 END IF 620 END IF621 700 END DO 701 nfsloop = 1 702 nfeloop = nlci 703 DO jn = 2,jpni-1 704 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 705 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 706 nfsloop = nldi 707 ENDIF 708 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 709 nfeloop = nlei 710 ENDIF 711 ENDIF 712 END DO 713 622 714 ENDIF 623 715 l_north_nogather = .TRUE.
Note: See TracChangeset
for help on using the changeset viewer.