Changeset 3680 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC
- Timestamp:
- 2012-11-27T15:42:24+01:00 (12 years ago)
- Location:
- branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC
- Files:
-
- 10 edited
- 1 copied
-
cyclone.F90 (copied) (copied from branches/2012/dev_LOCEAN_UKMO_CMCC_INGV_2012/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90)
-
fldread.F90 (modified) (3 diffs)
-
sbc_oce.F90 (modified) (1 diff)
-
sbcapr.F90 (modified) (1 diff)
-
sbcblk_core.F90 (modified) (5 diffs)
-
sbccpl.F90 (modified) (7 diffs)
-
sbcice_lim_2.F90 (modified) (4 diffs)
-
sbcmod.F90 (modified) (5 diffs)
-
sbcrnf.F90 (modified) (2 diffs)
-
sbcssm.F90 (modified) (1 diff)
-
sbcwave.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r3651 r3680 629 629 INTEGER :: ipk ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 630 630 INTEGER :: iw ! index into wgts array 631 !!--------------------------------------------------------------------- 632 631 INTEGER :: ipdom ! index of the domain 632 !!--------------------------------------------------------------------- 633 ! 633 634 ipk = SIZE( sdjf%fnow, 3 ) 634 635 ! 635 636 IF( PRESENT(map) ) THEN 636 637 IF( sdjf%ln_tint ) THEN ; CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1), map ) … … 643 644 ENDIF 644 645 ELSE 646 IF( SIZE(sdjf%fnow, 1) == jpi ) THEN ; ipdom = jpdom_data 647 ELSE ; ipdom = jpdom_unknown 648 ENDIF 645 649 SELECT CASE( ipk ) 646 CASE(1) 647 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) )648 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) )650 CASE(1) 651 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 652 ELSE ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1 ), sdjf%nrec_a(1) ) 649 653 ENDIF 650 654 CASE DEFAULT 651 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) )652 ELSE ; CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1) )655 IF( sdjf%ln_tint ) THEN ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 656 ELSE ; CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,: ), sdjf%nrec_a(1) ) 653 657 ENDIF 654 658 END SELECT … … 850 854 IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 ) sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 851 855 sdf(jf)%vcomp = sdf_n(jf)%vcomp 856 sdf(jf)%rotn = .FALSE. 852 857 END DO 853 858 -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r3625 r3680 49 49 ! !: = 1 global mean of e-p-r set to zero at each nn_fsbc time step 50 50 ! !: = 2 annual global mean of e-p-r set to zero 51 LOGICAL , PUBLIC :: ln_cdgw = .FALSE. !: true if neutral drag coefficient read from wave model 51 LOGICAL , PUBLIC :: ln_wave = .FALSE. !: true if some coupling with wave model 52 LOGICAL , PUBLIC :: ln_cdgw = .FALSE. !: true if neutral drag coefficient from wave model 53 LOGICAL , PUBLIC :: ln_sdw = .FALSE. !: true if 3d stokes drift from wave model 52 54 53 55 !!---------------------------------------------------------------------- -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r3651 r3680 20 20 USE iom ! IOM library 21 21 USE lib_mpp ! MPP library 22 USE restart ! ocean restart23 22 24 23 IMPLICIT NONE -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90
r3625 r3680 29 29 USE fldread ! read input fields 30 30 USE sbc_oce ! Surface boundary condition: ocean fields 31 USE cyclone ! Cyclone 10m wind form trac of cyclone centres 31 32 USE sbcdcy ! surface boundary condition: diurnal cycle 32 33 USE iom ! I/O manager library … … 186 187 187 188 ! ! compute the surface ocean fluxes using CORE bulk formulea 188 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( sf, sst_m, ssu_m, ssv_m )189 IF( MOD( kt - 1, nn_fsbc ) == 0 ) CALL blk_oce_core( kt, sf, sst_m, ssu_m, ssv_m ) 189 190 190 191 #if defined key_cice … … 204 205 205 206 206 SUBROUTINE blk_oce_core( sf, pst, pu, pv )207 SUBROUTINE blk_oce_core( kt, sf, pst, pu, pv ) 207 208 !!--------------------------------------------------------------------- 208 209 !! *** ROUTINE blk_core *** … … 225 226 !! ** Nota : sf has to be a dummy argument for AGRIF on NEC 226 227 !!--------------------------------------------------------------------- 227 TYPE(fld), INTENT(in), DIMENSION(:) :: sf ! input data 228 REAL(wp) , INTENT(in), DIMENSION(:,:) :: pst ! surface temperature [Celcius] 229 REAL(wp) , INTENT(in), DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s] 230 REAL(wp) , INTENT(in), DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s] 228 INTEGER , INTENT(in ) :: kt ! time step index 229 TYPE(fld), INTENT(inout), DIMENSION(:) :: sf ! input data 230 REAL(wp) , INTENT(in) , DIMENSION(:,:) :: pst ! surface temperature [Celcius] 231 REAL(wp) , INTENT(in) , DIMENSION(:,:) :: pu ! surface current at U-point (i-component) [m/s] 232 REAL(wp) , INTENT(in) , DIMENSION(:,:) :: pv ! surface current at V-point (j-component) [m/s] 231 233 ! 232 234 INTEGER :: ji, jj ! dummy loop indices … … 261 263 zwnd_i(:,:) = 0.e0 262 264 zwnd_j(:,:) = 0.e0 265 #if defined key_cyclone 266 # if defined key_vectopt_loop 267 !CDIR COLLAPSE 268 # endif 269 CALL wnd_cyc( kt, zwnd_i, zwnd_j ) ! add Manu ! 270 DO jj = 2, jpjm1 271 DO ji = fs_2, fs_jpim1 ! vect. opt. 272 sf(jp_wndi)%fnow(ji,jj,1) = sf(jp_wndi)%fnow(ji,jj,1) + zwnd_i(ji,jj) 273 sf(jp_wndj)%fnow(ji,jj,1) = sf(jp_wndj)%fnow(ji,jj,1) + zwnd_j(ji,jj) 274 END DO 275 END DO 276 #endif 263 277 #if defined key_vectopt_loop 264 278 !CDIR COLLAPSE -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3632 r3680 41 41 #endif 42 42 USE geo2ocean ! 43 USE restart !44 43 USE oce , ONLY : tsn, un, vn 45 44 USE albedo ! … … 381 380 & srcv( (/jpr_otz1, jpr_otz2, jpr_itz1, jpr_itz2/) )%laction = .FALSE. 382 381 ! 382 IF( TRIM( sn_rcv_tau%clvor ) == 'local grid' ) THEN ! already on local grid -> no need of the second grid 383 srcv(jpr_otx2:jpr_otz2)%laction = .FALSE. 384 srcv(jpr_itx2:jpr_itz2)%laction = .FALSE. 385 srcv(jpr_oty1)%clgrid = srcv(jpr_oty2)%clgrid ! not needed but cleaner... 386 srcv(jpr_ity1)%clgrid = srcv(jpr_ity2)%clgrid ! not needed but cleaner... 387 ENDIF 388 ! 383 389 IF( TRIM( sn_rcv_tau%cldes ) /= 'oce and ice' ) THEN ! 'oce and ice' case ocean stress on ocean mesh used 384 390 srcv(jpr_itx1:jpr_itz2)%laction = .FALSE. ! ice components not received … … 520 526 ssnd(jps_tmix)%clname = 'O_TepMix' 521 527 SELECT CASE( TRIM( sn_snd_temp%cldes ) ) 528 CASE( 'none' ) ! nothing to do 522 529 CASE( 'oce only' ) ; ssnd( jps_toce )%laction = .TRUE. 523 530 CASE( 'weighted oce and ice' ) … … 562 569 563 570 SELECT CASE ( TRIM( sn_snd_thick%cldes ) ) 564 CASE ( 'ice and snow' ) 571 CASE( 'none' ) ! nothing to do 572 CASE( 'ice and snow' ) 565 573 ssnd(jps_hice:jps_hsnw)%laction = .TRUE. 566 574 IF ( TRIM( sn_snd_thick%clcat ) == 'yes' ) THEN … … 568 576 ELSE 569 577 IF ( jpl > 1 ) THEN 570 578 CALL ctl_stop( 'sbc_cpl_init: use weighted ice and snow option for sn_snd_thick%cldes if not exchanging category fields' ) 571 579 ENDIF 572 580 ENDIF … … 1357 1365 ! ! Surface temperature ! in Kelvin 1358 1366 ! ! ------------------------- ! 1359 SELECT CASE( sn_snd_temp%cldes) 1360 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1361 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1362 SELECT CASE( sn_snd_temp%clcat ) 1363 CASE( 'yes' ) 1364 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1365 CASE( 'no' ) 1366 ztmp3(:,:,:) = 0._wp 1367 IF( ssnd(jps_toce)%laction .OR. ssnd(jps_tice)%laction .OR. ssnd(jps_tmix)%laction ) THEN 1368 SELECT CASE( sn_snd_temp%cldes) 1369 CASE( 'oce only' ) ; ztmp1(:,:) = tsn(:,:,1,jp_tem) + rt0 1370 CASE( 'weighted oce and ice' ) ; ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 1371 SELECT CASE( sn_snd_temp%clcat ) 1372 CASE( 'yes' ) 1373 ztmp3(:,:,1:jpl) = tn_ice(:,:,1:jpl) * a_i(:,:,1:jpl) 1374 CASE( 'no' ) 1375 ztmp3(:,:,:) = 0.0 1376 DO jl=1,jpl 1377 ztmp3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl) 1378 ENDDO 1379 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' ) 1380 END SELECT 1381 CASE( 'mixed oce-ice' ) 1382 ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1367 1383 DO jl=1,jpl 1368 ztmp 3(:,:,1) = ztmp3(:,:,1) + tn_ice(:,:,jl) * a_i(:,:,jl)1384 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1369 1385 ENDDO 1370 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%clcat' )1386 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1371 1387 END SELECT 1372 CASE( 'mixed oce-ice' ) 1373 ztmp1(:,:) = ( tsn(:,:,1,1) + rt0 ) * zfr_l(:,:) 1374 DO jl=1,jpl 1375 ztmp1(:,:) = ztmp1(:,:) + tn_ice(:,:,jl) * a_i(:,:,jl) 1376 ENDDO 1377 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_temp%cldes' ) 1378 END SELECT 1379 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1380 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1381 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1388 IF( ssnd(jps_toce)%laction ) CALL cpl_prism_snd( jps_toce, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1389 IF( ssnd(jps_tice)%laction ) CALL cpl_prism_snd( jps_tice, isec, ztmp3, info ) 1390 IF( ssnd(jps_tmix)%laction ) CALL cpl_prism_snd( jps_tmix, isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info ) 1391 ENDIF 1382 1392 ! 1383 1393 ! ! ------------------------- ! … … 1399 1409 ! ! ------------------------- ! 1400 1410 ! Send ice fraction field 1401 SELECT CASE( sn_snd_thick%clcat )1402 CASE( 'yes' )1403 ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl)1404 CASE( 'no' )1405 ztmp3(:,:,1) = fr_i(:,:)1406 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' )1407 END SELECT1408 IF( ssnd(jps_fice)%laction ) CALL cpl_prism_snd( jps_fice, isec, ztmp3, info )1411 IF( ssnd(jps_fice)%laction ) THEN 1412 SELECT CASE( sn_snd_thick%clcat ) 1413 CASE( 'yes' ) ; ztmp3(:,:,1:jpl) = a_i(:,:,1:jpl) 1414 CASE( 'no' ) ; ztmp3(:,:,1 ) = fr_i(:,: ) 1415 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1416 END SELECT 1417 CALL cpl_prism_snd( jps_fice, isec, ztmp3, info ) 1418 ENDIF 1409 1419 1410 1420 ! Send ice and snow thickness field 1411 SELECT CASE( sn_snd_thick%cldes) 1412 CASE( 'weighted ice and snow' ) 1413 SELECT CASE( sn_snd_thick%clcat ) 1414 CASE( 'yes' ) 1415 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 1416 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 1417 CASE( 'no' ) 1418 ztmp3(:,:,:) = 0._wp ; ztmp4(:,:,:) = 0._wp 1419 DO jl=1,jpl 1420 ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 1421 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 1422 ENDDO 1423 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1421 IF( ssnd(jps_hice)%laction .OR. ssnd(jps_hsnw)%laction ) THEN 1422 SELECT CASE( sn_snd_thick%cldes) 1423 CASE( 'none' ) ! nothing to do 1424 CASE( 'weighted ice and snow' ) 1425 SELECT CASE( sn_snd_thick%clcat ) 1426 CASE( 'yes' ) 1427 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) * a_i(:,:,1:jpl) 1428 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) * a_i(:,:,1:jpl) 1429 CASE( 'no' ) 1430 ztmp3(:,:,:) = 0.0 ; ztmp4(:,:,:) = 0.0 1431 DO jl=1,jpl 1432 ztmp3(:,:,1) = ztmp3(:,:,1) + ht_i(:,:,jl) * a_i(:,:,jl) 1433 ztmp4(:,:,1) = ztmp4(:,:,1) + ht_s(:,:,jl) * a_i(:,:,jl) 1434 ENDDO 1435 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%clcat' ) 1436 END SELECT 1437 CASE( 'ice and snow' ) 1438 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1439 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1440 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1424 1441 END SELECT 1425 CASE( 'ice and snow' ) 1426 ztmp3(:,:,1:jpl) = ht_i(:,:,1:jpl) 1427 ztmp4(:,:,1:jpl) = ht_s(:,:,1:jpl) 1428 CASE default ; CALL ctl_stop( 'sbc_cpl_snd: wrong definition of sn_snd_thick%cldes' ) 1429 END SELECT 1430 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 1431 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 1442 IF( ssnd(jps_hice)%laction ) CALL cpl_prism_snd( jps_hice, isec, ztmp3, info ) 1443 IF( ssnd(jps_hsnw)%laction ) CALL cpl_prism_snd( jps_hsnw, isec, ztmp4, info ) 1444 ENDIF 1432 1445 ! 1433 1446 #if defined key_cpl_carbon_cycle -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90
r3625 r3680 48 48 USE in_out_manager ! I/O manager 49 49 USE prtctl ! Print control 50 51 # if defined key_agrif 52 USE agrif_ice 53 USE agrif_lim2_update 54 # endif 50 55 51 56 IMPLICIT NONE … … 101 106 ! 102 107 CALL ice_init_2 108 ! 109 # if defined key_agrif 110 IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2 ! AGRIF: set the meshes 111 # endif 103 112 ENDIF 104 113 … … 106 115 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only ! 107 116 ! !----------------------! 117 # if defined key_agrif 118 IF( .NOT. Agrif_Root() ) lim_nbstep = MOD(lim_nbstep,Agrif_rhot()& 119 &*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1 120 # endif 108 121 ! Bulk Formulea ! 109 122 !----------------! … … 211 224 IF( lrst_ice ) CALL lim_rst_write_2( kt ) ! Ice restart file 212 225 ! 226 # if defined key_agrif && defined key_lim2 227 IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt ) 228 # endif 229 ! 213 230 ENDIF ! End sea-ice time step only 214 231 ! -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3632 r3680 47 47 48 48 USE prtctl ! Print control (prt_ctl routine) 49 USE restart ! ocean restart50 49 USE iom ! IOM library 51 50 USE in_out_manager ! I/O manager … … 87 86 NAMELIST/namsbc/ nn_fsbc , ln_ana , ln_flx, ln_blk_clio, ln_blk_core, ln_cpl, & 88 87 & ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc , ln_rnf, & 89 & ln_ssr , nn_fwb , ln_cdgw 88 & ln_ssr , nn_fwb , ln_cdgw , ln_wave , ln_sdw 90 89 !!---------------------------------------------------------------------- 91 90 … … 96 95 ENDIF 97 96 97 call flush(numout) 98 98 REWIND( numnam ) ! Read Namelist namsbc 99 99 READ ( numnam, namsbc ) 100 call flush(numout) 100 101 101 102 ! ! overwrite namelist parameter using CPP key information … … 176 177 & CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' ) 177 178 178 !drag coefficient read from wave model definable only with mfs bulk formulae and core 179 IF(ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) ) & 180 & CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 179 IF ( ln_wave ) THEN 180 !Activated wave module but neither drag nor stokes drift activated 181 IF ( .NOT.(ln_cdgw .OR. ln_sdw) ) THEN 182 CALL ctl_warn( 'Ask for wave coupling but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' ) 183 !drag coefficient read from wave model definable only with mfs bulk formulae and core 184 ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) ) THEN 185 CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core') 186 ENDIF 187 ELSE 188 IF ( ln_cdgw .OR. ln_sdw ) & 189 & CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but & 190 & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ') 191 ENDIF 181 192 182 193 ! ! Choice of the Surface Boudary Condition (set nsbc) … … 266 277 ! ! averaged over nf_sbc time-step 267 278 268 IF (ln_ cdgw) CALL sbc_wave( kt )279 IF (ln_wave) CALL sbc_wave( kt ) 269 280 !== sbc formulation ==! 270 281 -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r3632 r3680 21 21 USE closea ! closed seas 22 22 USE fldread ! read input field at current time step 23 USE restart ! restart24 23 USE in_out_manager ! I/O manager 25 24 USE iom ! I/O module … … 57 56 58 57 59 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read)60 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read)61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read)58 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_rnf ! structure: river runoff (file information, fields read) 59 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_s_rnf ! structure: river runoff salinity (file information, fields read) 60 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_t_rnf ! structure: river runoff temperature (file information, fields read) 62 61 63 62 !! * Substitutions -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r3614 r3680 18 18 USE sbcapr ! surface boundary condition: atmospheric pressure 19 19 USE prtctl ! Print control (prt_ctl routine) 20 USE restart ! ocean restart21 20 USE iom 22 21 USE in_out_manager ! I/O manager -
branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r3294 r3680 4 4 !! Wave module 5 5 !!====================================================================== 6 !! History : 3.3.1 ! 2011-09 (Adani M) Original code 6 !! History : 3.3.1 ! 2011-09 (Adani M) Original code: Drag Coefficient 7 !! : 3.4 ! 2012-10 (Adani M) Stokes Drift 7 8 !!---------------------------------------------------------------------- 8 9 USE iom ! I/O manager library … … 10 11 USE lib_mpp ! distribued memory computing library 11 12 USE fldread ! read input fields 13 USE oce 12 14 USE sbc_oce ! Surface boundary condition: ocean fields 15 USE domvvl 13 16 14 17 … … 22 25 PUBLIC sbc_wave ! routine called in sbc_blk_core or sbc_blk_mfs 23 26 24 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_wave ! structure of input fields (file informations, fields read) 27 INTEGER , PARAMETER :: jpfld = 3 ! maximum number of files to read for srokes drift 28 INTEGER , PARAMETER :: jp_usd = 1 ! index of stokes drift (i-component) (m/s) at T-point 29 INTEGER , PARAMETER :: jp_vsd = 2 ! index of stokes drift (j-component) (m/s) at T-point 30 INTEGER , PARAMETER :: jp_wn = 3 ! index of wave number (1/m) at T-point 31 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_cd ! structure of input fields (file informations, fields read) Drag Coefficient 32 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_sd ! structure of input fields (file informations, fields read) Stokes Drift 25 33 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:) :: cdn_wave 34 REAL(wp),ALLOCATABLE,DIMENSION (:,:) :: usd2d,vsd2d,uwavenum,vwavenum 35 REAL(wp),PUBLIC,ALLOCATABLE,DIMENSION (:,:,:) :: usd3d,vsd3d,wsd3d 26 36 37 !! * Substitutions 38 # include "domzgr_substitute.h90" 27 39 !!---------------------------------------------------------------------- 28 40 !! NEMO/OPA 4.0 , NEMO Consortium (2011) … … 40 52 !! ** Method : - Read namelist namsbc_wave 41 53 !! - Read Cd_n10 fields in netcdf files 54 !! - Read stokes drift 2d in netcdf files 55 !! - Read wave number in netcdf files 56 !! - Compute 3d stokes drift using monochromatic 42 57 !! ** action : 43 58 !! 44 59 !!--------------------------------------------------------------------- 45 INTEGER, INTENT( in ) :: kt ! ocean time step 60 USE oce, ONLY : un,vn,hdivn,rotn 61 USE divcur 62 USE wrk_nemo 63 #if defined key_bdy 64 USE bdy_oce, ONLY : bdytmask 65 #endif 66 INTEGER, INTENT( in ) :: kt ! ocean time step 46 67 INTEGER :: ierror ! return error code 47 CHARACTER(len=100) :: cn_dir_cdg ! Root directory for location of drag coefficient files 48 TYPE(FLD_N) :: sn_cdg ! informations about the fields to be read 68 INTEGER :: ifpr, jj,ji,jk 69 REAL(wp),DIMENSION(:,:,:),POINTER :: udummy,vdummy,hdivdummy,rotdummy 70 REAL :: z2dt,z1_2dt 71 TYPE(FLD_N), DIMENSION(jpfld) :: slf_i ! array of namelist informations on the fields to read 72 CHARACTER(len=100) :: cn_dir ! Root directory for location of drag coefficient files 73 TYPE(FLD_N) :: sn_cdg, sn_usd, sn_vsd, sn_wn ! informations about the fields to be read 49 74 !!--------------------------------------------------------------------- 50 NAMELIST/namsbc_wave/ sn_cdg, cn_dir _cdg75 NAMELIST/namsbc_wave/ sn_cdg, cn_dir, sn_usd, sn_vsd, sn_wn 51 76 !!--------------------------------------------------------------------- 52 77 … … 62 87 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 63 88 sn_cdg = FLD_N('cdg_wave' , 1 ,'drag_coeff', .true. , .false. , 'daily' , '' , '' ) 64 cn_dir_cdg = './' ! directory in which the Patm data are 89 sn_usd = FLD_N('sdw_wave' , 1 ,'u_sd2d', .true. , .false. , 'daily' , '' , '' ) 90 sn_vsd = FLD_N('sdw_wave' , 1 ,'v_sd2d', .true. , .false. , 'daily' , '' , '' ) 91 sn_wn = FLD_N( 'sdw_wave' , 1 ,'wave_num', .true. , .false. , 'daily' , '' , '' ) 92 cn_dir = './' ! directory in which the wave data are 65 93 66 94 … … 69 97 ! 70 98 71 ALLOCATE( sf_wave(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 72 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 73 ! 74 CALL fld_fill( sf_wave, (/ sn_cdg /), cn_dir_cdg, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 75 ALLOCATE( sf_wave(1)%fnow(jpi,jpj,1) ) 76 IF( sn_cdg%ln_tint ) ALLOCATE( sf_wave(1)%fdta(jpi,jpj,1,2) ) 77 ALLOCATE( cdn_wave(jpi,jpj) ) 78 cdn_wave(:,:) = 0.0 99 IF ( ln_cdgw ) THEN 100 ALLOCATE( sf_cd(1), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 101 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 102 ! 103 ALLOCATE( sf_cd(1)%fnow(jpi,jpj,1) ) 104 IF( sn_cdg%ln_tint ) ALLOCATE( sf_cd(1)%fdta(jpi,jpj,1,2) ) 105 CALL fld_fill( sf_cd, (/ sn_cdg /), cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 106 ALLOCATE( cdn_wave(jpi,jpj) ) 107 cdn_wave(:,:) = 0.0 108 ENDIF 109 IF ( ln_sdw ) THEN 110 slf_i(jp_usd) = sn_usd ; slf_i(jp_vsd) = sn_vsd; slf_i(jp_wn) = sn_wn 111 ALLOCATE( sf_sd(3), STAT=ierror ) !* allocate and fill sf_wave with sn_cdg 112 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_wave: unable to allocate sf_wave structure' ) 113 ! 114 DO ifpr= 1, jpfld 115 ALLOCATE( sf_sd(ifpr)%fnow(jpi,jpj,1) ) 116 IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf_sd(ifpr)%fdta(jpi,jpj,1,2) ) 117 END DO 118 CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave', 'Wave module ', 'namsbc_wave' ) 119 ALLOCATE( usd2d(jpi,jpj),vsd2d(jpi,jpj),uwavenum(jpi,jpj),vwavenum(jpi,jpj) ) 120 ALLOCATE( usd3d(jpi,jpj,jpk),vsd3d(jpi,jpj,jpk),wsd3d(jpi,jpj,jpk) ) 121 usd2d(:,:) = 0.0 ; vsd2d(:,:) = 0.0 ; uwavenum(:,:) = 0.0 ; vwavenum(:,:) = 0.0 122 usd3d(:,:,:) = 0.0 ;vsd3d(:,:,:) = 0.0 ; wsd3d(:,:,:) = 0.0 123 ENDIF 79 124 ENDIF 80 125 ! 81 126 ! 82 CALL fld_read( kt, nn_fsbc, sf_wave ) !* read drag coefficient from external forcing 83 cdn_wave(:,:) = sf_wave(1)%fnow(:,:,1) 127 IF ( ln_cdgw ) THEN 128 CALL fld_read( kt, nn_fsbc, sf_cd ) !* read drag coefficient from external forcing 129 cdn_wave(:,:) = sf_cd(1)%fnow(:,:,1) 130 ENDIF 131 IF ( ln_sdw ) THEN 132 CALL fld_read( kt, nn_fsbc, sf_sd ) !* read drag coefficient from external forcing 84 133 134 ! Interpolate wavenumber, stokes drift into the grid_V and grid_V 135 !------------------------------------------------- 136 137 DO jj = 1, jpjm1 138 DO ji = 1, jpim1 139 uwavenum(ji,jj)=0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) & 140 & + sf_sd(3)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) ) 141 142 vwavenum(ji,jj)=0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(3)%fnow(ji,jj,1) * tmask(ji,jj,1) & 143 & + sf_sd(3)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) ) 144 145 usd2d(ji,jj) = 0.5 * ( 2. - umask(ji,jj,1) ) * ( sf_sd(1)%fnow(ji,jj,1) * tmask(ji,jj,1) & 146 & + sf_sd(1)%fnow(ji+1,jj,1) * tmask(ji+1,jj,1) ) 147 148 vsd2d(ji,jj) = 0.5 * ( 2. - vmask(ji,jj,1) ) * ( sf_sd(2)%fnow(ji,jj,1) * tmask(ji,jj,1) & 149 & + sf_sd(2)%fnow(ji,jj+1,1) * tmask(ji,jj+1,1) ) 150 END DO 151 END DO 152 153 !Computation of the 3d Stokes Drift 154 DO jk = 1, jpk 155 DO jj = 1, jpj-1 156 DO ji = 1, jpi-1 157 usd3d(ji,jj,jk) = usd2d(ji,jj)*exp(2.0*uwavenum(ji,jj)*(-MIN( gdept(ji,jj,jk) , gdept(ji+1,jj ,jk)))) 158 vsd3d(ji,jj,jk) = vsd2d(ji,jj)*exp(2.0*vwavenum(ji,jj)*(-MIN( gdept(ji,jj,jk) , gdept(ji ,jj+1,jk)))) 159 END DO 160 END DO 161 usd3d(jpi,:,jk) = usd2d(jpi,:)*exp( 2.0*uwavenum(jpi,:)*(-gdept(jpi,:,jk)) ) 162 vsd3d(:,jpj,jk) = vsd2d(:,jpj)*exp( 2.0*vwavenum(:,jpj)*(-gdept(:,jpj,jk)) ) 163 END DO 164 165 CALL wrk_alloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy) 166 167 udummy(:,:,:)=un(:,:,:) 168 vdummy(:,:,:)=vn(:,:,:) 169 hdivdummy(:,:,:)=hdivn(:,:,:) 170 rotdummy(:,:,:)=rotn(:,:,:) 171 un(:,:,:)=usd3d(:,:,:) 172 vn(:,:,:)=vsd3d(:,:,:) 173 CALL div_cur(kt) 174 ! !------------------------------! 175 ! ! Now Vertical Velocity ! 176 ! !------------------------------! 177 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 178 179 z1_2dt = 1.e0 / z2dt 180 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 181 ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise 182 wsd3d(:,:,jk) = wsd3d(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) & 183 & - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) & 184 & * tmask(:,:,jk) * z1_2dt 185 #if defined key_bdy 186 wsd3d(:,:,jk) = wsd3d(:,:,jk) * bdytmask(:,:) 187 #endif 188 END DO 189 hdivn(:,:,:)=hdivdummy(:,:,:) 190 rotn(:,:,:)=rotdummy(:,:,:) 191 vn(:,:,:)=vdummy(:,:,:) 192 un(:,:,:)=udummy(:,:,:) 193 CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy) 194 ENDIF 85 195 END SUBROUTINE sbc_wave 86 196
Note: See TracChangeset
for help on using the changeset viewer.
