Changeset 1756 for trunk/NEMO
- Timestamp:
- 2009-11-25T15:15:20+01:00 (15 years ago)
- Location:
- trunk/NEMO
- Files:
-
- 1 added
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/LIM_SRC_2/ice_2.F90
r1471 r1756 58 58 59 59 !!* diagnostic quantities 60 !! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: firic !: IR flux over the ice (only used for outputs)61 !! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fcsic !: Sensible heat flux over the ice (only used for outputs)62 !! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fleic !: Latent heat flux over the ice (only used for outputs)63 !! REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: qlatic !: latent flux (only used for outputs)64 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvosif !: Variation of volume at surface (only used for outputs)65 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvobif !: Variation of ice volume at the bottom ice (only used for outputs)66 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: fdvolif !: Total variation of ice volume (only used for outputs)67 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: rdvonif !: Lateral Variation of ice volume (only used for outputs)68 69 60 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: sist !: Sea-Ice Surface Temperature (Kelvin) 70 61 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: tfu !: Freezing/Melting point temperature of sea water at SSS -
trunk/NEMO/LIM_SRC_2/limsbc_2.F90
r1695 r1756 24 24 USE lbclnk ! ocean lateral boundary condition 25 25 USE in_out_manager ! I/O manager 26 USE diaar5, ONLY : lk_diaar5 26 27 USE iom ! 27 28 USE albedo ! albedo parameters … … 80 81 INTEGER :: iflt, ial, iadv, ifral, ifrdv 81 82 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integers 83 REAL(wp) :: zrdtir ! 1. / rdt_ice 82 84 REAL(wp) :: zqsr , zqns ! solar & non solar heat flux 83 85 REAL(wp) :: zinda ! switch for testing the values of ice concentration … … 97 99 !!--------------------------------------------------------------------- 98 100 101 zrdtir = 1. / rdt_ice 102 99 103 IF( kt == nit000 ) THEN 100 104 IF(lwp) WRITE(numout,*) … … 180 184 zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads 181 185 & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) & 182 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) / rdt_ice&183 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) / rdt_ice186 & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * zrdtir & 187 & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * zrdtir 184 188 185 189 fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! ??? … … 190 194 END DO 191 195 196 CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) ) 192 197 CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) ) 193 198 CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1. - pfrld(:,:)) ) … … 206 211 #if defined key_coupled 207 212 zemp = emp_tot(ji,jj) - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! 208 & + rdmsnif(ji,jj) / rdt_ice! freshwaterflux due to snow melting213 & + rdmsnif(ji,jj) * zrdtir ! freshwaterflux due to snow melting 209 214 #else 210 215 !!$ ! computing freshwater exchanges at the ice/ocean interface … … 217 222 & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precipitation reaches directly the ocean 218 223 & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) & ! taking into account change in ice cover within the time step 219 & + rdmsnif(ji,jj) / rdt_ice! freshwaterflux due to snow melting224 & + rdmsnif(ji,jj) * zrdtir ! freshwaterflux due to snow melting 220 225 ! ! ice-covered fraction: 221 226 #endif 222 227 223 228 ! computing salt exchanges at the ice/ocean interface 224 zfons = ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) / rdt_ice)229 zfons = ( soce_r(ji,jj) - sice_r(ji,jj) ) * ( rdmicif(ji,jj) * zrdtir ) 225 230 226 231 ! converting the salt flux from ice to a freshwater flux from ocean … … 232 237 END DO 233 238 END DO 239 240 IF( lk_diaar5 ) THEN 241 CALL iom_put( 'isnwmlt_cea' , rdmsnif(:,:) * zrdtir ) 242 CALL iom_put( 'fsal_virt_cea', soce_r(:,:) * rdmicif(:,:) * zrdtir ) 243 CALL iom_put( 'fsal_real_cea', - sice_r(:,:) * rdmicif(:,:) * zrdtir ) 244 ENDIF 234 245 235 246 !------------------------------------------! -
trunk/NEMO/LIM_SRC_2/limthd_2.F90
r1755 r1756 20 20 USE lbclnk 21 21 USE in_out_manager ! I/O manager 22 USE lib_mpp 22 23 USE iom ! IOM library 23 24 USE ice_2 ! LIM sea-ice variables … … 31 32 USE prtctl ! Print control 32 33 USE cpl_oasis3, ONLY : lk_cpl 34 USE diaar5, ONLY : lk_diaar5 33 35 34 36 IMPLICIT NONE … … 90 92 REAL(wp), DIMENSION(jpi,jpj) :: ztmp ! 2D workspace 91 93 REAL(wp), DIMENSION(jpi,jpj) :: zqlbsbq ! link with lead energy budget qldif 94 REAL(wp) :: zuice_m, zvice_m ! Sea-ice velocities at U & V-points 95 REAL(wp) :: zhice_u, zhice_v ! Sea-ice volume at U & V-points 96 REAL(wp) :: ztr_fram ! Sea-ice transport through Fram strait 97 REAL(wp) :: zrhoij, zrhoijm1 ! temporary scalars 98 REAL(wp) :: zztmp ! temporary scalars within a loop 99 REAL(wp), DIMENSION(jpi,jpj) :: zlicegr ! link with lateral ice growth 92 100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmsk ! 3D workspace 101 !!$ REAL(wp), DIMENSION(jpi,jpj) :: firic !: IR flux over the ice (outputs only) 102 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fcsic !: Sensible heat flux over the ice (outputs only) 103 !!$ REAL(wp), DIMENSION(jpi,jpj) :: fleic !: Latent heat flux over the ice (outputs only) 104 !!$ REAL(wp), DIMENSION(jpi,jpj) :: qlatic !: latent flux (outputs only) 105 REAL(wp), DIMENSION(jpi,jpj) :: zdvosif !: Variation of volume at surface (outputs only) 106 REAL(wp), DIMENSION(jpi,jpj) :: zdvobif !: Variation of ice volume at the bottom ice (outputs only) 107 REAL(wp), DIMENSION(jpi,jpj) :: zdvolif !: Total variation of ice volume (outputs only) 108 REAL(wp), DIMENSION(jpi,jpj) :: zdvonif !: Surface accretion Snow to Ice transformation (outputs only) 109 REAL(wp), DIMENSION(jpi,jpj) :: zdvomif !: Bottom variation of ice volume due to melting (outputs only) 110 REAL(wp), DIMENSION(jpi,jpj) :: zu_imasstr !: Sea-ice transport along i-axis at U-point (outputs only) 111 REAL(wp), DIMENSION(jpi,jpj) :: zv_imasstr !: Sea-ice transport along j-axis at V-point (outputs only) 93 112 !!------------------------------------------------------------------- 94 113 … … 100 119 101 120 !!gm needed? yes at least for some of these arrays 102 rdvosif(:,:) = 0.e0 ! variation of ice volume at surface 103 rdvobif(:,:) = 0.e0 ! variation of ice volume at bottom 104 fdvolif(:,:) = 0.e0 ! total variation of ice volume 105 rdvonif(:,:) = 0.e0 ! lateral variation of ice volume 121 zdvosif(:,:) = 0.e0 ! variation of ice volume at surface 122 zdvobif(:,:) = 0.e0 ! variation of ice volume at bottom 123 zdvolif(:,:) = 0.e0 ! total variation of ice volume 124 zdvonif(:,:) = 0.e0 ! transformation of snow to sea-ice volume 125 ! zdvonif(:,:) = 0.e0 ! lateral variation of ice volume 126 zlicegr(:,:) = 0.e0 ! lateral variation of ice volume 127 zdvomif(:,:) = 0.e0 ! variation of ice volume at bottom due to melting only 128 ztr_fram = 0.e0 ! sea-ice transport through Fram strait 106 129 fstric (:,:) = 0.e0 ! part of solar radiation absorbing inside the ice 107 130 fscmbq (:,:) = 0.e0 ! linked with fstric … … 306 329 CALL tab_1d_2d_2( nbpb, dmgwi , npb, dmgwi_1d (1:nbpb) , jpi, jpj ) 307 330 CALL tab_1d_2d_2( nbpb, rdmsnif , npb, rdmsnif_1d(1:nbpb) , jpi, jpj ) 308 CALL tab_1d_2d_2( nbpb, rdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 309 CALL tab_1d_2d_2( nbpb, rdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 310 CALL tab_1d_2d_2( nbpb, fdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 311 CALL tab_1d_2d_2( nbpb, rdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 331 CALL tab_1d_2d_2( nbpb, zdvosif , npb, dvsbq_1d (1:nbpb) , jpi, jpj ) 332 CALL tab_1d_2d_2( nbpb, zdvobif , npb, dvbbq_1d (1:nbpb) , jpi, jpj ) 333 CALL tab_1d_2d_2( nbpb, zdvomif , npb, rdvomif_1d(1:nbpb) , jpi, jpj ) 334 CALL tab_1d_2d_2( nbpb, zdvolif , npb, dvlbq_1d (1:nbpb) , jpi, jpj ) 335 CALL tab_1d_2d_2( nbpb, zdvonif , npb, dvnbq_1d (1:nbpb) , jpi, jpj ) 312 336 CALL tab_1d_2d_2( nbpb, qsr_ice(:,:,1), npb, qsr_ice_1d(1:nbpb) , jpi, jpj ) 313 337 CALL tab_1d_2d_2( nbpb, qns_ice(:,:,1), npb, qns_ice_1d(1:nbpb) , jpi, jpj ) … … 362 386 IF( nbpac > 0 ) THEN 363 387 ! 388 zlicegr(:,:) = rdmicif(:,:) ! to output the lateral sea-ice growth 364 389 !...Put the variable in a 1-D array for lateral accretion 365 390 CALL tab_2d_1d_2( nbpac, frld_1d (1:nbpac) , frld , jpi, jpj, npac(1:nbpac) ) … … 373 398 CALL tab_2d_1d_2( nbpac, qstbif_1d (1:nbpac) , qstoif , jpi, jpj, npac(1:nbpac) ) 374 399 CALL tab_2d_1d_2( nbpac, rdmicif_1d(1:nbpac) , rdmicif , jpi, jpj, npac(1:nbpac) ) 375 CALL tab_2d_1d_2( nbpac, dvlbq_1d (1:nbpac) , fdvolif , jpi, jpj, npac(1:nbpac) )400 CALL tab_2d_1d_2( nbpac, dvlbq_1d (1:nbpac) , zdvolif , jpi, jpj, npac(1:nbpac) ) 376 401 CALL tab_2d_1d_2( nbpac, tfu_1d (1:nbpac) , tfu , jpi, jpj, npac(1:nbpac) ) 377 402 ! … … 387 412 CALL tab_1d_2d_2( nbpac, qstoif , npac(1:nbpac), qstbif_1d (1:nbpac) , jpi, jpj ) 388 413 CALL tab_1d_2d_2( nbpac, rdmicif , npac(1:nbpac), rdmicif_1d(1:nbpac) , jpi, jpj ) 389 CALL tab_1d_2d_2( nbpac, fdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj )414 CALL tab_1d_2d_2( nbpac, zdvolif , npac(1:nbpac), dvlbq_1d (1:nbpac) , jpi, jpj ) 390 415 ! 391 416 ENDIF … … 405 430 ! Outputs 406 431 !-------------------------------------------------------------------------------- 407 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 408 CALL iom_put( 'ioceflxb', fbif ) ! Oceanic flux at the ice base [W/m2 ???] 409 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 410 CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 432 ztmp(:,:) = 1. - pfrld(:,:) ! fraction of ice after the dynamic, before the thermodynamic 433 CALL iom_put( 'ioceflxb', fbif ) ! Oceanic flux at the ice base [W/m2 ???] 434 CALL iom_put( 'ist_cea', (sist(:,:) - rt0) * ztmp(:,:) ) ! Ice surface temperature [Celius] 435 CALL iom_put( 'qsr_ai_cea', qsr_ice(:,:,1) * ztmp(:,:) ) ! Solar flux over the ice [W/m2] 436 CALL iom_put( 'qns_ai_cea', qns_ice(:,:,1) * ztmp(:,:) ) ! Non-solar flux over the ice [W/m2] 411 437 IF( .NOT. lk_cpl ) CALL iom_put( 'qla_ai_cea', qla_ice(:,:,1) * ztmp(:,:) ) ! Latent flux over the ice [W/m2] 412 438 ! 413 CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] 414 CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] 415 CALL iom_put( 'iceprod_cea' , hicifp(:,:) / rdt_ice ) ! Ice produced [m/s] 439 CALL iom_put( 'snowthic_cea', hsnif (:,:) * fr_i(:,:) ) ! Snow thickness [m] 440 CALL iom_put( 'icethic_cea' , hicif (:,:) * fr_i(:,:) ) ! Ice thickness [m] 441 zztmp = 1.0 / rdt_ice 442 CALL iom_put( 'iceprod_cea' , hicifp (:,:) * zztmp ) ! Ice produced [m/s] 443 IF( lk_diaar5 ) THEN 444 CALL iom_put( 'snowmel_cea' , rdmsnif(:,:) * zztmp ) ! Snow melt [kg/m2/s] 445 zztmp = rhoic / rdt_ice 446 CALL iom_put( 'sntoice_cea' , zdvonif(:,:) * zztmp ) ! Snow to Ice transformation [kg/m2/s] 447 CALL iom_put( 'ticemel_cea' , zdvosif(:,:) * zztmp ) ! Melt at Sea Ice top [kg/m2/s] 448 CALL iom_put( 'bicemel_cea' , zdvomif(:,:) * zztmp ) ! Melt at Sea Ice bottom [kg/m2/s] 449 zlicegr(:,:) = MAX( 0.e0, rdmicif(:,:)-zlicegr(:,:) ) 450 CALL iom_put( 'licepro_cea' , zlicegr(:,:) * zztmp ) ! Latereal sea ice growth [kg/m2/s] 451 ENDIF 416 452 ! 417 ztmp(:,:) = 1. - AINT( frld, wp ) ! return 1 as soon as there is ice 418 CALL iom_put( 'ice_pres', ztmp ) ! Ice presence [-] 419 CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 420 CALL iom_put( 'uice_ipa', u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point 421 CALL iom_put( 'vice_ipa', v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point 453 ! Compute the Eastward & Northward sea-ice transport 454 zztmp = 0.25 * rhoic 455 DO jj = 1, jpjm1 456 DO ji = 1, jpim1 ! NO vector opt. 457 ! Ice velocities, volume & transport at U & V-points 458 zuice_m = u_ice(ji+1,jj+1) + u_ice(ji+1,jj ) 459 zvice_m = v_ice(ji+1,jj+1) + v_ice(ji ,jj+1) 460 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 ) 461 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) 462 zu_imasstr(ji,jj) = zztmp * zhice_u * zuice_m 463 zv_imasstr(ji,jj) = zztmp * zhice_v * zvice_m 464 END DO 465 END DO 466 CALL lbc_lnk( zu_imasstr, 'U', -1. ) ; CALL lbc_lnk( zv_imasstr, 'V', -1. ) 467 CALL iom_put( 'u_imasstr', zu_imasstr(:,:) ) ! Ice transport along i-axis at U-point [kg/s] 468 CALL iom_put( 'v_imasstr', zv_imasstr(:,:) ) ! Ice transport along j-axis at V-point [kg/s] 469 470 !! Fram Strait sea-ice transport (sea-ice + snow) (in ORCA2 = 5 points) 471 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN ! ORCA R2 configuration 472 DO jj = mj0(137), mj1(137) ! B grid 473 IF( mj0(jj-1) >= nldj ) THEN 474 DO ji = MAX(mi0(134),nldi), MIN(mi1(138),nlei) 475 zrhoij = e1t(ji,jj ) * fr_i(ji,jj ) * ( rhoic*hicif(ji,jj ) + rhosn*hsnif(ji,jj ) ) 476 zrhoijm1 = e1t(ji,jj-1) * fr_i(ji,jj-1) * ( rhoic*hicif(ji,jj-1) + rhosn*hsnif(ji,jj-1) ) 477 ztr_fram = ztr_fram - 0.25 * ( v_ice(ji,jj)+ v_ice(ji+1,jj) ) * ( zrhoij + zrhoijm1 ) 478 END DO 479 ENDIF 480 END DO 481 IF( lk_mpp ) CALL mpp_sum( ztr_fram ) 482 CALL iom_put( 'fram_trans', ztr_fram ) ! Ice transport through Fram strait [kg/s] 483 ENDIF 484 485 ztmp(:,:) = 1. - AINT( frld(:,:), wp ) ! return 1 as soon as there is ice 486 CALL iom_put( 'ice_pres' , ztmp ) ! Ice presence [-] 487 CALL iom_put( 'ist_ipa' , ( sist(:,:) - rt0 ) * ztmp(:,:) ) ! Ice surface temperature [Celius] 488 CALL iom_put( 'uice_ipa' , u_ice(:,:) * ztmp(:,:) ) ! Ice velocity along i-axis at I-point [m/s] 489 CALL iom_put( 'vice_ipa' , v_ice(:,:) * ztmp(:,:) ) ! Ice velocity along j-axis at I-point [m/s] 422 490 423 491 IF(ln_ctl) THEN -
trunk/NEMO/LIM_SRC_2/limthd_zdf_2.F90
r1465 r1756 596 596 !--limitation of bottom melting if so : hmelt maximum melting at bottom 597 597 zdhicmlt = MAX( hmelt , zdhicbot(ji) ) 598 !-- output part due to bottom melting only 599 IF( zdhicmlt < 0.e0 ) rdvomif_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicmlt 598 600 !--energy after bottom melting/growing 599 601 zqsup(ji) = ( 1.0 - frld_1d(ji) ) * xlic * ( zdhicmlt - zdhicbot(ji) ) -
trunk/NEMO/LIM_SRC_2/thd_ice_2.F90
r1156 r1756 72 72 dmgwi_1d , & !: " " dmgwi 73 73 dvsbq_1d , & !: " " rdvosif 74 rdvomif_1d , & !: " " rdvomif 74 75 dvbbq_1d , & !: " " rdvobif 75 76 dvlbq_1d , & !: " " rdvolif -
trunk/NEMO/OPA_SRC/DIA/diawri.F90
r1715 r1756 24 24 USE in_out_manager ! I/O manager 25 25 USE diadimg ! dimg direct access file format output 26 USE diaar5, ONLY : lk_diaar5 26 27 USE iom 27 28 USE ioipsl … … 50 51 !! * Substitutions 51 52 # include "zdfddm_substitute.h90" 53 # include "domzgr_substitute.h90" 54 # include "vectopt_loop_substitute.h90" 52 55 !!---------------------------------------------------------------------- 53 56 !! OPA 9.0 , LOCEAN-IPSL (2005) … … 85 88 !! 3.2 ! 05-11 (B. Lemaire) creation from old diawri 86 89 !!---------------------------------------------------------------------- 90 USE oce, ONLY : z3d => ta ! use ta as 3D workspace 91 !! 87 92 INTEGER, INTENT( in ) :: kt ! ocean time-step index 93 !! 94 INTEGER :: ji, jj, jk ! dummy loop indices 95 REAL(wp) :: zztmp, zztmpx, zztmpy ! 96 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 88 97 !!---------------------------------------------------------------------- 89 98 ! … … 94 103 ENDIF 95 104 96 CALL iom_put( "toce" , tn ) ! temperature 97 CALL iom_put( "soce" , sn ) ! salinity 98 CALL iom_put( "sst" , tn(:,:,1) ) ! sea surface temperature 99 CALL iom_put( "sss" , sn(:,:,1) ) ! sea surface salinity 100 CALL iom_put( "uoce" , un ) ! i-current 101 CALL iom_put( "voce" , vn ) ! j-current 105 CALL iom_put( "toce" , tn ) ! temperature 106 CALL iom_put( "soce" , sn ) ! salinity 107 CALL iom_put( "sst" , tn(:,:,1) ) ! sea surface temperature 108 CALL iom_put( "sst2" , tn(:,:,1) * tn(:,:,1) ) ! square of sea surface temperature 109 CALL iom_put( "sss" , sn(:,:,1) ) ! sea surface salinity 110 CALL iom_put( "sss2" , sn(:,:,1) * sn(:,:,1) ) ! square of sea surface salinity 111 CALL iom_put( "uoce" , un ) ! i-current 112 CALL iom_put( "voce" , vn ) ! j-current 102 113 103 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef.104 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef.114 CALL iom_put( "avt" , avt ) ! T vert. eddy diff. coef. 115 CALL iom_put( "avm" , avmu ) ! T vert. eddy visc. coef. 105 116 IF( lk_zdfddm ) THEN 106 CALL iom_put( "avs", fsavs(:,:,:) ) ! S vert. eddy diff. coef. 117 CALL iom_put( "avs" , fsavs(:,:,:) ) ! S vert. eddy diff. coef. 118 ENDIF 119 120 DO jj = 2, jpjm1 ! sst gradient 121 DO ji = fs_2, fs_jpim1 ! vector opt. 122 zztmp = tn(ji,jj,1) 123 zztmpx = ( tn(ji+1,jj ,1) - zztmp ) / e1u(ji,jj) + ( zztmp - tn(ji-1,jj ,1) ) / e1u(ji-1,jj ) 124 zztmpy = ( tn(ji ,jj+1,1) - zztmp ) / e2v(ji,jj) + ( zztmp - tn(ji ,jj-1,1) ) / e2v(ji ,jj-1) 125 z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy ) & 126 & * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 127 END DO 128 END DO 129 CALL lbc_lnk( z2d, 'T', 1. ) 130 CALL iom_put( "|sstgrad|2", z2d ) ! square of module of sst gradient 131 !CDIR NOVERRCHK 132 z2d(:,:) = SQRT( z2d(:,:) ) 133 CALL iom_put( "|sstgrad|" , z2d ) ! module of sst gradient 134 135 IF( lk_diaar5 ) THEN 136 z3d(:,:,jpk) = 0.e0 137 DO jk = 1, jpkm1 138 z3d(:,:,jk) = rau0 * un(:,:,jk) * e1u(:,:) * fse3u(:,:,jk) 139 END DO 140 CALL iom_put( "u_masstr", z3d ) ! mass transport in i-direction 141 zztmp = 0.5 * rcp 142 z2d(:,:) = 0.e0 143 DO jk = 1, jpkm1 144 DO jj = 2, jpjm1 145 DO ji = fs_2, fs_jpim1 ! vector opt. 146 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 147 END DO 148 END DO 149 END DO 150 CALL lbc_lnk( z2d, 'U', -1. ) 151 CALL iom_put( "u_heattr", z2d ) ! heat transport in i-direction 152 DO jk = 1, jpkm1 153 z3d(:,:,jk) = rau0 * vn(:,:,jk) * e2v(:,:) * fse3v(:,:,jk) 154 END DO 155 CALL iom_put( "v_masstr", z3d ) ! mass transport in j-direction 156 z2d(:,:) = 0.e0 157 DO jk = 1, jpkm1 158 DO jj = 2, jpjm1 159 DO ji = fs_2, fs_jpim1 ! vector opt. 160 z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) 161 END DO 162 END DO 163 END DO 164 CALL lbc_lnk( z2d, 'V', -1. ) 165 CALL iom_put( "v_heattr", z2d ) ! heat transport in i-direction 107 166 ENDIF 108 167 -
trunk/NEMO/OPA_SRC/DYN/sshwzv.F90
r1739 r1756 25 25 USE obc_par ! open boundary cond. parameter 26 26 USE obc_oce 27 USE diaar5, ONLY : lk_diaar5 27 28 USE iom 28 29 … … 65 66 !! hu, hv, hur, hvr : ocean depth and its inverse at u-,v-points 66 67 !!---------------------------------------------------------------------- 68 USE oce, ONLY : z3d => ta ! use ta as 3D workspace 69 !! 67 70 INTEGER, INTENT(in) :: kt ! time step 68 71 !! … … 71 74 REAL(wp) :: z2dt, zraur ! temporary scalars 72 75 REAL(wp), DIMENSION(jpi,jpj) :: zhdiv ! 2D workspace 76 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 73 77 !!---------------------------------------------------------------------- 74 78 … … 193 197 END DO 194 198 ! 195 CALL iom_put( "woce", wn ) ! vertical velocity 196 CALL iom_put( "ssh" , sshn ) ! sea surface height 199 CALL iom_put( "woce", wn ) ! vertical velocity 200 CALL iom_put( "ssh" , sshn ) ! sea surface height 201 CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) ) ! square of sea surface height 202 IF( lk_diaar5 ) THEN 203 z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 204 DO jk = 1, jpk 205 z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 206 END DO 207 CALL iom_put( "w_masstr" , z3d ) ! vertical mass transport 208 CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) ) ! square of vertical mass transport 209 ENDIF 197 210 ! 198 211 END SUBROUTINE ssh_wzv -
trunk/NEMO/OPA_SRC/SBC/sbccpl.F90
r1752 r1756 49 49 USE p4zflx, ONLY : oce_co2 50 50 #endif 51 USE diaar5, ONLY : lk_diaar5 51 52 IMPLICIT NONE 52 53 PRIVATE … … 1038 1039 INTEGER :: isec, info ! temporary integer 1039 1040 REAL(wp):: zcoef, ztsurf ! temporary scalar 1041 REAL(wp), DIMENSION(jpi,jpj ):: zcptn ! rcp * tn(:,:,1) 1042 REAL(wp), DIMENSION(jpi,jpj ):: ztmp ! temporary array 1040 1043 REAL(wp), DIMENSION(jpi,jpj ):: zsnow ! snow precipitation 1041 1044 REAL(wp), DIMENSION(jpi,jpj,jpl):: zicefr ! ice fraction 1042 1045 !!---------------------------------------------------------------------- 1043 1046 zicefr(:,:,1) = 1.- p_frld(:,:,1) 1047 IF( lk_diaar5 ) zcptn(:,:) = rcp * tn(:,:,1) 1044 1048 ! 1045 1049 ! ! ========================= ! … … 1055 1059 pemp_ice(:,:) = frcv(:,:,jpr_ievp) - frcv(:,:,jpr_snow) 1056 1060 zsnow (:,:) = frcv(:,:,jpr_snow) 1061 CALL iom_put( 'rain' , frcv(:,:,jpr_rain) ) ! liquid precipitation 1062 IF( lk_diaar5 ) CALL iom_put( 'hflx_rain_cea', frcv(:,:,jpr_rain) * zcptn(:,:) ) ! heat flux from liq. precip. 1063 ztmp(:,:) = frcv(:,:,jpr_tevp) - frcv(:,:,jpr_ievp) * zicefr(:,:,1) 1064 CALL iom_put( 'evap_ao_cea' , ztmp ) ! ice-free oce evap (cell average) 1065 IF( lk_diaar5 ) CALL iom_put( 'hflx_evap_cea', ztmp(:,: ) * zcptn(:,:) ) ! heat flux from from evap (cell ave) 1057 1066 CASE( 'oce and ice' ) ! received fields: jpr_sbpr, jpr_semp, jpr_oemp 1058 1067 pemp_tot(:,:) = p_frld(:,:,1) * frcv(:,:,jpr_oemp) + zicefr(:,:,1) * frcv(:,:,jpr_sbpr) … … 1061 1070 END SELECT 1062 1071 psprecip(:,:) = - pemp_ice(:,:) 1063 CALL iom_put( 'snowpre', psprecip ) ! Snow precipitation 1072 CALL iom_put( 'snowpre' , zsnow ) ! Snow 1073 CALL iom_put( 'snow_ao_cea', zsnow(:,: ) * p_frld(:,:,1) ) ! Snow over ice-free ocean (cell average) 1074 CALL iom_put( 'snow_ai_cea', zsnow(:,: ) * zicefr(:,:,1) ) ! Snow over sea-ice (cell average) 1075 CALL iom_put( 'subl_ai_cea', frcv (:,:,jpr_ievp) * zicefr(:,:,1) ) ! Sublimation over sea-ice (cell average) 1064 1076 ! 1065 1077 ! ! runoffs and calving (put in emp_tot) 1066 IF( srcv(jpr_rnf)%laction ) pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf) 1067 IF( srcv(jpr_cal)%laction ) pemp_tot(:,:) = pemp_tot(:,:) - ABS( frcv(:,:,jpr_cal) ) 1078 IF( srcv(jpr_rnf)%laction ) THEN 1079 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_rnf) 1080 CALL iom_put( 'runoffs' , frcv(:,:,jpr_rnf ) ) ! rivers 1081 IF( lk_diaar5 ) CALL iom_put( 'hflx_rnf_cea' , frcv(:,:,jpr_rnf ) * zcptn(:,:) ) ! heat flux from rivers 1082 ENDIF 1083 IF( srcv(jpr_cal)%laction ) THEN 1084 pemp_tot(:,:) = pemp_tot(:,:) - frcv(:,:,jpr_cal) 1085 CALL iom_put( 'calving', frcv(:,:,jpr_cal) ) 1086 ENDIF 1068 1087 ! 1069 1088 !!gm : this seems to be internal cooking, not sure to need that in a generic interface … … 1101 1120 ! energy for melting solid precipitation over ice-free ocean 1102 1121 zcoef = xlsn / rhosn 1103 pqns_tot(:,:) = pqns_tot(:,:) - p_frld(:,:,1) * zsnow(:,:) * zcoef 1122 ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * zcoef 1123 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 1124 IF( lk_diaar5 ) CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) ) ! heat flux from snow (cell average) 1104 1125 !!gm 1105 1126 !! currently it is taken into account in leads budget but not in the qns_tot, and thus not in … … 1113 1134 IF( srcv(jpr_cal)%laction ) THEN 1114 1135 zcoef = xlic / rhoic 1115 pqns_tot(:,:) = pqns_tot(:,:) - frcv(:,:,jpr_cal) * zcoef 1136 ztmp(:,:) = frcv(:,:,jpr_cal) * zcoef 1137 pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 1138 IF( lk_diaar5 ) CALL iom_put( 'hflx_cal_cea', ztmp + frcv(:,:,jpr_cal) * zcptn(:,:) ) ! heat flux from calving 1116 1139 ENDIF 1117 1140 -
trunk/NEMO/OPA_SRC/TRA/traadv_eiv.F90
r1482 r1756 21 21 USE in_out_manager ! I/O manager 22 22 USE iom 23 # if defined key_diaeiv 24 USE phycst ! physical constants 25 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 26 USE diaar5, ONLY : lk_diaar5 27 # endif 23 28 24 29 IMPLICIT NONE … … 67 72 REAL(wp) :: zvwk, zvwk1, zvwj, zvwj1 ! " " 68 73 REAL(wp) :: zu_eiv, zv_eiv, zw_eiv ! " " 74 # if defined key_diaeiv 75 REAL(wp) :: zztmp ! " " 76 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! " " 77 # endif 69 78 !!---------------------------------------------------------------------- 70 79 … … 135 144 CALL iom_put( "voce_eiv", v_eiv ) ! j-eiv current 136 145 CALL iom_put( "woce_eiv", w_eiv ) ! vert. eiv current 146 IF( lk_diaar5 ) THEN 147 zztmp = 0.5 * rau0 * rcp 148 z2d(:,:) = 0.e0 149 DO jk = 1, jpkm1 150 DO jj = 2, jpjm1 151 DO ji = fs_2, fs_jpim1 ! vector opt. 152 z2d(ji,jj) = z2d(ji,jj) + zztmp * u_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji+1,jj,jk)) * e1u(ji,jj) * fse3u(ji,jj,jk) 153 END DO 154 END DO 155 END DO 156 CALL lbc_lnk( z2d, 'U', -1. ) 157 CALL iom_put( "ueiv_heattr", z2d ) ! heat transport in i-direction 158 z2d(:,:) = 0.e0 159 DO jk = 1, jpkm1 160 DO jj = 2, jpjm1 161 DO ji = fs_2, fs_jpim1 ! vector opt. 162 z2d(ji,jj) = z2d(ji,jj) + zztmp * v_eiv(ji,jj,jk) * (tn(ji,jj,jk)+tn(ji,jj+1,jk)) * e2v(ji,jj) * fse3v(ji,jj,jk) 163 END DO 164 END DO 165 END DO 166 CALL lbc_lnk( z2d, 'V', -1. ) 167 CALL iom_put( "veiv_heattr", z2d ) ! heat transport in i-direction 168 ENDIF 137 169 # endif 138 170 ! -
trunk/NEMO/OPA_SRC/TRA/traldf_iso.F90
r1152 r1756 26 26 USE zdf_oce ! ocean vertical physics 27 27 USE in_out_manager ! I/O manager 28 USE iom ! 28 29 USE ldfslp ! iso-neutral slopes 29 30 USE diaptr ! poleward transport diagnostics 30 31 USE prtctl ! Print control 32 #if defined key_diaar5 33 USE phycst ! physical constants 34 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 35 #endif 31 36 32 37 IMPLICIT NONE … … 98 103 REAL(wp) :: zmskv, zabe2, zcof2, zcoef4, zsa ! " " 99 104 REAL(wp) :: zcoef0, zbtr ! " " 100 REAL(wp), DIMENSION(jpi,jpj) :: zdkt , zdk1t, zftu ! 2D workspace 101 REAL(wp), DIMENSION(jpi,jpj) :: zdks , zdk1s, zfsu ! " " 105 REAL(wp), DIMENSION(jpi,jpj) :: zdkt , zdk1t ! 2D workspace 106 REAL(wp), DIMENSION(jpi,jpj) :: zdks , zdk1s, zfsu ! " " 107 #if defined key_diaar5 108 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! " " 109 REAL(wp) :: zztmp ! " " 110 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zftu ! 3D workspace 111 #else 112 REAL(wp), DIMENSION(jpi,jpj) :: zftu ! 2D workspace 113 #endif 102 114 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdit, zdjt, ztfw ! 3D workspace 103 115 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdis, zdjs, zsfw ! " " 116 # if defined key_diaar5 117 # endif 104 118 !!---------------------------------------------------------------------- 105 119 … … 149 163 !!---------------------------------------------------------------------- 150 164 165 #if defined key_diaar5 166 !CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zfsu ) 167 #else 151 168 !CDIR PARALLEL DO PRIVATE( zdk1t, zdk1s, zftu, zfsu ) 169 #endif 152 170 ! ! =============== 153 171 DO jk = 1, jpkm1 ! Horizontal slab … … 186 204 zcof2 = -fsahtv(ji,jj,jk) * e1v(ji,jj) * vslp(ji,jj,jk) * zmskv 187 205 206 #if defined key_diaar5 207 zftu(ji,jj,jk) = ( zabe1 * zdit(ji,jj,jk) & 208 #else 188 209 zftu(ji,jj ) = ( zabe1 * zdit(ji,jj,jk) & 210 #endif 189 211 & + zcof1 * ( zdkt (ji+1,jj) + zdk1t(ji,jj) & 190 212 & + zdk1t(ji+1,jj) + zdkt (ji,jj) ) ) * umask(ji,jj,jk) … … 207 229 DO ji = fs_2, fs_jpim1 ! vector opt. 208 230 zbtr= 1. / ( e1t(ji,jj)*e2t(ji,jj)*fse3t(ji,jj,jk) ) 231 #if defined key_diaar5 232 zta = zbtr * ( zftu(ji,jj,jk) - zftu(ji-1,jj,jk) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 233 #else 209 234 zta = zbtr * ( zftu(ji,jj ) - zftu(ji-1,jj ) + zftv(ji,jj,jk) - zftv(ji,jj-1,jk) ) 235 #endif 210 236 zsa = zbtr * ( zfsu(ji,jj ) - zfsu(ji-1,jj ) + zfsv(ji,jj,jk) - zfsv(ji,jj-1,jk) ) 211 237 ta (ji,jj,jk) = ta (ji,jj,jk) + zta … … 221 247 pst_ldf(:) = ptr_vj( zfsv(:,:,:) ) 222 248 ENDIF 249 #if defined key_diaar5 250 zztmp = 0.5 * rau0 * rcp 251 z2d(:,:) = 0.e0 252 DO jk = 1, jpkm1 253 DO jj = 2, jpjm1 254 DO ji = fs_2, fs_jpim1 ! vector opt. 255 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftu(ji,jj,jk) * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) * e1u(ji,jj) * fse3u(ji,jj,jk) 256 END DO 257 END DO 258 END DO 259 CALL lbc_lnk( z2d, 'U', -1. ) 260 CALL iom_put( "udiff_heattr", z2d ) ! heat transport in i-direction 261 z2d(:,:) = 0.e0 262 DO jk = 1, jpkm1 263 DO jj = 2, jpjm1 264 DO ji = fs_2, fs_jpim1 ! vector opt. 265 z2d(ji,jj) = z2d(ji,jj) + zztmp * zftv(ji,jj,jk) * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) * e2v(ji,jj) * fse3v(ji,jj,jk) 266 END DO 267 END DO 268 END DO 269 CALL lbc_lnk( z2d, 'V', -1. ) 270 CALL iom_put( "vdiff_heattr", z2d ) ! heat transport in i-direction 271 #endif 223 272 224 273 !!---------------------------------------------------------------------- -
trunk/NEMO/OPA_SRC/TRA/traqsr.F90
r1601 r1756 124 124 END DO 125 125 END DO 126 CALL iom_put( 'qsr3d', etot3 ) ! Shortwave Radiation 3D distribution 126 127 ! ! ============================================== ! 127 128 ELSE ! Ocean alone : … … 178 179 ta(:,:,jk) = ta(:,:,jk) + ro0cpr * ( zea(:,:,jk) - zea(:,:,jk+1) ) / fse3t(:,:,jk) 179 180 END DO 181 zea(:,:,nksr+1:jpk) = 0.e0 ! below 400m set to zero 182 CALL iom_put( 'qsr3d', zea ) ! Shortwave Radiation 3D distribution 180 183 ! 181 184 ELSE !* Constant Chlorophyll -
trunk/NEMO/OPA_SRC/ZDF/zdftke.F90
r1719 r1756 180 180 !! 181 181 INTEGER :: ji, jj, jk ! dummy loop arguments 182 INTEGER :: ikbu, ikbv, ikbum1, ikbvm1 ! temporary scalar183 INTEGER :: ikbt, ikbumm1, ikbvmm1 ! temporary scalar182 !!$ INTEGER :: ikbu, ikbv, ikbum1, ikbvm1 ! temporary scalar 183 !!$ INTEGER :: ikbt, ikbumm1, ikbvmm1 ! temporary scalar 184 184 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 185 185 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient … … 190 190 REAL(wp) :: zus , zwlc , zind ! - - 191 191 REAL(wp) :: zzd_up, zzd_lw ! - - 192 REAL(wp) :: zebot ! - -192 !!$ REAL(wp) :: zebot ! - - 193 193 INTEGER , DIMENSION(jpi,jpj) :: imlc ! 2D workspace 194 194 REAL(wp), DIMENSION(jpi,jpj) :: zhlc ! - - -
trunk/NEMO/OPA_SRC/step.F90
r1725 r1756 107 107 USE diahdy ! dynamic height (dia_hdy routine) 108 108 USE diaptr ! poleward transports (dia_ptr routine) 109 USE diaar5 ! AR5 diagnosics (dia_ar5 routine) 109 110 USE diahth ! thermocline depth (dia_hth routine) 110 111 USE diafwb ! freshwater budget (dia_fwb routine) … … 245 246 IF( lk_diafwb ) CALL dia_fwb( kstp ) ! Fresh water budget diagnostics 246 247 IF( ln_diaptr ) CALL dia_ptr( kstp ) ! Poleward TRansports diagnostics 248 IF( lk_diaar5 ) CALL dia_ar5( kstp ) ! ar5 diag 247 249 CALL dia_wri( kstp ) ! ocean model: outputs 248 250
Note: See TracChangeset
for help on using the changeset viewer.