Changeset 5407 for trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
- Timestamp:
- 2015-06-11T21:13:22+02:00 (9 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5215 r5407 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, & … … 163 183 & jpizoom, jpjzoom, jperio, ln_use_jattr 164 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,*) … … 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 … … 397 459 ENDIF 398 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 ! 399 465 END SUBROUTINE nemo_ctl 400 466 … … 438 504 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 439 505 ! 440 INTEGER :: ierr,ierr4 506 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 507 INTEGER :: jpm 441 508 !!---------------------------------------------------------------------- 442 509 ! … … 444 511 ierr = ierr + dom_oce_alloc () ! ocean domain 445 512 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 446 & snwice_fmass(jpi,jpj), STAT= ierr4 ) 447 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 448 527 ! 449 528 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 470 549 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 471 550 !!---------------------------------------------------------------------- 472 551 ! 473 552 ierr = 0 474 553 ! 475 554 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 476 555 ! 477 556 IF( nfact <= 1 ) THEN 478 557 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 516 595 INTEGER, PARAMETER :: ntest = 14 517 596 INTEGER :: ilfax(ntest) 518 597 ! 519 598 ! lfax contains the set of allowed factors. 520 599 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 601 680 !loop over the other north-fold processes to find the processes 602 681 !managing the points belonging to the sxT-dxT range 603 DO jn = jpnij - jpni +1, jpnij604 IF ( njmppt(jn) == njmppmax ) THEN682 683 DO jn = 1, jpni 605 684 !sxT is the first point (in the global domain) of the jn 606 685 !process 607 sxT = n imppt(jn)686 sxT = nfiimpp(jn, jpnj) 608 687 !dxT is the last point (in the global domain) of the jn 609 688 !process 610 dxT = n imppt(jn) + nlcit(jn) - 1689 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 611 690 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 612 691 nsndto = nsndto + 1 613 isendto(nsndto) = jn614 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN692 isendto(nsndto) = jn 693 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 615 694 nsndto = nsndto + 1 616 695 isendto(nsndto) = jn … … 619 698 isendto(nsndto) = jn 620 699 END IF 621 END IF622 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 623 714 ENDIF 624 715 l_north_nogather = .TRUE.
Note: See TracChangeset
for help on using the changeset viewer.
