- Timestamp:
- 2022-01-19T19:42:26+01:00 (2 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC
- Files:
-
- 3 edited
-
cpl_oasis3.F90 (modified) (9 diffs)
-
geo2ocean.F90 (modified) (2 diffs)
-
sbccpl.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/cpl_oasis3.F90
r14075 r15661 69 69 INTEGER, PUBLIC, PARAMETER :: nmaxcat=5 ! Maximum number of coupling fields 70 70 INTEGER, PUBLIC, PARAMETER :: nmaxcpl=5 ! Maximum number of coupling fields 71 LOGICAL, PARAMETER :: ltmp_wapatch = .TRUE. ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 71 LOGICAL, PARAMETER :: ltmp_wapatch = .FALSE. ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 72 LOGICAL, PARAMETER :: ltmp_landproc = .TRUE. ! patch to restrict coupled area to non halo cells 72 73 INTEGER :: nldi_save, nlei_save 73 74 INTEGER :: nldj_save, nlej_save … … 157 158 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 158 159 ENDIF 160 161 ! patch to restrict coupled area to non halo cells 162 IF ( ltmp_landproc ) THEN 163 nldi_save = nldi ; nlei_save = nlei 164 nldj_save = nldj ; nlej_save = nlej 165 IF( nimpp == 1 ) nldi = 1 166 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 167 IF( nowe == -1 ) nldi = nldi + 1 168 IF( noea == -1 ) nlei = nlei - 1 169 IF( noso == -1 ) nldj = nldj + 1 170 IF( nono == -1 ) nlej = nlej - 1 171 ENDIF 172 159 173 IF(lwp) WRITE(numout,*) 160 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 174 IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case', nldi 161 175 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~' 162 176 IF(lwp) WRITE(numout,*) … … 316 330 #endif 317 331 ! 318 IF ( ltmp_wapatch ) THEN332 IF ( ltmp_wapatch .OR. ltmp_landproc ) THEN 319 333 nldi = nldi_save ; nlei = nlei_save 320 334 nldj = nldj_save ; nlej = nlej_save … … 346 360 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 347 361 ENDIF 362 IF ( ltmp_landproc ) THEN 363 nldi_save = nldi ; nlei_save = nlei 364 nldj_save = nldj ; nlej_save = nlej 365 IF( nimpp == 1 ) nldi = 1 366 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 367 IF( nowe == -1 ) nldi = nldi + 1 368 IF( noea == -1 ) nlei = nlei - 1 369 IF( noso == -1 ) nldj = nldj + 1 370 IF( nono == -1 ) nlej = nlej - 1 371 ENDIF 348 372 ! 349 373 ! snd data to OASIS3 … … 374 398 ENDDO 375 399 ENDDO 376 IF ( ltmp_wapatch ) THEN400 IF ( ltmp_wapatch .OR. ltmp_landproc ) THEN 377 401 nldi = nldi_save ; nlei = nlei_save 378 402 nldj = nldj_save ; nlej = nlej_save … … 399 423 !!-------------------------------------------------------------------- 400 424 ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 401 IF ( ltmp_wapatch ) THEN425 IF ( ltmp_wapatch .OR. ltmp_landproc ) THEN 402 426 nldi_save = nldi ; nlei_save = nlei 403 427 nldj_save = nldj ; nlej_save = nlej … … 414 438 IF( njmpp == 1 ) nldj = 1 415 439 IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 416 ENDIF 440 ENDIF 441 IF ( ltmp_landproc ) THEN 442 IF( nimpp == 1 ) nldi = 1 443 IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 444 IF( nowe == -1 ) nldi = nldi + 1 445 IF( noea == -1 ) nlei = nlei - 1 446 IF( noso == -1 ) nldj = nldj + 1 447 IF( nono == -1 ) nlej = nlej - 1 448 ENDIF 449 417 450 llfisrt = .TRUE. 418 451 … … 448 481 WRITE(numout,*) ' - Sum value is ', SUM(pdata(nldi:nlei,nldj:nlej,jc)) 449 482 WRITE(numout,*) '****************' 483 CALL FLUSH(numout) 450 484 ENDIF 451 485 … … 456 490 ENDDO 457 491 458 IF ( ltmp_wapatch ) THEN492 IF ( ltmp_wapatch .OR. ltmp_landproc ) THEN 459 493 nldi = nldi_save ; nlei = nlei_save 460 494 nldj = nldj_save ; nlej = nlej_save -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/geo2ocean.F90
r14075 r15661 26 26 PRIVATE 27 27 28 PUBLIC repcmo ! called in sbccpl 28 29 PUBLIC rot_rep ! called in sbccpl, fldread, and cyclone 29 30 PUBLIC geo2oce ! called in sbccpl … … 50 51 !!---------------------------------------------------------------------- 51 52 CONTAINS 53 54 SUBROUTINE repcmo ( pxu1, pyu1, pxv1, pyv1, & 55 px2 , py2 , kchoix ) 56 !!---------------------------------------------------------------------- 57 !! *** ROUTINE repcmo *** 58 !! 59 !! ** Purpose : Change vector componantes from a geographic grid to a 60 !! stretched coordinates grid. 61 !! 62 !! ** Method : Initialization of arrays at the first call. 63 !! 64 !! ** Action : - px2 : first componante (defined at u point) 65 !! - py2 : second componante (defined at v point) 66 !!---------------------------------------------------------------------- 67 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxu1, pyu1 ! geographic vector componantes at u-point 68 REAL(wp), INTENT(in ), DIMENSION(jpi,jpj) :: pxv1, pyv1 ! geographic vector componantes at v-point 69 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: px2 ! i-componante (defined at u-point) 70 REAL(wp), INTENT( out), DIMENSION(jpi,jpj) :: py2 ! j-componante (defined at v-point) 71 !!---------------------------------------------------------------------- 72 INTEGER, INTENT( IN ) :: & 73 kchoix ! type of transformation 74 ! = 1 change from geographic to model grid. 75 ! =-1 change from model to geographic grid 76 !!---------------------------------------------------------------------- 77 78 SELECT CASE (kchoix) 79 CASE ( 1) 80 ! Change from geographic to stretched coordinate 81 ! ---------------------------------------------- 82 83 CALL rot_rep( pxu1, pyu1, 'U', 'en->i',px2 ) 84 CALL rot_rep( pxv1, pyv1, 'V', 'en->j',py2 ) 85 CASE (-1) 86 ! Change from stretched to geographic coordinate 87 ! ---------------------------------------------- 88 89 CALL rot_rep( pxu1, pyu1, 'U', 'ij->e',px2 ) 90 CALL rot_rep( pxv1, pyv1, 'V', 'ij->n',py2 ) 91 END SELECT 92 93 END SUBROUTINE repcmo 52 94 53 95 SUBROUTINE rot_rep ( pxin, pyin, cd_type, cdtodo, prot ) -
NEMO/branches/UKMO/NEMO_4.0.4_GO8_paquage_branch/src/OCE/SBC/sbccpl.F90
r14075 r15661 420 420 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 421 421 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 422 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 422 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 423 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 424 srcv(jpr_otx1)%laction = .TRUE. 425 srcv(jpr_oty1)%laction = .TRUE. 426 ! 423 427 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 424 428 CASE( 'T,I' ) … … 1129 1133 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 1130 1134 INTEGER :: ji, jj, jn ! dummy loop indices 1131 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 1135 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 1136 INTEGER :: ikchoix 1137 REAL(wp), DIMENSION(jpi,jpj) :: ztx2, zty2 1132 1138 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1133 1139 REAL(wp) :: zcoef ! temporary scalar … … 1182 1188 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1183 1189 ! ! (geographical to local grid -> rotate the components) 1184 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1185 IF( srcv(jpr_otx2)%laction ) THEN 1186 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1187 ELSE 1188 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1190 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1191 ! Temporary code for HadGEM3 - will be removed eventually. 1192 ! Only applies when we have only taux on U grid and tauy on V grid 1193 DO jj=2,jpjm1 1194 DO ji=2,jpim1 1195 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1196 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1197 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1198 zty(ji,jj)=0.25*umask(ji,jj,1) & 1199 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1200 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1201 ENDDO 1202 ENDDO 1203 1204 ikchoix = 1 1205 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1206 CALL lbc_lnk ('jpr_otx1', ztx2,'U', -1. ) 1207 CALL lbc_lnk ('jpr_oty1', zty2,'V', -1. ) 1208 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1209 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1210 ELSE 1211 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1212 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1213 IF( srcv(jpr_otx2)%laction ) THEN 1214 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1215 ELSE 1216 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1217 ENDIF 1218 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1189 1219 ENDIF 1190 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid1191 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid1192 1220 ENDIF 1193 1221 ! … … 2182 2210 ! 2183 2211 INTEGER :: ji, jj, jl ! dummy loop indices 2212 INTEGER :: ikchoix 2184 2213 INTEGER :: isec, info ! local integer 2185 2214 REAL(wp) :: zumax, zvmax … … 2459 2488 ! j+1 j -----V---F 2460 2489 ! surface velocity always sent from T point ! | 2461 ! 2490 ! [except for HadGEM3] j | T U 2462 2491 ! | | 2463 2492 ! j j-1 -I-------| … … 2471 2500 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2472 2501 CASE( 'oce only' ) ! C-grid ==> T 2473 DO jj = 2, jpjm1 2474 DO ji = fs_2, fs_jpim1 ! vector opt. 2475 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2476 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2502 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2503 DO jj = 2, jpjm1 2504 DO ji = fs_2, fs_jpim1 ! vector opt. 2505 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2506 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2507 END DO 2477 2508 END DO 2478 END DO 2509 ELSE 2510 ! Temporarily Changed for UKV 2511 DO jj = 2, jpjm1 2512 DO ji = 2, jpim1 2513 zotx1(ji,jj) = un(ji,jj,1) 2514 zoty1(ji,jj) = vn(ji,jj,1) 2515 END DO 2516 END DO 2517 ENDIF 2479 2518 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2480 2519 DO jj = 2, jpjm1 … … 2504 2543 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2505 2544 ! ! Ocean component 2506 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2507 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2508 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2509 zoty1(:,:) = ztmp2(:,:) 2510 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2511 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2512 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2513 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2514 zity1(:,:) = ztmp2(:,:) 2515 ENDIF 2545 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2546 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2547 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2548 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2549 zoty1(:,:) = ztmp2(:,:) 2550 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2551 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2552 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2553 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2554 zity1(:,:) = ztmp2(:,:) 2555 ENDIF 2556 ELSE 2557 ! Temporary code for HadGEM3 - will be removed eventually. 2558 ! Only applies when we want uvel on U grid and vvel on V grid 2559 ! Rotate U and V onto geographic grid before sending. 2560 2561 DO jj=2,jpjm1 2562 DO ji=2,jpim1 2563 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2564 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2565 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2566 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2567 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2568 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2569 ENDDO 2570 ENDDO 2571 2572 ! Ensure any N fold and wrap columns are updated 2573 CALL lbc_lnk('zotx1', ztmp1, 'V', -1.0) 2574 CALL lbc_lnk('zoty1', ztmp2, 'U', -1.0) 2575 2576 ikchoix = -1 2577 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2578 ENDIF 2516 2579 ENDIF 2517 2580 !
Note: See TracChangeset
for help on using the changeset viewer.
