Changeset 6332 for branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2016-02-19T08:20:00+01:00 (8 years ago)
- Location:
- branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 3 added
- 16 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90
r6331 r6332 71 71 REAL, POINTER, DIMENSION(:,:) :: ht_s !: now snow thickness 72 72 #endif 73 #if defined key_top 74 CHARACTER(LEN=20) :: cn_obc !: type of boundary condition to apply 75 REAL(wp) :: rn_fac !: multiplicative scaling factor 76 REAL(wp), POINTER, DIMENSION(:,:) :: trc !: now field of the tracer 77 LOGICAL :: dmp !: obc damping term 78 #endif 79 73 80 END TYPE OBC_DATA 74 81 -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90
r6331 r6332 37 37 #endif 38 38 USE sbcapr 39 #if defined key_top 40 USE par_trc 41 USE trc, ONLY: trn 42 #endif 39 43 40 44 IMPLICIT NONE -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90
r6331 r6332 161 161 162 162 z1_2 = 0.5_wp 163 #if defined key_cs15 164 z1_2 = 0.0_wp 165 #endif 163 166 164 167 ! ---------------------------------! -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90
r6331 r6332 102 102 103 103 REWIND(numnam_cfg) 104 REWIND(numnam_ref) ! slwa 104 105 105 106 DO ib_bdy = 1, nb_bdy -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6331 r6332 44 44 USE in_out_manager ! I/O manager 45 45 USE diadimg ! dimg direct access file format output 46 USE diatmb ! Top,middle,bottom output 47 USE dia25h ! 25h Mean output 46 48 USE iom 47 49 USE ioipsl … … 379 381 CALL wrk_dealloc( jpi , jpj , z2d ) 380 382 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 383 ! 384 ! If we want tmb values 385 386 IF (ln_diatmb) THEN 387 CALL dia_tmb 388 ENDIF 389 IF (ln_dia25h) THEN 390 CALL dia_25h( kt ) 391 ENDIF 381 392 ! 382 393 IF( nn_timing == 1 ) CALL timing_stop('dia_wri') -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r6331 r6332 136 136 USE ioipsl 137 137 NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, & 138 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rst art , nn_rstctl, &138 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstdate, ln_rstart , nn_rstctl, & 139 139 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 140 140 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler … … 174 174 WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir 175 175 WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart 176 WRITE(numout,*) ' datestamping of restarts ln_rstdate = ', ln_rstdate 176 177 WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler 177 178 WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90
r6331 r6332 31 31 USE wrk_nemo ! Memory allocation 32 32 USE timing ! Timing 33 USE iom ! slwa 33 34 34 35 IMPLICIT NONE … … 135 136 INTEGER :: ios 136 137 INTEGER :: isrow ! index for ORCA1 starting row 138 #if defined key_bdy && defined key_cs15 139 INTEGER :: inum !slwa 140 #endif 137 141 INTEGER , POINTER, DIMENSION(:,:) :: imsk 138 142 REAL(wp), POINTER, DIMENSION(:,:) :: zwf … … 172 176 CALL ctl_stop( ctmp1 ) 173 177 ENDIF 178 !slwa 179 ! read in mask for unstructured open boundaries 180 #if defined key_bdy && defined key_cs15 181 CALL iom_open( 'mask_CS15.nc', inum ) 182 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zwf(:,:) ) 183 CALL iom_close( inum ) 184 #endif 185 !slwa 174 186 175 187 ! 1. Ocean/land mask at t-point (computed from mbathy) … … 182 194 DO ji = 1, jpi 183 195 IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp ) tmask(ji,jj,jk) = 1._wp 196 #if defined key_bdy && defined key_cs15 197 tmask(ji,jj,jk) = tmask(ji,jj,jk) * zwf(ji,jj) ! slwa 198 #endif 184 199 END DO 185 200 END DO -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r6331 r6332 41 41 USE timing ! Timing 42 42 USE sbcapr ! surface boundary condition: atmospheric pressure 43 USE diatmb ! Top,middle,bottom output 43 44 USE dynadv, ONLY: ln_dynadv_vec 44 45 #if defined key_agrif … … 144 145 INTEGER :: ji, jj, jk, jn ! dummy loop indices 145 146 INTEGER :: ikbu, ikbv, noffset ! local integers 147 REAL(wp) :: zmdi 146 148 REAL(wp) :: zraur, z1_2dt_b, z2dt_bf ! local scalars 147 149 REAL(wp) :: zx1, zy1, zx2, zy2 ! - - … … 169 171 CALL wrk_alloc( jpi, jpj, zhf ) 170 172 ! 173 zmdi=1.e+20 ! missing data indicator for masking 171 174 ! !* Local constant initialization 172 175 z1_12 = 1._wp / 12._wp … … 926 929 CALL wrk_dealloc( jpi, jpj, zhf ) 927 930 ! 931 IF ( ln_diatmb ) THEN 932 CALL iom_put( "baro_u" , un_b*umask(:,:,1)+zmdi*(1-umask(:,:,1 ) ) ) ! Barotropic U Velocity 933 CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+zmdi*(1-vmask(:,:,1 ) ) ) ! Barotropic V Velocity 934 ENDIF 928 935 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') 929 936 ! -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/ICB/icbrst.F90
r6331 r6332 18 18 !!---------------------------------------------------------------------- 19 19 USE par_oce ! NEMO parameters 20 USE phycst ! for rday 20 21 USE dom_oce ! NEMO domain 21 22 USE in_out_manager ! NEMO IO routines 22 23 USE lib_mpp ! NEMO MPI library, lk_mpp in particular 24 USE ioipsl, ONLY : ju2ymds ! for calendar 23 25 USE netcdf ! netcdf routines for IO 24 26 USE icb_oce ! define iceberg arrays … … 64 66 ! start and count arrays 65 67 LOGICAL :: ll_found_restart 66 CHARACTER(len=256) :: cl_path67 CHARACTER(len=256) :: cl_filename68 CHARACTER(len=256) :: cl_path 69 CHARACTER(len=256) :: cl_filename 68 70 CHARACTER(len=NF90_MAX_NAME) :: cl_dname 69 71 TYPE(iceberg) :: localberg ! NOT a pointer but an actual local variable … … 233 235 CHARACTER(len=256) :: cl_path 234 236 CHARACTER(len=256) :: cl_filename 237 INTEGER :: iyear, imonth, iday 238 REAL (wp) :: zsec 239 CHARACTER(len=256) :: cl_path 240 CHARACTER(len=256) :: cl_filename 241 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 235 242 TYPE(iceberg), POINTER :: this 236 243 TYPE(point) , POINTER :: pt … … 240 247 cl_path = TRIM(cn_ocerst_outdir) 241 248 IF( cl_path(LEN_TRIM(cl_path):) /= '/' ) cl_path = TRIM(cl_path) // '/' 249 IF ( ln_rstdate ) THEN 250 CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec ) 251 WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 252 ELSE 253 IF( kt > 999999999 ) THEN ; WRITE(clkt, * ) kt 254 ELSE ; WRITE(clkt, '(i8.8)') kt 255 ENDIF 256 ENDIF 242 257 IF( lk_mpp ) THEN 243 WRITE(cl_filename,'(A,"_icebergs_", I8.8,"_restart_",I4.4,".nc")') TRIM(cexper), kt, narea-1258 WRITE(cl_filename,'(A,"_icebergs_",A,"_restart_",I4.4,".nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)), narea-1 244 259 ELSE 245 WRITE(cl_filename,'(A,"_icebergs_", I8.8,"_restart.nc")') TRIM(cexper), kt260 WRITE(cl_filename,'(A,"_icebergs_",A,"_restart.nc")') TRIM(cexper), TRIM(ADJUSTL(clkt)) 246 261 ENDIF 247 262 IF (nn_verbose_level >= 0) WRITE(numout,'(2a)') 'icebergs, write_restart: creating ',TRIM(cl_path)//TRIM(cl_filename) -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r6331 r6332 30 30 CHARACTER(lc) :: cn_ocerst_outdir !: restart output directory 31 31 LOGICAL :: ln_rstart !: start from (F) rest or (T) a restart file 32 LOGICAL :: ln_rstdate !: datestamping of restarts 32 33 LOGICAL :: ln_rst_list !: output restarts at list of times (T) or by frequency (F) 33 34 INTEGER :: nn_no !: job number -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r6331 r6332 21 21 USE in_out_manager ! I/O manager 22 22 USE iom ! I/O module 23 USE ioipsl, ONLY : ju2ymds ! for calendar 23 24 USE eosbn2 ! equation of state (eos bn2 routine) 24 25 USE trdmxl_oce ! ocean active mixed layer tracers trends variables … … 54 55 !!---------------------------------------------------------------------- 55 56 INTEGER, INTENT(in) :: kt ! ocean time-step 57 INTEGER :: iyear, imonth, iday 58 REAL (wp) :: zsec 56 59 !! 57 60 CHARACTER(LEN=20) :: clkt ! ocean time-step deine as a character 58 61 CHARACTER(LEN=50) :: clname ! ocean output restart file name 59 CHARACTER( lc):: clpath ! full path to ocean output restart file62 CHARACTER(LEN=150) :: clpath ! full path to ocean output restart file 60 63 !!---------------------------------------------------------------------- 61 64 ! … … 81 84 IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 82 85 IF( nitrst <= nitend .AND. nitrst > 0 ) THEN 83 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 84 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 85 ELSE ; WRITE(clkt, '(i8.8)') nitrst 86 IF ( ln_rstdate ) THEN 87 CALL ju2ymds( fjulday + rdttra(1) / rday, iyear, imonth, iday, zsec ) 88 WRITE(clkt, '(i4.4,2i2.2)') iyear, imonth, iday 89 ELSE 90 ! beware of the format used to write kt (default is i8.8, that should be large enough...) 91 IF( nitrst > 999999999 ) THEN ; WRITE(clkt, * ) nitrst 92 ELSE ; WRITE(clkt, '(i8.8)') nitrst 93 ENDIF 86 94 ENDIF 87 95 ! create the file -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r6331 r6332 1241 1241 IF(lwm) WRITE( numond, nameos ) 1242 1242 ! 1243 rau0 = 1026._wp !: volumic mass of reference [kg/m3] 1243 rau0 = 1020._wp !: volumic mass of reference [kg/m3] 1244 ! rau0 = 1026._wp !: volumic mass of reference [kg/m3] 1244 1245 rcp = 3991.86795711963_wp !: heat capacity [J/K] 1245 1246 ! -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r6331 r6332 100 100 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 101 101 ENDIF 102 ! slwa unless you use l_trdtra too, the above switches off trend calculations for l_trdtrc 103 l_trd = .FALSE. 104 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 105 !slwa 102 106 ! 103 107 IF( l_trd ) THEN -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r6331 r6332 46 46 LOGICAL , PUBLIC :: ln_qsr_ice !: light penetration for ice-model LIM3 (clem) 47 47 INTEGER , PUBLIC :: nn_chldta !: use Chlorophyll data (=1) or not (=0) 48 INTEGER , PUBLIC :: nn_kd490dta !: use kd490dta data (=1) or not (=0) 48 49 REAL(wp), PUBLIC :: rn_abs !: fraction absorbed in the very near surface (RGB & 2 bands) 49 50 REAL(wp), PUBLIC :: rn_si0 !: very near surface depth of extinction (RGB & 2 bands) … … 54 55 REAL(wp) :: xsi1r !: inverse of rn_si1 55 56 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_chl ! structure of input Chl (file informations, fields read) 57 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_kd490 ! structure of input kd490 (file informations, fields read) 56 58 INTEGER, PUBLIC :: nksr ! levels below which the light cannot penetrate ( depth larger than 391 m) 57 59 REAL(wp), DIMENSION(3,61) :: rkrgb !: tabulated attenuation coefficients for RGB absorption … … 306 308 ! 307 309 ENDIF 310 ! slwa 311 IF( nn_kd490dta == 1 ) THEN ! use KD490 data read in ! 312 ! ! ------------------------- ! 313 nksr = jpk - 1 314 ! 315 CALL fld_read( kt, 1, sf_kd490 ) ! Read kd490 data and provide it at the current time step 316 ! 317 zcoef = ( 1. - rn_abs ) 318 ze0(:,:,1) = rn_abs * qsr(:,:) 319 ze1(:,:,1) = zcoef * qsr(:,:) 320 zea(:,:,1) = qsr(:,:) 321 ! 322 DO jk = 2, nksr+1 323 !CDIR NOVERRCHK 324 DO jj = 1, jpj 325 !CDIR NOVERRCHK 326 DO ji = 1, jpi 327 zc0 = ze0(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * xsi0r ) 328 zc1 = ze1(ji,jj,jk-1) * EXP( - fse3t(ji,jj,jk-1) * sf_kd490(1)%fnow(ji,jj,1) ) 329 ze0(ji,jj,jk) = zc0 330 ze1(ji,jj,jk) = zc1 331 zea(ji,jj,jk) = ( zc0 + zc1 ) * tmask(ji,jj,jk) 332 END DO 333 END DO 334 END DO 335 ! clem: store attenuation coefficient of the first ocean level 336 IF ( ln_qsr_ice ) THEN 337 DO jj = 1, jpj 338 DO ji = 1, jpi 339 zzc0 = rn_abs * EXP( - fse3t(ji,jj,1) * xsi0r ) 340 zzc1 = zcoef * EXP( - fse3t(ji,jj,1) * sf_kd490(1)%fnow(ji,jj,1) ) 341 fraqsr_1lev(ji,jj) = 1.0 - ( zzc0 + zzc1 ) * tmask(ji,jj,2) 342 END DO 343 END DO 344 ENDIF 345 ! 346 DO jk = 1, nksr ! compute and add qsr trend to ta 347 qsr_hc(:,:,jk) = r1_rau0_rcp * ( zea(:,:,jk) - zea(:,:,jk+1) ) 348 END DO 349 zea(:,:,nksr+1:jpk) = 0.e0 ! 350 CALL iom_put( 'qsr3d', zea ) ! Shortwave Radiation 3D distribution 351 ! 352 ENDIF ! use KD490 data 353 !slwa 308 354 ! 309 355 ! Add to the general trend … … 374 420 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 375 421 TYPE(FLD_N) :: sn_chl ! informations about the chlorofyl field to be read 376 !! 377 NAMELIST/namtra_qsr/ sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice, & 378 & nn_chldta, rn_abs, rn_si0, rn_si1 422 TYPE(FLD_N) :: sn_kd490 ! informations about the kd490 field to be read 423 !! 424 NAMELIST/namtra_qsr/ sn_chl, sn_kd490, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice, & 425 & nn_chldta, rn_abs, rn_si0, rn_si1, nn_kd490dta 379 426 !!---------------------------------------------------------------------- 380 427 … … 409 456 WRITE(numout,*) ' RGB & 2 bands: shortess depth of extinction rn_si0 = ', rn_si0 410 457 WRITE(numout,*) ' 2 bands: longest depth of extinction rn_si1 = ', rn_si1 458 WRITE(numout,*) ' read in KD490 data nn_kd490dta = ', nn_kd490dta 411 459 ENDIF 412 460 … … 422 470 IF( ln_qsr_2bd ) ioptio = ioptio + 1 423 471 IF( ln_qsr_bio ) ioptio = ioptio + 1 472 IF( nn_kd490dta == 1 ) ioptio = ioptio + 1 424 473 ! 425 474 IF( ioptio /= 1 ) & … … 431 480 IF( ln_qsr_2bd ) nqsr = 3 432 481 IF( ln_qsr_bio ) nqsr = 4 482 IF( nn_kd490dta == 1 ) nqsr = 5 433 483 ! 434 484 IF(lwp) THEN ! Print the choice … … 438 488 IF( nqsr == 3 ) WRITE(numout,*) ' 2 bands light penetration' 439 489 IF( nqsr == 4 ) WRITE(numout,*) ' bio-model light penetration' 490 IF( nqsr == 5 ) WRITE(numout,*) ' KD490 light penetration' 440 491 ENDIF 441 492 ! … … 447 498 xsi0r = 1.e0 / rn_si0 448 499 xsi1r = 1.e0 / rn_si1 500 IF( nn_kd490dta == 1 ) THEN !* KD490 data : set sf_kd490 structure 501 IF(lwp) WRITE(numout,*) 502 IF(lwp) WRITE(numout,*) ' KD490 read in a file' 503 ALLOCATE( sf_kd490(1), STAT=ierror ) 504 IF( ierror > 0 ) THEN 505 CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_kd490 structure' ) ; RETURN 506 ENDIF 507 ALLOCATE( sf_kd490(1)%fnow(jpi,jpj,1) ) 508 IF( sn_kd490%ln_tint )ALLOCATE( sf_kd490(1)%fdta(jpi,jpj,1,2) ) 509 ! ! fill sf_kd490 with sn_kd490 and control print 510 CALL fld_fill( sf_kd490, (/ sn_kd490 /), cn_dir, 'tra_qsr_init', & 511 & 'Solar penetration function of read KD490', 'namtra_qsr' ) 449 512 ! ! ---------------------------------- ! 450 IF( ln_qsr_rgb ) THEN ! Red-Green-Blue light penetration !513 ELSEIF( ln_qsr_rgb ) THEN ! Red-Green-Blue light penetration ! 451 514 ! ! ---------------------------------- ! 452 515 ! -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r6331 r6332 203 203 DO jj = 2, jpjm1 204 204 DO ji = fs_2, fs_jpim1 ! vector opt. 205 #if defined key_tracer_budget 206 ! ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) ) * tmask(ji,jj,jk) 207 ptrd(ji,jj,jk) = - pf (ji,jj,jk) * tmask(ji,jj,jk) 208 #else 205 209 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 206 210 & - ( pun(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) & 207 211 & / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) * tmask(ji,jj,jk) 212 #endif 208 213 END DO 209 214 END DO -
branches/UKMO/CO6_KD490/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r6331 r6332 85 85 USE stopar 86 86 USE stopts 87 USE diatmb ! Top,middle,bottom output 88 USE dia25h ! 25h mean output 87 89 88 90 IMPLICIT NONE … … 475 477 IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments 476 478 IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler 479 CALL dia_tmb_init ! TMB outputs 480 CALL dia_25h_init ! 25h mean outputs 477 481 ! 478 482 END SUBROUTINE nemo_init … … 630 634 USE ldftra_oce, ONLY: ldftra_oce_alloc 631 635 USE trc_oce , ONLY: trc_oce_alloc 636 USE diainsitutem, ONLY: insitu_tem_alloc 632 637 #if defined key_diadct 633 638 USE diadct , ONLY: diadct_alloc … … 646 651 ierr = ierr + ldftra_oce_alloc() ! ocean lateral physics : tracers 647 652 ierr = ierr + zdf_oce_alloc () ! ocean vertical physics 653 ierr = ierr + insitu_tem_alloc() 648 654 ! 649 655 ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays
Note: See TracChangeset
for help on using the changeset viewer.