Changeset 12803 for NEMO/branches/UKMO/r4.0-HEAD_r12713_dan_test_clems_branch/src/OCE/SBC/sbccpl.F90
- Timestamp:
- 2020-04-23T10:57:49+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/r4.0-HEAD_r12713_dan_test_clems_branch/src/OCE/SBC/sbccpl.F90
r12801 r12803 412 412 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 413 413 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 414 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 414 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 415 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 416 srcv(jpr_otx1)%laction = .TRUE. 417 srcv(jpr_oty1)%laction = .TRUE. 418 ! 415 419 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 416 420 CASE( 'T,I' ) … … 1121 1125 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 1122 1126 INTEGER :: ji, jj, jn ! dummy loop indices 1123 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 1127 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 1128 INTEGER :: ikchoix 1124 1129 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1125 1130 REAL(wp) :: zcoef ! temporary scalar … … 1127 1132 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1128 1133 REAL(wp) :: zzx, zzy ! temporary variables 1129 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1134 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 1130 1135 !!---------------------------------------------------------------------- 1131 1136 ! … … 1174 1179 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1175 1180 ! ! (geographical to local grid -> rotate the components) 1176 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1177 IF( srcv(jpr_otx2)%laction ) THEN 1178 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1179 ELSE 1180 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1181 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1182 ! Temporary code for HadGEM3 - will be removed eventually. 1183 ! Only applies when we have only taux on U grid and tauy on V grid 1184 DO jj=2,jpjm1 1185 DO ji=2,jpim1 1186 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1187 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1188 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1189 zty(ji,jj)=0.25*umask(ji,jj,1) & 1190 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1191 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1192 ENDDO 1193 ENDDO 1194 1195 ikchoix = 1 1196 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1197 CALL lbc_lnk ('jpr_otx1', ztx2,'U', -1. ) 1198 CALL lbc_lnk ('jpr_oty1', zty2,'V', -1. ) 1199 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1200 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1201 ELSE 1202 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1203 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1204 IF( srcv(jpr_otx2)%laction ) THEN 1205 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1206 ELSE 1207 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1208 ENDIF 1209 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1181 1210 ENDIF 1182 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid1183 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid1184 1211 ENDIF 1185 1212 ! … … 2177 2204 ! 2178 2205 INTEGER :: ji, jj, jl ! dummy loop indices 2206 INTEGER :: ikchoix 2179 2207 INTEGER :: isec, info ! local integer 2180 2208 REAL(wp) :: zumax, zvmax … … 2453 2481 ! j+1 j -----V---F 2454 2482 ! surface velocity always sent from T point ! | 2455 ! 2483 ! [except for HadGEM3] j | T U 2456 2484 ! | | 2457 2485 ! j j-1 -I-------| … … 2465 2493 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2466 2494 CASE( 'oce only' ) ! C-grid ==> T 2467 DO jj = 2, jpjm1 2468 DO ji = fs_2, fs_jpim1 ! vector opt. 2469 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2470 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2495 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2496 DO jj = 2, jpjm1 2497 DO ji = fs_2, fs_jpim1 ! vector opt. 2498 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2499 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2500 END DO 2471 2501 END DO 2472 END DO 2502 ELSE 2503 ! Temporarily Changed for UKV 2504 DO jj = 2, jpjm1 2505 DO ji = 2, jpim1 2506 zotx1(ji,jj) = un(ji,jj,1) 2507 zoty1(ji,jj) = vn(ji,jj,1) 2508 END DO 2509 END DO 2510 ENDIF 2473 2511 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2474 2512 DO jj = 2, jpjm1 … … 2498 2536 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2499 2537 ! ! Ocean component 2500 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2501 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2502 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2503 zoty1(:,:) = ztmp2(:,:) 2504 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2505 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2506 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2507 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2508 zity1(:,:) = ztmp2(:,:) 2509 ENDIF 2538 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2539 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2540 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2541 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2542 zoty1(:,:) = ztmp2(:,:) 2543 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2544 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2545 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2546 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2547 zity1(:,:) = ztmp2(:,:) 2548 ENDIF 2549 ELSE 2550 ! Temporary code for HadGEM3 - will be removed eventually. 2551 ! Only applies when we want uvel on U grid and vvel on V grid 2552 ! Rotate U and V onto geographic grid before sending. 2553 2554 DO jj=2,jpjm1 2555 DO ji=2,jpim1 2556 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2557 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2558 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2559 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2560 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2561 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2562 ENDDO 2563 ENDDO 2564 2565 ! Ensure any N fold and wrap columns are updated 2566 CALL lbc_lnk('zotx1', ztmp1, 'V', -1.0) 2567 CALL lbc_lnk('zoty1', ztmp2, 'U', -1.0) 2568 2569 ikchoix = -1 2570 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2571 ENDIF 2510 2572 ENDIF 2511 2573 !
Note: See TracChangeset
for help on using the changeset viewer.