- Timestamp:
- 2016-03-29T11:24:48+02:00 (8 years ago)
- Location:
- branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/SAS_SRC
- Files:
-
- 5 edited
-
daymod.F90 (modified) (5 diffs)
-
diawri.F90 (modified) (15 diffs)
-
nemogcm.F90 (modified) (3 diffs)
-
sbcssm.F90 (modified) (6 diffs)
-
step.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r6401 r6404 20 20 !! 21 21 !! we suppose that the time step is deviding the number of second of in a day 22 !! ---> MOD( rday, rdt tra(1)) == 022 !! ---> MOD( rday, rdt ) == 0 23 23 !! 24 24 !! ----------- WARNING ----------- … … 76 76 & 'You must do a restart at higher frequency (or remove this stop and recompile the code in I8)' ) 77 77 ENDIF 78 ! all calendar staff is based on the fact that MOD( rday, rdt tra(1)) == 079 IF( MOD( rday , rdttra(1)) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' )80 IF( MOD( rday , 2.) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' )81 IF( MOD( rdt tra(1), 2.) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' )82 nsecd = NINT(rday 83 nsecd05 = NINT(0.5 * rday 84 ndt = NINT( rdt tra(1))85 ndt05 = NINT(0.5 * rdt tra(1))78 ! all calendar staff is based on the fact that MOD( rday, rdt ) == 0 79 IF( MOD( rday , rdt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' ) 80 IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' ) 81 IF( MOD( rdt , 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' ) 82 nsecd = NINT(rday ) 83 nsecd05 = NINT(0.5 * rday ) 84 ndt = NINT( rdt ) 85 ndt05 = NINT(0.5 * rdt ) 86 86 87 87 ! ==> clem: here we read the ocean restart for the date (only if it exists) … … 224 224 nsec_week = nsec_week + ndt 225 225 nsec_day = nsec_day + ndt 226 adatrj = adatrj + rdt tra(1)/ rday227 fjulday = fjulday + rdt tra(1)/ rday226 adatrj = adatrj + rdt / rday 227 fjulday = fjulday + rdt / rday 228 228 IF( ABS(fjulday - REAL(NINT(fjulday),wp)) < zprec ) fjulday = REAL(NINT(fjulday),wp) ! avoid truncation error 229 229 IF( ABS(adatrj - REAL(NINT(adatrj ),wp)) < zprec ) adatrj = REAL(NINT(adatrj ),wp) ! avoid truncation error … … 340 340 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 341 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 ) * rdt tra(1)) / rday342 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 343 343 ! note this is wrong if time step has changed during run 344 344 ENDIF … … 346 346 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) 347 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 ) * rdt tra(1)) / rday348 adatrj = ( REAL( nit000-1, wp ) * rdt ) / rday 349 349 ENDIF 350 350 IF( ABS(adatrj - REAL(NINT(adatrj),wp)) < 0.1 / rday ) adatrj = REAL(NINT(adatrj),wp) ! avoid truncation error -
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/SAS_SRC/diawri.F90
r6401 r6404 26 26 USE dom_oce ! ocean space and time domain 27 27 USE zdf_oce ! ocean vertical physics 28 USE ldftra_oce ! ocean active tracers: lateral physics29 USE ldfdyn_oce ! ocean dynamics: lateral physics30 USE traldf_iso_grif, ONLY : psix_eiv, psiy_eiv31 USE sol_oce ! solver variables32 28 USE sbc_oce ! Surface boundary condition: ocean fields 33 29 USE sbc_ice ! Surface boundary condition: ice fields … … 40 36 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 41 37 USE in_out_manager ! I/O manager 42 USE diadimg ! dimg direct access file format output43 38 USE diaar5, ONLY : lk_diaar5 44 39 USE iom … … 65 60 66 61 !! * Substitutions 67 # include "zdfddm_substitute.h90"68 # include "domzgr_substitute.h90"69 62 # include "vectopt_loop_substitute.h90" 70 63 !!---------------------------------------------------------------------- … … 85 78 END FUNCTION dia_wri_alloc 86 79 87 #if defined key_dimgout88 !!----------------------------------------------------------------------89 !! 'key_dimgout' DIMG output file90 !!----------------------------------------------------------------------91 # include "diawri_dimg.h90"92 93 #else94 80 !!---------------------------------------------------------------------- 95 81 !! Default option NetCDF output file 96 82 !!---------------------------------------------------------------------- 97 # 83 #if defined key_iomput 98 84 !!---------------------------------------------------------------------- 99 85 !! 'key_iomput' use IOM library … … 110 96 !! ** Method : use iom_put 111 97 !!---------------------------------------------------------------------- 112 !! 113 INTEGER, INTENT( in ) :: kt ! ocean time-step index 98 INTEGER, INTENT(in) :: kt ! ocean time-step index 114 99 !!---------------------------------------------------------------------- 115 100 ! … … 144 129 INTEGER :: ierr ! error code return from allocation 145 130 INTEGER :: iimi, iima, ipk, it, itmod, ijmi, ijma ! local integers 146 REAL(wp) :: zsto, zout, zmax, zjulian , zdt! local scalars131 REAL(wp) :: zsto, zout, zmax, zjulian ! local scalars 147 132 !!---------------------------------------------------------------------- 148 133 ! … … 163 148 164 149 ! Define frequency of output and means 165 zdt = rdt166 IF( nacc == 1 ) zdt = rdtmin167 150 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!) 168 151 ELSE ; clop = "x" ! no use of the mask value (require less cpu time) 169 152 ENDIF 170 153 #if defined key_diainstant 171 zsto = nwrite * zdt154 zsto = nwrite * rdt 172 155 clop = "inst("//TRIM(clop)//")" 173 156 #else 174 zsto= zdt157 zsto=rdt 175 158 clop = "ave("//TRIM(clop)//")" 176 159 #endif 177 zout = nwrite * zdt178 zmax = ( nitend - nit000 + 1 ) * zdt160 zout = nwrite * rdt 161 zmax = ( nitend - nit000 + 1 ) * rdt 179 162 180 163 ! Define indices of the horizontal output zoom and vertical limit storage … … 218 201 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & ! Horizontal grid: glamt and gphit 219 202 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 220 & nit000-1, zjulian, zdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set )203 & nit000-1, zjulian, rdt, nh_T, nid_T, domain_id=nidom, snc4chunks=snc4set ) 221 204 CALL histvert( nid_T, "deptht", "Vertical T levels", & ! Vertical grid: gdept 222 205 & "m", ipk, gdept_1d, nz_T, "down" ) … … 230 213 CALL histbeg( clhstnam, jpi, glamu, jpj, gphiu, & ! Horizontal grid: glamu and gphiu 231 214 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 232 & nit000-1, zjulian, zdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set )215 & nit000-1, zjulian, rdt, nh_U, nid_U, domain_id=nidom, snc4chunks=snc4set ) 233 216 CALL histvert( nid_U, "depthu", "Vertical U levels", & ! Vertical grid: gdept 234 217 & "m", ipk, gdept_1d, nz_U, "down" ) … … 242 225 CALL histbeg( clhstnam, jpi, glamv, jpj, gphiv, & ! Horizontal grid: glamv and gphiv 243 226 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 244 & nit000-1, zjulian, zdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set )227 & nit000-1, zjulian, rdt, nh_V, nid_V, domain_id=nidom, snc4chunks=snc4set ) 245 228 CALL histvert( nid_V, "depthv", "Vertical V levels", & ! Vertical grid : gdept 246 229 & "m", ipk, gdept_1d, nz_V, "down" ) … … 338 321 ! 339 322 END SUBROUTINE dia_wri 340 # endif341 342 323 #endif 343 324 … … 362 343 INTEGER :: id_i , nz_i, nh_i 363 344 INTEGER, DIMENSION(1) :: idex ! local workspace 364 REAL(wp) :: zsto, zout, zmax, zjulian , zdt345 REAL(wp) :: zsto, zout, zmax, zjulian 365 346 !!---------------------------------------------------------------------- 366 347 ! … … 373 354 clname = cdfile_name 374 355 IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 375 zdt = rdt376 356 zsto = rdt 377 357 clop = "inst(x)" ! no use of the mask value (require less cpu time) 378 358 zout = rdt 379 zmax = ( nitend - nit000 + 1 ) * zdt359 zmax = ( nitend - nit000 + 1 ) * rdt 380 360 381 361 IF(lwp) WRITE(numout,*) … … 392 372 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 393 373 CALL histbeg( clname, jpi, glamt, jpj, gphit, & 394 1, jpi, 1, jpj, nit000-1, zjulian, zdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit374 1, jpi, 1, jpj, nit000-1, zjulian, rdt, nh_i, id_i, domain_id=nidom, snc4chunks=snc4set ) ! Horizontal grid : glamt and gphit 395 375 CALL histvert( id_i, "deptht", "Vertical T levels", & ! Vertical grid : gdept 396 376 "m", jpk, gdept_1d, nz_i, "down") … … 435 415 ! ----------------- 436 416 CALL histclo( id_i ) 437 #if ! defined key_iomput && ! defined key_dimgout417 #if ! defined key_iomput 438 418 IF( ninist /= 1 ) THEN 439 419 CALL histclo( nid_T ) -
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r6401 r6404 184 184 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 185 185 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & 186 & nn_bench, nn_timing 186 & nn_bench, nn_timing, nn_diacfl 187 187 NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, & 188 188 & jpizoom, jpjzoom, jperio, ln_use_jattr … … 521 521 #endif 522 522 ! 523 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 523 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6,ierr7,ierr8 524 524 INTEGER :: jpm 525 525 !!---------------------------------------------------------------------- … … 545 545 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 546 546 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 547 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 547 ALLOCATE( un(jpi,jpj,1) , STAT=ierr7 ) 548 ALLOCATE( vn(jpi,jpj,1) , STAT=ierr8 ) 549 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 + ierr7 + ierr8 548 550 #endif 549 551 ! -
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r6401 r6404 88 88 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 89 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-velocity90 IF( .NOT.ln_linssh ) 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-velocity94 IF( .NOT.ln_linssh ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 95 95 ENDIF 96 96 ! … … 115 115 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask, ovlap=1 ) 116 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 )117 IF( .NOT.ln_linssh ) 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 119 ENDIF 120 120 ! … … 125 125 CALL iom_put( 'sss_m', sss_m ) 126 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 )127 IF( .NOT.ln_linssh ) CALL iom_put( 'e3t_m', e3t_m ) 128 IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m ) 129 129 ENDIF 130 130 ! … … 216 216 IF( ln_3d_uve ) THEN 217 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 read218 nfld_3d = 2 + COUNT( (/.NOT.ln_linssh/) ) ! number of 3D fields to read 219 219 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 220 220 ELSE 221 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/ lk_vvl/) ) ! update 2D fields index221 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/.NOT.ln_linssh/) ) ! update 2D fields index 222 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 read223 nfld_2d = 5 + COUNT( (/.NOT.ln_linssh/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 224 224 ENDIF 225 225 … … 231 231 slf_3d(jf_usp) = sn_usp 232 232 slf_3d(jf_vsp) = sn_vsp 233 IF( lk_vvl) slf_3d(jf_e3t) = sn_e3t233 IF( .NOT.ln_linssh ) slf_3d(jf_e3t) = sn_e3t 234 234 ENDIF 235 235 … … 243 243 IF( .NOT. ln_3d_uve ) THEN 244 244 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 245 IF( lk_vvl) slf_2d(jf_e3t) = sn_e3t245 IF( .NOT.ln_linssh ) slf_2d(jf_e3t) = sn_e3t 246 246 ENDIF 247 247 ENDIF -
branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/SAS_SRC/step.F90
r6401 r6404 16 16 USE oce ! ocean dynamics and tracers variables 17 17 USE dom_oce ! ocean space and time domain variables 18 USE in_out_manager ! I/O manager19 USE sbc_oce20 USE sbccpl21 USE iom !22 USE lbclnk23 #if defined key_iomput24 USE xios25 #endif26 27 18 USE daymod ! calendar (day routine) 28 19 USE sbc_oce ! surface boundary condition: fields 29 20 USE sbcmod ! surface boundary condition (sbc routine) 30 21 USE sbcrnf ! surface boundary condition: runoff variables 31 22 USE sbccpl ! surface boundary condition: coupled interface 32 23 USE eosbn2 ! equation of state (eos_bn2 routine) 33 34 24 USE diawri ! Standard run outputs (dia_wri routine) 35 USE stpctl ! time stepping control (stp_ctl routine)36 USE prtctl ! Print control (prt_ctl routine)37 38 USE timing ! Timing39 40 25 USE bdy_par ! clem: mandatory for LIM3 41 26 #if defined key_bdy 42 27 USE bdydta ! clem: mandatory for LIM3 28 #endif 29 USE stpctl ! time stepping control (stp_ctl routine) 30 ! 31 USE in_out_manager ! I/O manager 32 USE prtctl ! Print control (prt_ctl routine) 33 USE iom ! 34 USE lbclnk ! 35 USE timing ! Timing 36 #if defined key_iomput 37 USE xios 43 38 #endif 44 39 … … 46 41 PRIVATE 47 42 48 PUBLIC stp ! called by opa.F9043 PUBLIC stp ! called by nemogcm.F90 49 44 50 !! * Substitutions51 # include "domzgr_substitute.h90"52 # include "zdfddm_substitute.h90"53 45 !!---------------------------------------------------------------------- 54 46 !! NEMO/OPA 3.3 , NEMO Consortium (2010)
Note: See TracChangeset
for help on using the changeset viewer.
