Changeset 4967 for branches/2014/dev_MERGE_2014
- Timestamp:
- 2014-12-03T15:06:15+01:00 (9 years ago)
- Location:
- branches/2014/dev_MERGE_2014/NEMOGCM/NEMO
- Files:
-
- 19 edited
-
LIM_SRC_2/limsbc_2.F90 (modified) (3 diffs)
-
LIM_SRC_2/limthd_2.F90 (modified) (3 diffs)
-
LIM_SRC_3/limdiahsb.F90 (modified) (5 diffs)
-
LIM_SRC_3/limsbc.F90 (modified) (1 diff)
-
LIM_SRC_3/limwri.F90 (modified) (2 diffs)
-
OPA_SRC/DIA/diahsb.F90 (modified) (2 diffs)
-
OPA_SRC/DIA/diawri.F90 (modified) (8 diffs)
-
OPA_SRC/DYN/sshwzv.F90 (modified) (4 diffs)
-
OPA_SRC/OBS/ddatetoymdhms.h90 (modified) (1 diff)
-
OPA_SRC/OBS/obs_read_prof.F90 (modified) (1 diff)
-
OPA_SRC/OBS/obs_read_seaice.F90 (modified) (1 diff)
-
OPA_SRC/OBS/obs_read_sla.F90 (modified) (2 diffs)
-
OPA_SRC/OBS/obs_read_sst.F90 (modified) (1 diff)
-
OPA_SRC/OBS/obs_read_vel.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/sbccpl.F90 (modified) (5 diffs)
-
OPA_SRC/SBC/sbcice_cice.F90 (modified) (2 diffs)
-
OPA_SRC/SBC/sbcisf.F90 (modified) (1 diff)
-
OPA_SRC/TRA/traadv_eiv.F90 (modified) (5 diffs)
-
OPA_SRC/TRA/trasbc.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90
r4946 r4967 36 36 USE wrk_nemo ! work arrays 37 37 USE in_out_manager ! I/O manager 38 USE diaar5, ONLY : lk_diaar539 38 USE iom ! I/O library 40 39 USE prtctl ! Print control … … 242 241 ENDIF 243 242 244 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) 245 CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) ) 246 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 247 248 IF( lk_diaar5 ) THEN ! AR5 diagnostics 249 CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice ) 250 CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 251 CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 252 ENDIF 243 IF( iom_use('hflx_ice_cea' ) ) CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) 244 IF( iom_use('qns_io_cea' ) ) CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) ) 245 IF( iom_use('qsr_io_cea' ) ) CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) ) 246 247 IF( iom_use('isnwmlt_cea' ) ) CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice ) 248 IF( iom_use('fsal_virt_cea') ) CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 249 IF( iom_use('fsal_real_cea') ) CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice ) 253 250 254 251 !-----------------------------------------------! … … 264 261 CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb ) 265 262 alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys) 266 CALL iom_put( "icealb_cea", alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo263 IF( iom_use('icealb_cea' ) ) CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo 267 264 ENDIF 268 265 -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_2/limthd_2.F90
r4946 r4967 33 33 USE limtab_2 34 34 USE prtctl ! Print control 35 USE diaar5 , ONLY : lk_diaar536 35 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 37 36 … … 439 438 !-------------------------------------------------------------------------------- 440 439 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 441 CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] 442 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 443 CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 444 IF( .NOT. lk_cpl ) CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 440 IF( iom_use('ist_cea' ) ) CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] 441 IF( iom_use('qsr_ai_cea' ) ) CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 442 IF( iom_use('qns_ai_cea' ) ) CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 443 IF( iom_use('qla_ai_cea' ) .AND. .NOT. lk_cpl ) & 444 & CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 445 445 ! 446 CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness[m]447 CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness[m]446 IF( iom_use('snowthic_cea')) CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] 447 IF( iom_use('icethic_cea' )) CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] 448 448 zztmp = 1.0 / rdt_ice 449 CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced[m/s]450 CALL iom_put( 'iiceconc' , fr_i(:,:) ) ! Ice concentration[-]451 IF( lk_diaar5 ) THEN452 CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp ) ! Snow melt [kg/m2/s]453 zztmp = rhoic / rdt_ice454 CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation[kg/m2/s]455 CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top[kg/m2/s]456 CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s]449 IF( iom_use('iceprod_cea') ) CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] 450 IF( iom_use('iiceconc' ) ) CALL iom_put( 'iiceconc' , fr_i(:,:) ) ! Ice concentration [-] 451 IF( iom_use('snowmel_cea') ) CALL iom_put( 'snowmel_cea' , rdm_snw(:,:) * zztmp ) ! Snow melt [kg/m2/s] 452 zztmp = rhoic / rdt_ice 453 IF( iom_use('sntoice_cea') ) CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation [kg/m2/s] 454 IF( iom_use('ticemel_cea') ) CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top [kg/m2/s] 455 IF( iom_use('bicemel_cea') ) CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s] 456 IF( iom_use('licepro_cea') ) THEN 457 457 zlicegr(:,:) = MAX( 0.e0, rdm_ice(:,:)-zlicegr(:,:) ) 458 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Lateral sea ice growth[kg/m2/s]458 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Lateral sea ice growth [kg/m2/s] 459 459 ENDIF 460 460 ! 461 461 ! Compute the Eastward & Northward sea-ice transport 462 zztmp = 0.25 * rhoic 463 DO jj = 1, jpjm1 464 DO ji = 1, jpim1 ! NO vector opt. 465 ! Ice velocities, volume & transport at U & V-points 466 zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 467 zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 468 zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj )*e2t(ji+1,jj )*fr_i(ji+1,jj ) 469 zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji ,jj+1)*e1t(ji ,jj+1)*fr_i(ji ,jj+1) 470 zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 471 zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 472 END DO 473 END DO 474 CALL lbc_lnk( zu_imasstr, 'U', -1. ) ; CALL lbc_lnk( zv_imasstr, 'V', -1. ) 475 CALL iom_put( 'u_imasstr', zu_imasstr(:,:) ) ! Ice transport along i-axis at U-point [kg/s] 476 CALL iom_put( 'v_imasstr', zv_imasstr(:,:) ) ! Ice transport along j-axis at V-point [kg/s] 462 IF( iom_use('u_imasstr') ) THEN 463 zztmp = 0.25 * rhoic 464 DO jj = 1, jpjm1 465 DO ji = 1, jpim1 ! NO vector opt. 466 ! Ice velocities, volume & transport at U-points 467 zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 468 zhice_u = hicif(ji,jj)*e2t(ji,jj)*fr_i(ji,jj) + hicif(ji+1,jj )*e2t(ji+1,jj )*fr_i(ji+1,jj ) 469 zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 470 END DO 471 END DO 472 CALL lbc_lnk( zu_imasstr, 'U', -1. ) 473 CALL iom_put( 'u_imasstr', zu_imasstr(:,:) ) ! Ice transport along i-axis at U-point [kg/s] 474 ENDIF 475 IF( iom_use('v_imasstr') ) THEN 476 zztmp = 0.25 * rhoic 477 DO jj = 1, jpjm1 478 DO ji = 1, jpim1 ! NO vector opt. 479 ! Ice velocities, volume & transport at V-points 480 zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 481 zhice_v = hicif(ji,jj)*e1t(ji,jj)*fr_i(ji,jj) + hicif(ji ,jj+1)*e1t(ji ,jj+1)*fr_i(ji ,jj+1) 482 zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 483 END DO 484 END DO 485 CALL lbc_lnk( zv_imasstr, 'V', -1. ) 486 CALL iom_put( 'v_imasstr', zv_imasstr(:,:) ) ! Ice transport along j-axis at V-point [kg/s] 487 ENDIF 477 488 478 489 !! Fram Strait sea-ice transport (sea-ice + snow) (in ORCA2 = 5 points) 479 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration490 IF( iom_use('fram_trans') .and. cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 480 491 DO jj = mj0(137), mj1(137) ! B grid 481 492 IF( mj0(jj-1) >= nldj ) THEN … … 491 502 ENDIF 492 503 504 IF( iom_use('ice_pres') .OR. iom_use('ist_ipa') .OR. iom_use('uice_ipa') .OR. iom_use('vice_ipa') ) THEN 493 505 !! ce ztmp(:,:) = 1. - AINT( frld(:,:), wp ) ! return 1 as soon as there is ice 494 506 !! ce A big warning because the model crashes on IDRIS/IBM SP6 with xlf 13.1.0.3, see ticket #761 495 !! ce We Unroll the loop and everything works fine 496 DO jj = 1, jpj 497 DO ji = 1, jpi 498 ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp ) ! return 1 as soon as there is ice 499 END DO 500 END DO 501 ! 502 CALL iom_put( 'ice_pres' , ztmp ) ! Ice presence [-] 503 CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 504 CALL iom_put( 'uice_ipa' , u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point [m/s] 505 CALL iom_put( 'vice_ipa' , v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point [m/s] 507 !! ce We Unroll the loop and everything works fine 508 DO jj = 1, jpj 509 DO ji = 1, jpi 510 ztmp(ji,jj) = 1. - AINT( frld(ji,jj), wp ) ! return 1 as soon as there is ice 511 END DO 512 END DO 513 ! 514 IF( iom_use('ice_pres') ) CALL iom_put( 'ice_pres', ztmp ) ! Ice presence [-] 515 IF( iom_use('ist_ipa' ) ) CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 516 IF( iom_use('uice_ipa') ) CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point [m/s] 517 IF( iom_use('vice_ipa') ) CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point [m/s] 518 ENDIF 506 519 507 520 IF(ln_ctl) THEN -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limdiahsb.F90
r4946 r4967 35 35 !!PUBLIC lim_diahsb_rst ! routine called by ice_init.F90 36 36 37 REAL(dp) :: frc_sal, frc_vol ! global forcing trends38 REAL(dp) :: bg_grme ! global ice growth+melt trends37 real(wp) :: frc_sal, frc_vol ! global forcing trends 38 real(wp) :: bg_grme ! global ice growth+melt trends 39 39 REAL(wp) :: epsi06 = 1.e-6_wp ! small number 40 40 … … 58 58 !!--------------------------------------------------------------------------- 59 59 !! 60 REAL(dp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc61 REAL(dp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, &60 real(wp) :: zbg_ivo, zbg_svo, zbg_are, zbg_sal ,zbg_tem ,zbg_ihc ,zbg_shc 61 real(wp) :: zbg_sfx, zbg_sfx_bri, zbg_sfx_bog, zbg_sfx_bom, zbg_sfx_sum, zbg_sfx_sni, & 62 62 & zbg_sfx_opw, zbg_sfx_res, zbg_sfx_dyn 63 REAL(dp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 64 REAL(dp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub 65 REAL(dp) :: zbg_hfx_dhc, zbg_hfx_spr 66 REAL(dp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in 67 REAL(dp) :: zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 68 REAL(dp) :: z_frc_vol, z_frc_sal, z_bg_grme 69 REAL(dp) :: z1_area ! - - 70 REAL(dp) :: zinda, zindb 63 real(wp) :: zbg_vfx, zbg_vfx_bog, zbg_vfx_opw, zbg_vfx_sni, zbg_vfx_dyn 64 real(wp) :: zbg_vfx_bom, zbg_vfx_sum, zbg_vfx_res, zbg_vfx_spr, zbg_vfx_snw, zbg_vfx_sub 65 real(wp) :: zbg_hfx_dhc, zbg_hfx_spr 66 real(wp) :: zbg_hfx_res, zbg_hfx_sub, zbg_hfx_dyn, zbg_hfx_thd, zbg_hfx_snw, zbg_hfx_out, zbg_hfx_in 67 real(wp) :: zbg_hfx_sum, zbg_hfx_bom, zbg_hfx_bog, zbg_hfx_dif, zbg_hfx_opw 68 real(wp) :: z_frc_vol, z_frc_sal, z_bg_grme 69 real(wp) :: z1_area ! - - 70 real(wp) :: zinda, zindb 71 REAL(wp) :: ztmp 71 72 !!--------------------------------------------------------------------------- 72 73 IF( nn_timing == 1 ) CALL timing_start('lim_diahsb') … … 91 92 92 93 ! Volume 93 zbg_vfx = zinda * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 94 zbg_vfx_bog = zinda * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 95 zbg_vfx_opw = zinda * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 96 zbg_vfx_sni = zinda * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 97 zbg_vfx_dyn = zinda * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 98 zbg_vfx_bom = zinda * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 99 zbg_vfx_sum = zinda * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 100 zbg_vfx_res = zinda * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 101 zbg_vfx_spr = zinda * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 102 zbg_vfx_snw = zinda * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 103 zbg_vfx_sub = zinda * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday 94 ztmp = zinda * z1_area * r1_rau0 * rday 95 zbg_vfx = ztmp * glob_sum( emp(:,:) * area(:,:) * tms(:,:) ) 96 zbg_vfx_bog = ztmp * glob_sum( wfx_bog(:,:) * area(:,:) * tms(:,:) ) 97 zbg_vfx_opw = ztmp * glob_sum( wfx_opw(:,:) * area(:,:) * tms(:,:) ) 98 zbg_vfx_sni = ztmp * glob_sum( wfx_sni(:,:) * area(:,:) * tms(:,:) ) 99 zbg_vfx_dyn = ztmp * glob_sum( wfx_dyn(:,:) * area(:,:) * tms(:,:) ) 100 zbg_vfx_bom = ztmp * glob_sum( wfx_bom(:,:) * area(:,:) * tms(:,:) ) 101 zbg_vfx_sum = ztmp * glob_sum( wfx_sum(:,:) * area(:,:) * tms(:,:) ) 102 zbg_vfx_res = ztmp * glob_sum( wfx_res(:,:) * area(:,:) * tms(:,:) ) 103 zbg_vfx_spr = ztmp * glob_sum( wfx_spr(:,:) * area(:,:) * tms(:,:) ) 104 zbg_vfx_snw = ztmp * glob_sum( wfx_snw(:,:) * area(:,:) * tms(:,:) ) 105 zbg_vfx_sub = ztmp * glob_sum( wfx_sub(:,:) * area(:,:) * tms(:,:) ) 104 106 105 107 ! Salt 106 zbg_sfx = z inda * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday107 zbg_sfx_bri = z inda * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday108 zbg_sfx_res = z inda * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday109 zbg_sfx_dyn = z inda * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday110 111 zbg_sfx_bog = z inda * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday112 zbg_sfx_opw = z inda * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday113 zbg_sfx_sni = z inda * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday114 zbg_sfx_bom = z inda * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday115 zbg_sfx_sum = z inda * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) * z1_area * r1_rau0 * rday108 zbg_sfx = ztmp * glob_sum( sfx(:,:) * area(:,:) * tms(:,:) ) 109 zbg_sfx_bri = ztmp * glob_sum( sfx_bri(:,:) * area(:,:) * tms(:,:) ) 110 zbg_sfx_res = ztmp * glob_sum( sfx_res(:,:) * area(:,:) * tms(:,:) ) 111 zbg_sfx_dyn = ztmp * glob_sum( sfx_dyn(:,:) * area(:,:) * tms(:,:) ) 112 113 zbg_sfx_bog = ztmp * glob_sum( sfx_bog(:,:) * area(:,:) * tms(:,:) ) 114 zbg_sfx_opw = ztmp * glob_sum( sfx_opw(:,:) * area(:,:) * tms(:,:) ) 115 zbg_sfx_sni = ztmp * glob_sum( sfx_sni(:,:) * area(:,:) * tms(:,:) ) 116 zbg_sfx_bom = ztmp * glob_sum( sfx_bom(:,:) * area(:,:) * tms(:,:) ) 117 zbg_sfx_sum = ztmp * glob_sum( sfx_sum(:,:) * area(:,:) * tms(:,:) ) 116 118 117 119 ! Heat budget … … 155 157 zindb = MAX( 0._wp , SIGN( 1._wp , zbg_ivo - epsi06 ) ) 156 158 ! 159 IF( iom_use('ibgvoltot') ) & 157 160 CALL iom_put( 'ibgvoltot' , zbg_ivo * rhoic * r1_rau0 * 1.e-9 ) ! ice volume (km3 equivalent liquid) 161 IF( iom_use('sbgvoltot') ) & 158 162 CALL iom_put( 'sbgvoltot' , zbg_svo * rhosn * r1_rau0 * 1.e-9 ) ! snw volume (km3 equivalent liquid) 163 IF( iom_use('ibgarea') ) & 159 164 CALL iom_put( 'ibgarea' , zbg_are * 1.e-6 ) ! ice area (km2) 165 IF( iom_use('ibgsaline') ) & 160 166 CALL iom_put( 'ibgsaline' , zindb * zbg_sal / MAX( zbg_ivo, epsi06 ) ) ! ice saline (psu) 167 IF( iom_use('ibgtemper') ) & 161 168 CALL iom_put( 'ibgtemper' , zindb * zbg_tem / MAX( zbg_ivo, epsi06 ) ) ! ice temper (C) 162 169 CALL iom_put( 'ibgheatco' , zbg_ihc ) ! ice heat content (1.e20 J) 163 170 CALL iom_put( 'sbgheatco' , zbg_shc ) ! snw heat content (1.e20 J) 171 IF( iom_use('ibgsaltco') ) & 164 172 CALL iom_put( 'ibgsaltco' , zbg_sal * rhoic * r1_rau0 * 1.e-9 ) ! ice salt content (psu*km3 equivalent liquid) 165 173 … … 204 212 CALL iom_put( 'ibgfrcvol' , frc_vol * 1.e-9 ) ! vol - forcing (km3 equivalent liquid) 205 213 CALL iom_put( 'ibgfrcsfx' , frc_sal * 1.e-9 ) ! sal - forcing (psu*km3 equivalent liquid) 214 IF( iom_use('ibgvolgrm') ) & 206 215 CALL iom_put( 'ibgvolgrm' , bg_grme * r1_rau0 * 1.e-9 ) ! vol growth + melt (km3 equivalent liquid) 207 216 -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90
r4946 r4967 116 116 117 117 ! make calls for heat fluxes before it is modified 118 CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface119 CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface120 CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )! solar flux at ice surface121 CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )! non-solar flux at ice surface122 CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) )! solar flux transmitted thru ice123 CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) )124 CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) )118 IF( iom_use('qsr_oce') ) CALL iom_put( "qsr_oce" , qsr(:,:) * pfrld(:,:) ) ! solar flux at ocean surface 119 IF( iom_use('qns_oce') ) CALL iom_put( "qns_oce" , qns(:,:) * pfrld(:,:) ) ! non-solar flux at ocean surface 120 IF( iom_use('qsr_ice') ) CALL iom_put( "qsr_ice" , SUM( qsr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux at ice surface 121 IF( iom_use('qns_ice') ) CALL iom_put( "qns_ice" , SUM( qns_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! non-solar flux at ice surface 122 IF( iom_use('qtr_ice') ) CALL iom_put( "qtr_ice" , SUM( ftr_ice(:,:,:) * a_i_b(:,:,:), dim=3 ) ) ! solar flux transmitted thru ice 123 IF( iom_use('qt_oce' ) ) CALL iom_put( "qt_oce" , ( qsr(:,:) + qns(:,:) ) * pfrld(:,:) ) 124 IF( iom_use('qt_ice' ) ) CALL iom_put( "qt_ice" , SUM( ( qns_ice(:,:,:) + qsr_ice(:,:,:) ) * a_i_b(:,:,:), dim=3 ) ) 125 125 126 126 ! pfrld is the lead fraction at the previous time step (actually between TRP and THD) -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/LIM_SRC_3/limwri.F90
r4924 r4967 61 61 INTEGER :: ji, jj, jk, jl ! dummy loop indices 62 62 REAL(wp) :: zinda, zindb, z1_365 63 REAL(wp) :: ztmp 63 64 REAL(wp), POINTER, DIMENSION(:,:,:) :: zoi, zei 64 65 REAL(wp), POINTER, DIMENSION(:,:) :: z2d, z2da, z2db, zind ! 2D workspace … … 199 200 CALL iom_put( "sfx" , sfx * rday ) ! total salt flux 200 201 201 CALL iom_put( "vfxres" , wfx_res * rday / rhoic ) ! daily prod./melting due to limupdate 202 CALL iom_put( "vfxopw" , wfx_opw * rday / rhoic ) ! daily lateral thermodynamic ice production 203 CALL iom_put( "vfxsni" , wfx_sni * rday / rhoic ) ! daily snowice ice production 204 CALL iom_put( "vfxbog" , wfx_bog * rday / rhoic ) ! daily bottom thermodynamic ice production 205 CALL iom_put( "vfxdyn" , wfx_dyn * rday / rhoic ) ! daily dynamic ice production (rid/raft) 206 CALL iom_put( "vfxsum" , wfx_sum * rday / rhoic ) ! surface melt 207 CALL iom_put( "vfxbom" , wfx_bom * rday / rhoic ) ! bottom melt 208 CALL iom_put( "vfxice" , wfx_ice * rday / rhoic ) ! total ice growth/melt 209 CALL iom_put( "vfxsnw" , wfx_snw * rday / rhoic ) ! total snw growth/melt 210 CALL iom_put( "vfxsub" , wfx_sub * rday / rhoic ) ! sublimation (snow) 211 CALL iom_put( "vfxspr" , wfx_spr * rday / rhoic ) ! precip (snow) 202 ztmp = rday / rhoic 203 CALL iom_put( "vfxres" , wfx_res * ztmp ) ! daily prod./melting due to limupdate 204 CALL iom_put( "vfxopw" , wfx_opw * ztmp ) ! daily lateral thermodynamic ice production 205 CALL iom_put( "vfxsni" , wfx_sni * ztmp ) ! daily snowice ice production 206 CALL iom_put( "vfxbog" , wfx_bog * ztmp ) ! daily bottom thermodynamic ice production 207 CALL iom_put( "vfxdyn" , wfx_dyn * ztmp ) ! daily dynamic ice production (rid/raft) 208 CALL iom_put( "vfxsum" , wfx_sum * ztmp ) ! surface melt 209 CALL iom_put( "vfxbom" , wfx_bom * ztmp ) ! bottom melt 210 CALL iom_put( "vfxice" , wfx_ice * ztmp ) ! total ice growth/melt 211 CALL iom_put( "vfxsnw" , wfx_snw * ztmp ) ! total snw growth/melt 212 CALL iom_put( "vfxsub" , wfx_sub * ztmp ) ! sublimation (snow) 213 CALL iom_put( "vfxspr" , wfx_spr * ztmp ) ! precip (snow) 212 214 213 215 CALL iom_put ('hfxthd', hfx_thd(:,:) ) ! -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r4946 r4967 37 37 LOGICAL, PUBLIC :: ln_diahsb !: check the heat and salt budgets 38 38 39 REAL(dp) :: surf_tot !40 REAL(dp) :: frc_t , frc_s , frc_v ! global forcing trends41 REAL(dp) :: frc_wn_t , frc_wn_s ! global forcing trends42 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini !43 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini !44 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini39 real(wp) :: surf_tot ! 40 real(wp) :: frc_t , frc_s , frc_v ! global forcing trends 41 real(wp) :: frc_wn_t , frc_wn_s ! global forcing trends 42 real(wp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 43 real(wp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 44 real(wp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini 45 45 46 46 !! * Substitutions … … 70 70 !! 71 71 INTEGER :: jk, ji, jj ! dummy loop indice 72 REAL(dp) :: zdiff_hc , zdiff_sc ! heat and salt content variations73 REAL(dp) :: zdiff_hc1 , zdiff_sc1 ! - - - - - - - -74 REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation75 REAL(dp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit76 REAL(dp) :: zvol_tot ! volume77 REAL(dp) :: z_frc_trd_t , z_frc_trd_s ! - -78 REAL(dp) :: z_frc_trd_v ! - -79 REAL(dp) :: z_wn_trd_t , z_wn_trd_s ! - -80 REAL(dp) :: z_ssh_hc , z_ssh_sc ! - -81 REAL(dp), DIMENSION(:,:), POINTER :: z2d0, z2d172 real(wp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 73 real(wp) :: zdiff_hc1 , zdiff_sc1 ! - - - - - - - - 74 real(wp) :: zdiff_v1 , zdiff_v2 ! volume variation 75 real(wp) :: zerr_hc1 , zerr_sc1 ! heat and salt content misfit 76 real(wp) :: zvol_tot ! volume 77 real(wp) :: z_frc_trd_t , z_frc_trd_s ! - - 78 real(wp) :: z_frc_trd_v ! - - 79 real(wp) :: z_wn_trd_t , z_wn_trd_s ! - - 80 real(wp) :: z_ssh_hc , z_ssh_sc ! - - 81 real(wp), DIMENSION(:,:), POINTER :: z2d0, z2d1 82 82 !!--------------------------------------------------------------------------- 83 83 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r4946 r4967 44 44 USE in_out_manager ! I/O manager 45 45 USE diadimg ! dimg direct access file format output 46 USE diaar5, ONLY : lk_diaar547 46 USE iom 48 47 USE ioipsl … … 129 128 !! 130 129 REAL(wp), POINTER, DIMENSION(:,:) :: z2d ! 2D workspace 131 REAL(wp), POINTER, DIMENSION(:,:) :: z2ds ! 2D workspace132 130 REAL(wp), POINTER, DIMENSION(:,:,:) :: z3d ! 3D workspace 133 131 !!---------------------------------------------------------------------- … … 135 133 IF( nn_timing == 1 ) CALL timing_start('dia_wri') 136 134 ! 137 CALL wrk_alloc( jpi , jpj , z2d , z2ds)135 CALL wrk_alloc( jpi , jpj , z2d ) 138 136 CALL wrk_alloc( jpi , jpj, jpk , z3d ) 139 137 ! … … 175 173 ELSE 176 174 CALL iom_put( "toce" , tsn(:,:,:,jp_tem) ) ! temperature 177 DO jj = 1, jpj 178 DO ji = 1, jpi 179 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) 180 END DO 181 END DO 182 CALL iom_put( "sst" , z2d(:,:) ) ! sea surface temperature 183 CALL iom_put( "sst2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface temperature 175 IF ( iom_use("sst") ) THEN 176 DO jj = 1, jpj 177 DO ji = 1, jpi 178 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_tem) 179 END DO 180 END DO 181 CALL iom_put( "sst" , z2d(:,:) ) ! sea surface temperature 182 ENDIF 183 IF ( iom_use("sst2") ) CALL iom_put( "sst2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface temperature 184 184 CALL iom_put( "soce" , tsn(:,:,:,jp_sal) ) ! salinity 185 DO jj = 1, jpj 186 DO ji = 1, jpi 187 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) 188 END DO 189 END DO 190 CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity 185 IF ( iom_use("sss") ) THEN 186 DO jj = 1, jpj 187 DO ji = 1, jpi 188 z2d(ji,jj) = tsn(ji,jj,mikt(ji,jj),jp_sal) 189 END DO 190 END DO 191 CALL iom_put( "sss" , z2d(:,:) ) ! sea surface salinity 192 ENDIF 191 193 CALL iom_put( "sss2" , z2d(:,:) * z2d(:,:) ) ! square of sea surface salinity 192 194 END IF … … 197 199 CALL iom_put( "uoce" , umask(:,:,:) * un(:,:,:) ) ! i-current 198 200 CALL iom_put( "voce" , vmask(:,:,:) * vn(:,:,:) ) ! j-current 199 DO jj = 1, jpj 200 DO ji = 1, jpi 201 z2d(ji,jj) = un(ji,jj,miku(ji,jj)) 202 END DO 203 END DO 204 CALL iom_put( "ssu" , z2d ) ! i-current 205 DO jj = 1, jpj 206 DO ji = 1, jpi 207 z2d(ji,jj) = vn(ji,jj,mikv(ji,jj)) 208 END DO 209 END DO 210 CALL iom_put( "ssv" , z2d ) ! j-current 211 END IF 201 IF ( iom_use("ssu") ) THEN 202 DO jj = 1, jpj 203 DO ji = 1, jpi 204 z2d(ji,jj) = un(ji,jj,miku(ji,jj)) 205 END DO 206 END DO 207 CALL iom_put( "ssu" , z2d ) ! i-current 208 ENDIF 209 IF ( iom_use("ssv") ) THEN 210 DO jj = 1, jpj 211 DO ji = 1, jpi 212 z2d(ji,jj) = vn(ji,jj,mikv(ji,jj)) 213 END DO 214 END DO 215 CALL iom_put( "ssv" , z2d ) ! j-current 216 ENDIF 217 ENDIF 212 218 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 213 219 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. … … 216 222 ENDIF 217 223 218 DO jj = 2, jpjm1 ! sst gradient 219 DO ji = fs_2, fs_jpim1 ! vector opt. 220 zztmp = tsn(ji,jj,1,jp_tem) 221 zztmpx = ( tsn(ji+1,jj ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) / e1u(ji-1,jj ) 222 zztmpy = ( tsn(ji ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) / e2v(ji ,jj-1) 223 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 224 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 225 END DO 226 END DO 227 CALL lbc_lnk( z2d, 'T', 1. ) 228 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 229 !CDIR NOVERRCHK 230 z2d(:,:) = SQRT( z2d(:,:) ) 231 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 232 224 IF ( iom_use("sstgrad2") .OR. iom_use("sstgrad2") ) THEN 225 DO jj = 2, jpjm1 ! sst gradient 226 DO ji = fs_2, fs_jpim1 ! vector opt. 227 zztmp = tsn(ji,jj,1,jp_tem) 228 zztmpx = ( tsn(ji+1,jj ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj ,1,jp_tem) ) / e1u(ji-1,jj ) 229 zztmpy = ( tsn(ji ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji ,jj-1,1,jp_tem) ) / e2v(ji ,jj-1) 230 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 231 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 232 END DO 233 END DO 234 CALL lbc_lnk( z2d, 'T', 1. ) 235 CALL iom_put( "sstgrad2", z2d ) ! square of module of sst gradient 236 !CDIR NOVERRCHK< 237 z2d(:,:) = SQRT( z2d(:,:) ) 238 CALL iom_put( "sstgrad" , z2d ) ! module of sst gradient 239 ENDIF 240 233 241 ! clem: heat and salt content 234 z2d(:,:) = 0._wp 235 z2ds(:,:) = 0._wp 236 DO jk = 1, jpkm1 237 DO jj = 2, jpjm1 238 DO ji = fs_2, fs_jpim1 ! vector opt. 239 z2d(ji,jj) = z2d(ji,jj) + rau0 * rcp * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 240 z2ds(ji,jj) = z2ds(ji,jj) + rau0 * fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 241 END DO 242 END DO 243 END DO 244 CALL lbc_lnk( z2d, 'T', 1. ) 245 CALL lbc_lnk( z2ds, 'T', 1. ) 246 CALL iom_put( "heatc", z2d ) ! vertically integrated heat content (J/m2) 247 CALL iom_put( "saltc", z2ds ) ! vertically integrated salt content (PSU*kg/m2) 248 249 ! 250 rke(:,:,jk) = 0._wp ! kinetic energy 251 DO jk = 1, jpkm1 252 DO jj = 2, jpjm1 253 DO ji = fs_2, fs_jpim1 ! vector opt. 254 zztmp = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 255 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) & 256 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) & 257 & * zztmp 258 ! 259 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) & 260 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) ) & 261 & * zztmp 262 ! 263 rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 264 ! 242 IF( iom_use("heatc") ) THEN 243 z2d(:,:) = 0._wp 244 DO jk = 1, jpkm1 245 DO jj = 2, jpjm1 246 DO ji = fs_2, fs_jpim1 ! vector opt. 247 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 248 END DO 249 END DO 250 END DO 251 CALL lbc_lnk( z2d, 'T', 1. ) 252 CALL iom_put( "heatc", (rau0 * rcp) * z2d ) ! vertically integrated heat content (J/m2) 253 ENDIF 254 255 IF( iom_use("saltc") ) THEN 256 z2d(:,:) = 0._wp 257 DO jk = 1, jpkm1 258 DO jj = 2, jpjm1 259 DO ji = fs_2, fs_jpim1 ! vector opt. 260 z2d(ji,jj) = z2d(ji,jj) + fse3t(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 261 END DO 262 END DO 263 END DO 264 CALL lbc_lnk( z2d, 'T', 1. ) 265 CALL iom_put( "saltc", rau0 * z2d ) ! vertically integrated salt content (PSU*kg/m2) 266 ENDIF 267 ! 268 IF ( iom_use("eken") ) THEN 269 rke(:,:,jk) = 0._wp ! kinetic energy 270 DO jk = 1, jpkm1 271 DO jj = 2, jpjm1 272 DO ji = fs_2, fs_jpim1 ! vector opt. 273 zztmp = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) ) 274 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) & 275 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) & 276 & * zztmp 277 ! 278 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) & 279 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) ) & 280 & * zztmp 281 ! 282 rke(ji,jj,jk) = 0.5_wp * ( zztmpx + zztmpy ) 283 ! 284 ENDDO 265 285 ENDDO 266 286 ENDDO 267 ENDDO268 CALL lbc_lnk( rke, 'T', 1. )269 CALL iom_put( "eken", rke )270 271 IF( lk_diaar5) THEN287 CALL lbc_lnk( rke, 'T', 1. ) 288 CALL iom_put( "eken", rke ) 289 ENDIF 290 291 IF( iom_use("u_masstr") .OR. iom_use("u_heattr") .OR. iom_use("u_salttr") ) THEN 272 292 z3d(:,:,jpk) = 0.e0 273 293 DO jk = 1, jpkm1 … … 275 295 END DO 276 296 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 277 278 zztmp = 0.5 * rcp 297 ENDIF 298 299 IF( iom_use("u_heattr") ) THEN 279 300 z2d(:,:) = 0.e0 280 z2ds(:,:) = 0.e0281 301 DO jk = 1, jpkm1 282 302 DO jj = 2, jpjm1 283 303 DO ji = fs_2, fs_jpim1 ! vector opt. 284 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 285 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 304 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 286 305 END DO 287 306 END DO 288 307 END DO 289 308 CALL lbc_lnk( z2d, 'U', -1. ) 290 CALL lbc_lnk( z2ds, 'U', -1. ) 291 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 292 CALL iom_put( "u_salttr", z2ds ) ! salt transport in i-direction 293 309 CALL iom_put( "u_heattr", (0.5 * rcp) * z2d ) ! heat transport in i-direction 310 ENDIF 311 312 IF( iom_use("u_salttr") ) THEN 313 z2d(:,:) = 0.e0 314 DO jk = 1, jpkm1 315 DO jj = 2, jpjm1 316 DO ji = fs_2, fs_jpim1 ! vector opt. 317 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 318 END DO 319 END DO 320 END DO 321 CALL lbc_lnk( z2d, 'U', -1. ) 322 CALL iom_put( "u_salttr", 0.5 * z2d ) ! heat transport in i-direction 323 ENDIF 324 325 326 IF( iom_use("v_masstr") .OR. iom_use("v_heattr") .OR. iom_use("v_salttr") ) THEN 294 327 z3d(:,:,jpk) = 0.e0 295 328 DO jk = 1, jpkm1 … … 297 330 END DO 298 331 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 299 332 ENDIF 333 334 IF( iom_use("v_heattr") ) THEN 300 335 z2d(:,:) = 0.e0 301 z2ds(:,:) = 0.e0302 336 DO jk = 1, jpkm1 303 337 DO jj = 2, jpjm1 304 338 DO ji = fs_2, fs_jpim1 ! vector opt. 305 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 306 z2ds(ji,jj) = z2ds(ji,jj) + z3d(ji,jj,jk) * 0.5_wp * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 339 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 307 340 END DO 308 341 END DO 309 342 END DO 310 343 CALL lbc_lnk( z2d, 'V', -1. ) 311 CALL lbc_lnk( z2ds, 'V', -1. ) 312 CALL iom_put( "v_heattr", z2d ) ! heat transport in j-direction 313 CALL iom_put( "v_salttr", z2ds ) ! salt transport in j-direction 314 ENDIF 315 ! 316 CALL wrk_dealloc( jpi , jpj , z2d , z2ds ) 344 CALL iom_put( "v_heattr", (0.5 * rcp) * z2d ) ! heat transport in j-direction 345 ENDIF 346 347 IF( iom_use("v_salttr") ) THEN 348 z2d(:,:) = 0.e0 349 DO jk = 1, jpkm1 350 DO jj = 2, jpjm1 351 DO ji = fs_2, fs_jpim1 ! vector opt. 352 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * ( tsn(ji,jj,jk,jp_sal) + tsn(ji,jj+1,jk,jp_sal) ) 353 END DO 354 END DO 355 END DO 356 CALL lbc_lnk( z2d, 'V', -1. ) 357 CALL iom_put( "v_salttr", 0.5 * z2d ) ! heat transport in j-direction 358 ENDIF 359 ! 360 CALL wrk_dealloc( jpi , jpj , z2d ) 317 361 CALL wrk_dealloc( jpi , jpj, jpk , z3d ) 318 362 ! -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r4726 r4967 31 31 USE bdy_par 32 32 USE bdydyn2d ! bdy_ssh routine 33 USE diaar5, ONLY: lk_diaar534 33 USE iom 35 34 #if defined key_agrif … … 138 137 ! ! outputs ! 139 138 ! !------------------------------! 140 CALL iom_put( "ssh" , sshn 141 CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height139 CALL iom_put( "ssh" , sshn ) ! sea surface height 140 if( iom_use('ssh2') ) CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height 142 141 ! 143 142 IF(ln_ctl) CALL prt_ctl( tab2d_1=ssha, clinfo1=' ssha - : ', mask1=tmask, ovlap=1 ) … … 233 232 ! !------------------------------! 234 233 CALL iom_put( "woce", wn ) ! vertical velocity 235 IF( lk_diaar5 ) THEN! vertical mass transport & its square value234 IF( iom_use('w_masstr') .OR. iom_use('w_masstr2') ) THEN ! vertical mass transport & its square value 236 235 CALL wrk_alloc( jpi, jpj, z2d ) 237 236 CALL wrk_alloc( jpi, jpj, jpk, z3d ) … … 241 240 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 242 241 END DO 243 CALL iom_put( "w_masstr" , z3d 244 CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )242 CALL iom_put( "w_masstr" , z3d ) 243 IF( iom_use('w_masstr2') ) CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) 245 244 CALL wrk_dealloc( jpi, jpj, z2d ) 246 245 CALL wrk_dealloc( jpi, jpj, jpk, z3d ) -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/OBS/ddatetoymdhms.h90
r2287 r4967 21 21 22 22 !! * Arguments 23 REAL(dp), INTENT(IN) :: ddate23 real(wp), INTENT(IN) :: ddate 24 24 INTEGER, INTENT(OUT) :: kyea 25 25 INTEGER, INTENT(OUT) :: kmon -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_prof.F90
r4932 r4967 128 128 & zphi, & 129 129 & zlam 130 REAL(dp), DIMENSION(:), ALLOCATABLE :: &130 real(wp), DIMENSION(:), ALLOCATABLE :: & 131 131 & zdat 132 132 LOGICAL :: llvalprof 133 133 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 134 134 & inpfiles 135 REAL(dp), DIMENSION(knumfiles) :: &135 real(wp), DIMENSION(knumfiles) :: & 136 136 & djulini, & 137 137 & djulend -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_seaice.F90
r4932 r4967 110 110 & zphi, & 111 111 & zlam 112 REAL(dp), DIMENSION(:), ALLOCATABLE :: &112 real(wp), DIMENSION(:), ALLOCATABLE :: & 113 113 & zdat 114 114 LOGICAL :: llvalprof 115 115 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 116 116 & inpfiles 117 REAL(dp), DIMENSION(knumfiles) :: &117 real(wp), DIMENSION(knumfiles) :: & 118 118 & djulini, & 119 119 & djulend -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sla.F90
r4932 r4967 111 111 & zphi, & 112 112 & zlam 113 REAL(dp), DIMENSION(:), ALLOCATABLE :: &113 real(wp), DIMENSION(:), ALLOCATABLE :: & 114 114 & zdat 115 115 LOGICAL :: llvalprof … … 117 117 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 118 118 & inpfiles 119 REAL(dp), DIMENSION(knumfiles) :: &119 real(wp), DIMENSION(knumfiles) :: & 120 120 & djulini, & 121 121 & djulend -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_sst.F90
r4932 r4967 110 110 & zphi, & 111 111 & zlam 112 REAL(dp), DIMENSION(:), ALLOCATABLE :: &112 real(wp), DIMENSION(:), ALLOCATABLE :: & 113 113 & zdat 114 114 LOGICAL :: llvalprof 115 115 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 116 116 & inpfiles 117 REAL(dp), DIMENSION(knumfiles) :: &117 real(wp), DIMENSION(knumfiles) :: & 118 118 & djulini, & 119 119 & djulend -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/OBS/obs_read_vel.F90
r4932 r4967 118 118 & zphi, & 119 119 & zlam 120 REAL(dp), DIMENSION(:), ALLOCATABLE :: &120 real(wp), DIMENSION(:), ALLOCATABLE :: & 121 121 & zdat 122 122 LOGICAL :: & … … 124 124 TYPE(obfbdata), POINTER, DIMENSION(:) :: & 125 125 & inpfiles 126 REAL(dp), DIMENSION(knumfiles) :: &126 real(wp), DIMENSION(knumfiles) :: & 127 127 & djulini, & 128 128 & djulend -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r4946 r4967 44 44 USE p4zflx, ONLY : oce_co2 45 45 #endif 46 USE diaar5, ONLY : lk_diaar547 46 #if defined key_cice 48 47 USE ice_domain_size, only: ncat … … 1127 1126 emp_tot(:,:) = frcv(jpr_tevp)%z3(:,:,1) - tprecip(:,:) 1128 1127 emp_ice(:,:) = frcv(jpr_ievp)%z3(:,:,1) - frcv(jpr_snow)%z3(:,:,1) 1129 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1130 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1131 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1132 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1133 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1128 CALL iom_put( 'rain' , frcv(jpr_rain)%z3(:,:,1) ) ! liquid precipitation 1129 IF( iom_use('hflx_rain_cea') ) & 1130 CALL iom_put( 'hflx_rain_cea', frcv(jpr_rain)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from liq. precip. 1131 IF( iom_use('evap_ao_cea') .OR. iom_use('hflx_evap_cea') ) & 1132 ztmp(:,:) = frcv(jpr_tevp)%z3(:,:,1) - frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) 1133 IF( iom_use('evap_ao_cea' ) ) & 1134 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1135 IF( iom_use('hflx_evap_cea') ) & 1136 CALL iom_put( 'hflx_evap_cea', ztmp(:,:) * zcptn(:,:) ) ! heat flux from from evap (cell average) 1134 1137 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp, jpr_ievp 1135 1138 emp_tot(:,:) = p_frld(:,:) * frcv(jpr_oemp)%z3(:,:,1) + zicefr(:,:) * frcv(jpr_sbpr)%z3(:,:,1) … … 1138 1141 END SELECT 1139 1142 1140 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1141 CALL iom_put( 'snow_ao_cea', sprecip(:,: ) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1142 CALL iom_put( 'snow_ai_cea', sprecip(:,: ) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1143 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1143 CALL iom_put( 'snowpre' , sprecip ) ! Snow 1144 IF( iom_use('snow_ao_cea') ) & 1145 CALL iom_put( 'snow_ao_cea', sprecip(:,:) * p_frld(:,:) ) ! Snow over ice-free ocean (cell average) 1146 IF( iom_use('snow_ai_cea') ) & 1147 CALL iom_put( 'snow_ai_cea', sprecip(:,:) * zicefr(:,:) ) ! Snow over sea-ice (cell average) 1148 IF( iom_use('subl_ai_cea') ) & 1149 CALL iom_put( 'subl_ai_cea', frcv(jpr_ievp)%z3(:,:,1) * zicefr(:,:) ) ! Sublimation over sea-ice (cell average) 1144 1150 ! 1145 1151 ! ! runoffs and calving (put in emp_tot) 1146 1152 IF( srcv(jpr_rnf)%laction ) THEN 1147 1153 emp_tot(:,:) = emp_tot(:,:) - frcv(jpr_rnf)%z3(:,:,1) 1148 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1149 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1154 CALL iom_put( 'runoffs' , frcv(jpr_rnf)%z3(:,:,1) ) ! rivers 1155 IF( iom_use('hflx_rnf_cea') ) & 1156 CALL iom_put( 'hflx_rnf_cea' , frcv(jpr_rnf)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from rivers 1150 1157 ENDIF 1151 1158 IF( srcv(jpr_cal)%laction ) THEN … … 1209 1216 & - ( emp_tot(:,:) & ! remove the heat content of mass flux (assumed to be at SST) 1210 1217 & - emp_ice(:,:) * zicefr(:,:) ) * zcptn(:,:) 1211 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1218 IF( iom_use('hflx_snow_cea') ) & 1219 CALL iom_put( 'hflx_snow_cea', ztmp + sprecip(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1212 1220 !!gm 1213 1221 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 1221 1229 ztmp(:,:) = frcv(jpr_cal)%z3(:,:,1) * lfus ! add the latent heat of iceberg melting 1222 1230 qns_tot(:,:) = qns_tot(:,:) - ztmp(:,:) 1223 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1231 IF( iom_use('hflx_cal_cea') ) & 1232 CALL iom_put( 'hflx_cal_cea', ztmp + frcv(jpr_cal)%z3(:,:,1) * zcptn(:,:) ) ! heat flux from calving 1224 1233 ENDIF 1225 1234 -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r4946 r4967 17 17 USE phycst, only : rcp, rau0, r1_rau0, rhosn, rhoic 18 18 USE in_out_manager ! I/O manager 19 USE iom, only : iom_put! I/O manager library !!Joakim edit19 USE iom, ONLY : iom_put,iom_use ! I/O manager library !!Joakim edit 20 20 USE lib_mpp ! distributed memory computing library 21 21 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 430 430 ! Snowfall 431 431 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) 432 CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit432 IF( iom_use('snowpre') ) CALL iom_put('snowpre',MAX( (1.0-fr_i(:,:))*sprecip(:,:) ,0.0)) !!Joakim edit 433 433 ztmp(:,:)=MAX(fr_i(:,:)*sprecip(:,:),0.0) 434 434 CALL nemo2cice(ztmp,fsnow,'T', 1. ) 435 435 436 436 ! Rainfall 437 CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit437 IF( iom_use('precip') ) CALL iom_put('precip', (1.0-fr_i(:,:))*(tprecip(:,:)-sprecip(:,:)) ) !!Joakim edit 438 438 ztmp(:,:)=fr_i(:,:)*(tprecip(:,:)-sprecip(:,:)) 439 439 CALL nemo2cice(ztmp,frain,'T', 1. ) -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r4957 r4967 298 298 ! output 299 299 CALL iom_put('qisf' , qisf) 300 CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce )300 IF( iom_use('fwfisf') ) CALL iom_put('fwfisf', fwfisf * stbl(:,:) / soce ) 301 301 END IF 302 302 -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r3787 r4967 25 25 USE phycst ! physical constants 26 26 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 27 USE diaar5, ONLY: lk_diaar528 27 # endif 29 28 USE wrk_nemo ! Memory Allocation … … 161 160 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 162 161 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 163 IF( lk_diaar5) THEN162 IF( iom_use('ueiv_heattr') ) THEN 164 163 zztmp = 0.5 * rau0 * rcp 165 164 z2d(:,:) = 0.e0 … … 167 166 DO jj = 2, jpjm1 168 167 DO ji = fs_2, fs_jpim1 ! vector opt. 169 z2d(ji,jj) = z2d(ji,jj) + zztmp *u_eiv(ji,jj,jk) &168 z2d(ji,jj) = z2d(ji,jj) + u_eiv(ji,jj,jk) & 170 169 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji+1,jj,jk,jp_tem)) * e2u(ji,jj) * fse3u(ji,jj,jk) 171 170 END DO … … 173 172 END DO 174 173 CALL lbc_lnk( z2d, 'U', -1. ) 175 CALL iom_put( "ueiv_heattr", z2d ) ! heat transport in i-direction 174 CALL iom_put( "ueiv_heattr", zztmp * z2d ) ! heat transport in i-direction 175 ENDIF 176 177 IF( iom_use('veiv_heattr') ) THEN 178 zztmp = 0.5 * rau0 * rcp 176 179 z2d(:,:) = 0.e0 177 180 DO jk = 1, jpkm1 178 181 DO jj = 2, jpjm1 179 182 DO ji = fs_2, fs_jpim1 ! vector opt. 180 z2d(ji,jj) = z2d(ji,jj) + zztmp *v_eiv(ji,jj,jk) &183 z2d(ji,jj) = z2d(ji,jj) + v_eiv(ji,jj,jk) & 181 184 & * (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * e1v(ji,jj) * fse3v(ji,jj,jk) 182 185 END DO … … 184 187 END DO 185 188 CALL lbc_lnk( z2d, 'V', -1. ) 186 CALL iom_put( "veiv_heattr", z 2d ) ! heat transport in i-direction189 CALL iom_put( "veiv_heattr", zztmp * z2d ) ! heat transport in i-direction 187 190 ENDIF 188 191 END IF -
branches/2014/dev_MERGE_2014/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r4946 r4967 191 191 END DO 192 192 END DO 193 CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) )! c/d term on sst194 CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) )! c/d term on sss193 IF( iom_use('emp_x_sst') ) CALL iom_put( "emp_x_sst", emp (:,:) * tsn(:,:,1,jp_tem) ) ! c/d term on sst 194 IF( iom_use('emp_x_sss') ) CALL iom_put( "emp_x_sss", emp (:,:) * tsn(:,:,1,jp_sal) ) ! c/d term on sss 195 195 ENDIF 196 196 ! Concentration dilution effect on (t,s) due to evapouration, precipitation and qns, but not river runoff
Note: See TracChangeset
for help on using the changeset viewer.
