- Timestamp:
- 2017-06-21T14:27:02+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6M_dev/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8046 r8200 207 207 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 208 208 #endif 209 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 209 !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 210 ! Hardwire only two models as nn_cplmodel has not been read in 211 ! from the namelist yet. 212 ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) ) 210 213 ! 211 214 sbc_cpl_alloc = MAXVAL( ierr ) … … 321 324 322 325 ! ! allocate sbccpl arrays 323 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )326 !IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 324 327 325 328 ! ================================ ! … … 384 387 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 385 388 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 386 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 389 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 390 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 391 srcv(jpr_otx1)%laction = .TRUE. 392 srcv(jpr_oty1)%laction = .TRUE. 393 ! 387 394 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 388 395 CASE( 'T,I' ) … … 1035 1042 INTEGER :: ji, jj, jl, jn ! dummy loop indices 1036 1043 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 1044 INTEGER :: ikchoix 1037 1045 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1038 1046 REAL(wp) :: zgreenland_icesheet_mass_in, zantarctica_icesheet_mass_in … … 1043 1051 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1044 1052 REAL(wp) :: zzx, zzy ! temporary variables 1045 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr 1053 REAL(wp), POINTER, DIMENSION(:,:) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 1046 1054 !!---------------------------------------------------------------------- 1047 1055 … … 1054 1062 IF( nn_timing == 1 ) CALL timing_start('sbc_cpl_rcv') 1055 1063 ! 1056 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1064 CALL wrk_alloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1057 1065 ! 1058 1066 IF( ln_mixcpl ) zmsk(:,:) = 1. - xcplmask(:,:,0) … … 1092 1100 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1093 1101 ! ! (geographical to local grid -> rotate the components) 1094 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1095 IF( srcv(jpr_otx2)%laction ) THEN 1096 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1097 ELSE 1098 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1102 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1103 ! Temporary code for HadGEM3 - will be removed eventually. 1104 ! Only applies when we have only taux on U grid and tauy on V grid 1105 DO jj=2,jpjm1 1106 DO ji=2,jpim1 1107 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1108 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1109 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1110 zty(ji,jj)=0.25*umask(ji,jj,1) & 1111 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1112 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1113 ENDDO 1114 ENDDO 1115 1116 ikchoix = 1 1117 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1118 CALL lbc_lnk (ztx2,'U', -1. ) 1119 CALL lbc_lnk (zty2,'V', -1. ) 1120 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1121 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1122 ELSE 1123 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1124 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1125 IF( srcv(jpr_otx2)%laction ) THEN 1126 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1127 ELSE 1128 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1129 ENDIF 1130 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1099 1131 ENDIF 1100 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid1101 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid1102 1132 ENDIF 1103 1133 ! … … 1419 1449 1420 1450 ! 1421 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr )1451 CALL wrk_dealloc( jpi,jpj, ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 ) 1422 1452 ! 1423 1453 IF( nn_timing == 1 ) CALL timing_stop('sbc_cpl_rcv') … … 2101 2131 ! 2102 2132 INTEGER :: ji, jj, jl ! dummy loop indices 2133 INTEGER :: ikchoix 2103 2134 INTEGER :: isec, info ! local integer 2104 2135 REAL(wp) :: zumax, zvmax … … 2365 2396 ! j+1 j -----V---F 2366 2397 ! surface velocity always sent from T point ! | 2367 ! 2398 ! [except for HadGEM3] j | T U 2368 2399 ! | | 2369 2400 ! j j-1 -I-------| … … 2377 2408 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2378 2409 CASE( 'oce only' ) ! C-grid ==> T 2379 DO jj = 2, jpjm1 2380 DO ji = fs_2, fs_jpim1 ! vector opt. 2381 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2382 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2410 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2411 DO jj = 2, jpjm1 2412 DO ji = fs_2, fs_jpim1 ! vector opt. 2413 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2414 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2415 END DO 2383 2416 END DO 2384 END DO 2417 ELSE 2418 ! Temporarily Changed for UKV 2419 DO jj = 2, jpjm1 2420 DO ji = 2, jpim1 2421 zotx1(ji,jj) = un(ji,jj,1) 2422 zoty1(ji,jj) = vn(ji,jj,1) 2423 END DO 2424 END DO 2425 ENDIF 2385 2426 CASE( 'weighted oce and ice' ) 2386 2427 SELECT CASE ( cp_ice_msh ) … … 2441 2482 END DO 2442 2483 CASE( 'F' ) ! Ocean on C grid, Ice on F-point (B-grid) ==> T 2443 DO jj = 2, jpjm1 2444 DO ji = 2, jpim1 ! NO vector opt. 2445 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) * zfr_l(ji,jj) & 2446 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2447 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2448 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) * zfr_l(ji,jj) & 2449 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2450 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2484 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2485 DO jj = 2, jpjm1 2486 DO ji = 2, jpim1 ! NO vector opt. 2487 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj,1) ) * zfr_l(ji,jj) & 2488 & + 0.25 * ( u_ice(ji-1,jj-1) + u_ice(ji,jj-1) & 2489 & + u_ice(ji-1,jj ) + u_ice(ji,jj ) ) * fr_i(ji,jj) 2490 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji,jj-1,1) ) * zfr_l(ji,jj) & 2491 & + 0.25 * ( v_ice(ji-1,jj-1) + v_ice(ji,jj-1) & 2492 & + v_ice(ji-1,jj ) + v_ice(ji,jj ) ) * fr_i(ji,jj) 2493 END DO 2451 2494 END DO 2452 END DO 2495 #if defined key_cice 2496 ELSE 2497 ! Temporarily Changed for HadGEM3 2498 DO jj = 2, jpjm1 2499 DO ji = 2, jpim1 ! NO vector opt. 2500 zotx1(ji,jj) = (1.0-fr_iu(ji,jj)) * un(ji,jj,1) & 2501 & + fr_iu(ji,jj) * 0.5 * ( u_ice(ji,jj-1) + u_ice(ji,jj) ) 2502 zoty1(ji,jj) = (1.0-fr_iv(ji,jj)) * vn(ji,jj,1) & 2503 & + fr_iv(ji,jj) * 0.5 * ( v_ice(ji-1,jj) + v_ice(ji,jj) ) 2504 END DO 2505 END DO 2506 #endif 2507 ENDIF 2453 2508 END SELECT 2454 2509 END SELECT … … 2460 2515 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2461 2516 ! ! Ocean component 2462 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2463 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2464 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2465 zoty1(:,:) = ztmp2(:,:) 2466 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2467 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2468 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2469 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2470 zity1(:,:) = ztmp2(:,:) 2471 ENDIF 2517 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2518 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2519 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2520 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2521 zoty1(:,:) = ztmp2(:,:) 2522 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2523 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2524 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2525 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2526 zity1(:,:) = ztmp2(:,:) 2527 ENDIF 2528 ELSE 2529 ! Temporary code for HadGEM3 - will be removed eventually. 2530 ! Only applies when we want uvel on U grid and vvel on V grid 2531 ! Rotate U and V onto geographic grid before sending. 2532 2533 DO jj=2,jpjm1 2534 DO ji=2,jpim1 2535 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2536 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2537 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2538 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2539 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2540 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2541 ENDDO 2542 ENDDO 2543 2544 ! Ensure any N fold and wrap columns are updated 2545 CALL lbc_lnk(ztmp1, 'V', -1.0) 2546 CALL lbc_lnk(ztmp2, 'U', -1.0) 2547 2548 ikchoix = -1 2549 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2550 ENDIF 2472 2551 ENDIF 2473 2552 !
Note: See TracChangeset
for help on using the changeset viewer.
