- Timestamp:
- 2015-07-16T13:55:15+02:00 (9 years ago)
- Location:
- branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC
- Files:
-
- 6 edited
-
daymod.F90 (modified) (4 diffs, 1 prop)
-
diawri.F90 (modified) (1 diff, 1 prop)
-
nemogcm.F90 (modified) (20 diffs, 1 prop)
-
sbcssm.F90 (modified) (11 diffs, 1 prop)
-
step.F90 (modified) (5 diffs, 1 prop)
-
stpctl.F90 (modified) (1 diff, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/daymod.F90
- Property svn:keywords set to Id
r4162 r5602 45 45 !!---------------------------------------------------------------------- 46 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 47 !! $Id : daymod.F90 3294 2012-01-28 16:44:18Z rblod$47 !! $Id$ 48 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 49 49 !!---------------------------------------------------------------------- … … 80 80 ndt05 = NINT(0.5 * rdttra(1)) 81 81 82 ! parameters corresponding to nit000 - 1 (as we start the step loop with a call to day) 83 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 84 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 85 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error 86 ! 87 IF(lwp) THEN 88 WRITE(numout,*) ' *** Info used values : ' 89 WRITE(numout,*) ' date ndastp : ', ndastp 90 WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj 91 WRITE(numout,*) 92 ENDIF 82 ! ==> clem: here we read the ocean restart for the date (only if it exists) 83 ! It is not clean and another solution should be found 84 CALL day_rst( nit000, 'READ' ) 85 ! ==> 93 86 94 87 ! set the calendar from ndastp (read in restart file and namelist) … … 131 124 132 125 ! control print 133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i 6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', &126 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', & 134 127 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_week:', nsec_week 135 128 … … 285 278 ! 286 279 END SUBROUTINE day 280 281 282 SUBROUTINE day_rst( kt, cdrw ) 283 !!--------------------------------------------------------------------- 284 !! *** ROUTINE ts_rst *** 285 !! 286 !! ** Purpose : Read or write calendar in restart file: 287 !! 288 !! WRITE(READ) mode: 289 !! kt : number of time step since the begining of the experiment at the 290 !! end of the current(previous) run 291 !! adatrj(0) : number of elapsed days since the begining of the experiment at the 292 !! end of the current(previous) run (REAL -> keep fractions of day) 293 !! ndastp : date at the end of the current(previous) run (coded as yyyymmdd integer) 294 !! 295 !! According to namelist parameter nrstdt, 296 !! nrstdt = 0 no control on the date (nit000 is arbitrary). 297 !! nrstdt = 1 we verify that nit000 is equal to the last 298 !! time step of previous run + 1. 299 !! In both those options, the exact duration of the experiment 300 !! since the beginning (cumulated duration of all previous restart runs) 301 !! is not stored in the restart and is assumed to be (nit000-1)*rdt. 302 !! This is valid is the time step has remained constant. 303 !! 304 !! nrstdt = 2 the duration of the experiment in days (adatrj) 305 !! has been stored in the restart file. 306 !!---------------------------------------------------------------------- 307 INTEGER , INTENT(in) :: kt ! ocean time-step 308 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 309 ! 310 REAL(wp) :: zkt, zndastp 311 !!---------------------------------------------------------------------- 312 313 IF( TRIM(cdrw) == 'READ' ) THEN 314 315 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 316 ! Get Calendar informations 317 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run 318 IF(lwp) THEN 319 WRITE(numout,*) ' *** Info read in restart : ' 320 WRITE(numout,*) ' previous time-step : ', NINT( zkt ) 321 WRITE(numout,*) ' *** restart option' 322 SELECT CASE ( nrstdt ) 323 CASE ( 0 ) ; WRITE(numout,*) ' nrstdt = 0 : no control of nit000' 324 CASE ( 1 ) ; WRITE(numout,*) ' nrstdt = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 325 CASE ( 2 ) ; WRITE(numout,*) ' nrstdt = 2 : calendar parameters read in restart' 326 END SELECT 327 WRITE(numout,*) 328 ENDIF 329 ! Control of date 330 IF( nit000 - NINT( zkt ) /= 1 .AND. nrstdt /= 0 ) & 331 & CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart', & 332 & ' verify the restart file or rerun with nrstdt = 0 (namelist)' ) 333 ! define ndastp and adatrj 334 IF ( nrstdt == 2 ) THEN 335 ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 336 CALL iom_get( numror, 'ndastp', zndastp ) 337 ndastp = NINT( zndastp ) 338 CALL iom_get( numror, 'adatrj', adatrj ) 339 ELSE 340 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 341 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 342 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 343 ! note this is wrong if time step has changed during run 344 ENDIF 345 ELSE 346 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 347 ndastp = ndate0 - 1 ! ndate0 read in the namelist in dom_nam, we assume that we start run at 00:00 348 adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 349 ENDIF 350 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error 351 ! 352 IF(lwp) THEN 353 WRITE(numout,*) ' *** Info used values : ' 354 WRITE(numout,*) ' date ndastp : ', ndastp 355 WRITE(numout,*) ' number of elapsed days since the begining of run : ', adatrj 356 WRITE(numout,*) 357 ENDIF 358 ! 359 ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 360 ! 361 IF( kt == nitrst ) THEN 362 IF(lwp) WRITE(numout,*) 363 IF(lwp) WRITE(numout,*) 'rst_write : write oce restart file kt =', kt 364 IF(lwp) WRITE(numout,*) '~~~~~~~' 365 ENDIF 366 ! calendar control 367 CALL iom_rstput( kt, nitrst, numrow, 'kt' , REAL( kt , wp) ) ! time-step 368 CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) ) ! date 369 CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj ) ! number of elapsed days since 370 ! ! the begining of the run [s] 371 ENDIF 372 ! 373 END SUBROUTINE day_rst 287 374 !!====================================================================== 288 375 END MODULE daymod -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/diawri.F90
- Property svn:keywords set to Id
r4292 r5602 70 70 !!---------------------------------------------------------------------- 71 71 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 72 !! $Id 72 !! $Id$ 73 73 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 74 74 !!---------------------------------------------------------------------- -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
- Property svn:keywords set to Id
r4624 r5602 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, & 161 186 & nn_bench, nn_timing 162 187 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 163 & jpizoom, jpjzoom, jperio 164 !!---------------------------------------------------------------------- 188 & jpizoom, jpjzoom, jperio, ln_use_jattr 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,*) … … 250 319 WRITE(numout,*) ' NEMO team' 251 320 WRITE(numout,*) ' Ocean General Circulation Model' 252 WRITE(numout,*) ' version 3. 4 (2011) '321 WRITE(numout,*) ' version 3.6 (2015) ' 253 322 WRITE(numout,*) ' StandAlone Surface version (SAS) ' 254 323 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 … … 348 422 WRITE(numout,*) ' left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom 349 423 WRITE(numout,*) ' lateral cond. type (between 0 and 6) jperio = ', jperio 424 WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr 350 425 ENDIF 351 426 ! ! Parameter control … … 396 471 ENDIF 397 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 ! 398 477 END SUBROUTINE nemo_ctl 399 478 … … 435 514 USE diawri , ONLY: dia_wri_alloc 436 515 USE dom_oce , ONLY: dom_oce_alloc 437 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 438 ! 439 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 440 525 !!---------------------------------------------------------------------- 441 526 ! 442 527 ierr = dia_wri_alloc () 443 528 ierr = ierr + dom_oce_alloc () ! ocean domain 444 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 445 & snwice_fmass(jpi,jpj), STAT= ierr4 ) 446 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 447 549 ! 448 550 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 469 571 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 470 572 !!---------------------------------------------------------------------- 471 573 ! 472 574 ierr = 0 473 575 ! 474 576 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 475 577 ! 476 578 IF( nfact <= 1 ) THEN 477 579 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 515 617 INTEGER, PARAMETER :: ntest = 14 516 618 INTEGER :: ilfax(ntest) 517 619 ! 518 620 ! lfax contains the set of allowed factors. 519 621 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 600 702 !loop over the other north-fold processes to find the processes 601 703 !managing the points belonging to the sxT-dxT range 602 DO jn = jpnij - jpni +1, jpnij603 IF ( njmppt(jn) == njmppmax ) THEN704 705 DO jn = 1, jpni 604 706 !sxT is the first point (in the global domain) of the jn 605 707 !process 606 sxT = n imppt(jn)708 sxT = nfiimpp(jn, jpnj) 607 709 !dxT is the last point (in the global domain) of the jn 608 710 !process 609 dxT = n imppt(jn) + nlcit(jn) - 1711 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 610 712 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 611 713 nsndto = nsndto + 1 612 isendto(nsndto) = jn613 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN714 isendto(nsndto) = jn 715 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 614 716 nsndto = nsndto + 1 615 717 isendto(nsndto) = jn … … 618 720 isendto(nsndto) = jn 619 721 END IF 620 END IF621 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 622 736 ENDIF 623 737 l_north_nogather = .TRUE. -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
- Property svn:keywords set to Id
r4990 r5602 36 36 PUBLIC sbc_ssm ! called by sbc 37 37 38 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uv = .true. !: specify whether input velocity data is 3D 40 INTEGER , SAVE :: nfld_3d 41 INTEGER , SAVE :: nfld_2d 42 43 INTEGER , PARAMETER :: jpfld_3d = 4 ! maximum number of files to read 44 INTEGER , PARAMETER :: jpfld_2d = 1 ! maximum number of files to read 45 INTEGER , SAVE :: jf_tem ! index of temperature 46 INTEGER , SAVE :: jf_sal ! index of salinity 47 INTEGER , SAVE :: jf_usp ! index of u velocity component 48 INTEGER , SAVE :: jf_vsp ! index of v velocity component 49 INTEGER , SAVE :: jf_ssh ! index of sea surface height 38 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 40 LOGICAL :: ln_read_frq !: specify whether we must read frq or not 41 LOGICAL :: l_initdone = .false. 42 INTEGER :: nfld_3d 43 INTEGER :: nfld_2d 44 45 INTEGER :: jf_tem ! index of temperature 46 INTEGER :: jf_sal ! index of salinity 47 INTEGER :: jf_usp ! index of u velocity component 48 INTEGER :: jf_vsp ! index of v velocity component 49 INTEGER :: jf_ssh ! index of sea surface height 50 INTEGER :: jf_e3t ! index of first T level thickness 51 INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level 50 52 51 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read) 52 54 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d ! structure of input fields (file information, fields read) 53 55 54 !! * Substitutions55 # include "domzgr_substitute.h90"56 # include "vectopt_loop_substitute.h90"57 56 !!---------------------------------------------------------------------- 58 57 !! NEMO/OFF 3.3 , NEMO Consortium (2010) 59 !! $Id : sbcssm.F90 3294 2012-01-28 16:44:18Z rblod$58 !! $Id$ 60 59 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 61 60 !!---------------------------------------------------------------------- … … 86 85 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 87 86 ! 88 IF( ln_3d_uv ) THEN87 IF( ln_3d_uve ) THEN 89 88 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 90 89 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 90 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 91 91 ELSE 92 92 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 93 93 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 94 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 94 95 ENDIF 95 96 ! … … 97 98 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 98 99 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 99 ! 100 tsn(:,:,1,jp_tem) = sst_m(:,:) 101 tsn(:,:,1,jp_sal) = sss_m(:,:) 100 IF( ln_read_frq ) frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 101 ! 102 102 IF ( nn_ice == 1 ) THEN 103 tsn(:,:,1,jp_tem) = sst_m(:,:) 104 tsn(:,:,1,jp_sal) = sss_m(:,:) 103 105 tsb(:,:,1,jp_tem) = sst_m(:,:) 104 106 tsb(:,:,1,jp_sal) = sss_m(:,:) 105 107 ENDIF 106 ub (:,:,1 107 vb (:,:,1 108 ub (:,:,1) = ssu_m(:,:) 109 vb (:,:,1) = ssv_m(:,:) 108 110 109 111 IF(ln_ctl) THEN ! print control … … 113 115 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask, ovlap=1 ) 114 116 CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask, ovlap=1 ) 117 IF( lk_vvl ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask, ovlap=1 ) 118 IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask, ovlap=1 ) 119 ENDIF 120 ! 121 IF( l_initdone ) THEN ! Mean value at each nn_fsbc time-step ! 122 CALL iom_put( 'ssu_m', ssu_m ) 123 CALL iom_put( 'ssv_m', ssv_m ) 124 CALL iom_put( 'sst_m', sst_m ) 125 CALL iom_put( 'sss_m', sss_m ) 126 CALL iom_put( 'ssh_m', ssh_m ) 127 IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m ) 128 IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m ) 115 129 ENDIF 116 130 ! … … 138 152 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_2d ! array of namelist information on the fields to read 139 153 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 140 TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh 141 ! 142 NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh 143 !!---------------------------------------------------------------------- 154 TYPE(FLD_N) :: sn_usp, sn_vsp 155 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 156 ! 157 NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 158 !!---------------------------------------------------------------------- 159 160 IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 144 161 145 162 REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields … … 159 176 WRITE(numout,*) '~~~~~~~~~~~ ' 160 177 WRITE(numout,*) ' Namelist namsbc_sas' 178 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 179 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq 161 180 WRITE(numout,*) 162 181 ENDIF 163 164 182 ! 165 183 !! switch off stuff that isn't sensible with a standalone module … … 170 188 ln_apr_dyn = .FALSE. 171 189 ENDIF 172 IF( ln_dm2dc ) THEN173 IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'174 ln_dm2dc = .FALSE.175 ENDIF176 190 IF( ln_rnf ) THEN 177 191 IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' … … 190 204 nn_closea = 0 191 205 ENDIF 192 193 206 ! 194 207 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 195 208 !! when we have other 3d arrays that we need to read in 196 209 !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 197 !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,198 !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,210 !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 211 !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 199 212 !! and the rest of the logic should still work 200 213 ! 201 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 202 ! 203 IF( ln_3d_uv ) THEN204 jf_usp = 1 ; jf_vsp = 2 205 nfld_3d = 2 206 nfld_2d = 3 214 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4 ! default 2D fields index 215 ! 216 IF( ln_3d_uve ) THEN 217 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 218 nfld_3d = 2 + COUNT( (/lk_vvl/) ) ! number of 3D fields to read 219 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 207 220 ELSE 208 jf_usp = 4 ; jf_vsp = 5 209 nfld_3d = 0 210 nfld_2d = 5 221 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) ) ! update 2D fields index 222 nfld_3d = 0 ! no 3D fields to read 223 nfld_2d = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 211 224 ENDIF 212 225 … … 216 229 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN 217 230 ENDIF 218 IF( ln_3d_uv ) THEN 219 slf_3d(jf_usp) = sn_usp 220 slf_3d(jf_vsp) = sn_vsp 221 ENDIF 231 slf_3d(jf_usp) = sn_usp 232 slf_3d(jf_vsp) = sn_vsp 233 IF( lk_vvl ) slf_3d(jf_e3t) = sn_e3t 222 234 ENDIF 223 235 … … 228 240 ENDIF 229 241 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 230 IF( .NOT. ln_3d_uv ) THEN 242 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 243 IF( .NOT. ln_3d_uve ) THEN 231 244 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 232 ENDIF 233 ENDIF 234 ! 245 IF( lk_vvl ) slf_2d(jf_e3t) = sn_e3t 246 ENDIF 247 ENDIF 248 ! 249 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 235 250 IF( nfld_3d > 0 ) THEN 236 251 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 265 280 ENDIF 266 281 ! 267 ! lim code currently uses surface temperature and salinity in tsn array for initialisation268 ! and ub, vb arrays in ice dynamics269 ! so allocate enough of arrays to use270 !271 ierr3 = 0272 jpm = MAX(jp_tem, jp_sal)273 ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )274 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr1 )275 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr2 )276 IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )277 ierr = ierr0 + ierr1 + ierr2 + ierr3278 IF( ierr > 0 ) THEN279 CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')280 ENDIF281 !282 282 ! finally tidy up 283 283 284 284 IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 285 285 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 286 287 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 288 IF( .NOT. ln_read_frq ) frq_m(:,:) = 1. 289 l_initdone = .TRUE. 286 290 ! 287 291 END SUBROUTINE sbc_ssm_init -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/step.F90
- Property svn:keywords set to Id
r4166 r5602 17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE in_out_manager ! I/O manager 19 USE sbc_oce 20 USE sbccpl 19 21 USE iom ! 20 22 USE lbclnk … … 36 38 USE timing ! Timing 37 39 40 USE bdy_par ! clem: mandatory for LIM3 41 #if defined key_bdy 42 USE bdydta ! clem: mandatory for LIM3 43 #endif 44 38 45 IMPLICIT NONE 39 46 PRIVATE … … 46 53 !!---------------------------------------------------------------------- 47 54 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 48 !! $Id : step.F90 3294 2012-01-28 16:44:18Z rblod$55 !! $Id$ 49 56 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 50 57 !!---------------------------------------------------------------------- … … 72 79 kstp = nit000 + Agrif_Nb_Step() 73 80 # if defined key_iomput 74 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo")81 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 75 82 # endif 76 83 #endif 77 IF( kstp == nit000 ) CALL iom_init( "nemo" )! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)84 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 78 85 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 79 CALL iom_setkt( kstp , "nemo" ) ! say to iom thatwe are at time step kstp86 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 80 87 88 ! ==> clem: open boundaries is mandatory for LIM3 because ice BDY is not decoupled from 89 ! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules. 90 ! From SAS: ocean bdy data are wrong (but we do not care) and ice bdy data are OK. 91 ! This is not clean and should be changed in the future. 92 #if defined key_bdy 93 IF( lk_bdy ) CALL bdy_dta ( kstp, time_offset=+1 ) ! update dynamic & tracer data at open boundaries 94 #endif 95 ! ==> 81 96 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) 82 97 … … 86 101 ! need to keep the same interface 87 102 CALL stp_ctl( kstp, indic ) 103 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 104 ! Coupled mode 105 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 106 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges if OASIS-coupled ice 107 88 108 #if defined key_iomput 89 IF( kstp == nitend ) CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 109 IF( kstp == nitend .OR. indic < 0 ) THEN 110 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 111 ENDIF 90 112 #endif 91 113 ! -
branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/SAS_SRC/stpctl.F90
- Property svn:keywords set to Id
r3358 r5602 28 28 !!---------------------------------------------------------------------- 29 29 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 30 !! $Id : stpctl.F90 3294 2012-01-28 16:44:18Z rblod$30 !! $Id$ 31 31 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 32 32 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.
