Changeset 13771 for NEMO/branches
- Timestamp:
- 2020-11-10T19:04:12+01:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.3_GC_couple_pkg
- Files:
-
- 7 edited
-
cfgs/SHARED/namelist_ref (modified) (1 diff)
-
src/OCE/LBC/lib_mpp.F90 (modified) (3 diffs)
-
src/OCE/SBC/cpl_oasis3.F90 (modified) (1 diff)
-
src/OCE/SBC/geo2ocean.F90 (modified) (2 diffs)
-
src/OCE/SBC/sbccpl.F90 (modified) (7 diffs)
-
src/OCE/nemogcm.F90 (modified) (5 diffs)
-
src/OCE/step.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.3_GC_couple_pkg/cfgs/SHARED/namelist_ref
r13587 r13771 335 335 sn_rcv_tauwoc = 'none' , 'no' , '' , '' , '' 336 336 sn_rcv_tauw = 'none' , 'no' , '' , '' , '' 337 sn_rcv_wdrag = 'none' , 'no' , '' , '' , ''338 337 / 339 338 !----------------------------------------------------------------------- -
NEMO/branches/UKMO/NEMO_4.0.3_GC_couple_pkg/src/OCE/LBC/lib_mpp.F90
r13587 r13771 666 666 667 667 SUBROUTINE mppstop( ld_abort ) 668 669 USE mod_oasis ! coupling routines 670 668 671 !!---------------------------------------------------------------------- 669 672 !! *** routine mppstop *** … … 679 682 IF( PRESENT(ld_abort) ) ll_abort = ld_abort 680 683 ! 684 685 #if defined key_oasis3 686 ! If we're trying to shut down cleanly then we need to consider the fact 687 ! that this could be part of an MPMD configuration - we don't want to 688 ! leave other components deadlocked. 689 690 CALL oasis_abort(nproc,"mppstop","NEMO initiated abort") 691 692 693 #else 681 694 #if defined key_mpp_mpi 682 695 IF(ll_abort) THEN … … 689 702 IF( ll_abort ) STOP 123 690 703 ! 704 #endif 691 705 END SUBROUTINE mppstop 692 706 -
NEMO/branches/UKMO/NEMO_4.0.3_GC_couple_pkg/src/OCE/SBC/cpl_oasis3.F90
r13587 r13771 448 448 WRITE(numout,*) ' - Sum value is ', SUM(pdata(nldi:nlei,nldj:nlej,jc)) 449 449 WRITE(numout,*) '****************' 450 CALL FLUSH(numout) 450 451 ENDIF 451 452 -
NEMO/branches/UKMO/NEMO_4.0.3_GC_couple_pkg/src/OCE/SBC/geo2ocean.F90
r13587 r13771 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.3_GC_couple_pkg/src/OCE/SBC/sbccpl.F90
r13587 r13771 414 414 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 415 415 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 416 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 416 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 417 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 418 srcv(jpr_otx1)%laction = .TRUE. 419 srcv(jpr_oty1)%laction = .TRUE. 420 ! 417 421 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 418 422 CASE( 'T,I' ) … … 1123 1127 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 1124 1128 INTEGER :: ji, jj, jn ! dummy loop indices 1125 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 1129 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 1130 INTEGER :: ikchoix 1126 1131 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1127 1132 REAL(wp) :: zcoef ! temporary scalar 1128 1133 REAL(wp) :: zrhoa = 1.22 ! Air density kg/m3 1129 1134 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1135 REAL(wp), DIMENSION(jpi,jpj) :: ztx2, zty2 1130 1136 REAL(wp) :: zzx, zzy ! temporary variables 1131 1137 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, zcloud_fra … … 1176 1182 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1177 1183 ! ! (geographical to local grid -> rotate the components) 1178 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1179 IF( srcv(jpr_otx2)%laction ) THEN 1180 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1181 ELSE 1182 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1184 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1185 ! Temporary code for HadGEM3 - will be removed eventually. 1186 ! Only applies when we have only taux on U grid and tauy on V grid 1187 DO jj=2,jpjm1 1188 DO ji=2,jpim1 1189 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1190 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1191 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1192 zty(ji,jj)=0.25*umask(ji,jj,1) & 1193 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1194 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1195 ENDDO 1196 ENDDO 1197 1198 ikchoix = 1 1199 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1200 CALL lbc_lnk ('jpr_otx1', ztx2,'U', -1. ) 1201 CALL lbc_lnk ('jpr_oty1', zty2,'V', -1. ) 1202 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1203 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1204 ELSE 1205 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1206 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1207 IF( srcv(jpr_otx2)%laction ) THEN 1208 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1209 ELSE 1210 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1211 ENDIF 1212 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1183 1213 ENDIF 1184 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid1185 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid1186 1214 ENDIF 1187 1215 ! … … 2176 2204 ! 2177 2205 INTEGER :: ji, jj, jl ! dummy loop indices 2206 INTEGER :: ikchoix 2178 2207 INTEGER :: isec, info ! local integer 2179 2208 REAL(wp) :: zumax, zvmax … … 2452 2481 ! j+1 j -----V---F 2453 2482 ! surface velocity always sent from T point ! | 2454 ! 2483 ! [except for HadGEM3] j | T U 2455 2484 ! | | 2456 2485 ! j j-1 -I-------| … … 2464 2493 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2465 2494 CASE( 'oce only' ) ! C-grid ==> T 2466 DO jj = 2, jpjm1 2467 DO ji = fs_2, fs_jpim1 ! vector opt. 2468 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2469 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 2470 2501 END DO 2471 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 2472 2511 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2473 2512 DO jj = 2, jpjm1 … … 2497 2536 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2498 2537 ! ! Ocean component 2499 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2500 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2501 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2502 zoty1(:,:) = ztmp2(:,:) 2503 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2504 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2505 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2506 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2507 zity1(:,:) = ztmp2(:,:) 2508 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 2509 2572 ENDIF 2510 2573 ! -
NEMO/branches/UKMO/NEMO_4.0.3_GC_couple_pkg/src/OCE/nemogcm.F90
r13587 r13771 87 87 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 88 88 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 89 USE sbccpl 89 90 #if defined key_iomput 90 91 USE xios ! xIOserver … … 192 193 ENDIF 193 194 195 IF (lk_oasis) THEN 196 CALL sbc_cpl_snd( istp ) ! Coupling to atmos 197 ENDIF 194 198 CALL stp ( istp ) 195 199 istp = istp + 1 … … 280 284 IF( Agrif_Root() ) THEN 281 285 IF( lk_oasis ) THEN 282 CALL cpl_init( " oceanx", ilocal_comm )! nemo local communicator given by oasis286 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 283 287 CALL xios_initialize( "not used" , local_comm =ilocal_comm ) ! send nemo communicator to xios 284 288 ELSE … … 290 294 IF( lk_oasis ) THEN 291 295 IF( Agrif_Root() ) THEN 292 CALL cpl_init( " oceanx", ilocal_comm )! nemo local communicator given by oasis296 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 293 297 ENDIF 294 298 CALL mpp_start( ilocal_comm ) … … 499 503 ! 500 504 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 505 506 IF (nstop > 0) THEN 507 CALL CTL_STOP('STOP','Critical errors in NEMO initialisation') 508 END IF 509 501 510 ! 502 511 IF( ln_timing ) CALL timing_stop( 'nemo_init') -
NEMO/branches/UKMO/NEMO_4.0.3_GC_couple_pkg/src/OCE/step.F90
r13587 r13771 311 311 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 312 312 !!gm why lk_oasis and not lk_cpl ???? 313 IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges313 ! IF( lk_oasis .AND. nstop == 0 ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 314 314 ! 315 315 #if defined key_iomput
Note: See TracChangeset
for help on using the changeset viewer.
