Changeset 11105 for NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg
- Timestamp:
- 2019-06-13T18:20:13+02:00 (5 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE
- Files:
-
- 8 edited
-
DIA/diawri.F90 (modified) (1 diff)
-
LBC/lib_mpp.F90 (modified) (4 diffs)
-
SBC/cpl_oasis3.F90 (modified) (5 diffs)
-
SBC/geo2ocean.F90 (modified) (2 diffs)
-
SBC/sbccpl.F90 (modified) (10 diffs)
-
SBC/sbcmod.F90 (modified) (1 diff)
-
nemogcm.F90 (modified) (6 diffs)
-
step.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/DIA/diawri.F90
r10888 r11105 935 935 ! 936 936 CALL iom_close( inum ) 937 938 IF (cdfile_name == "output.abort") THEN 939 CALL ctl_stop('STOP', 'NEMO abort from dia_wri_state') 940 END IF 941 937 942 ! 938 943 END SUBROUTINE dia_wri_state -
NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/LBC/lib_mpp.F90
r10888 r11105 896 896 897 897 SUBROUTINE mppstop( ldfinal, ld_force_abort ) 898 899 USE mod_oasis ! coupling routines 900 898 901 !!---------------------------------------------------------------------- 899 902 !! *** routine mppstop *** … … 912 915 IF( PRESENT(ld_force_abort) ) ll_force_abort = ld_force_abort 913 916 ! 917 918 #if defined key_oasis3 919 ! If we're trying to shut down cleanly then we need to consider the fact 920 ! that this could be part of an MPMD configuration - we don't want to 921 ! leave other components deadlocked. 922 923 CALL oasis_abort(nproc,"mppstop","NEMO initiated abort") 924 925 926 #else 914 927 IF(ll_force_abort) THEN 915 928 CALL mpi_abort( MPI_COMM_WORLD ) … … 920 933 IF( .NOT. llfinal ) STOP 123 921 934 ! 935 #endif 922 936 END SUBROUTINE mppstop 923 937 … … 2021 2035 ENDIF 2022 2036 CALL FLUSH( kout ) 2023 STOP 'ctl_opn bad opening'2037 CALL ctl_stop ('STOP', 'NEMO abort ctl_opn bad opening') 2024 2038 ENDIF 2025 2039 ! -
NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/SBC/cpl_oasis3.F90
r10888 r11105 42 42 PUBLIC cpl_freq 43 43 PUBLIC cpl_finalize 44 #if defined key_mpp_mpi 45 INCLUDE 'mpif.h' 46 #endif 47 48 INTEGER, PARAMETER :: localRoot = 0 49 LOGICAL :: commRank ! true for ranks doing OASIS communication 50 #if defined key_cpl_rootexchg 51 LOGICAL :: rootexchg =.true. ! logical switch 52 #else 53 LOGICAL :: rootexchg =.false. ! logical switch 54 #endif 44 55 45 56 INTEGER, PUBLIC :: OASIS_Rcv = 1 !: return code if received field … … 86 97 87 98 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: exfld ! Temporary buffer for receiving 88 99 INTEGER, PUBLIC :: localComm 100 89 101 !!---------------------------------------------------------------------- 90 102 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 124 136 IF ( nerror /= OASIS_Ok ) & 125 137 CALL oasis_abort (ncomp_id, 'cpl_init','Failure in oasis_get_localcomm' ) 138 localComm = kl_comm 126 139 ! 127 140 END SUBROUTINE cpl_init … … 442 455 WRITE(numout,*) ' - Sum value is ', SUM(pdata(:,:,jc)) 443 456 WRITE(numout,*) '****************' 457 CALL FLUSH(numout) 444 458 ENDIF 445 459 … … 511 525 CALL oasis_get_freqs(id, mop, 1, itmp, info) 512 526 #else 513 CALL oasis_get_freqs(id, 1, itmp, info) 527 ! CALL oasis_get_freqs(id, 1, itmp, info) 528 cpl_freq = namflddti( id ) 514 529 #endif 515 cpl_freq = itmp(1)516 530 ENDIF 517 531 ! -
NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/SBC/geo2ocean.F90
r10888 r11105 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_GC_couple_pkg/src/OCE/SBC/sbccpl.F90
r10888 r11105 219 219 ALLOCATE( a_i(jpi,jpj,1) , STAT=ierr(2) ) ! used in sbcice_if.F90 (done here as there is no sbc_ice_if_init) 220 220 #endif 221 ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 221 !ALLOCATE( xcplmask(jpi,jpj,0:nn_cplmodel) , STAT=ierr(3) ) 222 ! Hardwire only two models as nn_cplmodel has not been read in 223 ! from the namelist yet. 224 ALLOCATE( xcplmask(jpi,jpj,0:2) , STAT=ierr(3) ) 222 225 ! 223 226 IF( .NOT. ln_apr_dyn ) ALLOCATE( ssh_ib(jpi,jpj), ssh_ibb(jpi,jpj), apr(jpi, jpj), STAT=ierr(4) ) … … 333 336 334 337 ! ! allocate sbccpl arrays 335 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )338 !IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 336 339 337 340 ! ================================ ! … … 397 400 srcv(jpr_otx2:jpr_otz2)%clgrid = 'V' ! and V-point 398 401 srcv(jpr_itx1:jpr_itz1)%clgrid = 'F' ! ice components given at F-point 399 srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 402 !srcv(jpr_otx1:jpr_otz2)%laction = .TRUE. ! receive oce components on grid 1 & 2 403 ! Currently needed for HadGEM3 - but shouldn't affect anyone else for the moment 404 srcv(jpr_otx1)%laction = .TRUE. 405 srcv(jpr_oty1)%laction = .TRUE. 406 ! 400 407 srcv(jpr_itx1:jpr_itz1)%laction = .TRUE. ! receive ice components on grid 1 only 401 408 CASE( 'T,I' ) … … 1102 1109 LOGICAL :: llnewtx, llnewtau ! update wind stress components and module?? 1103 1110 INTEGER :: ji, jj, jn ! dummy loop indices 1104 INTEGER :: isec ! number of seconds since nit000 (assuming rdt did not change since nit000) 1111 INTEGER :: isec ! number of seconds since nit000 (assuming rdttra did not change since nit000) 1112 INTEGER :: ikchoix 1105 1113 REAL(wp) :: zcumulneg, zcumulpos ! temporary scalars 1106 1114 REAL(wp) :: zcoef ! temporary scalar … … 1108 1116 REAL(wp) :: zcdrag = 1.5e-3 ! drag coefficient 1109 1117 REAL(wp) :: zzx, zzy ! temporary variables 1110 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr 1118 REAL(wp), DIMENSION(jpi,jpj) :: ztx, zty, zmsk, zemp, zqns, zqsr, ztx2, zty2 1111 1119 !!---------------------------------------------------------------------- 1112 1120 ! … … 1147 1155 IF( TRIM( sn_rcv_tau%clvor ) == 'eastward-northward' ) THEN ! 2 components oriented along the local grid 1148 1156 ! ! (geographical to local grid -> rotate the components) 1149 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1150 IF( srcv(jpr_otx2)%laction ) THEN 1151 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1152 ELSE 1153 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1157 IF( srcv(jpr_otx1)%clgrid == 'U' .AND. (.NOT. srcv(jpr_otx2)%laction) ) THEN 1158 ! Temporary code for HadGEM3 - will be removed eventually. 1159 ! Only applies when we have only taux on U grid and tauy on V grid 1160 DO jj=2,jpjm1 1161 DO ji=2,jpim1 1162 ztx(ji,jj)=0.25*vmask(ji,jj,1) & 1163 *(frcv(jpr_otx1)%z3(ji,jj,1)+frcv(jpr_otx1)%z3(ji-1,jj,1) & 1164 +frcv(jpr_otx1)%z3(ji,jj+1,1)+frcv(jpr_otx1)%z3(ji-1,jj+1,1)) 1165 zty(ji,jj)=0.25*umask(ji,jj,1) & 1166 *(frcv(jpr_oty1)%z3(ji,jj,1)+frcv(jpr_oty1)%z3(ji+1,jj,1) & 1167 +frcv(jpr_oty1)%z3(ji,jj-1,1)+frcv(jpr_oty1)%z3(ji+1,jj-1,1)) 1168 ENDDO 1169 ENDDO 1170 1171 ikchoix = 1 1172 CALL repcmo (frcv(jpr_otx1)%z3(:,:,1),zty,ztx,frcv(jpr_oty1)%z3(:,:,1),ztx2,zty2,ikchoix) 1173 CALL lbc_lnk (ztx2,'U', -1. ) 1174 CALL lbc_lnk (zty2,'V', -1. ) 1175 frcv(jpr_otx1)%z3(:,:,1)=ztx2(:,:) 1176 frcv(jpr_oty1)%z3(:,:,1)=zty2(:,:) 1177 ELSE 1178 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->i', ztx ) 1179 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid 1180 IF( srcv(jpr_otx2)%laction ) THEN 1181 CALL rot_rep( frcv(jpr_otx2)%z3(:,:,1), frcv(jpr_oty2)%z3(:,:,1), srcv(jpr_otx2)%clgrid, 'en->j', zty ) 1182 ELSE 1183 CALL rot_rep( frcv(jpr_otx1)%z3(:,:,1), frcv(jpr_oty1)%z3(:,:,1), srcv(jpr_otx1)%clgrid, 'en->j', zty ) 1184 ENDIF 1185 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid 1154 1186 ENDIF 1155 frcv(jpr_otx1)%z3(:,:,1) = ztx(:,:) ! overwrite 1st component on the 1st grid1156 frcv(jpr_oty1)%z3(:,:,1) = zty(:,:) ! overwrite 2nd component on the 2nd grid1157 1187 ENDIF 1158 1188 ! … … 2048 2078 ! 2049 2079 INTEGER :: ji, jj, jl ! dummy loop indices 2080 INTEGER :: ikchoix 2050 2081 INTEGER :: isec, info ! local integer 2051 2082 REAL(wp) :: zumax, zvmax … … 2309 2340 ! j+1 j -----V---F 2310 2341 ! surface velocity always sent from T point ! | 2311 ! 2342 ! [except for HadGEM3] j | T U 2312 2343 ! | | 2313 2344 ! j j-1 -I-------| … … 2321 2352 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2322 2353 CASE( 'oce only' ) ! C-grid ==> T 2323 DO jj = 2, jpjm1 2324 DO ji = fs_2, fs_jpim1 ! vector opt. 2325 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2326 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2354 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2355 DO jj = 2, jpjm1 2356 DO ji = fs_2, fs_jpim1 ! vector opt. 2357 zotx1(ji,jj) = 0.5 * ( un(ji,jj,1) + un(ji-1,jj ,1) ) 2358 zoty1(ji,jj) = 0.5 * ( vn(ji,jj,1) + vn(ji ,jj-1,1) ) 2359 END DO 2327 2360 END DO 2328 END DO 2361 ELSE 2362 ! Temporarily Changed for UKV 2363 DO jj = 2, jpjm1 2364 DO ji = 2, jpim1 2365 zotx1(ji,jj) = un(ji,jj,1) 2366 zoty1(ji,jj) = vn(ji,jj,1) 2367 END DO 2368 END DO 2369 ENDIF 2329 2370 CASE( 'weighted oce and ice' ) ! Ocean and Ice on C-grid ==> T 2330 2371 DO jj = 2, jpjm1 … … 2354 2395 IF( TRIM( sn_snd_crt%clvor ) == 'eastward-northward' ) THEN ! Rotation of the components 2355 2396 ! ! Ocean component 2356 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2357 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2358 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2359 zoty1(:,:) = ztmp2(:,:) 2360 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2361 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2362 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2363 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2364 zity1(:,:) = ztmp2(:,:) 2365 ENDIF 2397 IF ( TRIM( sn_snd_crt%clvgrd ) == 'T' ) THEN 2398 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2399 CALL rot_rep( zotx1, zoty1, ssnd(jps_ocx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2400 zotx1(:,:) = ztmp1(:,:) ! overwrite the components 2401 zoty1(:,:) = ztmp2(:,:) 2402 IF( ssnd(jps_ivx1)%laction ) THEN ! Ice component 2403 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->e', ztmp1 ) ! 1st component 2404 CALL rot_rep( zitx1, zity1, ssnd(jps_ivx1)%clgrid, 'ij->n', ztmp2 ) ! 2nd component 2405 zitx1(:,:) = ztmp1(:,:) ! overwrite the components 2406 zity1(:,:) = ztmp2(:,:) 2407 ENDIF 2408 ELSE 2409 ! Temporary code for HadGEM3 - will be removed eventually. 2410 ! Only applies when we want uvel on U grid and vvel on V grid 2411 ! Rotate U and V onto geographic grid before sending. 2412 2413 DO jj=2,jpjm1 2414 DO ji=2,jpim1 2415 ztmp1(ji,jj)=0.25*vmask(ji,jj,1) & 2416 *(zotx1(ji,jj)+zotx1(ji-1,jj) & 2417 +zotx1(ji,jj+1)+zotx1(ji-1,jj+1)) 2418 ztmp2(ji,jj)=0.25*umask(ji,jj,1) & 2419 *(zoty1(ji,jj)+zoty1(ji+1,jj) & 2420 +zoty1(ji,jj-1)+zoty1(ji+1,jj-1)) 2421 ENDDO 2422 ENDDO 2423 2424 ! Ensure any N fold and wrap columns are updated 2425 CALL lbc_lnk(ztmp1, 'V', -1.0) 2426 CALL lbc_lnk(ztmp2, 'U', -1.0) 2427 2428 ikchoix = -1 2429 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2430 ENDIF 2366 2431 ENDIF 2367 2432 ! -
NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/SBC/sbcmod.F90
r10888 r11105 291 291 ! !* OASIS initialization 292 292 ! 293 IF( lk_oasis ) CALL sbc_cpl_init( nn_ice ) ! Must be done before: (1) first time step 294 ! ! (2) the use of nn_fsbc 293 IF( lk_oasis ) THEN 294 IF( sbc_cpl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' ) 295 CALL sbc_cpl_init( nn_ice ) ! Must be done before: (1) first time step 296 ! (2) the use of nn_fsbc 297 ENDIF 295 298 ! nn_fsbc initialization if OPA-SAS coupling via OASIS 296 299 ! SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly -
NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/nemogcm.F90
r10888 r11105 86 86 USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 87 87 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 88 USE sbccpl 88 89 #if defined key_iomput 89 90 USE xios ! xIOserver … … 193 194 IF ( istp == nitend ) elapsed_time = MPI_Wtime() - elapsed_time 194 195 #endif 196 IF (lk_oasis) THEN 197 CALL sbc_cpl_snd( istp ) ! Coupling to atmos 198 ENDIF 195 199 CALL stp ( istp ) 196 200 istp = istp + 1 … … 200 204 ! 201 205 DO WHILE( istp <= nitend .AND. nstop == 0 ) 202 CALL stp_diurnal( istp ) ! time step only the diurnal SST 206 CALL stp_diurnal( istp ) ! time step only the diurnal SST 203 207 istp = istp + 1 204 208 END DO … … 305 309 IF( Agrif_Root() ) THEN 306 310 IF( lk_oasis ) THEN 307 CALL cpl_init( " oceanx", ilocal_comm )! nemo local communicator given by oasis311 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 308 312 CALL xios_initialize( "not used" ,local_comm= ilocal_comm ) ! send nemo communicator to xios 309 313 ELSE … … 316 320 IF( lk_oasis ) THEN 317 321 IF( Agrif_Root() ) THEN 318 CALL cpl_init( " oceanx", ilocal_comm )! nemo local communicator given by oasis322 CALL cpl_init( "toyoce", ilocal_comm ) ! nemo local communicator given by oasis 319 323 ENDIF 320 324 ! Nodes selection (control print return in cltxt) … … 495 499 ! 496 500 IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA 501 502 IF (nstop > 0) THEN 503 CALL CTL_STOP('STOP','Critical errors in NEMO initialisation') 504 END IF 505 497 506 ! 498 507 IF( ln_timing ) CALL timing_stop( 'nemo_init') -
NEMO/branches/UKMO/NEMO_4.0_GC_couple_pkg/src/OCE/step.F90
r10888 r11105 314 314 ! Coupled mode 315 315 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 316 !!gm why lk_oasis and not lk_cpl ???? 317 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 316 !IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges 318 317 ! 319 318 #if defined key_iomput
Note: See TracChangeset
for help on using the changeset viewer.
